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

Include TypeSet in OpsM.

Browse Source 
This means the TypeSet is only rebuilt when the ops are extended, not
each time the operation is applied (curse the unpredictability of
Haskell CAF optimisation).
This commit is contained in:
Adam Sampson 2008-06-11 12:04:06 +00:00
parent 02c444be95
commit 7a11d0b2c3
1 changed files with 10 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
pass/Traversal.hs
View File

@ -37,7 +37,7 @@ import GenericUtils
import Pass import Pass
-- | A set of generic operations. -- | A set of generic operations.
type OpsM m = ([TypeKey], DescendM m -> RecurseM m) type OpsM m = ([TypeKey], TypeSet, DescendM m -> RecurseM m)
-- | As 'OpsM', but specialised for 'PassM'. -- | As 'OpsM', but specialised for 'PassM'.
type Ops = OpsM PassM type Ops = OpsM PassM
@ -58,14 +58,18 @@ type Check t = CheckM PassM t
-- | An empty set of operations. -- | An empty set of operations.
baseOp :: forall m. Monad m => OpsM m baseOp :: forall m. Monad m => OpsM m
baseOp = ([], id) baseOp = ([], makeTypeSet [], id)
-- | Add a 'TransformM' to a set, to be applied with explicit descent -- | Add a 'TransformM' to a set, to be applied with explicit descent
-- (that is, the transform will be responsible for recursing into child -- (that is, the transform will be responsible for recursing into child
-- elements itself). -- elements itself).
extOp :: forall m t. (Monad m, Data t) => OpsM m -> TransformM m t -> OpsM m extOp :: forall m t. (Monad m, Data t) => OpsM m -> TransformM m t -> OpsM m
extOp (tks, g) f = ((typeKey (undefined :: t)) : tks, extOp (tks, _, g) f
= (tks',
makeTypeSet tks',
(\descend -> g descend `extM` f)) (\descend -> g descend `extM` f))
where
tks' = typeKey (undefined :: t) : tks
-- | As 'extOp', but for transformations that work on all 'A.Structured' types. -- | As 'extOp', but for transformations that work on all 'A.Structured' types.
extOpS :: forall m. Monad m => extOpS :: forall m. Monad m =>
@ -132,7 +136,7 @@ type Recurse = RecurseM PassM
-- | Build a 'RecurseM' function from a set of operations. -- | Build a 'RecurseM' function from a set of operations.
makeRecurse :: forall m. Monad m => OpsM m -> RecurseM m makeRecurse :: forall m. Monad m => OpsM m -> RecurseM m
makeRecurse ops@(_, f) = f descend makeRecurse ops@(_, _, f) = f descend
where where
descend :: DescendM m descend :: DescendM m
descend = makeDescend ops descend = makeDescend ops
@ -151,11 +155,8 @@ type Descend = DescendM PassM
-- | Build a 'DescendM' function from a set of operations. -- | Build a 'DescendM' function from a set of operations.
makeDescend :: forall m. Monad m => OpsM m -> DescendM m makeDescend :: forall m. Monad m => OpsM m -> DescendM m
makeDescend ops@(tks, _) = gmapMFor ts recurse makeDescend ops@(_, ts, _) = gmapMFor ts recurse
where where
ts :: TypeSet
ts = makeTypeSet tks
recurse :: RecurseM m recurse :: RecurseM m
recurse = makeRecurse ops recurse = makeRecurse ops