diff --git a/doc/Analyzing.markdown b/doc/Analyzing.markdown index 926706f..14d4afc 100644 --- a/doc/Analyzing.markdown +++ b/doc/Analyzing.markdown @@ -14,7 +14,7 @@ routine. | lda #4 | sta score | } - = main + = main ([]) = A: UpdatedWith (Immediate 4) = NamedLocation (Just Byte) "score": UpdatedWith A @@ -50,13 +50,13 @@ But if it does it can. | jsr update_score | sta border_colour | } - = main + = main ([]) = A: UpdatedWith (Immediate 4) = X: PoisonedWith (Immediate 1) = NamedLocation (Just Byte) "border_colour": UpdatedWith A = NamedLocation (Just Byte) "score": PoisonedWith X = - = update_score + = update_score ([]) = X: UpdatedWith (Immediate 1) = NamedLocation (Just Byte) "score": UpdatedWith X @@ -90,12 +90,11 @@ modifying score, as an "output" of the routine. | jsr update_score | ldx score | } - = main - = A: UpdatedWith (Immediate 4) - = X: PoisonedWith (Immediate 1) - = NamedLocation (Just Byte) "border_colour": UpdatedWith A - = NamedLocation (Just Byte) "score": PoisonedWith X + = main ([]) + = A: PoisonedWith (Immediate 8) + = X: UpdatedWith (NamedLocation (Just Byte) "score") + = NamedLocation (Just Byte) "score": UpdatedWith A = - = update_score - = X: UpdatedWith (Immediate 1) - = NamedLocation (Just Byte) "score": UpdatedWith X + = update_score ([NamedLocation Nothing "score"]) + = A: UpdatedWith (Immediate 8) + = NamedLocation (Just Byte) "score": UpdatedWith A diff --git a/src/Main.hs b/src/Main.hs index 0355cec..2c4466d 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -34,7 +34,7 @@ main = do ("analyze", Right program) -> case checkAndTransformProgram program of Just newprog -> - ppAnalysis $ analyzeProgram newprog + ppAnalysis newprog (analyzeProgram newprog) ("emit", Right program) -> case checkAndTransformProgram program of Just newprog -> diff --git a/src/SixtyPical/Analyzer.hs b/src/SixtyPical/Analyzer.hs index 9a6cbc1..58ecc71 100644 --- a/src/SixtyPical/Analyzer.hs +++ b/src/SixtyPical/Analyzer.hs @@ -81,6 +81,15 @@ mergeRoutCtxs routCtx calledRoutCtx calledRout@(Routine name outputs _) = poison location usage routCtxAccum = case usage of UpdatedWith ulocation -> - Map.insert location (PoisonedWith ulocation) routCtxAccum + case (untypedLocation location) `elem` outputs of + True -> + Map.insert location usage routCtxAccum + False -> + Map.insert location (PoisonedWith ulocation) routCtxAccum in Map.foldrWithKey (poison) routCtx calledRoutCtx + +untypedLocation (NamedLocation (Just _) name) = + NamedLocation Nothing name +untypedLocation x = x + diff --git a/src/SixtyPical/Context.hs b/src/SixtyPical/Context.hs index c21183a..fab7078 100644 --- a/src/SixtyPical/Context.hs +++ b/src/SixtyPical/Context.hs @@ -26,19 +26,22 @@ type RoutineContext = Map.Map StorageLocation Usage type ProgramContext = Map.Map RoutineName RoutineContext -ppAnalysis :: ProgramContext -> IO () -ppAnalysis progCtx = +ppAnalysis :: Program -> ProgramContext -> IO () +ppAnalysis program progCtx = let li = Map.toList progCtx in do - ppRoutines li + ppRoutines program li -ppRoutines [] = return () -ppRoutines ((name, routCtx):rest) = do - putStrLn $ name - ppRoutine routCtx - putStrLn "" - ppRoutines rest +ppRoutines program [] = return () +ppRoutines program ((name, routCtx):rest) = + let + Just (Routine rname outputs _) = lookupRoutine program name + in do + putStrLn (rname ++ " (" ++ (show outputs) ++ ")") + ppRoutine routCtx + putStrLn "" + ppRoutines program rest ppRoutine routCtx = let