Merge f8186b3 into c503a24

grin/src/AbstractInterpretation/ExtendedSyntax/CreatedBy/CodeGen.hs

@@ -337,7 +337,10 @@ codeGen e = flip evalState emptyCGState $ para folder e >> mkCByProgramM where
     -}
     AltF cpat (_, cgAlt) -> pure $ A cpat cgAlt
     -- NOTE: Currently, the names of the alternatives are ignored by the analysis.
-    NAltF cpat n (_, cgAlt) -> pure $ A cpat cgAlt
+    NAltF cpat n (_, cgAlt) -> do
+      altNameReg <- newReg
+      addReg n altNameReg
+      pure $ A cpat cgAlt
 
     SAppF name args -> getExternal name >>= \case
       Just ext  -> do

grin/src/AbstractInterpretation/ExtendedSyntax/EffectTracking/CodeGen.hs

@@ -81,7 +81,10 @@ codeGenM = cata folder where
 
     AltF _ exp -> exp
     -- NOTE: Currently, the names of the alternatives are ignored by the analysis.
-    NAltF _ _ exp -> exp
+    NAltF _ n exp -> do
+      altNameReg <- newReg
+      addReg n altNameReg
+      exp
 
     SAppF name args -> getExternal name >>= \case
       Just ext  -> do

grin/src/AbstractInterpretation/ExtendedSyntax/HeapPointsTo/CodeGen.hs

@@ -291,7 +291,10 @@ codeGenM = cata folder where
 
     AltF cpat exp -> pure $ A cpat exp
     -- NOTE: Currently, the names of the alternatives are ignored by the analysis.
-    NAltF cpat n exp -> pure $ A cpat exp
+    NAltF cpat n exp -> do
+      altNameReg <- newReg
+      addReg n altNameReg
+      pure $ A cpat exp
 
     SAppF name args -> do
       -- copy args to definition's variables ; read function result register

grin/src/AbstractInterpretation/ExtendedSyntax/LiveVariable/CodeGen.hs

@@ -398,7 +398,10 @@ codeGenM e = (cata folder >=> const setMainLive) e
 
     AltF cpat exp -> pure $ A cpat exp
     -- NOTE: Currently, the names of the alternatives are ignored by the analysis.
-    NAltF cpat n exp -> pure $ A cpat exp
+    NAltF cpat n exp -> do
+      altNameReg <- newReg
+      addReg n altNameReg
+      pure $ A cpat exp
 
     SAppF name args -> do
       appReg  <- newReg

grin/src/Grin/ExtendedSyntax/Parse/AST.hs

@@ -49,7 +49,7 @@ ifThenElse i = do
 
 simpleExp :: Pos -> Parser SimpleExp
 simpleExp i = SReturn <$ kw "pure" <*> value <|>
-              ECase <$ kw "case" <*> var <* kw "of" <*> (L.indentGuard sc GT i >>= some . (\pos -> try (alternative pos) <|> nAlternative pos)) <|>
+              ECase <$ kw "case" <*> var <* kw "of" <*> (L.indentGuard sc GT i >>= some . nAlternative) <|>
               SStore <$ kw "store" <*> var <|>
               SFetch <$ kw "fetch" <*> var <|>
               SUpdate <$ kw "update" <*> var <*> var <|>
