[unbox strict arguments when possible
John Meacham <john@repetae.net>**20051019132310] hunk ./E/WorkerWrapper.hs 5
+import Maybe
hunk ./E/WorkerWrapper.hs 15
-import E.TypeCheck
+import E.TypeCheck()
hunk ./E/WorkerWrapper.hs 17
+import GenUtil
hunk ./E/WorkerWrapper.hs 27
-
-wrapable (Fun x) (ELam _ e) = f x e where
-    f (Fun x) (ELam _ e) = f x e
-    f (Tup _) _ = True
-    f (Tag [_]) _ = True
-    f _ _ = False
-wrapable _ _ = False
hunk ./E/WorkerWrapper.hs 29
-{-
hunk ./E/WorkerWrapper.hs 33
-    -> m (E,[TVr])  -- ^ (Body,Args)
+    -> m (Name,E,[(Maybe (Constructor,[TVr]),TVr)])  -- ^ (Body,Args)
hunk ./E/WorkerWrapper.hs 37
-    ans = f e sa cpr
-    f (ELam t e) (s:ss) (Fun x) =
-    -}
-
+    ans = f e ( sa ++ repeat L) cpr []
+    f (ELam t e) (S _:ss) (Fun x) ts
+       | Just con <- getProduct dataTable tt = f e ss x ((Just (con,as con),t):ts)
+         where
+            as con = [ tvr { tvrIdent = n, tvrType = st } | st <- slotTypes dataTable (conName con) tt | n <- tmpNames Val (tvrIdent t) ]
+            tt = getType t
+    f (ELam t e) (_:ss) (Fun x) ts = f e ss x ((Nothing,t):ts)
+    f e _ (Tup n) ts = return (n,e,reverse ts)
+    f e _ (Tag [n]) ts = return (n,e,reverse ts)
+    f _ _ _ _ = fail "not workwrapable"
hunk ./E/WorkerWrapper.hs 57
+
+tmpNames ns x = case fromId x of
+    Just y  -> [toId (toName ns ("X@",'f':show y ++ "@" ++ show i)) | i <- [(1::Int)..] ]
+    Nothing -> [toId (toName ns ("X@",'f':show x ++ "@" ++ show i)) | i <- [(1::Int)..] ]
hunk ./E/WorkerWrapper.hs 63
-workWrap' dataTable tvr e | wrapable cpr e = ans where
-    cpr = maybe Top id (Info.lookup (tvrInfo tvr))
-    sa = maybe L id (Info.lookup (tvrInfo tvr))
+workWrap' dataTable tvr e | isJust res = ans where
+    res@(~(Just (cname,body,sargs))) = wrappable dataTable tvr e
+    args = snds sargs
+    args' = concatMap f sargs where
+        f (Nothing,t) = [t]
+        f (Just (c,ts),_) = ts
+    lets = concatMap f sargs where
+        f (Nothing,_) = []
+        f (Just (c,ts),t) = [(t,ELit (LitCons (conName c) (map EVar ts) (getType t)))]
+    cases e = f sargs where
+        f [] = e
+        f ((Nothing,_):rs) = f rs
+        f ((Just (c,ts),t):rs) = eCase (EVar t) [Alt (LitCons (conName c) ts (getType t)) (f rs)] Unknown
hunk ./E/WorkerWrapper.hs 78
-    wt = typeInfer dataTable  worker
-    worker = foldr ELam body' args where
-        body' = eCase body [cb] Unknown
+    worker = foldr ELam body' args' where
+        body' = eLetRec lets $ eCase body [cb] Unknown
hunk ./E/WorkerWrapper.hs 82
-        ne | isSingleton = eStrictLet sv (foldl EAp (EVar tvr') (map EVar args))  (ELit $ LitCons cname [EVar sv] bodyTyp)
-           | otherwise = eCase (foldl EAp (EVar tvr') (map EVar args)) [ca] Unknown
+        ne | isSingleton = cases $ eStrictLet sv (foldl EAp (EVar tvr') (map EVar args'))  (ELit $ LitCons cname [EVar sv] bodyTyp)
+           | otherwise = cases $ eCase (foldl EAp (EVar tvr') (map EVar args')) [ca] Unknown
hunk ./E/WorkerWrapper.hs 89
-    bodyTyp = typeInfer dataTable body
-    (cname,args,body) = f cpr e []
-    f (Fun x) (ELam a e) as = f x e (a:as)
-    f (Tup n) e as = (n,reverse as,e)
-    f (Tag [n]) e as = (n,reverse as,e)
-    f x y z = error $ show (x,y,z)
+    Just wt = typecheck dataTable  worker
+    Just bodyTyp = typecheck dataTable body
hunk ./docs/conventions.txt 19
+* X@ - various temporary names generated from existing names