diff --git a/core/src/Ohua/DFGraph.hs b/core/src/Ohua/DFGraph.hs index 5e5ce81..4cfbd7f 100644 --- a/core/src/Ohua/DFGraph.hs +++ b/core/src/Ohua/DFGraph.hs @@ -11,6 +11,7 @@ module Ohua.DFGraph where import Ohua.Prelude import qualified Data.HashMap.Strict as HM +import qualified Data.HashSet as HS import Ohua.DFLang.Lang data Operator = Operator @@ -26,8 +27,8 @@ data Target = Target data Arcs envExpr = Arcs { direct :: ![DirectArc envExpr] - , compound :: ![CompoundArc] , state :: ![StateArc envExpr] + , dead :: ![DeadArc] } deriving (Eq, Generic, Show) data Arc target source = Arc @@ -35,11 +36,13 @@ data Arc target source = Arc , source :: !source } deriving (Eq, Show, Generic) -type CompoundArc = Arc Target [Target] - type DirectArc envExpr = Arc Target (Source envExpr) - type StateArc envExpr = Arc FnId (Source envExpr) +-- | A dead arc is a binding created in DFLang that is unused. Hence its +-- 'target' field is the constant '()' and the 'source' is some operator at some +-- index. Mostly this is used when dataflow operators that implement the +-- argument dispatch themselves have one of their outputs be unused. +type DeadArc = Arc () Target data Source envExpr = LocalSource !Target @@ -94,17 +97,12 @@ toGraph (DFExpr lets r) = OutGraph ops grArcs (getSource r) | (var, idx) <- zip (output l) [0 ..] ] grArcs = - let (compounds, directs) = - partitionEithers - [ case v of - DFVarList l -> Left $ arc $ map getSource l - _ -> Right $ arc $ varToSource v - | LetExpr {..} <- toList lets - , (idx, v) <- zip [0 ..] callArguments - , let arc :: source -> Arc Target source - arc = Arc $ Target callSiteId idx - ] - in Arcs directs compounds states + let directs = + [ Arc (Target callSiteId idx) $ varToSource v + | LetExpr {..} <- toList lets + , (idx, v) <- zip [0 ..] callArguments + ] + in Arcs directs states deads getSource v = fromMaybe (error $ @@ -115,6 +113,12 @@ toGraph (DFExpr lets r) = OutGraph ops grArcs (getSource r) \case DFVar v -> LocalSource $ getSource v DFEnvVar envExpr -> EnvSource envExpr - DFVarList _ -> error "Invariant Broken!" + deads = + map (Arc () . getSource) $ + HS.toList $ allBindings `HS.difference` usedBindings + where + allBindings = HS.fromList $ toList lets >>= output + usedBindings = + HS.fromList $ [v | l <- toList lets, DFVar v <- callArguments l] -- spliceEnv :: (Int -> a) -> OutGraph -> AbstractOutGraph a -- spliceEnv lookupExpr = fmap f where f i = lookupExpr $ unwrap i diff --git a/core/src/Ohua/DFGraph/Show.hs b/core/src/Ohua/DFGraph/Show.hs index cdda0bd..38ea9d6 100644 --- a/core/src/Ohua/DFGraph/Show.hs +++ b/core/src/Ohua/DFGraph/Show.hs @@ -15,7 +15,7 @@ import Ohua.DFGraph -- | TODO show return arc asTable :: OutGraph -> T.Text -asTable (OutGraph ops (Arcs direct compound state) _) = +asTable (OutGraph ops Arcs {..} _) = T.pack $ render $ vsep @@ -28,13 +28,6 @@ asTable (OutGraph ops (Arcs direct compound state) _) = 4 top [sourceList direct sourceToBox, targetList direct targetToBox] - , text "Compound Arcs" - , hsep - 4 - top - [ sourceList compound $ hsep 1 left . map targetToBox - , targetList compound targetToBox - ] , text "State Arcs" , hsep 4 @@ -42,6 +35,8 @@ asTable (OutGraph ops (Arcs direct compound state) _) = [ sourceList state sourceToBox , targetList state $ text . show . unwrap ] + , text "Dead Arcs" + , hsep 4 top [sourceList dead $ targetToBox] ] where idList = diff --git a/core/src/Ohua/DFLang/Lang.hs b/core/src/Ohua/DFLang/Lang.hs index 6adc80d..343d984 100644 --- a/core/src/Ohua/DFLang/Lang.hs +++ b/core/src/Ohua/DFLang/Lang.hs @@ -52,7 +52,7 @@ data DFFnRef = DFFnRef instance Hashable DFFnRef pattern DFFunction :: QualifiedBinding -> DFFnRef -pattern DFFunction b = DFFnRef OperatorNode b +pattern DFFunction b = DFFnRef OperatorNode b pattern EmbedSf :: QualifiedBinding -> DFFnRef pattern EmbedSf b = DFFnRef FunctionNode b @@ -71,7 +71,6 @@ instance NFData NodeType data DFVar = DFEnvVar !Lit | DFVar !Binding - | DFVarList ![Binding] deriving (Eq, Show, Lift, Generic) instance Hashable DFVar diff --git a/core/src/Ohua/DFLang/PPrint.hs b/core/src/Ohua/DFLang/PPrint.hs index 2db0465..08f52d1 100644 --- a/core/src/Ohua/DFLang/PPrint.hs +++ b/core/src/Ohua/DFLang/PPrint.hs @@ -34,7 +34,6 @@ prettyDFVar :: DFVar -> Doc a prettyDFVar = \case DFEnvVar he -> pretty he DFVar b -> pretty b - DFVarList bnds -> PP.list $ map pretty bnds instance Pretty DFVar where pretty = prettyDFVar diff --git a/core/src/Ohua/DFLang/Passes.hs b/core/src/Ohua/DFLang/Passes.hs index 34ef4bc..5fee4c5 100644 --- a/core/src/Ohua/DFLang/Passes.hs +++ b/core/src/Ohua/DFLang/Passes.hs @@ -29,7 +29,6 @@ import Ohua.ALang.PPrint import Ohua.DFLang.Lang import qualified Ohua.DFLang.Refs as Refs -import Ohua.DFLang.Util import Ohua.Stage type Pass m @@ -209,8 +208,7 @@ collapseNth selectionFunction = return $ Just e {output = newOuts, functionRef = DFFnRef OperatorNode fun} - | [DFEnvVar (NumericLit index), _len, DFVar source] <- callArguments e = do - toRemove <- getPast + | [DFEnvVar (NumericLit index), _len, DFVar source] <- callArguments e = ifM (queryRemoval source) (recordRemoval source oldOut index >> return Nothing) diff --git a/core/src/Ohua/DFLang/Verify.hs b/core/src/Ohua/DFLang/Verify.hs index fb118fe..4b5558a 100644 --- a/core/src/Ohua/DFLang/Verify.hs +++ b/core/src/Ohua/DFLang/Verify.hs @@ -18,22 +18,6 @@ verify = sequence_ . sequenceA checks checks :: [DFExpr -> m ()] checks = [checkBuiltinArities] -checkDFVarList :: MonadError Error m => DFExpr -> m () -checkDFVarList e = for_ (letExprs e) check - where - check l@(LetExpr {functionRef, callArguments}) - | hasVarArgList callArguments = - case functionRef of - DFFunction _ -> pure () - _ -> - error $ - "Invariant broken: Only dataflow operators can have var lists! " <> - "This is not a dataflow function: " <> - (show l) - hasVarArgList (DFVarList _:_) = True - hasVarArgList (_:[]) = False - hasVarArgList (_:args) = hasVarArgList args - checkBuiltinArities :: MonadError Error m => DFExpr -> m () checkBuiltinArities e = for_ (letExprs e) $ \LetExpr {functionRef, callArguments} -> diff --git a/core/src/Ohua/Feature/TailRec/Passes/DFLang.hs b/core/src/Ohua/Feature/TailRec/Passes/DFLang.hs index f7e4eb4..d01f6dc 100644 --- a/core/src/Ohua/Feature/TailRec/Passes/DFLang.hs +++ b/core/src/Ohua/Feature/TailRec/Passes/DFLang.hs @@ -8,8 +8,7 @@ import Ohua.DFLang.Refs as Refs import Ohua.DFLang.Util import qualified Ohua.Feature.TailRec.Passes.ALang as ALangPass -import qualified Data.List.NonEmpty as NE -import Data.Sequence as DS ((><), filter) +import Data.Sequence as DS (filter) recurLowering :: DFExpr -> DFExpr recurLowering (DFExpr letExprs returnVar) diff --git a/tests/src/AesonConvertSpec.hs b/tests/src/AesonConvertSpec.hs index 4751b51..aa958c2 100644 --- a/tests/src/AesonConvertSpec.hs +++ b/tests/src/AesonConvertSpec.hs @@ -55,7 +55,7 @@ spec = describe "encode . decode == id" $ do prop "for targets" (testConvert :: Target -> Result) prop "for direct arcs" (testConvert :: DirectArc Lit -> Result) prop "for state arcs" (testConvert :: StateArc Lit -> Result) - prop "for compound arcs" (testConvert :: CompoundArc -> Result) + prop "for compound arcs" (testConvert :: DeadArc -> Result) prop "for sources" (testConvert :: Source HostExpr -> Result) prop "for fn names" (testConvert :: Binding -> Result) prop "for fn ids" (testConvert :: FnId -> Result)