[add ability for workerwrapper to recurse into subexpressions and work-wrap local functions
John Meacham <john@repetae.net>**20051011231301] hunk ./E/WorkerWrapper.hs 1
-module E.WorkerWrapper where
+module E.WorkerWrapper(workWrap,performWorkWrap) where
hunk ./E/WorkerWrapper.hs 3
+import Control.Monad.Identity
hunk ./E/WorkerWrapper.hs 5
+import Monad
hunk ./E/WorkerWrapper.hs 7
+import Atom
+import CanType
hunk ./E/WorkerWrapper.hs 10
-import E.E
hunk ./E/WorkerWrapper.hs 11
+import E.E
+import E.Inline
hunk ./E/WorkerWrapper.hs 14
+import E.TypeCheck
hunk ./E/WorkerWrapper.hs 16
-import CanType
hunk ./E/WorkerWrapper.hs 19
-import E.TypeCheck
+import qualified Stats
hunk ./E/WorkerWrapper.hs 33
-workWrap :: DataTable -> TVr -> E -> [(TVr,E)]
-workWrap dataTable tvr e | wrapable cpr e = ans where
+workWrap dataTable tvr e = case workWrap' dataTable tvr e of
+    Nothing -> [(tvr,e)]
+    Just (x,y) -> [x,y]
+
+workWrap' :: Monad m => DataTable -> TVr -> E -> m ((TVr,E),(TVr,E))
+workWrap' dataTable tvr e | wrapable cpr e = ans where
hunk ./E/WorkerWrapper.hs 41
-    ans = [(setProperty prop_WRAPPER tvr,wrapper),(setProperty prop_WORKER tvr',worker)]
+    ans = return ((setProperty prop_WRAPPER tvr,wrapper),(setProperty prop_WORKER tvr',worker))
hunk ./E/WorkerWrapper.hs 64
-workWrap _dataTable tvr e = [(tvr,e)]
+workWrap' _dataTable tvr e = fail "not workWrapable"
hunk ./E/WorkerWrapper.hs 66
+
+a_workWrap = toAtom "E.Simplify.WorkerWrapper"
+
+performWorkWrap :: DataTable -> [(TVr,E)] -> ([(TVr,E)],Stats.Stat)
+performWorkWrap dataTable ds = runIdentity $ Stats.runStatT (wwDs ds) where
+    wwDs :: [(TVr,E)] -> Stats.StatT Identity [(TVr,E)]
+    wwDs ds = liftM concat $ mapM wwDef ds
+    wwDef :: (TVr,E) -> Stats.StatT Identity [(TVr,E)]
+    wwDef (tvr,e) = case workWrap' dataTable tvr e of
+        Just ((tx,x),(ty,y)) -> do
+            Stats.mtick a_workWrap
+            y' <- wwE y
+            return ([ (tx,x), (ty,y') ] :: [(TVr,E)])
+        Nothing -> do
+            e' <- wwE e
+            return ([(tvr,e')]:: [(TVr,E)])
+    wwE :: E -> Stats.StatT Identity E
+    wwE (ELetRec ds e) = do
+        ds' <- wwDs ds
+        e' <- wwE e
+        return (ELetRec ds' e')
+    wwE e = emapE' wwE e