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

Changed from using monoid (which always concatenated) to using prepending, but I'm not sure it's any faster

Browse Source
This commit is contained in:
Neil Brown 2008-11-24 10:41:30 +00:00
parent 4af8845142
commit 5bb528fbc3
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
checks/CheckFramework.hs
View File

@ -342,7 +342,7 @@ forAnyASTStructBottomUpAccum :: forall b. Data b =>
forAnyASTStructBottomUpAccum origF = CheckOptM $ do
tr <- get >>* ast
doTree (makeTypeSet $ typeKey (undefined::b) : typeKeys)
(flip evalStateT [] . applyAccum singleton typeKeys allF)
(flip evalStateT [] . applyAccum ([],(:),(++)) typeKeys allF)
tr
where
allF :: (forall c. Data c => TransFuncAcc [b] c)
@ -393,24 +393,25 @@ doTree typeSet apply tr
doTree typeSet apply tr'
Right _ -> return ()
applyAccum :: forall acc t. (Monoid acc, Data t) => (t -> acc) -> [TypeKey] -> (forall a. Data a => TransFuncAcc acc a) ->
applyAccum :: forall acc t. (Data t) => (acc, t -> acc -> acc, acc -> acc -> acc) ->
[TypeKey] -> (forall a. Data a => TransFuncAcc acc a) ->
(forall b. Data b => (b, Route b A.AST) -> StateT acc (RestartT CheckOptM) b)
applyAccum accF typeKeysGiven = applyAccum'
applyAccum (accEmpty, accOneF, accJoinF) typeKeysGiven = applyAccum'
where
typeSet = makeTypeSet $ typeKey (undefined :: t) : typeKeysGiven
extF ::
(forall a. Data a => TransFuncS acc z a) ->
(forall c. Data c => TransFuncS acc z c)
extF = (`extMRAccS` (\(x,_) -> modify (`mappend` accF x) >> return x))
extF = (`extMRAccS` (\(x,_) -> modify (accOneF x) >> return x))
applyAccum' :: (forall a. Data a => TransFuncAcc acc a) ->
(forall b. Data b => (b, Route b A.AST) -> StateT acc (RestartT CheckOptM) b)
applyAccum' f (x, route)
= do when (findMeta x /= emptyMeta) $ lift . lift . CheckOptM $ modify $ \d -> d {lastValidMeta = findMeta x}
(x', acc) <- lift $ flip runStateT mempty (gmapMForRoute typeSet (extF wrap) x)
(x', acc) <- lift $ flip runStateT accEmpty (gmapMForRoute typeSet (extF wrap) x)
r <- f' (x', route, acc)
modify (`mappend` acc)
modify (`accJoinF` acc)
return r
where
wrap (y, route') = applyAccum' f (y, route @-> route')