Merge pull request #59 from grin-compiler/32-conversion-fix

Extended syntax: syntax conversion fix

Author: Anabra

grin/src/Transformations/ExtendedSyntax/Conversion.hs

@@ -125,16 +125,40 @@ instance Convertible Exp New.Exp where
   convert exp = fst $ evalNameM exp $ flip anaM exp $ \case
     (Program exts defs)  -> pure $ New.ProgramF (map convert exts) defs
     (Def name args body) -> pure $ New.DefF (convert name) (map convert args) body
-    {- NOTE: we assume Binding Pattern Simplification has been run
+
+    {- NOTE: We assume Binding Pattern Simplification has been run,
+       and the value has been given the name v.0. This is a special
+       case of the next program patterns. This one transforms the result
+       of Binding Pattern Simplification to a more concise form.
+
       v.0 <- pure <value>
       <non-var pat> <- pure v.0
       <rhs2>
+
+      <non-var pat> @ v.0 <- pure <value>
+      <rhs2>
     -}
     (EBind lhs1 (Var var) rhs1)
       | EBind (SReturn (Var var')) pat rhs2 <- rhs1
       , isn't _Var pat
       , var == var'
       -> pure $ New.EBindF lhs1 (New.AsPat (convert var) (convert pat)) rhs2
+    {- NOTE: In this case, v.0 has been defined earlier in the program.
+       This is a more general case that covers the one before as well.
+
+      v.0 <- pure <value>
+      <...>
+      <non-var pat> <- pure v.0
+      <rhs>
+
+      v.0 <- pure <value>
+      <...>
+      <non-var pat> @ a.0 <- pure v.0
+      <rhs>
+    -}
+    (EBind lhs pat rhs) | isn't _Var pat -> do
+      asPatName <- deriveNewName "a"
+      pure $ New.EBindF lhs (New.AsPat (convert asPatName) (convert pat)) rhs
     (EBind lhs (Var var) rhs)
       -> pure $ New.EBindF lhs (New.VarPat $ convert var) rhs
     (ECase scrut alts)
@@ -158,6 +182,7 @@ instance Convertible Exp New.Exp where
     (Alt cpat exp) -> do
       altName <- deriveNewName "alt"
       pure $ New.NAltF (convert cpat) (convert altName) exp
+    _ -> error "Conversion from Old to New has failed: unexpected AST pattern"
 
 instance Convertible New.TagType TagType where
   convert = \case
@@ -257,10 +282,10 @@ instance Convertible New.Exp Exp where
 convertToNew :: Exp -> New.Exp
 convertToNew = convert . nameEverything
 
--- TODO: modify CopyPropagation such that it removes resulting dead bindings (see CopyPropagation.hs)
 nameEverything :: Exp -> Exp
 nameEverything
-  = bindNormalisation
+  = copyPropagation
+  . bindNormalisation
   . nodeArgumentNaming
   . bindNormalisation
   . appArgumentNaming

grin/src/Transformations/Optimising/CopyPropagation.hs

@@ -15,12 +15,6 @@ import Transformations.Util
   NOTE:
     Do not propagate literal values because literals are not used for optimisations. (GRIN is not a supercompiler)
     Only propagates variables. It does not cause performance penalty, LLVM will optimise the code further.
-
-  TODO:
-    CUrrently, copy propagation does not remove the resulting dead bindings, SDVE does. However, SDVE needs interprocedural
-    information such as the type env (this can be removed) and the effect map. Maybe copy propagation should remove
-    the binding for which it already substituted the variable.
-
 -}
 
 type Env = (Map Val Val, Map Name Name)
@@ -69,5 +63,15 @@ copyPropagation e = hylo folder builder (mempty, e) where
       | val == lpat
       , isConstant val
       -> rightExp
+    -- left unit law ; cleanup x <- pure y copies
+    {- NOTE: This case could be handled by SDVE as well, however
+       performing it locally saves us an effect tracking analysis.
+       This is because here, we have more information about variable
+       bidnings. We know for sure that such copying bindings are not needed
+       since all the occurences of the left-hand side have been replaced with
+       the variable on the right-hand side.
+    -}
+    EBindF (SReturn Var{}) Var{} rightExp
+      -> rightExp
 
     exp -> embed exp

grin/src/Transformations/Simplifying/BindingPatternSimplification.hs

@@ -22,6 +22,11 @@ bindingPatternSimplification e = evalNameM e . cataM alg $ e where
   alg :: ExpF Exp -> NameM Exp
   alg = \case
 
+    -- NOTE: <pat> <- pure <var>
+    -- The above pattern does not need to be simplified.
+    EBindF lhs@(SReturn Var{}) pat rhs ->
+      pure $ EBind lhs pat rhs
+
     -- NOTE: binding to Unit?
     EBindF lhs pat rhs | isn't _ValVar pat -> do
       newVar <- fmap Var newNodeName

grin/test/Transformations/Optimising/CopyPropagationSpec.hs

@@ -25,8 +25,6 @@ spec = do
         |]
       let after = [expr|
           a1 <- pure 1
-          a2 <- pure a1
-          a3 <- pure a1
           pure a1
         |]
       copyPropagation (ctx before) `sameAs` (ctx after)
@@ -41,8 +39,6 @@ spec = do
         |]
       let after = [expr|
           a1 <- pure 1
-          a2 <- pure a1
-          a3 <- pure a1
           case a1 of
             #default -> pure a1
         |]
@@ -61,11 +57,7 @@ spec = do
       let after = [expr|
           a1 <- pure 1
           n1 <- pure (CNode a1 0)
-          n2 <- pure n1
-          a2 <- pure a1
           b1 <- pure 0
-          b2 <- pure b1
-          a3 <- pure a1
           pure (CNode a1 b1)
         |]
       copyPropagation (ctx before) `sameAs` (ctx after)
@@ -84,7 +76,6 @@ spec = do
           a1 <- pure 1
           b1 <- pure 0
           n1 <- pure (CNode a1 b1)
-          a2 <- pure a1
           n2 <- pure (CNode a1 b1)
           case n2 of
             #default -> pure n2
@@ -119,7 +110,6 @@ spec = do
         |]
       let after = [expr|
           a1 <- pure 1
-          a2 <- pure a1
           0 <- pure 1
           pure a1
         |]