[create  appropriate worker/wrappers for CPR analysis
John Meacham <john@repetae.net>**20051002120759] hunk ./E/WorkerWrapper.hs 9
+import E.Values
+import CanType
hunk ./E/WorkerWrapper.hs 14
+import E.TypeCheck
hunk ./E/WorkerWrapper.hs 21
-wrapable (Fun x) = f x where
-    f (Fun x) = f x
-    f (Tup _) = True
-    f _ = False
+wrapable (Fun x) (ELam _ e) = f x e where
+    f (Fun x) (ELam _ e) = f x e
+    f (Tup _) _ = True
+    f _ _ = False
+wrapable _ _ = False
hunk ./E/WorkerWrapper.hs 28
-workWrap dataTable tvr e | wrapable cpr = ans where
+workWrap dataTable tvr e | wrapable cpr e = ans where
hunk ./E/WorkerWrapper.hs 36
-    wt = undefined
-    worker = undefined
-    wrapper = undefined
-    Just c = getConstructor cname dataTable
+    wt = typeInfer dataTable  worker
+    worker = foldr ELam body' args where
+        body' = eCase body [cb] Unknown
+        cb = Alt (LitCons cname vars bodyTyp) (if isSingleton then EVar sv else (ELit $ unboxedTuple (map EVar vars)))
+    wrapper = foldr ELam ne args where
+        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
+        ca = Alt (unboxedTuple vars) (ELit $ LitCons cname (map EVar vars) bodyTyp)
+    vars@(~[sv]) = [  tVr i t | t <- slotTypes dataTable cname bodyTyp | i <- [2,4..] ]
+    isSingleton = case vars of
+        [v] -> getType (getType v) == eHash
+        _ -> False
+    bodyTyp = typeInfer dataTable body
hunk ./E/WorkerWrapper.hs 51
-    f (Tup n) e as = (n,as,e)
+    f (Tup n) e as = (n,reverse as,e)
+    f x y z = error $ show (x,y,z)