diff --git a/parsley-core/src/ghc/Parsley/Internal/Backend/CodeGenerator.hs b/parsley-core/src/ghc/Parsley/Internal/Backend/CodeGenerator.hs index 47afb0c..9cdcd3b 100644 --- a/parsley-core/src/ghc/Parsley/Internal/Backend/CodeGenerator.hs +++ b/parsley-core/src/ghc/Parsley/Internal/Backend/CodeGenerator.hs @@ -53,11 +53,11 @@ codeGen :: (Trace, ?flags :: Opt.Flags) codeGen letBound p rs μ0 = trace ("GENERATING " ++ name ++ ": " ++ show p ++ "\nMACHINE: " ++ show (elems rs) ++ " => " ++ show m) $ makeLetBinding m rs newMeta where name = maybe "TOP LEVEL" show letBound + addCoinsTop = maybe addCoinsNeeded (const id) letBound m = finalise (histo alg p) alg :: Combinator (Cofree Combinator (CodeGen o a)) x -> CodeGen o a x alg = deep |> (\x -> CodeGen (shallow (imap extract x))) - -- it is now safe to add coins to the top-level of a binding, because it is always assumed to not cut - finalise cg = addCoinsNeeded (runCodeGenStack (runCodeGen cg (In4 Ret)) μ0 0) + finalise cg = addCoinsTop (runCodeGenStack (runCodeGen cg (In4 Ret)) μ0 0) pattern (:<$>:) :: Core.Defunc (a -> b) -> Cofree Combinator k a -> Combinator (Cofree Combinator k) b pattern f :<$>: p <- (_ :< Pure f) :<*>: p diff --git a/parsley-core/src/ghc/Parsley/Internal/Frontend/Analysis/Cut.hs b/parsley-core/src/ghc/Parsley/Internal/Frontend/Analysis/Cut.hs index 2cc78f8..a7796ba 100644 --- a/parsley-core/src/ghc/Parsley/Internal/Frontend/Analysis/Cut.hs +++ b/parsley-core/src/ghc/Parsley/Internal/Frontend/Analysis/Cut.hs @@ -33,6 +33,8 @@ newtype CutAnalysis a = CutAnalysis { doCut :: Bool -> (Fix Combinator a, Bool) -- TODO: UnguardedEffects should track a set of registers data Guardedness (a :: Type) = Guarded | UnguardedEffect | NoEffect deriving stock Eq +-- FIXME: the top-level binding needs a `cut unit *>` at the top-level + guardednessAlg :: Combinator Guardedness a -> Guardedness a guardednessAlg Pure{} = NoEffect guardednessAlg Satisfy{} = Guarded