ES Alt: EffectTracking now handles named alternatives

grin-compiler · Nov 30, 2019 · 75c8ff3 · 75c8ff3
1 parent 2c4dece
commit 75c8ff3
Show file tree

Hide file tree

Showing 3 changed files with 20 additions and 13 deletions.
diff --git a/grin/src/AbstractInterpretation/ExtendedSyntax/EffectTracking/CodeGen.hs b/grin/src/AbstractInterpretation/ExtendedSyntax/EffectTracking/CodeGen.hs
@@ -75,15 +75,22 @@ codeGenM = cata folder where
     ECaseF val alts_ -> do
       caseResultReg <- newReg
       altRegs <- sequence alts_
-      forM altRegs $ \(R altReg) ->
-        emit IR.Move { srcReg = altReg, dstReg = caseResultReg }
+      forM altRegs $ \(A _ altNameReg altM) -> do
+        altResult <- altM
+        case altResult of
+          R altResultReg -> do
+            -- NOTE: Propagate the effect info back to both the case result register and the alternative's register as well
+            emit IR.Move { srcReg = altResultReg, dstReg = caseResultReg }
+            emit IR.Move { srcReg = altResultReg, dstReg = altNameReg }
+          -- TODO: maybe put altName into "A" as well?
+          _ -> error $ "Effect tracking: a case alternative did not return a register. Scrutinee was: " ++ show (PP val)
       pure $ R caseResultReg
 
     -- NOTE: Currently, the names of the alternatives are ignored by the analysis.
-    AltF _ n exp -> do
+    AltF cpat n exp -> do
       altNameReg <- newReg
       addReg n altNameReg
-      exp
+      pure $ A cpat altNameReg exp
 
     SAppF name args -> getExternal name >>= \case
       Just ext  -> do

diff --git a/grin/src/AbstractInterpretation/ExtendedSyntax/EffectTracking/CodeGenBase.hs b/grin/src/AbstractInterpretation/ExtendedSyntax/EffectTracking/CodeGenBase.hs
@@ -76,7 +76,7 @@ type CG = State CGState
 data Result
   = R IR.Reg
   | Z
-  | A CPat (CG Result)
+  | A CPat IR.Reg (CG Result)
 
 emit :: IR.Instruction -> CG ()
 emit inst = modify' $ \s@CGState{..} -> s {_sInstructions = inst : _sInstructions}

diff --git a/grin/test/AbstractInterpretation/ExtendedSyntax/EffectTrackingSpec.hs b/grin/test/AbstractInterpretation/ExtendedSyntax/EffectTrackingSpec.hs
@@ -144,8 +144,8 @@ spec = describe "Effect Tracking Analysis" $ do
                         , ("y", Effects ["_prim_int_print", "_prim_string_print"])
                         , ("n", Effects [])
 
-                        , ("_1", Effects [])
-                        , ("_2", Effects [])
+                        , ("_1", Effects ["_prim_int_print"])
+                        , ("_2", Effects ["_prim_string_print"])
                         , ("_3", Effects [])
                         ]
           , _function = [ ("grinMain", Effects ["_prim_int_print", "_prim_string_print"]) ]
@@ -177,8 +177,8 @@ spec = describe "Effect Tracking Analysis" $ do
                         , ("y", Effects ["_prim_int_print", "_prim_string_print"])
                         , ("n", Effects [])
 
-                        , ("_1", Effects [])
-                        , ("_2", Effects [])
+                        , ("_1", Effects ["_prim_int_print"])
+                        , ("_2", Effects ["_prim_string_print"])
                         , ("_3", Effects [])
                         ]
           , _function = [ ("f",  Effects ["_prim_int_print"])
@@ -218,10 +218,10 @@ spec = describe "Effect Tracking Analysis" $ do
                         , ("z", Effects ["_prim_int_print", "_prim_error"])
                         , ("n", Effects [])
 
-                        , ("_1",  Effects [])
-                        , ("_11", Effects [])
-                        , ("_12", Effects [])
-                        , ("_2",  Effects [])
+                        , ("_1",  Effects ["_prim_int_print", "_prim_error"])
+                        , ("_11", Effects ["_prim_int_print"])
+                        , ("_12", Effects ["_prim_error"])
+                        , ("_2",  Effects ["_prim_string_print"])
                         , ("_3",  Effects [])
                         ]
           , _function = [ ("grinMain", Effects ["_prim_int_print", "_prim_string_print", "_prim_error"]) ]