@@ -71,7 +71,7 @@ nAlternative i = NAlt <$> try (L.indentGuard sc EQ i *> altPat) <*> (op "@" *> v
 -- and we don't want to parenthesize variables, literals and units.
 bindingPat :: Parser BPat
 bindingPat =
-  try (AsPat <$> (var <* char '@') <*> {- parens -} value) <|>
+  try (flip AsPat <$> value <*> (op "@" *> var)) <|>
   VarPat <$> var
 
 

grin/src/Grin/ExtendedSyntax/Pretty.hs

@@ -146,7 +146,7 @@ instance Pretty Lit where
 instance Pretty BPat where
   pretty = \case
     VarPat v    -> pretty v
-    AsPat v val -> pretty v <> pretty '@' <> pretty '(' <> pretty val <> pretty ')'
+    AsPat v pat -> pretty pat <+> pretty '@' <+> pretty v
 
 instance Pretty CPat where
   pretty = \case

grin/src/Grin/ExtendedSyntax/Syntax.hs

@@ -85,9 +85,9 @@ data CPat
 
 
 -- * Binding pattern
-
 data BPat
   = VarPat { _bPatVar :: Name }
+  -- TODO: swap the fields so that it is consistent with the concrete syntax
   | AsPat  { _bPatVar :: Name
            , _bPatVal :: Val
            }
@@ -137,20 +137,14 @@ deriving instance Ord a   => Ord  (ExpF a)
 pattern BoolPat b = LitPat (LBool b)
 
 _AltCPat :: Traversal' Exp CPat
-_AltCPat f (Alt p e) = (`Alt` e) <$> f p
-_AltCPat _ other     = pure other
+_AltCPat f (Alt p e)    = (`Alt` e) <$> f p
+_AltCPat f (NAlt p n e) = NAlt <$> f p <*> pure n <*> pure e
+_AltCPat _ other        = pure other
 
 _AltFCPat :: Traversal' (ExpF a) CPat
-_AltFCPat f (AltF p e) = (`AltF` e) <$> f p
-_AltFCPat _ other      = pure other
-
-_NAltCPat :: Traversal' Exp CPat
-_NAltCPat f (NAlt p n e) = NAlt <$> f p <*> pure n <*> pure e
-_NAltCPat _ other       = pure other
-
-_NAltFCPat :: Traversal' (ExpF a) CPat
-_NAltFCPat f (NAltF p n e) = NAltF <$> f p <*> pure n <*> pure e
-_NAltFCPat _ other        = pure other
+_AltFCPat f (AltF p e)    = (`AltF` e) <$> f p
+_AltFCPat f (NAltF p n e) = NAltF <$> f p <*> pure n <*> pure e
+_AltFCPat _ other         = pure other
 
 _ValVar :: Traversal' Val Name
 _ValVar f (Var name) = Var <$> f name

grin/src/Transformations/ExtendedSyntax/Conversion.hs

@@ -28,9 +28,14 @@ import qualified Grin.ExtendedSyntax.Syntax as New
 import qualified Grin.ExtendedSyntax.SyntaxDefs as New
 import qualified Grin.ExtendedSyntax.TypeEnvDefs as New
 
+import Grin.TypeCheck
+
 import Transformations.Util
 import Transformations.Names
+import Transformations.EffectMap
 import Transformations.BindNormalisation
+import Transformations.Optimising.CopyPropagation
+import Transformations.Optimising.SimpleDeadVariableElimination
 import Transformations.Simplifying.ProducerNameIntroduction
 import Transformations.Simplifying.BindingPatternSimplification
 
@@ -257,14 +262,27 @@ convertToNew :: Exp -> New.Exp
 convertToNew = convert . nameEverything
 
 nameEverything :: Exp -> Exp
-nameEverything = nodeArgumentNaming
-               . bindNormalisation
-               . appArgumentNaming
-               . bindNormalisation
-               . fst . bindingPatternSimplification
-               . bindNormalisation
-               . fst . producerNameIntroduction
-               . bindNormalisation
+nameEverything
+  = sdve
+  . copyPropagation
+  . bindNormalisation
+  . nodeArgumentNaming
+  . bindNormalisation
+  . appArgumentNaming
+  . bindNormalisation
+  . fst . bindingPatternSimplification
+  . bindNormalisation
+  . fst . producerNameIntroduction
+  . bindNormalisation
+
+  where
+    -- SDVE that infers the type env and the effect map
+    sdve :: Exp -> Exp
+    sdve exp = let tyEnv  = inferTypeEnv exp
+                   effMap = effectMap (tyEnv, exp)
+               in simpleDeadVariableElimination tyEnv effMap exp
+
+
 
 appArgumentNaming :: Exp -> Exp
 appArgumentNaming e = fst . evalNameM e . cata alg $ e where
@@ -284,7 +302,7 @@ appArgumentNaming e = fst . evalNameM e . cata alg $ e where
   newArgName :: NameM Name
   newArgName = deriveNewName "x"
 
--- NOTE: we can ssume tha Producer Name Introduction
+-- NOTE: we can assume that Producer Name Introduction
 -- & Binding Pattern Simplification has already been run
 -- ConstTagNodes can only appear in SReturns
 nodeArgumentNaming :: Exp -> Exp

grin/src/Transformations/ExtendedSyntax/Names.hs

@@ -128,6 +128,7 @@ mapNameDefExpM f = \case
   EBind leftExp (VarPat var) rightExp -> do EBind leftExp <$> (VarPat <$> f var) <*> pure rightExp
   EBind leftExp (AsPat var val) rightExp -> EBind leftExp <$> (AsPat <$> f var <*> mapNamesValM f val) <*> pure rightExp
   Alt cpat body               -> Alt <$> mapNamesCPatM f cpat <*> pure body
+  NAlt cpat n body            -> NAlt <$> mapNamesCPatM f cpat <*> f n <*> pure body
   exp                         -> pure exp
 
 mapNamesCPatM :: Monad m => (Name -> m Name) -> CPat -> m CPat

grin/src/Transformations/Optimising/CopyPropagation.hs

@@ -15,6 +15,12 @@ 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)