ES: analyses as-pats

Author: Anabra

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

@@ -168,11 +168,7 @@ producesNode (Undefined T_NodeSet{}) = True
 producesNode _ = False
 
 asPatternDataflow :: IR.Reg -> BPat -> CG ()
-asPatternDataflow r asPat@(AsPat _ asVal) = case asVal of
-  Unit  -> pure ()
-  Lit{} -> pure ()
-  Var v -> addReg v r
-  ConstTagNode tag args -> do
+asPatternDataflow r asPat@(AsPat tag args _) = do
     irTag <- getTag tag
     bindInstructions <- forM (zip [1..] args) $ \(idx, arg) -> do
       argReg <- newReg
@@ -187,7 +183,6 @@ asPatternDataflow r asPat@(AsPat _ asVal) = case asVal of
       , srcReg        = r
       , instructions  = concat bindInstructions
       }
-  valPat -> error $ "unsupported @pattern: " ++ show (PP asPat)
 asPatternDataflow _ pat = error $ "not @pattern: " ++ show (PP pat)
 
 {- NOTE: para is needed to specify the order of evalution of the lhs and rhs on binds.
@@ -227,17 +222,10 @@ codeGen e = flip evalState emptyCGState $ para folder e >> mkCByProgramM where
       cgRhs
 
     -- NOTE: @patterns
-    EBindF (lhs, cgLhs) asPat@(AsPat var valPat) (_, cgRhs) -> do
+    EBindF (lhs, cgLhs) asPat@(AsPat tag args var) (_, cgRhs) -> do
       lhsRes <- cgLhs
       case lhsRes of
-        Z -> do
-          r <- newReg
-          emit IR.Set {dstReg = r, constant = IR.CSimpleType unitType}
-          addReg var r
-          case valPat of
-            Unit      -> pure ()
-            Var inner -> addReg inner r
-            _ -> error $ "pattern mismatch at CreatedBy bind codegen, expected Unit got " ++ show (PP valPat)
+        Z -> error $ "pattern mismatch at CreatedBy bind codegen, expected Unit got " ++ show (PP $ ConstTagNode tag args)
         R r -> do
           case lhs of
             SReturn val | producesNode val -> do

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

@@ -66,8 +66,8 @@ codeGenM = cata folder where
       let R rhsReg = rhs
 
       case bPat of
-        VarPat var   -> addReg var lhsReg
-        AsPat  var _ -> addReg var lhsReg
+        VarPat var     -> addReg var lhsReg
+        AsPat  _ _ var -> addReg var lhsReg
 
       emit IR.Move { srcReg = lhsReg, dstReg = rhsReg }
       pure $ R rhsReg

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

@@ -176,28 +176,14 @@ codeGenM = cata folder where
     EBindF leftExp bpat rightExp -> do
       leftExp >>= \case
         Z -> case bpat of
-          AsPat varName Unit -> do
-            r <- newReg
-            emit IR.Set {dstReg = r, constant = IR.CSimpleType unitType}
-            addReg varName r
           VarPat varName -> do
             r <- newReg
             emit IR.Set {dstReg = r, constant = IR.CSimpleType unitType}
             addReg varName r
           _ -> error $ "pattern mismatch at HPT bind codegen, Unit cannot be matched against " ++ show bpat
         R r -> case bpat of -- QUESTION: should the evaluation continue if the pattern does not match yet?
           VarPat varName -> addReg varName r
-          AsPat varName Unit -> do
-            addReg varName r
-            pure () -- TODO: is this ok? or error?
-          -- NOTE: I think this is okay. Could be optimised though (since we already know the result)?
-          AsPat varName Lit{} -> do
-            addReg varName r
-            pure () -- TODO: is this ok? or error?
-          AsPat v1 (Var v2) -> do
-            addReg v1 r
-            addReg v2 r
-          AsPat varName (ConstTagNode tag args) -> do
+          AsPat tag args varName -> do
             addReg varName r
             irTag <- getTag tag
             bindInstructions <- forM (zip [0..] args) $ \(idx, name) -> do

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

@@ -237,16 +237,7 @@ codeGenM e = (cata folder >=> const setMainLive) e
 
       case bPat of
         VarPat v -> mkRegsThenVarPatternDataFlow v
-        AsPat v Unit -> do
-          setBasicValLive lhsReg
-          mkRegsThenVarPatternDataFlow v
-        AsPat v Lit{} -> do
-          setBasicValLive lhsReg
-          mkRegsThenVarPatternDataFlow v
-        AsPat v1 (Var v2) -> do
-          mkRegsThenVarPatternDataFlow v1
-          mkRegsThenVarPatternDataFlow v2
-        AsPat v (ConstTagNode tag args) -> do
+        AsPat tag args v -> do
           irTag <- getTag tag
           setTagLive irTag lhsReg
           bindInstructions <- codeGenBlock_ $ forM (zip [1..] args) $ \(idx, arg) -> do