suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added functions for helping to decompose the AST and map functions over it

Browse Source
This commit is contained in:
Neil Brown 2007-11-07 11:26:07 +00:00
parent 3b43411d4e
commit 13cf7df8bf
2 changed files with 32 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
common/FlowGraph.hs
View File

@ -45,10 +45,12 @@ module FlowGraph (EdgeLabel(..), FNode(..), FlowGraph, GraphLabelFuncs(..), buil
import Control.Monad.Error
import Control.Monad.State
import Data.Generics
import Data.Graph.Inductive
import qualified AST as A
import Metadata
import TreeUtil
import Utils
-- | A node will either have zero links out, one or more Seq links, or one or more Par links.
@ -219,3 +221,11 @@ buildFlowGraph funcs s
return (nStart, nEnd)
buildProcess p = do (liftM mkPair) $ addNode' (findMeta p) labelProcess p
decomp22 :: (Monad m, Data a, Typeable a0, Typeable a1) => (a0 -> a1 -> a) -> (a1 -> m a1) -> (a -> m a)
decomp22 con f1 = decomp2 con return f1
decomp23 :: (Monad m, Data a, Typeable a0, Typeable a1, Typeable a2) => (a0 -> a1 -> a2 -> a) -> (a1 -> m a1) -> (a -> m a)
decomp23 con f1 = decomp3 con return f1 return
decomp33 :: (Monad m, Data a, Typeable a0, Typeable a1, Typeable a2) => (a0 -> a1 -> a2 -> a) -> (a2 -> m a2) -> (a -> m a)
decomp33 con f2 = decomp3 con return return f2

22
common/TreeUtil.hs
View File

@ -24,6 +24,7 @@ module TreeUtil (
mkPattern, stopCaringPattern, namePattern, nameAndStopCaringPattern,
checkTreeForConstr,
con0, con1, con2, con3, con4, con5, con6, con7
, decomp1, decomp2, decomp3
) where
import Control.Monad.State
@ -381,3 +382,24 @@ con7 :: Data a => (a0 -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a) -> Constr
con7 f = toConstr (f undefined undefined undefined undefined undefined undefined undefined)
popFunc :: Monad m => GenericM (StateT [GenericM' m] m)
popFunc x = do (f:fs) <- get
put fs
lift ((unGM f) x)
mkM' :: (Monad m, Typeable a) => (a -> m a)-> GenericM' m
mkM' f = GM {unGM = mkM f}
gmapFuncs :: (Monad m, Data a) => [GenericM' m] -> a -> m a
gmapFuncs funcs term = evalStateT (gmapM popFunc term) funcs
--TODO check con against the constructor
decomp1 :: (Monad m, Data a, Typeable a0) => (a0 -> a) -> (a0 -> m a0) -> (a -> m a)
decomp1 con f0 = gmapFuncs [mkM' f0]
decomp2 :: (Monad m, Data a, Typeable a0, Typeable a1) => (a0 -> a1 -> a) -> (a0 -> m a0) -> (a1 -> m a1) -> (a -> m a)
decomp2 con f0 f1 = gmapFuncs [mkM' f0, mkM' f1]
decomp3 :: (Monad m, Data a, Typeable a0, Typeable a1, Typeable a2) => (a0 -> a1 -> a2 -> a) -> (a0 -> m a0) -> (a1 -> m a1) -> (a2 -> m a2) -> (a -> m a)
decomp3 con f0 f1 f2 = gmapFuncs [mkM' f0, mkM' f1, mkM' f2]