From 947bdc4069d26b81bc61f55244efc2608a3d2a63 Mon Sep 17 00:00:00 2001 From: Vidush Singhal Date: Wed, 4 Dec 2024 08:33:41 -0500 Subject: [PATCH] edits --- gibbon-compiler/src/Gibbon/L2/Examples.hs | 110 +++++++++--------- gibbon-compiler/src/Gibbon/L2/Interp.hs | 4 +- gibbon-compiler/src/Gibbon/L2/Typecheck.hs | 5 +- gibbon-compiler/src/Gibbon/NewL2/FromOldL2.hs | 4 +- gibbon-compiler/src/Gibbon/NewL2/Syntax.hs | 8 +- gibbon-compiler/src/Gibbon/Passes/AddRAN.hs | 4 +- .../src/Gibbon/Passes/AddTraversals.hs | 4 +- .../src/Gibbon/Passes/CalculateBounds.hs | 6 +- .../src/Gibbon/Passes/Cursorize.hs | 7 +- .../src/Gibbon/Passes/FindWitnesses.hs | 8 +- .../src/Gibbon/Passes/FollowPtrs.hs | 2 +- .../src/Gibbon/Passes/InferLocations.hs | 59 +++++----- gibbon-compiler/src/Gibbon/Passes/ParAlloc.hs | 21 ++-- .../src/Gibbon/Passes/RegionsInwards.hs | 6 +- .../src/Gibbon/Passes/RemoveCopies.hs | 4 +- .../src/Gibbon/Passes/ReorderScalarWrites.hs | 4 +- .../src/Gibbon/Passes/RouteEnds.hs | 6 +- .../src/Gibbon/Passes/Simplifier.hs | 11 +- .../src/Gibbon/Passes/ThreadRegions.hs | 4 +- gibbon-compiler/src/Gibbon/Pretty.hs | 19 ++- 20 files changed, 160 insertions(+), 136 deletions(-) diff --git a/gibbon-compiler/src/Gibbon/L2/Examples.hs b/gibbon-compiler/src/Gibbon/L2/Examples.hs index 5e931cc22..b1c5b5edb 100644 --- a/gibbon-compiler/src/Gibbon/L2/Examples.hs +++ b/gibbon-compiler/src/Gibbon/L2/Examples.hs @@ -72,10 +72,10 @@ add1FunBod = CaseE (VarE "tr1") VarE "lf8") , ("Node", [("x9",(Single "l10")),("y11",(Single "l12"))], - Ext $ LetLocE (Single "l13") (AfterConstantLE 1 (Single "lout4")) $ + Ext $ LetLocE (Single "l13") (AfterConstantLE 1 [] (Single "lout4")) $ LetE ("x14",[],PackedTy "Tree" (Single "l13"), AppE "add1" [(Single "l10"),(Single "l13")] [VarE "x9"]) $ - Ext $ LetLocE (Single "l15") (AfterVariableLE "x14" (Single "l13") True) $ + Ext $ LetLocE (Single "l15") (AfterVariableLE "x14" [] (Single "l13") True) $ LetE ("y16",[],PackedTy "Tree" (Single "l15"), AppE "add1" [(Single "l12"),(Single "l15")] [VarE "y11"]) $ LetE ("z17",[],PackedTy "Tree" (Single "lout4"), DataConE (Single "lout4") "Node" [ VarE "x14" , VarE "y16"]) $ @@ -85,10 +85,10 @@ add1FunBod = CaseE (VarE "tr1") add1MainExp :: Exp2 add1MainExp = Ext $ LetRegionE (VarR "r99") Undefined Nothing $ Ext $ LetLocE (Single "l100") (StartOfRegionLE (VarR "r99")) $ - Ext $ LetLocE (Single "l101") (AfterConstantLE 1 (Single "l100")) $ + Ext $ LetLocE (Single "l101") (AfterConstantLE 1 [] (Single "l100")) $ LetE ("x102",[],PackedTy "Tree" (Single "l101"), DataConE (Single "l101") "Leaf" [LitE 1]) $ - Ext $ LetLocE (Single "l103") (AfterVariableLE "x102" (Single "l101") True) $ + Ext $ LetLocE (Single "l103") (AfterVariableLE "x102" [] (Single "l101") True) $ LetE ("y104",[],PackedTy "Tree" (Single "l103"), DataConE (Single "l103") "Leaf" [LitE 2]) $ LetE ("z105",[],PackedTy "Tree" (Single "l100"), @@ -124,10 +124,10 @@ leafProg = Prog ddtree M.empty (Just (leafMainExp, PackedTy "Tree" (Single "l151 nodeMainExp :: Exp2 nodeMainExp = Ext $ LetRegionE (VarR "r155") Undefined Nothing $ Ext $ LetLocE (Single "l156") (StartOfRegionLE (VarR "r155")) $ - Ext $ LetLocE (Single "l157") (AfterConstantLE 1 (Single "l156")) $ + Ext $ LetLocE (Single "l157") (AfterConstantLE 1 [] (Single "l156")) $ LetE ("x158",[],PackedTy "Tree" (Single "l157"), DataConE (Single "l157") "Leaf" [LitE 1]) $ - Ext $ LetLocE (Single "l159") (AfterVariableLE "x158" (Single "l157") True) $ + Ext $ LetLocE (Single "l159") (AfterVariableLE "x158" [] (Single "l157") True) $ LetE ("y160",[],PackedTy "Tree" (Single "l159"), DataConE (Single "l159") "Leaf" [LitE 2]) $ LetE ("z161",[],PackedTy "Tree" (Single "l156"), @@ -178,10 +178,10 @@ copyTreeFun = FunDef "copyTree" [ "tr22"] copyFunTy copyBod (FunMeta NotRec NoIn VarE "n28") , ("Node", [("x29",(Single "lx30")),("y31",(Single "ly32"))], - Ext $ LetLocE (Single "lx33") (AfterConstantLE 1 (Single "lout25")) $ + Ext $ LetLocE (Single "lx33") (AfterConstantLE 1 [] (Single "lout25")) $ LetE ("x34", [], PackedTy "Tree" (Single "lx33"), AppE "copyTree" [(Single "lx30"),(Single "lx33")] [VarE "x29"]) $ - Ext $ LetLocE (Single "ly35") (AfterVariableLE "x34" (Single "lx33") True) $ + Ext $ LetLocE (Single "ly35") (AfterVariableLE "x34" [] (Single "lx33") True) $ LetE ("y36", [], PackedTy "Tree" (Single "ly35"), AppE "copyTree" [(Single "ly32"),(Single "ly35")] [VarE "y31"]) $ DataConE (Single "lout25") "Node" [VarE "x34", VarE "y36"]) @@ -190,10 +190,10 @@ copyTreeFun = FunDef "copyTree" [ "tr22"] copyFunTy copyBod (FunMeta NotRec NoIn copyTreeMainExp :: Exp2 copyTreeMainExp = Ext $ LetRegionE (VarR "r200") Undefined Nothing $ Ext $ LetLocE (Single "l201") (StartOfRegionLE (VarR "r200")) $ - Ext $ LetLocE (Single "l202") (AfterConstantLE 1 (Single "l201")) $ + Ext $ LetLocE (Single "l202") (AfterConstantLE 1 [] (Single "l201")) $ LetE ("x203",[],PackedTy "Tree" (Single "l202"), DataConE (Single "l202") "Leaf" [LitE 1]) $ - Ext $ LetLocE (Single "r204") (AfterVariableLE "x203" (Single "l202") True) $ + Ext $ LetLocE (Single "r204") (AfterVariableLE "x203" [] (Single "l202") True) $ LetE ("y205",[],PackedTy "Tree" (Single "r204"), DataConE (Single "r204") "Leaf" [LitE 2]) $ LetE ("z206",[],PackedTy "Tree" (Single "l201"), @@ -240,10 +240,10 @@ copyOnId1Prog = Prog ddtree funs $ Just (copyOnId1MainExp, PackedTy "Tree" (Sing copyOnId1MainExp :: Exp2 copyOnId1MainExp = Ext $ LetRegionE (VarR "r220") Undefined Nothing $ Ext $ LetLocE (Single "l221") (StartOfRegionLE (VarR "r220")) $ - Ext $ LetLocE (Single "l222") (AfterConstantLE 1 (Single "l221")) $ + Ext $ LetLocE (Single "l222") (AfterConstantLE 1 [] (Single "l221")) $ LetE ("l223",[],PackedTy "Tree" (Single "l222"), DataConE (Single "l222") "Leaf" [LitE 1]) $ - Ext $ LetLocE (Single "l224") (AfterVariableLE "l223" (Single "l222") True) $ + Ext $ LetLocE (Single "l224") (AfterVariableLE "l223" [] (Single "l222") True) $ LetE ("l225",[],PackedTy "Tree" (Single "l224"), DataConE (Single "l224") "Leaf" [LitE 2]) $ LetE ("z226",[],PackedTy "Tree" (Single "l221"), @@ -331,10 +331,10 @@ leftmostBod = CaseE (VarE "t111") leftmostMainExp :: Exp2 leftmostMainExp = Ext $ LetRegionE (VarR "r122") Undefined Nothing $ Ext $ LetLocE (Single "l123") (StartOfRegionLE (VarR "r122")) $ - Ext $ LetLocE (Single "l124") (AfterConstantLE 1 (Single "l123")) $ + Ext $ LetLocE (Single "l124") (AfterConstantLE 1 [] (Single "l123")) $ LetE ("x125",[],PackedTy "Tree" (Single "l124"), DataConE (Single "l124") "Leaf" [LitE 1]) $ - Ext $ LetLocE (Single "l126") (AfterVariableLE "x125" (Single "l124") True) $ + Ext $ LetLocE (Single "l126") (AfterVariableLE "x125" [] (Single "l124") True) $ LetE ("y128",[],PackedTy "Tree" (Single "l126"), DataConE (Single "l126") "Leaf" [LitE 2]) $ LetE ("z127",[],PackedTy "Tree" (Single "l123"), @@ -376,10 +376,10 @@ rightmostBod = CaseE (VarE "t242") rightmostMainExp :: Exp2 rightmostMainExp = Ext $ LetRegionE (VarR "r253") Undefined Nothing $ Ext $ LetLocE (Single "l254") (StartOfRegionLE (VarR "r253")) $ - Ext $ LetLocE (Single "l255") (AfterConstantLE 1 (Single "l254")) $ + Ext $ LetLocE (Single "l255") (AfterConstantLE 1 [] (Single "l254")) $ LetE ("x256",[],PackedTy "Tree" (Single "l255"), DataConE (Single "l255") "Leaf" [LitE 1]) $ - Ext $ LetLocE (Single "l257") (AfterVariableLE "x256" (Single "l255") True) $ + Ext $ LetLocE (Single "l257") (AfterVariableLE "x256" [] (Single "l255") True) $ LetE ("y258",[],PackedTy "Tree" (Single "l257"), DataConE (Single "l257") "Leaf" [LitE 2]) $ LetE ("z259",[],PackedTy "Tree" (Single "l254"), @@ -439,10 +439,10 @@ buildTreeFun = FunDef "buildTree" [ "i270"] buildTreeTy buildTreeBod (FunMeta Re IfE (VarE "b279") (DataConE (Single "lout272") "Leaf" [LitE 1]) (LetE ("i273",[], IntTy, PrimAppE SubP [VarE "i270", LitE 1]) $ - Ext $ LetLocE (Single "l274") (AfterConstantLE 1 (Single "lout272")) $ + Ext $ LetLocE (Single "l274") (AfterConstantLE 1 [] (Single "lout272")) $ LetE ("x275",[],PackedTy "Tree" (Single "l274"), AppE "buildTree" [(Single "l274")] [VarE "i273"]) $ - Ext $ LetLocE (Single "l276") (AfterVariableLE "x275" (Single "l274") True) $ + Ext $ LetLocE (Single "l276") (AfterVariableLE "x275" [] (Single "l274") True) $ LetE ("y277",[],PackedTy "Tree" (Single "l276"), AppE "buildTree" [(Single "l276")] [VarE "i273"]) $ LetE ("a278",[],PackedTy "Tree" (Single "lout272"), @@ -520,12 +520,12 @@ buildTreeSumFun = FunDef "buildTreeSum" [ "i302"] buildTreeSumTy buildTreeSumBod MkProdE [LitE 1, VarE "c316"]) $ VarE "t317") (LetE ("i303",[], IntTy, PrimAppE SubP [VarE "i302", LitE 1]) $ - Ext $ LetLocE (Single "l304") (AfterConstantLE 1 (Single "lout301")) $ + Ext $ LetLocE (Single "l304") (AfterConstantLE 1 [] (Single "lout301")) $ LetE ("t318",[],ProdTy [IntTy, PackedTy "Tree" (Single "l304")], AppE "buildTreeSum" [(Single "l304")] [VarE "i303"]) $ LetE ("i309",[],IntTy, ProjE 0 (VarE "t318")) $ LetE ("x305",[],PackedTy "Tree" (Single "l304"), ProjE 1 (VarE "t318")) $ - Ext $ LetLocE (Single "l306") (AfterVariableLE "x305" (Single "l304") True) $ + Ext $ LetLocE (Single "l306") (AfterVariableLE "x305" [] (Single "l304") True) $ LetE ("t319",[],ProdTy [IntTy, PackedTy "Tree" (Single "l306")], AppE "buildTreeSum" [(Single "l306")] [VarE "i303"]) $ LetE ("i310",[],IntTy, ProjE 0 (VarE "t319")) $ @@ -614,7 +614,7 @@ printTupMainExp2 = Ext $ LetRegionE (VarR "r400") Undefined Nothing $ Ext $ LetLocE (Single "l401") (StartOfRegionLE (VarR "r400")) $ LetE ("x402",[], PackedTy "Tree" (Single "l401"), AppE "buildTree" [(Single "l401")] [LitE 2]) $ - Ext $ LetLocE (Single "l403") (AfterVariableLE "x402" (Single "l401") True) $ + Ext $ LetLocE (Single "l403") (AfterVariableLE "x402" [] (Single "l401") True) $ LetE ("y404",[], PackedTy "Tree" (Single "l403"), AppE "buildTree" [(Single "l403")] [LitE 1]) $ LetE ("z405",[], ProdTy [PackedTy "Tree" (Single "l401"), PackedTy "Tree" (Single "l403")], @@ -673,13 +673,13 @@ addTreesFun = FunDef "addTrees" [ "trees354"] addTreesTy addTreesBod (FunMeta Re ("Node", [("x360",(Single "l361")), ("y362",(Single "l363"))], CaseE (VarE "tree2") [("Node", [("x364",(Single "l365")), ("y366", (Single "l367"))], - Ext $ LetLocE (Single "l368") (AfterConstantLE 1 (Single "lout353")) $ + Ext $ LetLocE (Single "l368") (AfterConstantLE 1 [] (Single "lout353")) $ LetE ("tree3",[],ProdTy [PackedTy "Tree" (Single "l361"), PackedTy "Tree" (Single "l365")], MkProdE [VarE "x360", VarE "x364"]) $ LetE ("x369",[],PackedTy "Tree" (Single "l368"), AppE "addTrees" [(Single "l361"),(Single "l365"),(Single "l368")] [VarE "tree3"]) $ - Ext $ LetLocE (Single "l370") (AfterVariableLE "x369" (Single "l368") True) $ + Ext $ LetLocE (Single "l370") (AfterVariableLE "x369" [] (Single "l368") True) $ LetE ("tree4",[],ProdTy [PackedTy "Tree" (Single "l363"), PackedTy "Tree" (Single "l367")], MkProdE [VarE "y362", VarE "y366"]) $ @@ -738,13 +738,13 @@ testProdFun = FunDef "testprod" [ "tup130"] testprodTy testprodBod (FunMeta Rec VarE "tup148" ), ("Node",[("x140",(Single "l141")), ("y142",(Single "l143"))], - Ext $ LetLocE (Single "l144") (AfterConstantLE 1 (Single "lout133")) $ + Ext $ LetLocE (Single "l144") (AfterConstantLE 1 [] (Single "lout133")) $ LetE ("tup145",[], ProdTy [PackedTy "Tree" (Single "l144"), IntTy], AppE "testprod" [(Single "l141"),(Single "l144")] [MkProdE [VarE "x140", VarE "i135"]]) $ LetE ("x149",[], PackedTy "Tree" (Single "l144"), ProjE 0 (VarE "tup145")) $ - Ext $ LetLocE (Single "l146") (AfterVariableLE "x149" (Single "l144") True) $ + Ext $ LetLocE (Single "l146") (AfterVariableLE "x149" [] (Single "l144") True) $ LetE ("tup147",[], ProdTy [PackedTy "Tree" (Single "l146"), IntTy], AppE "testprod" [(Single "l143"),(Single "l146")] [MkProdE [VarE "y142", VarE "i135"]]) $ @@ -769,7 +769,7 @@ testFlattenProg = Prog M.empty (M.fromList [( "intAdd",intAddFun)]) $ Just (test testFlattenBod = Ext $ LetRegionE (VarR "_") Undefined Nothing $ Ext $ LetLocE (Single "_") (StartOfRegionLE (VarR "_")) $ - Ext $ LetLocE (Single "_") (AfterConstantLE 1 (Single "_")) $ + Ext $ LetLocE (Single "_") (AfterConstantLE 1 [] (Single "_")) $ LetE ("v170",[],IntTy, LetE ("v171",[],IntTy, AppE "intAdd" [] @@ -830,12 +830,12 @@ sumUpFun = FunDef "sumUp" [ "tr1"] sumUpFunTy sumUpFunBod (FunMeta Rec NoInline VarE "x505") , ("Inner", [("i506",(Single "l507")),("b508", (Single "l509")),("x510", (Single "l511")),("y512", (Single "l513"))], - Ext $ LetLocE (Single "l514") (AfterConstantLE 1 (Single "lout502")) $ - Ext $ LetLocE (Single "l550") (AfterVariableLE "i506" (Single "l514") True) $ - Ext $ LetLocE (Single "l551") (AfterVariableLE "b508" (Single "l550") True) $ + Ext $ LetLocE (Single "l514") (AfterConstantLE 1 [] (Single "lout502")) $ + Ext $ LetLocE (Single "l550") (AfterVariableLE "i506" [] (Single "l514") True) $ + Ext $ LetLocE (Single "l551") (AfterVariableLE "b508" [] (Single "l550") True) $ LetE ("x515",[],PackedTy "STree" (Single "l551"), AppE "sumUp" [(Single "l511"),(Single "l551")] [VarE "x510"]) $ - Ext $ LetLocE (Single "l516") (AfterVariableLE "x515" (Single "l551") True) $ + Ext $ LetLocE (Single "l516") (AfterVariableLE "x515" [] (Single "l551") True) $ LetE ("y517",[],PackedTy "STree" (Single "l516"), AppE "sumUp" [(Single "l513"),(Single "l516")] [VarE "y512"]) $ LetE ("v518",[],IntTy, AppE "valueSTree" [(Single "l551")] [VarE "x515"]) $ @@ -889,12 +889,12 @@ buildSTreeFun = FunDef "buildSTree" [ "i543"] buildSTreeTy buildSTreeBod (FunMet (LetE ("i548",[], IntTy, PrimAppE SubP [VarE "i543", LitE 1]) $ LetE ("i554",[], IntTy, LitE 0) $ LetE ("b555",[], IntTy, LitE 0) $ - Ext $ LetLocE (Single "l544") (AfterConstantLE 1 (Single "lout541")) $ - Ext $ LetLocE (Single "l552") (AfterVariableLE "i554" (Single "l544") True) $ - Ext $ LetLocE (Single "l553") (AfterVariableLE "b555" (Single "l552") True) $ + Ext $ LetLocE (Single "l544") (AfterConstantLE 1 [] (Single "lout541")) $ + Ext $ LetLocE (Single "l552") (AfterVariableLE "i554" [] (Single "l544") True) $ + Ext $ LetLocE (Single "l553") (AfterVariableLE "b555" [] (Single "l552") True) $ LetE ("x545",[],PackedTy "STree" (Single "l553"), AppE "buildSTree" [(Single "l553")] [VarE "i548"]) $ - Ext $ LetLocE (Single "l545") (AfterVariableLE "x545" (Single "l553") True) $ + Ext $ LetLocE (Single "l545") (AfterVariableLE "x545" [] (Single "l553") True) $ LetE ("y546",[],PackedTy "STree" (Single "l545"), AppE "buildSTree" [(Single "l545")] [VarE "i548"]) $ LetE ("a547",[],PackedTy "STree" (Single "lout541"), @@ -1038,12 +1038,12 @@ setEvenFun = FunDef "setEven" [ "tr570"] setEvenFunTy setEvenFunBod (FunMeta Rec VarE "x575") , ("Inner", [("i576",(Single "l577")),("b578",(Single "l579")),("x580",(Single "l581")),("y582",(Single "l583"))], - Ext $ LetLocE (Single "l584") (AfterConstantLE 1 (Single "lout572")) $ - Ext $ LetLocE (Single "l585") (AfterVariableLE "i576" (Single "l584") True) $ - Ext $ LetLocE (Single "l586") (AfterVariableLE "b578" (Single "l585") True) $ + Ext $ LetLocE (Single "l584") (AfterConstantLE 1 [] (Single "lout572")) $ + Ext $ LetLocE (Single "l585") (AfterVariableLE "i576" [] (Single "l584") True) $ + Ext $ LetLocE (Single "l586") (AfterVariableLE "b578" [] (Single "l585") True) $ LetE ("x587",[],PackedTy "STree" (Single "l586"), AppE "setEven" [(Single "l581"),(Single "l586")] [VarE "x580"]) $ - Ext $ LetLocE (Single "l588") (AfterVariableLE "x587" (Single "l586") True) $ + Ext $ LetLocE (Single "l588") (AfterVariableLE "x587" [] (Single "l586") True) $ LetE ("y589",[],PackedTy "STree" (Single "l588"), AppE "setEven" [(Single "l583"),(Single "l588")] [VarE "y582"]) $ LetE ("v590",[],IntTy, AppE "valueSTree" [(Single "l586")] [VarE "x587"]) $ @@ -1123,14 +1123,14 @@ sumUpSetEvenFun = FunDef "sumUpSetEven" [ "tr600"] sumUpSetEvenFunTy sumUpSetEve VarE "tx606") , ("Inner", [("i607",(Single "l608")),("b609", (Single "l610")),("x611", (Single "l612")),("y613", (Single "l622"))], - Ext $ LetLocE (Single "l614") (AfterConstantLE 1 (Single "lout602")) $ - Ext $ LetLocE (Single "l615") (AfterVariableLE "i607" (Single "l614") True) $ - Ext $ LetLocE (Single "l616") (AfterVariableLE "b609" (Single "l615") True) $ + Ext $ LetLocE (Single "l614") (AfterConstantLE 1 [] (Single "lout602")) $ + Ext $ LetLocE (Single "l615") (AfterVariableLE "i607" [] (Single "l614") True) $ + Ext $ LetLocE (Single "l616") (AfterVariableLE "b609" [] (Single "l615") True) $ LetE ("tx617",[], ProdTy [PackedTy "STree" (Single "l616"), IntTy], AppE "sumUpSetEven" [(Single "l612"),(Single "l616")] [VarE "x611"]) $ LetE ("x618",[],PackedTy "STree" (Single "l616"), ProjE 0 (VarE "tx617")) $ LetE ("v619",[],IntTy, ProjE 1 (VarE "tx617")) $ - Ext $ LetLocE (Single "l620") (AfterVariableLE "x618" (Single "l616") True) $ + Ext $ LetLocE (Single "l620") (AfterVariableLE "x618" [] (Single "l616") True) $ LetE ("tx621",[],ProdTy [PackedTy "STree" (Single "l620"), IntTy], AppE "sumUpSetEven" [(Single "l622"),(Single "l620")] [VarE "y613"]) $ LetE ("y623",[],PackedTy "STree" (Single "l620"), ProjE 0 (VarE "tx621")) $ @@ -1212,11 +1212,11 @@ copyExprFun = FunDef "copyExpr" [ "e700"] copyExprFunTy copyExprFunBod (FunMeta DataConE (Single "lout703") "VARREF" [VarE "v704"] ) , ("LETE", [("v706",(Single "l707")), ("rhs708", (Single "l709")), ("bod710", (Single "l711"))], - Ext $ LetLocE (Single "l712") (AfterConstantLE 1 (Single "lout703")) $ - Ext $ LetLocE (Single "l713") (AfterVariableLE "v706" (Single "l712") True) $ + Ext $ LetLocE (Single "l712") (AfterConstantLE 1 [] (Single "lout703")) $ + Ext $ LetLocE (Single "l713") (AfterVariableLE "v706" [] (Single "l712") True) $ LetE ("rhs714",[], PackedTy "Expr" (Single "l713"), AppE "copyExpr" [(Single "l709"),(Single "l713")] [VarE "rhs708"]) $ - Ext $ LetLocE (Single "l715") (AfterVariableLE "rhs714" (Single "l713") True) $ + Ext $ LetLocE (Single "l715") (AfterVariableLE "rhs714" [] (Single "l713") True) $ LetE ("bod716",[],PackedTy "Expr" (Single "l715"), AppE "copyExpr" [(Single "l711"), (Single "l715")] [VarE "bod710"]) $ LetE ("z717",[],PackedTy "Expr" (Single "lout703"), @@ -1258,13 +1258,13 @@ substFun = FunDef "subst" [ "tr653"] substFunTy substFunBod (FunMeta Rec NoInlin LetE ("b662",[],BoolTy, PrimAppE EqIntP [VarE "v656", VarE "old654"]) -- IfE (VarE "b662") - (Ext $ LetLocE (Single "l663") (AfterConstantLE 1 (Single "lout653")) $ - Ext $ LetLocE (Single "l664") (AfterVariableLE "v656" (Single "l663") True) $ + (Ext $ LetLocE (Single "l663") (AfterConstantLE 1 [] (Single "lout653")) $ + Ext $ LetLocE (Single "l664") (AfterVariableLE "v656" [] (Single "l663") True) $ LetE ("p668",[], ProdTy [IntTy, PackedTy "Expr" (Single "lin651"), PackedTy "Expr" (Single "l659")], MkProdE [VarE "old654", VarE "new655", VarE "rhs658"]) $ LetE ("rhs665",[],PackedTy "Expr" (Single "l664"), AppE "subst" [(Single "lin651"), (Single "l659"), (Single "l664")] [VarE "p668"]) $ - Ext $ LetLocE (Single "l669") (AfterVariableLE "rhs665" (Single "l664") True) $ + Ext $ LetLocE (Single "l669") (AfterVariableLE "rhs665" [] (Single "l664") True) $ LetE ("bod670",[], PackedTy "Expr" (Single "l669"), AppE "copyExpr" [(Single "l661"), (Single "l669")] [VarE "bod660"]) $ LetE ("z671",[], PackedTy "Expr" (Single "lout653"), @@ -1277,11 +1277,11 @@ substFun = FunDef "subst" [ "tr653"] substFunTy substFunBod (FunMeta Rec NoInlin substMainExp :: Exp2 substMainExp = Ext $ LetRegionE (VarR "r720") Undefined Nothing $ Ext $ LetLocE (Single "l721") (StartOfRegionLE (VarR "r720")) $ - Ext $ LetLocE (Single "l722") (AfterConstantLE 1 (Single "l721")) $ - Ext $ LetLocE (Single "l723") (AfterConstantLE 8 (Single "l722")) $ + Ext $ LetLocE (Single "l722") (AfterConstantLE 1 [] (Single "l721")) $ + Ext $ LetLocE (Single "l723") (AfterConstantLE 8 [] (Single "l722")) $ LetE ("rhs724",[], PackedTy "Expr" (Single "l723"), DataConE (Single "l723") "VARREF" [LitE 1]) $ - Ext $ LetLocE (Single "l724") (AfterVariableLE "rhs724" (Single "l723") True) $ + Ext $ LetLocE (Single "l724") (AfterVariableLE "rhs724" [] (Single "l723") True) $ LetE ("bod725",[], PackedTy "Expr" (Single "l724"), DataConE (Single "l724") "VARREF" [LitE 10]) $ LetE ("old726",[],IntTy,LitE 1) $ @@ -1293,7 +1293,7 @@ substMainExp = Ext $ LetRegionE (VarR "r720") Undefined Nothing $ DataConE (Single "l729") "VARREF" [LitE 42]) $ LetE ("p731",[],ProdTy [IntTy, PackedTy "Expr" (Single "l729"), PackedTy "Expr" (Single "l721")], MkProdE [VarE "old726", VarE "new730", VarE "z727"]) $ - Ext $ LetLocE (Single "l730") (AfterVariableLE "new730" (Single "l729") True) $ + Ext $ LetLocE (Single "l730") (AfterVariableLE "new730" [] (Single "l729") True) $ LetE ("z732",[], PackedTy "Expr" (Single "l730"), AppE "subst" [(Single "l729"), (Single "l721"), (Single "l730")] [VarE "p731"]) $ VarE "z732" @@ -1337,11 +1337,11 @@ indrBuildTreeFun = FunDef "indrBuildTree" [ "i270"] indrBuildTreeTy indrBuildTre IfE (VarE "b279") (DataConE (Single "lout272") "Leaf" [LitE 1]) (LetE ("i273",[], IntTy, PrimAppE SubP [VarE "i270", LitE 1]) $ - Ext $ LetLocE (Single "loc_indr") (AfterConstantLE 1 (Single "lout272")) $ - Ext $ LetLocE (Single "l274") (AfterConstantLE 8 (Single "loc_indr")) $ + Ext $ LetLocE (Single "loc_indr") (AfterConstantLE 1 [] (Single "lout272")) $ + Ext $ LetLocE (Single "l274") (AfterConstantLE 8 [] (Single "loc_indr")) $ LetE ("x275",[],PackedTy "Tree" (Single "l274"), AppE "indrBuildTree" [(Single "l274")] [VarE "i273"]) $ - Ext $ LetLocE (Single "l276") (AfterVariableLE "x275" (Single "l274") True) $ + Ext $ LetLocE (Single "l276") (AfterVariableLE "x275" [] (Single "l274") True) $ LetE ("y277",[],PackedTy "Tree" (Single "l276"), AppE "indrBuildTree" [(Single "l276")] [VarE "i273"]) $ LetE ("indr_cur",[],CursorTy,Ext (StartOfPkdCursor "y277")) $ diff --git a/gibbon-compiler/src/Gibbon/L2/Interp.hs b/gibbon-compiler/src/Gibbon/L2/Interp.hs index 4d99d1e65..6f7ebaa10 100644 --- a/gibbon-compiler/src/Gibbon/L2/Interp.hs +++ b/gibbon-compiler/src/Gibbon/L2/Interp.hs @@ -308,7 +308,7 @@ interpExt sizeEnv rc env ddefs fenv ext = Just _ -> go (M.insert (unwrapLocVar loc) (VLoc (regionToVar reg) 0) env) sizeEnv bod - AfterConstantLE i loc2 -> do + AfterConstantLE i _ loc2 -> do case M.lookup (unwrapLocVar loc2) env of Nothing -> error $ "L2.Interp: Unbound location: " ++ sdoc loc2 Just (VLoc reg offset) -> @@ -316,7 +316,7 @@ interpExt sizeEnv rc env ddefs fenv ext = Just val -> error $ "L2.Interp: Unexpected value for " ++ sdoc loc2 ++ ":" ++ sdoc val - AfterVariableLE v loc2 _ -> do + AfterVariableLE v _ loc2 _ -> do case M.lookup (unwrapLocVar loc2) env of Nothing -> error $ "L2.Interp: Unbound location: " ++ sdoc loc2 Just (VLoc reg offset) -> diff --git a/gibbon-compiler/src/Gibbon/L2/Typecheck.hs b/gibbon-compiler/src/Gibbon/L2/Typecheck.hs index 6a8a3a480..04340da5e 100644 --- a/gibbon-compiler/src/Gibbon/L2/Typecheck.hs +++ b/gibbon-compiler/src/Gibbon/L2/Typecheck.hs @@ -780,14 +780,15 @@ tcExp ddfs env funs constrs regs tstatein exp = (ty,tstate2) <- tcExp ddfs env' funs constrs1 regs tstate1 e tstate3 <- removeLoc exp tstate2 (Single loc) return (ty,tstate3) - AfterConstantLE i l1 -> + {-TODO handle what needs to happen with the wildcard argument, list of offsets in case of soa -} + AfterConstantLE i _ l1 -> do r <- getRegion exp constrs l1 let tstate1 = extendTS (Single loc) (Output,True) $ setAfter l1 tstatein let constrs1 = extendConstrs (InRegionC (Single loc) r) $ extendConstrs (AfterConstantC i l1 (Single loc)) constrs (ty,tstate2) <- tcExp ddfs env' funs constrs1 regs tstate1 e tstate3 <- removeLoc exp tstate2 (Single loc) return (ty,tstate3) - AfterVariableLE x l1 _ -> + AfterVariableLE x _ l1 _ -> do r <- getRegion exp constrs l1 (_xty,tstate1) <- tcExp ddfs env funs constrs regs tstatein $ VarE x -- NOTE: We now allow aliases (offsets) from scalar vars too. So we can leave out this check diff --git a/gibbon-compiler/src/Gibbon/NewL2/FromOldL2.hs b/gibbon-compiler/src/Gibbon/NewL2/FromOldL2.hs index 229a0634a..51d9584f3 100644 --- a/gibbon-compiler/src/Gibbon/NewL2/FromOldL2.hs +++ b/gibbon-compiler/src/Gibbon/NewL2/FromOldL2.hs @@ -237,10 +237,10 @@ fromOldL2Exp ddefs fundefs locenv env2 ex = toLocArg loc locexp locenv0 = case locexp of StartOfRegionLE reg -> New.Loc (New.LREM loc (regionToVar reg) (toEndV (regionToVar reg)) Output) - AfterConstantLE _ loc2 -> + AfterConstantLE _ _ loc2 -> let (New.Loc lrem) = locenv0 # loc2 in New.Loc (New.LREM loc (New.lremReg lrem) (New.lremEndReg lrem) Output) - AfterVariableLE _ loc2 _ -> + AfterVariableLE _ _ loc2 _ -> let (New.Loc lrem) = locenv0 # loc2 in New.Loc (New.LREM loc (New.lremReg lrem) (New.lremEndReg lrem) Output) InRegionLE reg -> diff --git a/gibbon-compiler/src/Gibbon/NewL2/Syntax.hs b/gibbon-compiler/src/Gibbon/NewL2/Syntax.hs index 48f91e834..0f5bd1fb8 100644 --- a/gibbon-compiler/src/Gibbon/NewL2/Syntax.hs +++ b/gibbon-compiler/src/Gibbon/NewL2/Syntax.hs @@ -139,8 +139,8 @@ toEndFromTaggedV v = (toVar "end_from_tagged_") `varAppend` v instance FreeVars LocExp where gFreeVars e = case e of - Old.AfterConstantLE _ loc -> S.singleton $ unwrapLocVar (toLocVar loc) - Old.AfterVariableLE v loc _ -> S.fromList $ [v, unwrapLocVar (toLocVar loc)] + Old.AfterConstantLE _ _ loc -> S.singleton $ unwrapLocVar (toLocVar loc) + Old.AfterVariableLE v vs loc _ -> S.fromList [v, unwrapLocVar (toLocVar loc)] `S.union` S.fromList vs _ -> S.empty @@ -510,8 +510,8 @@ depList = L.map (\(a,b) -> (a,a,b)) . M.toList . go M.empty dep ex = case ex of Old.StartOfRegionLE r -> [Old.regionToVar r] - Old.AfterConstantLE _ loc -> [unwrapLocVar $ toLocVar loc] - Old.AfterVariableLE v loc _ -> [v, unwrapLocVar $ toLocVar loc] + Old.AfterConstantLE _ _ loc -> [unwrapLocVar $ toLocVar loc] + Old.AfterVariableLE v vs loc _ -> [v, unwrapLocVar $ toLocVar loc] ++ vs Old.InRegionLE r -> [Old.regionToVar r] Old.FromEndLE loc -> [unwrapLocVar $ toLocVar loc] Old.FreeLE -> [] diff --git a/gibbon-compiler/src/Gibbon/Passes/AddRAN.hs b/gibbon-compiler/src/Gibbon/Passes/AddRAN.hs index a2da2286a..5896e0c8f 100644 --- a/gibbon-compiler/src/Gibbon/Passes/AddRAN.hs +++ b/gibbon-compiler/src/Gibbon/Passes/AddRAN.hs @@ -426,8 +426,8 @@ we need random access for that type. let reg = case rhs of StartOfRegionLE r -> regionToVar r InRegionLE r -> regionToVar r - AfterConstantLE _ lc -> renv # lc - AfterVariableLE _ lc _ -> renv # lc + AfterConstantLE _ _ lc -> renv # lc + AfterVariableLE _ _ lc _ -> renv # lc FromEndLE lc -> renv # lc -- TODO: This needs to be fixed in needsRANExp ddefs fundefs env2 (M.insert loc reg renv) tcenv parlocss bod _ -> S.empty diff --git a/gibbon-compiler/src/Gibbon/Passes/AddTraversals.hs b/gibbon-compiler/src/Gibbon/Passes/AddTraversals.hs index 0c70cb381..e255391bd 100644 --- a/gibbon-compiler/src/Gibbon/Passes/AddTraversals.hs +++ b/gibbon-compiler/src/Gibbon/Passes/AddTraversals.hs @@ -100,8 +100,8 @@ addTraversalsExp ddefs fundefs env2 renv context ex = let reg = case locexp of StartOfRegionLE r -> regionToVar r InRegionLE r -> regionToVar r - AfterConstantLE _ lc -> renv # lc - AfterVariableLE _ lc _ -> renv # lc + AfterConstantLE _ _ lc -> renv # lc + AfterVariableLE _ _ lc _ -> renv # lc FromEndLE lc -> renv # lc -- TODO: This needs to be fixed in Ext <$> LetLocE loc locexp <$> addTraversalsExp ddefs fundefs env2 (M.insert loc reg renv) context bod diff --git a/gibbon-compiler/src/Gibbon/Passes/CalculateBounds.hs b/gibbon-compiler/src/Gibbon/Passes/CalculateBounds.hs index 58e95cb76..66204ced9 100644 --- a/gibbon-compiler/src/Gibbon/Passes/CalculateBounds.hs +++ b/gibbon-compiler/src/Gibbon/Passes/CalculateBounds.hs @@ -180,10 +180,12 @@ calculateBoundsExp ddefs env2 varSzEnv varLocEnv locRegEnv locOffEnv regSzEnv re else do let (re, off) = case locExp of (StartOfRegionLE r ) -> (regionToVar r, BoundedSize 0) - (AfterConstantLE n l ) -> (locRegEnv # l, locOffEnv # l <> BoundedSize n) + -- [2024.12.04] VS: currently discarding offsets for SoA representation + (AfterConstantLE n _ l ) -> (locRegEnv # l, locOffEnv # l <> BoundedSize n) -- [2022.12.26] CSK: the lookup in varSzEnv always fails since the -- pass never inserts anything into it. Disabling it for now. - (AfterVariableLE v l _) -> (locRegEnv # l, locOffEnv # (varLocEnv # v)) -- <> varSzEnv # v + -- [2024.12.04] VS: currently discarding offsets for SoA representation + (AfterVariableLE v _ l _) -> (locRegEnv # l, locOffEnv # (varLocEnv # v)) -- <> varSzEnv # v (InRegionLE r ) -> (regionToVar r, Undefined) (FromEndLE l ) -> (locRegEnv # l, Undefined) FreeLE -> undefined diff --git a/gibbon-compiler/src/Gibbon/Passes/Cursorize.hs b/gibbon-compiler/src/Gibbon/Passes/Cursorize.hs index 4ec9e0351..159514bb0 100644 --- a/gibbon-compiler/src/Gibbon/Passes/Cursorize.hs +++ b/gibbon-compiler/src/Gibbon/Passes/Cursorize.hs @@ -694,11 +694,12 @@ cursorizeReadPackedFile ddfs fundefs denv tenv senv isPackedContext v path tyc r cursorizeLocExp :: DepEnv -> TyEnv Var Ty2 -> SyncEnv -> LocVar -> LocExp -> Either DepEnv (Exp3, [Binds Exp3], TyEnv Var Ty2, SyncEnv) cursorizeLocExp denv tenv senv lvar locExp = case locExp of - AfterConstantLE i loc -> + AfterConstantLE i [] loc -> let rhs = Ext $ AddCursor ((unwrapLocVar . toLocVar) loc) (LitE i) in if isBound ((toLocVar) loc) tenv then Right (rhs, [], tenv, senv) else Left$ M.insertWith (++) ((toLocVar) loc) [((unwrapLocVar lvar),[],CursorTy,rhs)] denv + AfterConstantLE i irst loc -> error "cursorizeLocExp :: AfterConstantLE Bounds for SoA not implemented." -- TODO: handle product types here {- [2018.03.07]: @@ -711,7 +712,7 @@ For BigInfinite regions, this is simple: But Infinite regions do not support sizes yet. Re-enable this later. -} - AfterVariableLE v locarg was_stolen -> do + AfterVariableLE v [] locarg was_stolen -> do let vty = case M.lookup v tenv of Just ty -> ty Nothing -> case M.lookup v senv of @@ -763,6 +764,8 @@ But Infinite regions do not support sizes yet. Re-enable this later. Right (bod, bnds, tenv', M.delete v senv) else Left $ M.insertWith (++) loc [((unwrapLocVar lvar),[],CursorTy,bod)] denv + AfterVariableLE v vrst locarg was_stolen -> error "TODO: cursorizeLocExp: AfterVariableLE offsets for SoA not implemented yet." + FromEndLE locarg -> let loc = toLocVar locarg in if isBound loc tenv diff --git a/gibbon-compiler/src/Gibbon/Passes/FindWitnesses.hs b/gibbon-compiler/src/Gibbon/Passes/FindWitnesses.hs index c66570ceb..ecacb9496 100644 --- a/gibbon-compiler/src/Gibbon/Passes/FindWitnesses.hs +++ b/gibbon-compiler/src/Gibbon/Passes/FindWitnesses.hs @@ -91,10 +91,10 @@ findWitnesses p@Prog{fundefs} = mapMExprs fn p then Ext $ LetLocE loc locexp $ goE (Set.insert loc bound) mp bod else case locexp of - AfterVariableLE v loc2 b -> - (go (Map.insert loc (DelayLoc (loc, (AfterVariableLE v loc2 b))) mp) bod) - AfterConstantLE i loc2 -> - go (Map.insert loc (DelayLoc (loc, (AfterConstantLE i loc2))) mp) bod + AfterVariableLE v vs loc2 b -> + (go (Map.insert loc (DelayLoc (loc, (AfterVariableLE v vs loc2 b))) mp) bod) + AfterConstantLE i irst loc2 -> + go (Map.insert loc (DelayLoc (loc, (AfterConstantLE i irst loc2))) mp) bod _ -> Ext $ LetLocE loc locexp $ goE (Set.insert loc bound) mp bod LetRegionE r sz ty bod -> Ext $ LetRegionE r sz ty $ go mp bod LetParRegionE r sz ty bod -> Ext $ LetParRegionE r sz ty $ go mp bod diff --git a/gibbon-compiler/src/Gibbon/Passes/FollowPtrs.hs b/gibbon-compiler/src/Gibbon/Passes/FollowPtrs.hs index 1afc2e299..3cb44dc5a 100644 --- a/gibbon-compiler/src/Gibbon/Passes/FollowPtrs.hs +++ b/gibbon-compiler/src/Gibbon/Passes/FollowPtrs.hs @@ -55,7 +55,7 @@ followPtrs (Prog ddefs fundefs mainExp) = do let in_locs = foldr (\loc acc -> if loc == scrt_loc then ((Single indir_ptrv) : acc) else (loc : acc)) [] (inLocVars funTy) let out_locs = outLocVars funTy wc <- gensym "wildcard" - let indir_bod = Ext $ LetLocE (Single jump) (AfterConstantLE 8 (Single indir_ptrloc)) $ + let indir_bod = Ext $ LetLocE (Single jump) (AfterConstantLE 8 [] (Single indir_ptrloc)) $ (if isPrinterName funName then LetE (wc,[],ProdTy[],PrimAppE PrintSym [LitSymE (toVar " ->i ")]) else id) $ LetE (callv,endofs',out_ty,AppE funName (in_locs ++ out_locs) args) $ Ext (RetE ret_endofs callv) diff --git a/gibbon-compiler/src/Gibbon/Passes/InferLocations.hs b/gibbon-compiler/src/Gibbon/Passes/InferLocations.hs index a9db447c6..f61c6201b 100644 --- a/gibbon-compiler/src/Gibbon/Passes/InferLocations.hs +++ b/gibbon-compiler/src/Gibbon/Passes/InferLocations.hs @@ -276,8 +276,11 @@ data Failure = FailUnify Ty2 Ty2 -- | Constraints here mean almost the same thing as they do in the L2 type checker. -- One difference is the presence of an AfterTag constraint, though I'm not opposed to -- adding one to the L2 language for symmetry. -data Constraint = AfterConstantL LocVar Int LocVar - | AfterVariableL LocVar Var LocVar +-- [2024.12.04] VS +-- For AfterConstantL and AfterVariableL add a list argument with offsets for fields in an SoA location +-- Optional for AoS Location. +data Constraint = AfterConstantL LocVar Int [Int] LocVar + | AfterVariableL LocVar Var [Var] LocVar | AfterTagL LocVar LocVar | StartRegionL LocVar Region | AfterCopyL LocVar Var Var LocVar Var [LocVar] @@ -390,10 +393,10 @@ inferExp' ddefs env exp bound dest= expr' = foldr addLetLoc expr constrs' addLetLoc i a = case i of - AfterConstantL lv1 v lv2 -> Ext (LetLocE lv1 (AfterConstantLE v lv2) a) - AfterVariableL lv1 v lv2 -> Ext (LetLocE lv1 (AfterVariableLE v lv2 True) a) + AfterConstantL lv1 v vs lv2 -> Ext (LetLocE lv1 (AfterConstantLE v vs lv2) a) + AfterVariableL lv1 v vs lv2 -> Ext (LetLocE lv1 (AfterVariableLE v vs lv2 True) a) StartRegionL lv r -> Ext (LetRegionE r Undefined Nothing (Ext (LetLocE lv (StartOfRegionLE r) a))) - AfterTagL lv1 lv2 -> Ext (LetLocE lv1 (AfterConstantLE 1 lv2) a) + AfterTagL lv1 lv2 -> Ext (LetLocE lv1 (AfterConstantLE 1 [] lv2) a) {- VS: I think it may be fine to hardcode [] since AfterTagL is reserved for a Tag loc?-} FreeL lv -> Ext (LetLocE lv FreeLE a) AfterCopyL lv1 v1 v' lv2 f lvs -> let arrty = arrOut $ lookupFEnv f env @@ -404,7 +407,7 @@ inferExp' ddefs env exp bound dest= _ -> error "bindAllLocations: Not a packed type" a' = subst v1 (VarE v') a in LetE (v',[],copyRetTy, AppE f lvs [VarE v1]) $ - Ext (LetLocE lv1 (AfterVariableLE v' lv2 True) a') + Ext (LetLocE lv1 (AfterVariableLE v' [] lv2 True) a') in do res <- inferExp ddefs env exp dest (e,ty,cs) <- bindAllLocations res @@ -510,7 +513,7 @@ inferExp ddefs env@FullEnv{dataDefs} ex0 dest = lv2' <- finalLocVar lv2 if lv' == lv1' then do (bod',ty',cs') <- bindImmediateDependentLoc lv (bod,ty,cs) - let bod'' = Ext (LetLocE lv1' (AfterConstantLE 1 lv2') bod') + let bod'' = Ext (LetLocE lv1' (AfterConstantLE 1 [] lv2') bod') return (bod'',ty',cs') else do (bod',ty',cs') <- bindImmediateDependentLoc lv (bod,ty,cs) return (bod',ty',(AfterTagL lv1 lv2):cs') @@ -526,21 +529,22 @@ inferExp ddefs env@FullEnv{dataDefs} ex0 dest = handleTrailingBindLoc v res = do (e,ty,cs) <- bindAfterLoc v res case e of - (Ext (LetLocE lv1 (AfterVariableLE v lv2 True) e)) -> + (Ext (LetLocE lv1 (AfterVariableLE v [] lv2 True) e)) -> do (e',ty',cs') <- bindTrivialAfterLoc lv1 (e,ty,cs) - return (Ext (LetLocE lv1 (AfterVariableLE v lv2 True) e'), ty', cs') + return (Ext (LetLocE lv1 (AfterVariableLE v [] lv2 True) e'), ty', cs') _ -> return (e,ty,cs) -- Should this signal an error instead of silently returning? -- | Transforms a result by adding a location binding derived from an AfterVariable constraint -- associated with the passed-in variable. + {- TODO: what about the extra list of offset in case of an SoA loc now? -} bindAfterLoc :: Var -> Result -> TiM Result bindAfterLoc v (e,ty,c:cs) = case c of - AfterVariableL lv1 v' lv2 -> + AfterVariableL lv1 v' vs lv2 -> if v == v' then do lv1' <- finalLocVar lv1 lv2' <- finalLocVar lv2 - let res' = (Ext (LetLocE lv1' (AfterVariableLE v lv2 True) e), ty, cs) + let res' = (Ext (LetLocE lv1' (AfterVariableLE v vs lv2 True) e), ty, cs) res'' <- bindAfterLoc v res' return res'' else do (e',ty',cs') <- bindAfterLoc v (e,ty,cs) @@ -555,7 +559,7 @@ inferExp ddefs env@FullEnv{dataDefs} ex0 dest = copyRetTy = case arrOut arrty of PackedTy _ loc -> substLoc (M.singleton loc lv2) (arrOut arrty) _ -> error "bindAfterLoc: Not a packed type" - let res' = (LetE (v',[],copyRetTy,AppE f lvs [VarE v1]) $ Ext (LetLocE lv1' (AfterVariableLE v' lv2' True) e), ty, cs) + let res' = (LetE (v',[],copyRetTy,AppE f lvs [VarE v1]) $ Ext (LetLocE lv1' (AfterVariableLE v' [] lv2' True) e), ty, cs) res'' <- bindAfterLoc v res' return res'' else do (e',ty',cs') <- bindAfterLoc v (e,ty,cs) @@ -585,16 +589,16 @@ inferExp ddefs env@FullEnv{dataDefs} ex0 dest = lv' <- finalLocVar lv if lv2' == lv' then do (e',ty',cs') <- bindTrivialAfterLoc lv1 (e,ty,cs) - return (Ext (LetLocE lv1' (AfterConstantLE 1 lv2') e'), ty', cs') + return (Ext (LetLocE lv1' (AfterConstantLE 1 [] lv2') e'), ty', cs') else do (e',ty',cs') <- bindTrivialAfterLoc lv (e,ty,cs) return (e',ty',c:cs') - AfterConstantL lv1 v lv2 -> + AfterConstantL lv1 v vs lv2 -> do lv1' <- finalLocVar lv1 lv2' <- finalLocVar lv2 lv' <- finalLocVar lv if lv2' == lv' then do (e',ty',cs') <- bindTrivialAfterLoc lv1 (e,ty,cs) - return (Ext (LetLocE lv1' (AfterConstantLE v lv2') e'), ty', cs') + return (Ext (LetLocE lv1' (AfterConstantLE v vs lv2') e'), ty', cs') else do (e',ty',cs') <- bindTrivialAfterLoc lv (e,ty,cs) return (e',ty',c:cs') _ -> do (e',ty',cs') <- bindTrivialAfterLoc lv (e,ty,cs) @@ -777,11 +781,12 @@ inferExp ddefs env@FullEnv{dataDefs} ex0 dest = return $ ArgCopy v (unwrapLocVar v') f lvs _ -> err $ "Expected argument to be trivial, got " ++ (show arg) newLocs <- mapM finalLocVar locs + {-VS: DCArg needs to be extended to include offset in case of an SoA loc, harcoding empty list atm. -} let afterVar :: (DCArg, Maybe LocVar, Maybe LocVar) -> Maybe Constraint afterVar ((ArgVar v), (Just loc1), (Just loc2)) = - Just $ AfterVariableL loc1 v loc2 + Just $ AfterVariableL loc1 v [] loc2 afterVar ((ArgFixed s), (Just loc1), (Just loc2)) = - Just $ AfterConstantL loc1 s loc2 + Just $ AfterConstantL loc1 s [] loc2 afterVar ((ArgCopy v v' f lvs), (Just loc1), (Just loc2)) = Just $ AfterCopyL loc1 v v' loc2 f lvs afterVar _ = Nothing @@ -1297,12 +1302,12 @@ finishExp e = e1' <- finishExp e1 loc' <- finalLocVar loc lex' <- case lex of - AfterConstantLE i lv -> do + AfterConstantLE i irst lv -> do lv' <- finalLocVar lv - return $ AfterConstantLE i lv' - AfterVariableLE v lv b -> do + return $ AfterConstantLE i irst lv' + AfterVariableLE v vs lv b -> do lv' <- finalLocVar lv - return $ AfterVariableLE v lv' b + return $ AfterVariableLE v vs lv' b oth -> return oth return $ Ext (LetLocE loc' lex' e1') Ext (L2.AddFixed cur i) -> pure $ Ext (L2.AddFixed cur i) @@ -1418,8 +1423,8 @@ cleanExp e = Ext (LetLocE loc lex e) -> let (e',s') = cleanExp e in if S.member loc s' then let ls = case lex of - AfterConstantLE _i lv -> [lv] - AfterVariableLE _v lv _ -> [lv] + AfterConstantLE _i _irst lv -> [lv] + AfterVariableLE _v _vrst lv _ -> [lv] oth -> [] in (Ext (LetLocE loc lex e'), S.delete loc $ S.union s' $ S.fromList ls) @@ -1555,7 +1560,7 @@ moveProjsAfterSync sv ex = case sv of noAfterLoc :: LocVar -> [Constraint] -> [Constraint] -> TiM Bool noAfterLoc lv fcs (c:cs) = case c of - AfterVariableL lv1 v lv2 -> + AfterVariableL lv1 v vs lv2 -> do lv2' <- finalLocVar lv2 lv' <- finalLocVar lv if lv' == lv2' then return False else noAfterLoc lv fcs cs @@ -1568,7 +1573,7 @@ noAfterLoc lv fcs (c:cs) = -- b2 <- noAfterLoc lv1 fcs fcs -- return (b1 && b2) else noAfterLoc lv fcs cs - AfterConstantL lv1 v lv2 -> + AfterConstantL lv1 v vs lv2 -> do lv2' <- finalLocVar lv2 lv' <- finalLocVar lv if lv' == lv2' then return False else noAfterLoc lv fcs cs @@ -1578,11 +1583,11 @@ noAfterLoc _ _ [] = return True noBeforeLoc :: LocVar -> [Constraint] -> TiM Bool noBeforeLoc lv (c:cs) = case c of - AfterVariableL lv1 v lv2 -> + AfterVariableL lv1 v vs lv2 -> do lv1' <- finalLocVar lv1 lv' <- finalLocVar lv if lv' == lv1' then return False else noBeforeLoc lv cs - AfterConstantL lv1 v lv2 -> + AfterConstantL lv1 v vs lv2 -> do lv1' <- finalLocVar lv1 lv' <- finalLocVar lv if lv' == lv1' then return False else noBeforeLoc lv cs diff --git a/gibbon-compiler/src/Gibbon/Passes/ParAlloc.hs b/gibbon-compiler/src/Gibbon/Passes/ParAlloc.hs index 271f016be..67a4cd4c2 100644 --- a/gibbon-compiler/src/Gibbon/Passes/ParAlloc.hs +++ b/gibbon-compiler/src/Gibbon/Passes/ParAlloc.hs @@ -141,7 +141,8 @@ parAllocExp ddefs fundefs env2 reg_env after_env mb_parent_id pending_binds spaw (\acc b -> case b of PVar vbnd -> mkLets [vbnd] acc - PAfter (loc1, (w, loc2)) -> Ext $ LetLocE loc1 (AfterVariableLE w loc2 False) $ acc) + {-[2024.12.04] VS: Harcoding an empty list for now, seems bad. TODO: fix-} + PAfter (loc1, (w, loc2)) -> Ext $ LetLocE loc1 (AfterVariableLE w [] loc2 False) $ acc) bod2 pending_binds pure $ LetE (v, endlocs, ty, SyncE) bod3 @@ -227,7 +228,7 @@ parAllocExp ddefs fundefs env2 reg_env after_env mb_parent_id pending_binds spaw LetLocE loc locexp bod -> do case locexp of -- Binding is swallowed, and it's continuation allocates in a fresh region. - AfterVariableLE v loc2 True | S.member v spawned -> do + AfterVariableLE v vs loc2 True | S.member v spawned -> do let (Just parent_id) = mb_parent_id cont_id <- gensym "cont_id" r <- gensym "rafter" @@ -251,24 +252,24 @@ parAllocExp ddefs fundefs env2 reg_env after_env mb_parent_id pending_binds spaw LetE (not_stolen, [], BoolTy, PrimAppE EqIntP [VarE cont_id, VarE parent_id]) $ IfE (VarE not_stolen) (Ext $ LetAvail [v] $ - Ext $ LetLocE loc (AfterVariableLE v loc2 False) bod2) -- don't allocate in a fresh region + Ext $ LetLocE loc (AfterVariableLE v vs loc2 False) bod2) -- don't allocate in a fresh region (Ext $ LetParRegionE newreg Undefined Nothing $ Ext $ LetLocE (singleLocVar newloc) (StartOfRegionLE newreg) bod1) else pure $ Ext $ LetParRegionE newreg Undefined Nothing $ Ext $ LetLocE (singleLocVar newloc) (StartOfRegionLE newreg) bod1 -- Binding is swallowed, but no fresh region is created. This can brought back safely after a sync. - AfterVariableLE v loc2 True | not (S.member loc2 boundlocs) || not (S.member (singleLocVar v) boundlocs) -> do + AfterVariableLE v _ loc2 True | not (S.member loc2 boundlocs) || not (S.member (singleLocVar v) boundlocs) -> do let pending_binds' = PAfter (loc, (v, loc2)) : pending_binds reg = reg_env # loc2 reg_env' = M.insert loc reg reg_env parAllocExp ddefs fundefs env2 reg_env' after_env mb_parent_id pending_binds' spawned boundlocs region_on_spawn bod - AfterVariableLE v loc2 True | S.member loc2 boundlocs && S.member (singleLocVar v) boundlocs -> do + AfterVariableLE v vs loc2 True | S.member loc2 boundlocs && S.member (singleLocVar v) boundlocs -> do let reg = reg_env # loc2 reg_env' = M.insert loc reg reg_env boundlocs'= S.insert loc boundlocs bod' <- parAllocExp ddefs fundefs env2 reg_env' after_env mb_parent_id pending_binds spawned boundlocs' region_on_spawn bod - pure $ Ext $ LetLocE loc (AfterVariableLE v loc2 False) bod' + pure $ Ext $ LetLocE loc (AfterVariableLE v vs loc2 False) bod' FreeLE -> do let boundlocs'= S.insert loc boundlocs @@ -279,8 +280,8 @@ parAllocExp ddefs fundefs env2 reg_env after_env mb_parent_id pending_binds spaw let reg = case locexp of StartOfRegionLE r -> regionToVar r InRegionLE r -> regionToVar r - AfterConstantLE _ lc -> reg_env # lc - AfterVariableLE _ lc _ -> reg_env # lc + AfterConstantLE _ _ lc -> reg_env # lc + AfterVariableLE _ _ lc _ -> reg_env # lc FromEndLE lc -> reg_env # lc reg_env' = M.insert loc reg reg_env boundlocs'= S.insert loc boundlocs @@ -361,8 +362,8 @@ substLocInExp mp ex1 = go2 lexp = case lexp of StartOfRegionLE{} -> lexp - AfterConstantLE i loc -> AfterConstantLE i (sub loc) - AfterVariableLE i loc b -> AfterVariableLE i (sub loc) b + AfterConstantLE i irst loc -> AfterConstantLE i irst (sub loc) + AfterVariableLE i irst loc b -> AfterVariableLE i irst (sub loc) b InRegionLE{} -> lexp FreeLE -> lexp FromEndLE loc -> FromEndLE (sub loc) diff --git a/gibbon-compiler/src/Gibbon/Passes/RegionsInwards.hs b/gibbon-compiler/src/Gibbon/Passes/RegionsInwards.hs index 2dae01b26..c4506c6b9 100644 --- a/gibbon-compiler/src/Gibbon/Passes/RegionsInwards.hs +++ b/gibbon-compiler/src/Gibbon/Passes/RegionsInwards.hs @@ -80,7 +80,7 @@ placeRegionInwards env scopeSet ex = newEnv = M.insert myKey' valList' tempDict in placeRegionInwards newEnv scopeSet rhs --recurse on rhs using the newenv - AfterConstantLE _ loc' -> do --In case statement, actual match = AfterConstantLE integralVal loc' + AfterConstantLE _ _ loc' -> do --In case statement, actual match = AfterConstantLE integralVal loc' let keyList' = M.keys env key' = F.find (S.member loc') keyList' in case key' of @@ -97,7 +97,7 @@ placeRegionInwards env scopeSet ex = newEnv = M.insert myKey' valList' tempDict in placeRegionInwards newEnv scopeSet rhs - AfterVariableLE _ loc' _ -> do --In case statement, actual match = AfterVariableLE variable loc' boolVal + AfterVariableLE _ _ loc' _ -> do --In case statement, actual match = AfterVariableLE variable loc' boolVal let keyList' = M.keys env key' = F.find (S.member loc') keyList' in case key' of @@ -309,7 +309,7 @@ freeVars ex = case ex of LetLocE _ phs rhs -> case phs of StartOfRegionLE _ -> freeVars rhs - AfterConstantLE _ _ -> freeVars rhs + AfterConstantLE _ _ _ -> freeVars rhs AfterVariableLE{} -> freeVars rhs InRegionLE _ -> freeVars rhs FromEndLE _ -> freeVars rhs diff --git a/gibbon-compiler/src/Gibbon/Passes/RemoveCopies.hs b/gibbon-compiler/src/Gibbon/Passes/RemoveCopies.hs index e6e892be7..fe4c4b082 100644 --- a/gibbon-compiler/src/Gibbon/Passes/RemoveCopies.hs +++ b/gibbon-compiler/src/Gibbon/Passes/RemoveCopies.hs @@ -86,8 +86,8 @@ removeCopiesExp ddefs fundefs lenv env2 ex = let reg = case rhs of StartOfRegionLE r -> regionToVar r InRegionLE r -> regionToVar r - AfterConstantLE _ lc -> lenv # lc - AfterVariableLE _ lc _ -> lenv # lc + AfterConstantLE _ _ lc -> lenv # lc + AfterVariableLE _ _ lc _ -> lenv # lc FromEndLE lc -> lenv # lc -- TODO: This needs to be fixed Ext <$> LetLocE loc rhs <$> removeCopiesExp ddefs fundefs (M.insert loc reg lenv) env2 bod diff --git a/gibbon-compiler/src/Gibbon/Passes/ReorderScalarWrites.hs b/gibbon-compiler/src/Gibbon/Passes/ReorderScalarWrites.hs index 35125d03f..6054ede36 100644 --- a/gibbon-compiler/src/Gibbon/Passes/ReorderScalarWrites.hs +++ b/gibbon-compiler/src/Gibbon/Passes/ReorderScalarWrites.hs @@ -108,8 +108,8 @@ writeOrderMarkers (Prog ddefs fundefs mainExp) = do let reg = case rhs of L2.StartOfRegionLE r -> r L2.InRegionLE r -> r - L2.AfterConstantLE _ lc -> reg_env # lc - L2.AfterVariableLE _ lc _ -> reg_env # lc + L2.AfterConstantLE _ _ lc -> reg_env # lc + L2.AfterVariableLE _ _ lc _ -> reg_env # lc L2.FromEndLE lc -> reg_env # lc reg_env' = M.insert loc reg reg_env case M.lookup reg alloc_env of diff --git a/gibbon-compiler/src/Gibbon/Passes/RouteEnds.hs b/gibbon-compiler/src/Gibbon/Passes/RouteEnds.hs index b0b425686..19d39917b 100644 --- a/gibbon-compiler/src/Gibbon/Passes/RouteEnds.hs +++ b/gibbon-compiler/src/Gibbon/Passes/RouteEnds.hs @@ -326,7 +326,7 @@ routeEnds prg@Prog{ddefs,fundefs,mainExp} = do l2 <- gensym "jump" let l2loc = singleLocVar l2 eor' = mkEnd l1 l2loc eor - e' = Ext $ LetLocE l2loc (AfterConstantLE 1 l1) e + e' = Ext $ LetLocE l2loc (AfterConstantLE 1 [] l1) e e'' <- exp fns retlocs eor' lenv (M.insert l1 l2loc lenv) env2 e' return (dc, vls, e'') Nothing -> error $ "Failed to find " ++ sdoc x ++ " in " ++ sdoc lenv @@ -353,7 +353,7 @@ routeEnds prg@Prog{ddefs,fundefs,mainExp} = do let l2loc = singleLocVar l2 eor' = mkEnd l1 l2loc eor (Just jump) = L1.sizeOfTy ty - e' = Ext $ LetLocE l2loc (AfterConstantLE jump l1) e + e' = Ext $ LetLocE l2loc (AfterConstantLE jump [] l1) e return (eor', e') vars = L.map fst vls varsToLocs = L.map singleLocVar vars @@ -545,7 +545,7 @@ routeEnds prg@Prog{ddefs,fundefs,mainExp} = do scalar_witnesses = go la [] bind_witnesses bod ls = L.foldr (\(v,w,sz) acc -> - Ext $ LetLocE v (AfterConstantLE sz w) acc) + Ext $ LetLocE v (AfterConstantLE sz [] w) acc) bod ls bod' = bind_witnesses e scalar_witnesses bod'' = Ext (LetLocE la (FromEndLE l2) bod') diff --git a/gibbon-compiler/src/Gibbon/Passes/Simplifier.hs b/gibbon-compiler/src/Gibbon/Passes/Simplifier.hs index e32cef7b4..7ff486223 100644 --- a/gibbon-compiler/src/Gibbon/Passes/Simplifier.hs +++ b/gibbon-compiler/src/Gibbon/Passes/Simplifier.hs @@ -134,13 +134,14 @@ simplifyLocBinds only_cse (Prog ddefs fundefs mainExp) = do case ext of LetRegionE reg sz ty bod -> Ext (LetRegionE reg sz ty (go env bod)) LetParRegionE reg sz ty bod -> Ext (LetParRegionE reg sz ty (go env bod)) - LetLocE loc (AfterConstantLE i loc2) bod -> + {- TODO VS: fix for SOA case -} + LetLocE loc (AfterConstantLE i irst loc2) bod -> case (M.lookup loc2 env) of Nothing -> - Ext $ LetLocE loc (AfterConstantLE i loc2) $ + Ext $ LetLocE loc (AfterConstantLE i irst loc2) $ go (M.insert loc (loc2,i) env) bod Just (loc3,j) -> - Ext $ LetLocE loc (AfterConstantLE (i+j) loc3) $ + Ext $ LetLocE loc (AfterConstantLE (i+j) irst loc3) $ go (M.insert loc (loc3,i+j) env) bod LetLocE loc rhs bod -> Ext (LetLocE loc rhs (go env bod)) LetAvail vars bod -> Ext (LetAvail vars (go env bod)) @@ -198,8 +199,8 @@ simplifyLocBinds only_cse (Prog ddefs fundefs mainExp) = do LetParRegionE reg sz ty bod -> Ext (LetParRegionE reg sz ty (go0 env1 env2 bod)) LetLocE loc rhs bod -> let rhs' = case rhs of - AfterConstantLE i loc2 -> AfterConstantLE i (substloc env2 loc2) - AfterVariableLE v loc2 b -> AfterVariableLE v (substloc env2 loc2) b + AfterConstantLE i irst loc2 -> AfterConstantLE i irst (substloc env2 loc2) + AfterVariableLE v vrst loc2 b -> AfterVariableLE v vrst (substloc env2 loc2) b _ -> rhs in case M.lookup rhs' env1 of Nothing -> Ext (LetLocE loc rhs' (go0 (M.insert rhs' loc env1) env2 bod)) diff --git a/gibbon-compiler/src/Gibbon/Passes/ThreadRegions.hs b/gibbon-compiler/src/Gibbon/Passes/ThreadRegions.hs index 8ee1c5af6..81bd3a68a 100644 --- a/gibbon-compiler/src/Gibbon/Passes/ThreadRegions.hs +++ b/gibbon-compiler/src/Gibbon/Passes/ThreadRegions.hs @@ -455,8 +455,8 @@ threadRegionsExp ddefs fundefs fnLocArgs renv env2 lfenv rlocs_env wlocs_env pkd let reg = case rhs of StartOfRegionLE r -> regionToVar r InRegionLE r -> regionToVar r - AfterConstantLE _ lc -> renv # (toLocVar lc) - AfterVariableLE _ lc _ -> renv # (toLocVar lc) + AfterConstantLE _ _ lc -> renv # (toLocVar lc) + AfterVariableLE _ _ lc _ -> renv # (toLocVar lc) FromEndLE lc -> renv # (toLocVar lc) wlocs_env' = M.insert loc hole_tycon wlocs_env region_locs1 = case rhs of diff --git a/gibbon-compiler/src/Gibbon/Pretty.hs b/gibbon-compiler/src/Gibbon/Pretty.hs index dd742fb21..2ca52ac4b 100644 --- a/gibbon-compiler/src/Gibbon/Pretty.hs +++ b/gibbon-compiler/src/Gibbon/Pretty.hs @@ -435,10 +435,21 @@ instance Pretty l => Pretty (L2.PreLocExp l) where pprintWithStyle _ le = case le of StartOfRegionLE r -> lparen <> text "startOfRegion" <+> text (sdoc r) <> rparen - AfterConstantLE i loc -> lparen <> pprint loc <+> text "+" <+> int i <> rparen - AfterVariableLE v loc b -> if b - then text "fresh" <> (parens $ pprint loc <+> text "+" <+> doc v) - else parens $ pprint loc <+> text "+" <+> doc v + AfterConstantLE i irst loc -> case irst of + {- AoS operation -} + [] -> lparen <> pprint loc <+> text "+" <+> int i <> rparen + {-VS: for some reason i cannot pattern match on loc here!!-} + --_ -> case loc of + -- Single x -> error "This should be an SoA loc!" + -- SoA dataBufLoc fieldLocs -> error "TODO: Pretty print for SoA operation not implemented yet." + AfterVariableLE v vrst loc b -> case vrst of + [] -> if b + then text "fresh" <> (parens $ pprint loc <+> text "+" <+> doc v) + else parens $ pprint loc <+> text "+" <+> doc v + --_ -> case loc of + -- Single x -> error "This should be an SoA loc!" + -- SoA dataBufLoc fieldLocs -> error "TODO: Pretty print for SoA operation not implemented yet." + InRegionLE r -> lparen <> text "inRegion" <+> text (sdoc r) <> rparen FromEndLE loc -> lparen <> text "fromEnd" <+> pprint loc <> rparen FreeLE -> lparen <> text "free" <> rparen