ES: restructured as-pats in grin dir

Author: Anabra

grin/src/Grin/ExtendedSyntax/Grin.hs

@@ -25,8 +25,8 @@ instance FoldNames Val where
 
 instance FoldNames BPat where
   foldNames f = \case
-    VarPat v    -> f v
-    AsPat v val -> f v <> foldNames f val
+    VarPat v     -> f v
+    AsPat t vs v -> f v <> foldNames (ConstTagNode t vs)
 
 
 instance FoldNames CPat where

grin/src/Grin/ExtendedSyntax/Lint.hs

@@ -310,8 +310,8 @@ lint warningKinds mTypeEnv exp@(Program exts _) =
         when (isn't _OnlyVarPat bPat) $ do
           forM_ mTypeEnv $ \typeEnv -> do
             fromMaybe (pure ()) $ case bPat of
-              AsPat v val -> do -- Maybe
-                expectedPatType <- normalizeType <$> mTypeOfValTE typeEnv val
+              AsPat tag fields v -> do -- Maybe
+                expectedPatType <- normalizeType <$> mTypeOfValTE typeEnv (ConstTagNode tag fields)
                 lhsType         <- normalizeType <$> extract leftExp
                 pure $ do -- Lint
                   -- NOTE: This can still give false positive errors, because bottom-up typing can only approximate the result of HPT.

grin/src/Grin/ExtendedSyntax/Nametable.hs

@@ -86,7 +86,7 @@ convert = second (view nametable) . flip runState emptyNS . cata build where
     ProgramF es defs            -> Program <$> mapM external es <*> sequence defs
     DefF fn ps body             -> Def <$> (nameToIdx fn) <*> (mapM nameToIdx ps) <*> body
     EBindF l (VarPat v) r       -> EBind <$> l <*> (VarPat <$> nameToIdx v) <*> r
-    EBindF l (AsPat var val) r  -> EBind <$> l <*> (AsPat <$> nameToIdx var <*> value val) <*> r
+    EBindF l (AsPat t vars v) r -> EBind <$> l <*> (AsPat <$> tag t <*> mapM nameToIdx vars <*> nameToIdx v) <*> r
     ECaseF v alts               -> ECase <$> nameToIdx v <*> sequence alts
     SAppF v ps                  -> SApp <$> nameToIdx v <*> (mapM nameToIdx ps)
     SReturnF v                  -> SReturn <$> value v
@@ -107,7 +107,7 @@ restore (exp, nt) = cata build exp where
     ProgramF es defs           -> Program (map rexternal es) defs
     DefF fn ps body            -> Def (rname fn) (map rname ps) body
     EBindF l (VarPat v) r      -> EBind l (VarPat $ rname v) r
-    EBindF l (AsPat var val) r -> EBind l (AsPat (rname var) (rvalue val)) r
+    EBindF l (AsPat t vs v) r  -> EBind l (AsPat (rtag t) (map rname vs) (rname v)) r
     ECaseF v alts              -> ECase (rname v) alts
     SAppF v ps                 -> SApp (rname v) (map rname ps)
     SReturnF v                 -> SReturn (rvalue v)

grin/src/Grin/ExtendedSyntax/Pretty.hs

@@ -144,8 +144,8 @@ instance Pretty Lit where
 
 instance Pretty BPat where
   pretty = \case
-    VarPat v    -> pretty v
-    AsPat v pat -> pretty pat <+> pretty '@' <+> pretty v
+    VarPat v           -> pretty v
+    AsPat tag fields v -> pretty (ConstTagNode tag fields) <+> pretty '@' <+> pretty v
 
 instance Pretty CPat where
   pretty = \case

grin/src/Grin/ExtendedSyntax/Statistics.hs

@@ -67,7 +67,7 @@ statistics = cata $ \case
   e -> Data.Foldable.fold e
 
 tagInBPat :: BPat -> Set.Set Tag
-tagInBPat (AsPat var (ConstTagNode t _)) = Set.singleton t
+tagInBPat (AsPat t _ _) = Set.singleton t
 tagInBPat _ = mempty
 
 

grin/src/Transformations/ExtendedSyntax/syntax-trf.notes

@@ -0,0 +1,39 @@
+easy (without type env):
+  - DONE: evaluated case elimination
+  - DONE: trivial case elimination
+  - DONE: update elimination
+  - constant propagation
+
+
+easy (with type env):
+  - non-shared elimination
+  - DONE: CSE
+  - SDFE, SDVE, SDPE
+  - SCO
+  - DFE, DPE
+
+medium:
+  - case copy propagation
+  - copy propagation
+  - DVE
+  - dead data elimination
+
+moderate:
+  - case hoisting
+  - inlining
+
+hard:
+  - arity raising
+  - generalized unboxing
+
+DONE: investigate update elimination vs CSE
+
+Branches:
+
+  [x] 32-conversion-fix
+  [ ] 32-alt-remove-unnamed
+  [ ] 32-alt-analyses
+  [ ] 32-trf-cse
+  [ ] 32-trf-case-elims
+
+  [ ] 32-trf-copy-propagation