diff --git a/fco2/ParseState.hs b/fco2/ParseState.hs index 45709ad..27ab4bb 100644 --- a/fco2/ParseState.hs +++ b/fco2/ParseState.hs @@ -14,9 +14,12 @@ data ParseState = ParseState { psNames :: [(String, A.NameDef)], psNameCounter :: Int, psNonceCounter :: Int, - psPulledSpecs :: [(Meta, A.Specification)] + psPulledItems :: [A.Process -> A.Process] } - deriving (Show, Eq, Typeable, Data) + deriving (Show, Data, Typeable) + +instance Show (A.Process -> A.Process) where + show p = "(function on A.Process)" emptyState :: ParseState emptyState = ParseState { @@ -24,7 +27,7 @@ emptyState = ParseState { psNames = [], psNameCounter = 0, psNonceCounter = 0, - psPulledSpecs = [] + psPulledItems = [] } -- | Add the definition of a name. @@ -43,3 +46,16 @@ makeNonce s put ps { psNonceCounter = i + 1 } return $ s ++ "_n" ++ show i +-- | Add a pulled item to the collection. +addPulled :: MonadState ParseState m => (A.Process -> A.Process) -> m () +addPulled item + = do ps <- get + put $ ps { psPulledItems = item : psPulledItems ps } + +-- | Apply pulled items to a Process. +applyPulled :: MonadState ParseState m => A.Process -> m A.Process +applyPulled ast + = do ps <- get + let ast' = foldl (\p f -> f p) ast (psPulledItems ps) + put $ ps { psPulledItems = [] } + return ast' diff --git a/fco2/Unnest.hs b/fco2/Unnest.hs index a98be78..f1ab774 100644 --- a/fco2/Unnest.hs +++ b/fco2/Unnest.hs @@ -193,10 +193,7 @@ removeFreeNames = doGeneric `extM` doProcess `extM` doStructured `extM` doValueP removeNesting :: A.Process -> PassM A.Process removeNesting p = do p' <- pullSpecs p - st <- get - let pulled = psPulledSpecs st - put $ st { psPulledSpecs = [] } - return $ foldl (\p (m, spec) -> A.ProcSpec m spec p) p' pulled + applyPulled p' where pullSpecs :: Data t => t -> PassM t pullSpecs = doGeneric `extM` doProcess `extM` doStructured `extM` doValueProcess @@ -220,7 +217,7 @@ removeNesting p doSpec orig m spec@(_, st) child = if canPull st then do spec' <- pullSpecs spec - modify $ (\ps -> ps { psPulledSpecs = (m, spec') : psPulledSpecs ps }) + addPulled $ A.ProcSpec m spec' child' <- pullSpecs child return child' else doGeneric orig