Merge c90e08b 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

@@ -257,7 +257,8 @@ convertToNew :: Exp -> New.Exp
 convertToNew = convert . nameEverything
 
 nameEverything :: Exp -> Exp
-nameEverything = nodeArgumentNaming
+nameEverything = bindNormalisation
+               . nodeArgumentNaming
                . bindNormalisation
                . appArgumentNaming
                . bindNormalisation
@@ -284,7 +285,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