From d095ce329654c9aeed07696a6fe15ab1182c9517 Mon Sep 17 00:00:00 2001 From: anabra Date: Tue, 28 Jan 2020 21:50:35 +0100 Subject: [PATCH 1/5] ES: fixed external liveness handling in LVA --- .../ExtendedSyntax/LiveVariable/CodeGen.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/grin/src/AbstractInterpretation/ExtendedSyntax/LiveVariable/CodeGen.hs b/grin/src/AbstractInterpretation/ExtendedSyntax/LiveVariable/CodeGen.hs index cf4f55c9..47762be2 100644 --- a/grin/src/AbstractInterpretation/ExtendedSyntax/LiveVariable/CodeGen.hs +++ b/grin/src/AbstractInterpretation/ExtendedSyntax/LiveVariable/CodeGen.hs @@ -23,8 +23,6 @@ import qualified AbstractInterpretation.ExtendedSyntax.IR as IR import AbstractInterpretation.ExtendedSyntax.IR (Instruction(..), AbstractProgram(..), AbstractMapping(..)) import AbstractInterpretation.ExtendedSyntax.LiveVariable.CodeGenBase -import AbstractInterpretation.ExtendedSyntax.EffectTracking.Result - -- NOTE: For a live variable, we could store its type information. -- Live variable analysis program. @@ -400,17 +398,20 @@ codeGenM e = (cata folder >=> const setMainLive) e argRegs <- mapM getReg args mExt <- getExternal name + (funResultReg, funArgRegs) <- getOrAddFunRegs name $ length args + varPatternDataFlow appReg funResultReg + case mExt of Nothing -> do -- regular function - (funResultReg, funArgRegs) <- getOrAddFunRegs name $ length args -- no effect data-flow between formal and actual arguments zipWithM_ livenessDataFlow funArgRegs argRegs zipWithM_ (\src dst -> emit $ copyStructureWithPtrInfo src dst) argRegs funArgRegs - - varPatternDataFlow appReg funResultReg Just ext | eEffectful ext -> do mapM_ setBasicValLive argRegs + mapM_ setBasicValLive funArgRegs setBasicValSideEffecting appReg - | otherwise -> do allArgsLive <- codeGenBlock_ $ mapM_ setBasicValLive argRegs + | otherwise -> do allArgsLive <- codeGenBlock_ $ do + mapM_ setBasicValLive argRegs + mapM_ setBasicValLive funArgRegs emit $ appReg `isLiveThen` allArgsLive pure $ R appReg From 7a22de1d68c17fa4418baa947191be412474337a Mon Sep 17 00:00:00 2001 From: anabra Date: Tue, 28 Jan 2020 21:51:16 +0100 Subject: [PATCH 2/5] ES: added primop liveness to LVA tests --- .../ExtendedSyntax/LiveVariableSpec.hs | 119 ++++++++++-------- 1 file changed, 66 insertions(+), 53 deletions(-) diff --git a/grin/test/AbstractInterpretation/ExtendedSyntax/LiveVariableSpec.hs b/grin/test/AbstractInterpretation/ExtendedSyntax/LiveVariableSpec.hs index 56116b7b..8e085994 100644 --- a/grin/test/AbstractInterpretation/ExtendedSyntax/LiveVariableSpec.hs +++ b/grin/test/AbstractInterpretation/ExtendedSyntax/LiveVariableSpec.hs @@ -60,11 +60,32 @@ spec = describe "Live Variable Analysis" $ do , _registerLv = [ ("x", liveVal) , ("y", deadVal) ] - , _functionLv = mkFunctionLivenessMap [] + , _functionLv = mkFunctionLivenessMap + [ ("_prim_int_print", fun (liveVal, [liveVal])) + ] } calculated = (calcLiveness exp) { _registerEff = mempty, _functionEff = mempty } calculated `sameAs` variableAliasExpected + it "pure primop" $ do + let exp = withPrimPrelude [prog| + grinMain = + x <- pure 0 + y <- _prim_int_add x x + pure y + |] + let purePrimopExpected = emptyLVAResult + { _memory = [] + , _registerLv = [ ("x", liveVal) + , ("y", liveVal) + ] + , _functionLv = mkFunctionLivenessMap + [ ("_prim_int_add", fun (liveVal, [liveVal, liveVal])) + ] + } + calculated = (calcLiveness exp) { _registerEff = mempty, _functionEff = mempty } + calculated `sameAs` purePrimopExpected + it "as_pattern_with_node_1" $ do let exp = withPrimPrelude [prog| grinMain = @@ -80,7 +101,9 @@ spec = describe "Live Variable Analysis" $ do , ("n0", nodeSet [ (cInt, [live]) ]) , ("_v", deadNodeSet [ (cInt, 1) ]) ] - , _functionLv = mkFunctionLivenessMap [] + , _functionLv = mkFunctionLivenessMap + [ ("_prim_int_print", fun (liveVal, [liveVal])) + ] } calculated = (calcLiveness exp) { _registerEff = mempty, _functionEff = mempty } calculated `sameAs` variableAliasExpected @@ -104,7 +127,9 @@ spec = describe "Live Variable Analysis" $ do , ("alt0", deadNodeSet [ (cInt, 1) ]) ] - , _functionLv = mkFunctionLivenessMap [] + , _functionLv = mkFunctionLivenessMap + [ ("_prim_int_print", fun (liveVal, [liveVal])) + ] } calculated = (calcLiveness exp) { _registerEff = mempty, _functionEff = mempty } calculated `sameAs` variableAliasExpected @@ -118,7 +143,7 @@ spec = describe "Live Variable Analysis" $ do case n0 of (CBool c0) @ alt0 -> pure (CBool c0) (CWord c1) @ alt1 -> pure (CNode c1) - #default@alt2 -> pure (CWord a0) + #default @ alt2 -> pure (CWord a0) |] let caseAnonymousExpected = emptyLVAResult { _memory = [] @@ -1119,47 +1144,6 @@ spec = describe "Live Variable Analysis" $ do calculated = (calcLiveness exp) { _registerEff = mempty, _functionEff = mempty } calculated `sameAs` nodesSimpleExpected - it "nodes_tricky" $ do - pendingWith "illegal grin code: every node tag must have a single arity for the whole program" - let exp = [prog| - grinMain = - z0 <- pure 0 - n0 <- f z0 - case n0 of - (COne c0 c1) @ alt0 -> pure z0 - (CTwo c2 c3) @ alt1 -> pure c2 - - f x = - case x of - 0@alt2 -> pure (COne x) - 1@alt3 -> pure (CTwo z0 x) - |] - let nodesTrickyExpected = emptyLVAResult - { _memory = [] - , _registerLv = nodesTrickyExpectedRegisters - , _functionLv = nodesTrickyExpectedFunctions - } - nodesTrickyExpectedRegisters = - [ ("n0", livenessN0) - , ("c0", deadVal) - , ("c1", deadVal) - , ("c2", liveVal) - , ("c3", deadVal) - , ("x", liveVal) - - , ("z0", liveVal) - , ("alt0", deadVal) - , ("alt1", deadVal) - , ("alt2", deadVal) - , ("alt3", deadVal) - ] - nodesTrickyExpectedFunctions = mkFunctionLivenessMap - [ ("f", fun (livenessN0, [liveVal])) ] - livenessN0 = nodeSet [ (cOne, [dead]), (cTwo, [live, dead]) ] - calculated = (calcLiveness exp) { _registerEff = mempty, _functionEff = mempty } - calculated `sameAs` nodesTrickyExpected - - -- TODO: new syntax, no conversion it "sum_opt" $ do let exp = withPrimPrelude [prog| grinMain = @@ -1232,6 +1216,9 @@ spec = describe "Live Variable Analysis" $ do ] sumOptExpectedFunctions = mkFunctionLivenessMap [ ("sum", fun (liveVal, [liveVal, liveVal, liveVal])) + , ("_prim_int_print", fun (liveVal, [liveVal])) + , ("_prim_int_add", fun (liveVal, [liveVal, liveVal])) + , ("_prim_int_gt", fun (liveVal, [liveVal, liveVal])) ] sumOptExpectedRegisterEffects = @@ -1266,8 +1253,11 @@ spec = describe "Live Variable Analysis" $ do ] sumOptExpectedFunctionEffects = - [ ("sum", noEffect) - , ("grinMain", hasEffect) + [ ("sum", noEffect) + , ("grinMain", hasEffect) + , ("_prim_int_print", noEffect) + , ("_prim_int_add", noEffect) + , ("_prim_int_gt", noEffect) ] calculated = calcLiveness exp @@ -1396,7 +1386,10 @@ spec = describe "Live Variable Analysis" $ do , ("alt1", deadVal) , ("alt2", deadVal) ] - expectedFunctionLiveness = mkFunctionLivenessMap [] + expectedFunctionLiveness = mkFunctionLivenessMap + [ ("_prim_int_print", fun (deadVal, [liveVal])) + , ("_prim_string_print", fun (deadVal, [liveVal])) + ] expectedRegisterEffects = [ ("n", noEffect) @@ -1411,6 +1404,8 @@ spec = describe "Live Variable Analysis" $ do expectedFunctionEffects = [ ("grinMain", hasEffect) + , ("_prim_int_print", noEffect) + , ("_prim_string_print", noEffect) ] calculated = calcLiveness exp @@ -1453,7 +1448,10 @@ spec = describe "Live Variable Analysis" $ do , ("alt1", deadVal) , ("alt2", deadVal) ] - expectedFunctionLiveness = mkFunctionLivenessMap [] + expectedFunctionLiveness = mkFunctionLivenessMap + [ ("_prim_int_print", fun (deadVal, [liveVal])) + , ("_prim_string_print", fun (deadVal, [deadVal])) + ] expectedRegisterEffects = [ ("n", noEffect) @@ -1472,6 +1470,8 @@ spec = describe "Live Variable Analysis" $ do expectedFunctionEffects = [ ("grinMain", hasEffect) + , ("_prim_int_print", noEffect) + , ("_prim_string_print", noEffect) ] calculated = calcLiveness exp @@ -1485,7 +1485,7 @@ spec = describe "Live Variable Analysis" $ do y <- case n of (CFoo c2) @ alt0 -> pure () - #default@alt1 -> + #default @ alt1 -> z1 <- pure 0 _prim_int_print z1 pure () @@ -1507,7 +1507,9 @@ spec = describe "Live Variable Analysis" $ do , ("alt0", deadVal) , ("alt1", deadNodeSet [ (cOne, 1) ]) ] - expectedFunctionLiveness = mkFunctionLivenessMap [] + expectedFunctionLiveness = mkFunctionLivenessMap + [ ("_prim_int_print", fun (deadVal, [liveVal])) + ] expectedRegisterEffects = [ ("n", noEffect) @@ -1522,6 +1524,7 @@ spec = describe "Live Variable Analysis" $ do expectedFunctionEffects = [ ("grinMain", hasEffect) + , ("_prim_int_print", noEffect) ] calculated = calcLiveness exp @@ -1574,7 +1577,9 @@ spec = describe "Live Variable Analysis" $ do , ("alt0", deadNodeSet [ (cTwo, 1) ]) ] - expectedFunctionLiveness = mkFunctionLivenessMap [] + expectedFunctionLiveness = mkFunctionLivenessMap + [ ("_prim_string_print", fun (deadVal, [liveVal])) + ] expectedRegisterEffects = [ ("n1", noEffect) @@ -1593,6 +1598,7 @@ spec = describe "Live Variable Analysis" $ do expectedFunctionEffects = [ ("grinMain", hasEffect) + , ("_prim_string_print", noEffect) ] calculated = calcLiveness exp @@ -1643,6 +1649,8 @@ spec = describe "Live Variable Analysis" $ do [ ("f", fun (deadVal, [liveVal])) , ("g", fun (deadVal, [liveVal])) , ("h", fun (deadVal, [])) + , ("_prim_int_print", fun (deadVal, [liveVal])) + , ("_prim_string_print", fun (deadVal, [liveVal])) ] expectedRegisterEffects = @@ -1665,6 +1673,8 @@ spec = describe "Live Variable Analysis" $ do [ ("f", hasEffect) , ("g", hasEffect) , ("h", noEffect) + , ("_prim_int_print", noEffect) + , ("_prim_string_print", noEffect) , ("grinMain", hasEffect) ] @@ -1703,7 +1713,9 @@ spec = describe "Live Variable Analysis" $ do , ("alt0", deadNodeSet [ (cInt, 1) ]) , ("alt1", deadVal) ] - expectedFunctionLiveness = mkFunctionLivenessMap [] + expectedFunctionLiveness = mkFunctionLivenessMap + [ ("_prim_int_print", fun (deadVal, [liveVal])) + ] expectedRegisterEffects = [ ("x", noEffect) @@ -1719,6 +1731,7 @@ spec = describe "Live Variable Analysis" $ do expectedFunctionEffects = [ ("grinMain", hasEffect) + , ("_prim_int_print", noEffect) ] calculated = calcLiveness exp From 5bf30c79b709b83ec8151cfab061f96ff9422a0e Mon Sep 17 00:00:00 2001 From: anabra Date: Tue, 28 Jan 2020 21:57:48 +0100 Subject: [PATCH 3/5] ES: LVA now contains effect info for externals as well --- .../ExtendedSyntax/LiveVariable/CodeGen.hs | 1 + .../ExtendedSyntax/LiveVariableSpec.hs | 22 ++++++++++--------- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/grin/src/AbstractInterpretation/ExtendedSyntax/LiveVariable/CodeGen.hs b/grin/src/AbstractInterpretation/ExtendedSyntax/LiveVariable/CodeGen.hs index 47762be2..b0023357 100644 --- a/grin/src/AbstractInterpretation/ExtendedSyntax/LiveVariable/CodeGen.hs +++ b/grin/src/AbstractInterpretation/ExtendedSyntax/LiveVariable/CodeGen.hs @@ -409,6 +409,7 @@ codeGenM e = (cata folder >=> const setMainLive) e Just ext | eEffectful ext -> do mapM_ setBasicValLive argRegs mapM_ setBasicValLive funArgRegs setBasicValSideEffecting appReg + setBasicValSideEffecting funResultReg | otherwise -> do allArgsLive <- codeGenBlock_ $ do mapM_ setBasicValLive argRegs mapM_ setBasicValLive funArgRegs diff --git a/grin/test/AbstractInterpretation/ExtendedSyntax/LiveVariableSpec.hs b/grin/test/AbstractInterpretation/ExtendedSyntax/LiveVariableSpec.hs index 8e085994..9ff5d4bf 100644 --- a/grin/test/AbstractInterpretation/ExtendedSyntax/LiveVariableSpec.hs +++ b/grin/test/AbstractInterpretation/ExtendedSyntax/LiveVariableSpec.hs @@ -1255,7 +1255,7 @@ spec = describe "Live Variable Analysis" $ do sumOptExpectedFunctionEffects = [ ("sum", noEffect) , ("grinMain", hasEffect) - , ("_prim_int_print", noEffect) + , ("_prim_int_print", hasEffect) , ("_prim_int_add", noEffect) , ("_prim_int_gt", noEffect) ] @@ -1404,8 +1404,8 @@ spec = describe "Live Variable Analysis" $ do expectedFunctionEffects = [ ("grinMain", hasEffect) - , ("_prim_int_print", noEffect) - , ("_prim_string_print", noEffect) + , ("_prim_int_print", hasEffect) + , ("_prim_string_print", hasEffect) ] calculated = calcLiveness exp @@ -1450,6 +1450,7 @@ spec = describe "Live Variable Analysis" $ do ] expectedFunctionLiveness = mkFunctionLivenessMap [ ("_prim_int_print", fun (deadVal, [liveVal])) + -- NOTE: the containing alternative is dead , ("_prim_string_print", fun (deadVal, [deadVal])) ] @@ -1469,8 +1470,9 @@ spec = describe "Live Variable Analysis" $ do ] expectedFunctionEffects = - [ ("grinMain", hasEffect) - , ("_prim_int_print", noEffect) + [ ("grinMain", hasEffect) + , ("_prim_int_print", hasEffect) + -- NOTE: the containing alternative is dead , ("_prim_string_print", noEffect) ] @@ -1524,7 +1526,7 @@ spec = describe "Live Variable Analysis" $ do expectedFunctionEffects = [ ("grinMain", hasEffect) - , ("_prim_int_print", noEffect) + , ("_prim_int_print", hasEffect) ] calculated = calcLiveness exp @@ -1598,7 +1600,7 @@ spec = describe "Live Variable Analysis" $ do expectedFunctionEffects = [ ("grinMain", hasEffect) - , ("_prim_string_print", noEffect) + , ("_prim_string_print", hasEffect) ] calculated = calcLiveness exp @@ -1673,8 +1675,8 @@ spec = describe "Live Variable Analysis" $ do [ ("f", hasEffect) , ("g", hasEffect) , ("h", noEffect) - , ("_prim_int_print", noEffect) - , ("_prim_string_print", noEffect) + , ("_prim_int_print", hasEffect) + , ("_prim_string_print", hasEffect) , ("grinMain", hasEffect) ] @@ -1731,7 +1733,7 @@ spec = describe "Live Variable Analysis" $ do expectedFunctionEffects = [ ("grinMain", hasEffect) - , ("_prim_int_print", noEffect) + , ("_prim_int_print", hasEffect) ] calculated = calcLiveness exp From 2d11fcec95ecea377d0c66f2419b5966c2f0c705 Mon Sep 17 00:00:00 2001 From: anabra Date: Wed, 29 Jan 2020 12:35:37 +0100 Subject: [PATCH 4/5] ES: added test-data loading --- grin/src/Test/ExtendedSyntax/Util.hs | 19 ++++- .../dead-data-elimination/length_after.grin | 54 ++++++++++++ .../dead-data-elimination/length_before.grin | 50 +++++++++++ .../dead-data-elimination/pnode_after.grin | 75 ++++++++++++++++ .../dead-data-elimination/pnode_before.grin | 84 ++++++++++++++++++ .../pnode_after.grin | 73 ++++++++++++++++ .../pnode_before.grin | 85 +++++++++++++++++++ 7 files changed, 439 insertions(+), 1 deletion(-) create mode 100644 grin/test-data/ExtendedSyntax/dead-data-elimination/length_after.grin create mode 100644 grin/test-data/ExtendedSyntax/dead-data-elimination/length_before.grin create mode 100644 grin/test-data/ExtendedSyntax/dead-data-elimination/pnode_after.grin create mode 100644 grin/test-data/ExtendedSyntax/dead-data-elimination/pnode_before.grin create mode 100644 grin/test-data/ExtendedSyntax/dead-parameter-elimination/pnode_after.grin create mode 100644 grin/test-data/ExtendedSyntax/dead-parameter-elimination/pnode_before.grin diff --git a/grin/src/Test/ExtendedSyntax/Util.hs b/grin/src/Test/ExtendedSyntax/Util.hs index f31aefff..a95b47a8 100644 --- a/grin/src/Test/ExtendedSyntax/Util.hs +++ b/grin/src/Test/ExtendedSyntax/Util.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, MultiWayIf #-} module Test.ExtendedSyntax.Util where -- TODO: Remove this module @@ -12,14 +12,19 @@ import Data.Text (Text) import qualified Data.Set as Set import qualified Data.Map as Map +import qualified Data.List as L (isSuffixOf) import qualified Data.Vector as V import qualified Data.Text.IO as T (readFile) +import System.Directory (getCurrentDirectory) + import Grin.ExtendedSyntax.Grin import Grin.ExtendedSyntax.Parse +import Grin.ExtendedSyntax.PrimOpsPrelude import AbstractInterpretation.ExtendedSyntax.HeapPointsTo.Result as HPT import Test.Hspec +import Test.Hspec.Core.Spec (SpecM) import Test.ExtendedSyntax.Assertions cInt :: Tag @@ -100,3 +105,15 @@ mkBeforeAfterTestCase name beforeDir afterDir = (before, after, specFun) expected <- runIO $ T.readFile after' let expected' = parseProg expected it name $ transformed `sameAs` expected' + +loadTestData :: FilePath -> IO Exp +loadTestData path = do + pwd <- getCurrentDirectory + -- There is a difference between the 'stack ghci --test' and 'stack test'. + -- Stack test uses the grin/grin meanwhile stack ghci uses 'grin' directory + let testDataDir = if | "/grin/grin" `L.isSuffixOf` pwd -> "test-data/ExtendedSyntax" + | "/grin" `L.isSuffixOf` pwd -> "grin/test-data/ExtendedSyntax" + | otherwise -> error "Impossible: stack did not run inside the project dir." + + file <- T.readFile (testDataDir path) + pure $ withPrimPrelude . parseProg $ file diff --git a/grin/test-data/ExtendedSyntax/dead-data-elimination/length_after.grin b/grin/test-data/ExtendedSyntax/dead-data-elimination/length_after.grin new file mode 100644 index 00000000..4465d2d9 --- /dev/null +++ b/grin/test-data/ExtendedSyntax/dead-data-elimination/length_after.grin @@ -0,0 +1,54 @@ +grinMain = n1 <- pure (CInt 1) + t1 <- store n1 + n2 <- pure (CInt 10000) + t2 <- store n2 + n3 <- pure (Fupto t1 t2) + t3 <- store n3 + n4 <- pure (Flength t3) + t4 <- store n4 + n5 <- eval t4 + (CInt r') <- pure n5 + _prim_int_print r' + +upto m n = n6 <- eval m + (CInt m') <- pure n6 + n7 <- eval n + (CInt n') <- pure n7 + b' <- _prim_int_gt m' n' + if b' then + n8 <- pure (CNil) + pure n8 + else + m1' <- _prim_int_add m' 1 + n9 <- pure (CInt m1') + m1 <- store n9 + n10 <- pure (Fupto m1 n) + p <- store n10 + n11 <- pure (CCons.0 p) + pure n11 + +length l = l2 <- eval l + case l2 of + (CNil) -> + n12 <- pure (CInt 0) + pure n12 + (CCons.0 xs) -> + x <- pure (#undefined :: #ptr) + n13 <- length xs + (CInt l') <- pure n13 + len <- _prim_int_add l' 1 + n14 <- pure (CInt len) + pure n14 + +eval q = v <- fetch q + case v of + (CInt x'1) -> pure v + (CNil) -> pure v + (CCons.0 ys) -> y <- pure (#undefined :: #ptr) + pure v + (Fupto a b) -> w <- upto a b + update q w + pure w + (Flength c) -> z <- length c + update q z + pure z diff --git a/grin/test-data/ExtendedSyntax/dead-data-elimination/length_before.grin b/grin/test-data/ExtendedSyntax/dead-data-elimination/length_before.grin new file mode 100644 index 00000000..dc3eff64 --- /dev/null +++ b/grin/test-data/ExtendedSyntax/dead-data-elimination/length_before.grin @@ -0,0 +1,50 @@ +grinMain = n1 <- pure (CInt 1) + t1 <- store n1 + n2 <- pure (CInt 10000) + t2 <- store n2 + n3 <- pure (Fupto t1 t2) + t3 <- store n3 + n4 <- pure (Flength t3) + t4 <- store n4 + n5 <- eval t4 + (CInt r') <- pure n5 + _prim_int_print r' + +upto m n = n6 <- eval m + (CInt m') <- pure n6 + n7 <- eval n + (CInt n') <- pure n7 + b' <- _prim_int_gt m' n' + if b' then + n8 <- pure (CNil) + pure n8 + else + m1' <- _prim_int_add m' 1 + n9 <- pure (CInt m1') + m1 <- store n9 + n10 <- pure (Fupto m1 n) + p <- store n10 + n11 <- pure (CCons m p) + pure n11 + +length l = l2 <- eval l + case l2 of + (CNil) -> n12 <- pure (CInt 0) + pure n12 + (CCons x xs) -> n13 <- length xs + (CInt l') <- pure n13 + len <- _prim_int_add l' 1 + n14 <- pure (CInt len) + pure n14 + +eval q = v <- fetch q + case v of + (CInt x'1) -> pure v + (CNil) -> pure v + (CCons y ys) -> pure v + (Fupto a b) -> w <- upto a b + update q w + pure w + (Flength c) -> z <- length c + update q z + pure z \ No newline at end of file diff --git a/grin/test-data/ExtendedSyntax/dead-data-elimination/pnode_after.grin b/grin/test-data/ExtendedSyntax/dead-data-elimination/pnode_after.grin new file mode 100644 index 00000000..9cd3df82 --- /dev/null +++ b/grin/test-data/ExtendedSyntax/dead-data-elimination/pnode_after.grin @@ -0,0 +1,75 @@ +grinMain = + a0 <- pure (CInt 5) + a1 <- pure (CInt 5) + a2 <- pure (CInt 5) + p0 <- store a0 + p1 <- store a1 + p2 <- store a2 + + foo3 <- pure (P3foo) + pfoo3 <- store foo3 + + foo3ap <- pure (Fap pfoo3 p0) + pfoo3ap <- store foo3ap + foo2 <- eval pfoo3ap + pfoo2 <- store foo2 + + foo2ap <- pure (Fap pfoo2 p1) + pfoo2ap <- store foo2ap + foo1 <- eval pfoo2ap + pfoo1 <- store foo1 + + foo1ap <- pure (Fap pfoo1 p2) + pfoo1ap <- store foo1ap + fooRet <- eval pfoo1ap + + pure fooRet + + +foo x0 y0 z0 = + y0' <- eval y0 + pure y0' + +-- apply always gets the function node in whnf +apply pf cur = + case pf of + (P3foo) -> + n0 <- pure (P2foo cur) + pure n0 + (P2foo v0) -> + n1 <- pure (P1foo v0 cur) + pure n1 + (P1foo v1 v2) -> + n2 <- foo v1 v2 cur + pure n2 + +ap f x = + f' <- eval f + apply f' x + +eval p = + v <- fetch p + case v of + (CInt n) -> pure v + + (P3foo) -> pure v + (P2foo v3) -> pure v + (P1foo v4 v5) -> pure v + + (Ffoo.0) -> + b2 <- pure (#undefined :: T_Dead) + b1 <- pure (#undefined :: T_Dead) + b0 <- pure (#undefined :: T_Dead) + w0 <- foo b0 b1 b2 + update p w0 + pure w0 + (Fapply.0) -> + y <- pure (#undefined :: T_Dead) + g <- pure (#undefined :: T_Dead) + w1 <- apply g y + update p w1 + pure w1 + (Fap h z) -> + w2 <- ap h z + update p w2 + pure w2 diff --git a/grin/test-data/ExtendedSyntax/dead-data-elimination/pnode_before.grin b/grin/test-data/ExtendedSyntax/dead-data-elimination/pnode_before.grin new file mode 100644 index 00000000..dd7a21ea --- /dev/null +++ b/grin/test-data/ExtendedSyntax/dead-data-elimination/pnode_before.grin @@ -0,0 +1,84 @@ +{- + Heap locations have way too general type sets. + This is due to the fact that apply can produce + many differenct node types. + (All partial applications and return values of all functions). + apply is called by ap, which is called by eval. + This means that all pointers will have this overly general type information. + So for example the second argument of foo could be CInt or any Pfoo node. + As a consequence, since foo's return value is the return value of grinMain, + all partial applications of foo will be completely live (this is not intended). + + Eval inlining + apply inlining should solve this issue. +-} + +grinMain = + a0 <- pure (CInt 5) + a1 <- pure (CInt 5) + a2 <- pure (CInt 5) + p0 <- store a0 + p1 <- store a1 + p2 <- store a2 + + foo3 <- pure (P3foo) + pfoo3 <- store foo3 + + foo3ap <- pure (Fap pfoo3 p0) + pfoo3ap <- store foo3ap + foo2 <- eval pfoo3ap + pfoo2 <- store foo2 + + foo2ap <- pure (Fap pfoo2 p1) + pfoo2ap <- store foo2ap + foo1 <- eval pfoo2ap + pfoo1 <- store foo1 + + foo1ap <- pure (Fap pfoo1 p2) + pfoo1ap <- store foo1ap + fooRet <- eval pfoo1ap + + pure fooRet + + +foo x0 y0 z0 = + y0' <- eval y0 + pure y0' + +-- apply always gets the function node in whnf +apply pf cur = + case pf of + (P3foo) -> + n0 <- pure (P2foo cur) + pure n0 + (P2foo v0) -> + n1 <- pure (P1foo v0 cur) + pure n1 + (P1foo v1 v2) -> + n2 <- foo v1 v2 cur + pure n2 + +ap f x = + f' <- eval f + apply f' x + +eval p = + v <- fetch p + case v of + (CInt n) -> pure v + + (P3foo) -> pure v + (P2foo v3) -> pure v + (P1foo v4 v5) -> pure v + + (Ffoo b0 b1 b2) -> + w0 <- foo b0 b1 b2 + update p w0 + pure w0 + (Fapply g y) -> + w1 <- apply g y + update p w1 + pure w1 + (Fap h z) -> + w2 <- ap h z + update p w2 + pure w2 diff --git a/grin/test-data/ExtendedSyntax/dead-parameter-elimination/pnode_after.grin b/grin/test-data/ExtendedSyntax/dead-parameter-elimination/pnode_after.grin new file mode 100644 index 00000000..a2596459 --- /dev/null +++ b/grin/test-data/ExtendedSyntax/dead-parameter-elimination/pnode_after.grin @@ -0,0 +1,73 @@ +grinMain = + k0 <- pure 5 + a0 <- pure (CInt k0) + a1 <- pure (CInt k0) + a2 <- pure (CInt k0) + p0 <- store a0 + p1 <- store a1 + p2 <- store a2 + + foo3 <- pure (P3foo) + pfoo3 <- store foo3 + + foo3ap <- pure (Fap pfoo3 p0) + pfoo3ap <- store foo3ap + foo2 <- eval pfoo3ap + pfoo2 <- store foo2 + + foo2ap <- pure (Fap pfoo2 p1) + pfoo2ap <- store foo2ap + foo1 <- eval pfoo2ap + pfoo1 <- store foo1 + + foo1ap <- pure (Fap pfoo1 p2) + pfoo1ap <- store foo1ap + fooRet <- eval pfoo1ap + + pure fooRet + + +foo y0 = + z0 <- pure (#undefined :: #ptr) + x0 <- pure (#undefined :: #ptr) + y0' <- eval y0 + pure y0' + +-- apply always gets the function node in whnf +apply pf cur = + case pf of + (P3foo) @ alt1 -> + n0 <- pure (P2foo cur) + pure n0 + (P2foo v0) @ alt2 -> + n1 <- pure (P1foo v0 cur) + pure n1 + (P1foo v1 v2) @ alt3 -> + n2 <- foo v2 + pure n2 + +ap f x = + f' <- eval f + apply f' x + +eval p = + v <- fetch p + case v of + (CInt n) @ alt4 -> pure v + + (P3foo) @ alt5 -> pure v + (P2foo v3) @ alt6 -> pure v + (P1foo v4 v5) @ alt7 -> pure v + + (Ffoo b0 b1 b2) @ alt8 -> + w0 <- foo b1 + _1 <- update p w0 + pure w0 + (Fapply g y) @ alt9 -> + w1 <- apply g y + _2 <- update p w1 + pure w1 + (Fap h z) @ alt10 -> + w2 <- ap h z + _3 <- update p w2 + pure w2 diff --git a/grin/test-data/ExtendedSyntax/dead-parameter-elimination/pnode_before.grin b/grin/test-data/ExtendedSyntax/dead-parameter-elimination/pnode_before.grin new file mode 100644 index 00000000..b8d13d79 --- /dev/null +++ b/grin/test-data/ExtendedSyntax/dead-parameter-elimination/pnode_before.grin @@ -0,0 +1,85 @@ +{- + Heap locations have way too general type sets. + This is due to the fact that apply can produce + many differenct node types. + (All partial applications and return values of all functions). + apply is called by ap, which is called by eval. + This means that all pointers will have this overly general type information. + So for example the second argument of foo could be CInt or any Pfoo node. + As a consequence, since foo's return value is the return value of grinMain, + all partial applications of foo will be completely live (this is not intended). + + Eval inlining + apply inlining should solve this issue. +-} + +grinMain = + k0 <- pure 5 + a0 <- pure (CInt k0) + a1 <- pure (CInt k0) + a2 <- pure (CInt k0) + p0 <- store a0 + p1 <- store a1 + p2 <- store a2 + + foo3 <- pure (P3foo) + pfoo3 <- store foo3 + + foo3ap <- pure (Fap pfoo3 p0) + pfoo3ap <- store foo3ap + foo2 <- eval pfoo3ap + pfoo2 <- store foo2 + + foo2ap <- pure (Fap pfoo2 p1) + pfoo2ap <- store foo2ap + foo1 <- eval pfoo2ap + pfoo1 <- store foo1 + + foo1ap <- pure (Fap pfoo1 p2) + pfoo1ap <- store foo1ap + fooRet <- eval pfoo1ap + + pure fooRet + + +foo x0 y0 z0 = + y0' <- eval y0 + pure y0' + +-- apply always gets the function node in whnf +apply pf cur = + case pf of + (P3foo) @ alt1 -> + n0 <- pure (P2foo cur) + pure n0 + (P2foo v0) @ alt2 -> + n1 <- pure (P1foo v0 cur) + pure n1 + (P1foo v1 v2) @ alt3 -> + n2 <- foo v1 v2 cur + pure n2 + +ap f x = + f' <- eval f + apply f' x + +eval p = + v <- fetch p + case v of + (CInt n) @ alt4 -> pure v + + (P3foo) @ alt5 -> pure v + (P2foo v3) @ alt6 -> pure v + (P1foo v4 v5) @ alt7 -> pure v + + (Ffoo b0 b1 b2) @ alt8 -> + w0 <- foo b0 b1 b2 + _1 <- update p w0 + pure w0 + (Fapply g y) @ alt9 -> + w1 <- apply g y + _2 <- update p w1 + pure w1 + (Fap h z) @ alt10 -> + w2 <- ap h z + _3 <- update p w2 + pure w2 From db9b2162b3e25f8a1257fb8734a349ee910696af Mon Sep 17 00:00:00 2001 From: anabra Date: Sat, 1 Feb 2020 02:26:20 +0100 Subject: [PATCH 5/5] ES: change as-pat semantics in LVA Now the liveness info of the node fields is propagated into the variable. --- .../ExtendedSyntax/LiveVariable/CodeGen.hs | 22 +++++++--- .../ExtendedSyntax/LiveVariableSpec.hs | 43 +++++++++---------- 2 files changed, 36 insertions(+), 29 deletions(-) diff --git a/grin/src/AbstractInterpretation/ExtendedSyntax/LiveVariable/CodeGen.hs b/grin/src/AbstractInterpretation/ExtendedSyntax/LiveVariable/CodeGen.hs index b0023357..d31c0915 100644 --- a/grin/src/AbstractInterpretation/ExtendedSyntax/LiveVariable/CodeGen.hs +++ b/grin/src/AbstractInterpretation/ExtendedSyntax/LiveVariable/CodeGen.hs @@ -228,26 +228,34 @@ codeGenM e = (cata folder >=> const setMainLive) e lhs <- leftExp let R lhsReg = lhs - let mkRegsThenVarPatternDataFlow v = do - varReg <- newReg - addReg v varReg - varPatternDataFlow varReg lhsReg - case bPat of - VarPat v -> mkRegsThenVarPatternDataFlow v + VarPat v -> do + varReg <- newReg + addReg v varReg + varPatternDataFlow varReg lhsReg AsPat tag args v -> do + varReg <- newReg + addReg v varReg + varPatternDataFlow varReg lhsReg + irTag <- getTag tag setTagLive irTag lhsReg bindInstructions <- codeGenBlock_ $ forM (zip [1..] args) $ \(idx, arg) -> do argReg <- newReg addReg arg argReg nodePatternDataFlow argReg lhsReg irTag idx + + -- propagating liveness info backwards + emit IR.Extend + { srcReg = argReg + , dstSelector = IR.NodeItem irTag idx + , dstReg = varReg + } emit IR.If { condition = IR.NodeTypeExists irTag , srcReg = lhsReg , instructions = bindInstructions } - mkRegsThenVarPatternDataFlow v -- QUESTION: what about undefined? _ -> error $ "unsupported bpat " ++ show (PP bPat) diff --git a/grin/test/AbstractInterpretation/ExtendedSyntax/LiveVariableSpec.hs b/grin/test/AbstractInterpretation/ExtendedSyntax/LiveVariableSpec.hs index 9ff5d4bf..9df2d1e2 100644 --- a/grin/test/AbstractInterpretation/ExtendedSyntax/LiveVariableSpec.hs +++ b/grin/test/AbstractInterpretation/ExtendedSyntax/LiveVariableSpec.hs @@ -98,8 +98,8 @@ spec = describe "Live Variable Analysis" $ do { _memory = [] , _registerLv = [ ("x0", liveVal) , ("x1", liveVal) - , ("n0", nodeSet [ (cInt, [live]) ]) - , ("_v", deadNodeSet [ (cInt, 1) ]) + , ("n0", nodeSet [ (cInt, [live]) ]) + , ("_v", nodeSet' [ (cInt, [dead, live]) ]) ] , _functionLv = mkFunctionLivenessMap [ ("_prim_int_print", fun (liveVal, [liveVal])) @@ -172,9 +172,9 @@ spec = describe "Live Variable Analysis" $ do d <- pure 0 e <- pure 0 case a of - 0@alt0 -> pure b - 1@alt1 -> pure c - 2@alt2 -> pure d + 0 @ alt0 -> pure b + 1 @ alt1 -> pure c + 2 @ alt2 -> pure d |] let caseMinLitExpected = emptyLVAResult { _memory = [] @@ -194,7 +194,6 @@ spec = describe "Live Variable Analysis" $ do calculated = (calcLiveness exp) { _registerEff = mempty, _functionEff = mempty } calculated `sameAs` caseMinLitExpected - -- QUESTION: is the liveness of _1 correct? it "case_min_nodes" $ do let exp = [prog| grinMain = @@ -217,7 +216,7 @@ spec = describe "Live Variable Analysis" $ do , ("b0", liveVal) , ("z0", liveVal) - , ("_1", nodeSet' [ (cNode, [dead, dead]) ]) + , ("_1", nodeSet' [ (cNode, [dead, live]) ]) , ("alt0", deadNodeSet [ (cBool, 1) ]) , ("alt1", deadVal) , ("alt2", deadVal) @@ -240,7 +239,7 @@ spec = describe "Live Variable Analysis" $ do (CBool c1) @ alt1 -> pure (CNode c1) (CWord c2) @ alt2 -> pure (CWord c2) #default @ alt3 -> pure (CNope) - (CNode b0)@_1 <- pure n1 + (CNode b0) @ _1 <- pure n1 pure b0 |] let caseMinNodesExpected = emptyLVAResult @@ -254,7 +253,7 @@ spec = describe "Live Variable Analysis" $ do , ("b0", liveVal) , ("z0", liveVal) - , ("_1", nodeSet' [ (cNode, [dead, dead]) ]) + , ("_1", nodeSet' [ (cNode, [dead, live]) ]) , ("alt0", nodeSet' [ (cBool, [live, live]) ]) , ("alt1", deadNodeSet [ (cBool, 1) ]) , ("alt2", deadVal) @@ -368,8 +367,8 @@ spec = describe "Live Variable Analysis" $ do , ("z0", liveVal) , ("z1", liveVal) - , ("_1", nodeSet' [ (cInt, [dead, dead]) ]) - , ("_2", nodeSet' [ (cWord, [dead, dead]) ]) + , ("_1", nodeSet' [ (cInt, [dead, live]) ]) + , ("_2", nodeSet' [ (cWord, [dead, live]) ]) , ("alt0", deadNodeSet [ (cInt, 1) ]) , ("alt1", deadVal) , ("alt2", deadNodeSet [ (cWord, 1) ]) @@ -395,7 +394,7 @@ spec = describe "Live Variable Analysis" $ do (CBool c1) @ alt1 -> n2 <- f c1 pure n2 - #default@alt2 -> + #default @ alt2 -> (CWord b1) @ _2 <- pure n0 n3 <- f b1 pure n3 @@ -404,9 +403,9 @@ spec = describe "Live Variable Analysis" $ do f x = z1 <- pure 0 case x of - 0@alt3 -> pure (CInt z1) - 1@alt4 -> pure (CBool z1) - 2@alt5 -> pure (CWord z1) + 0 @ alt3 -> pure (CInt z1) + 1 @ alt4 -> pure (CBool z1) + 2 @ alt5 -> pure (CWord z1) |] caseRestrictedNodesExpected = emptyLVAResult { _memory = [] @@ -427,8 +426,8 @@ spec = describe "Live Variable Analysis" $ do , ("z0", liveVal) , ("z1", liveVal) - , ("_1", nodeSet' [ (cInt, [dead, dead]) ]) - , ("_2", nodeSet' [ (cWord, [dead, dead]) ]) + , ("_1", nodeSet' [ (cInt, [dead, live]) ]) + , ("_2", nodeSet' [ (cWord, [dead, live]) ]) , ("alt0", deadNodeSet [ (cInt, 1) ]) , ("alt1", deadNodeSet [ (cBool, 1) ]) , ("alt2", deadNodeSet [ (cWord, 1) ]) @@ -616,7 +615,7 @@ spec = describe "Live Variable Analysis" $ do , ("b1", deadVal) , ("n", livenessN) - , ("_1", nodeSet' [(cTwo, [dead, dead, dead])] ) + , ("_1", nodeSet' [(cTwo, [dead, live, dead])] ) ] livenessN = nodeSet [ (cOne, [live]) ] functionCall2ExpectedFunctions = @@ -647,7 +646,7 @@ spec = describe "Live Variable Analysis" $ do , ("z0", liveVal) , ("z1", nodeSet [ (cBool, [live]) ]) , ("z2", nodeSet [ (cBool, [live]) ]) - , ("_1", nodeSet' [ (cBool, [dead, dead]) ]) + , ("_1", nodeSet' [ (cBool, [dead, live]) ]) , ("alt0", deadNodeSet [ (cBool, 1) ]) ] , _functionLv = mkFunctionLivenessMap [] @@ -846,7 +845,7 @@ spec = describe "Live Variable Analysis" $ do , ("z0", liveVal) , ("z1", deadVal) - , ("_1", nodeSet' [ (cTwo, [dead, dead, dead]) ]) + , ("_1", nodeSet' [ (cTwo, [dead, live, dead]) ]) ] livenessN = nodeSet $ [ (cTwo, [live, dead]) ] livenessX = livenessN @@ -1310,7 +1309,7 @@ spec = describe "Live Variable Analysis" $ do , ("z2", cConsDead) , ("z3", deadVal) , ("z4", liveVal) - , ("_1", cConsDead) + , ("_1", nodeSet' [ (cCons, [dead, live, dead]) ]) ] livenessN0 = cConsDead livenessN1 = cConsDead @@ -1345,7 +1344,7 @@ spec = describe "Live Variable Analysis" $ do , ("z0", cNilLiveness) , ("z1", liveLoc) - , ("_1", deadNodeSet [ (cCons, 2) ]) + , ("_1", nodeSet' [ (cCons, [dead, live, dead]) ]) ] undefinedWithLocInfoExpectedFunctions = [ ("grinMain", fun (cNilLiveness, [])) ]