[begin adding support for sub-cpr analysis
John Meacham <john@repetae.net>**20051021103833] hunk ./E/CPR.hs 9
+import Number
+import Util.SameShape
hunk ./E/CPR.hs 23
-    Top           -- the top.
-    | Fun Val     -- function taking an arg
-    | Tup Name    -- A constructed product
-    | Tag [Name]  -- A nullary constructor, like True, False
-    | Bot         -- the bottom
+    Top               -- the top.
+    | Fun Val         -- function taking an arg
+    | Tup Name [Val]  -- A constructed product
+    | VInt Number     -- A number
+    | Tag [Name]      -- A nullary constructor, like True, False
+    | Bot             -- the bottom
hunk ./E/CPR.hs 36
-    showsPrec _ (Tup n) = shows n
-    -- showsPrec _ (Tag [n]) = shows n
+    showsPrec _ (Tup n xs) = shows n <> tupled (map shows xs)
+    showsPrec _ (VInt n) = shows n
hunk ./E/CPR.hs 45
-lub (Tup a) (Tup b)
-    | a == b = Tup a
+lub (Tup a xs) (Tup b ys)
+    | a == b, sameShape1 xs ys = Tup a (zipWith lub xs ys)
+    | a == b = error "CPR.lub this shouldn't happen"
hunk ./E/CPR.hs 50
+lub (VInt n) (VInt n') | n == n' = VInt n
hunk ./E/CPR.hs 52
-lub (Tag _) (Tup _) = Top
-lub (Tup _) (Tag _) = Top
-lub a b = error $ "CPR.lub: " ++ show (a,b)
+lub (Tag _) (Tup _ _) = Top
+lub (Tup _ _) (Tag _) = Top
+lub _ _ = Top
+--lub a b = error $ "CPR.lub: " ++ show (a,b)
hunk ./E/CPR.hs 101
-    f (ELit (LitInt {})) = Top
+    f (ELit (LitInt n _)) = VInt n
hunk ./E/CPR.hs 103
-    f (ELit (LitCons n _  _)) = Tup n
-    f (EPi _ _) = Tup tc_Arrow
+    f (ELit (LitCons n xs  _)) = Tup n (map g xs)
+    f (EPi t e) = Tup tc_Arrow [g $ tvrType t, g e]
hunk ./E/CPR.hs 108
-    {-
-    f (ELam t e) = Fun (cprAnalyze (Env $ Map.insert t Top mp)  e)
-    f (EVar v)
-        | Just v <- Map.lookup v mp = v
-        | otherwise = Top
-     -}
+    g = snd . cprAnalyze env
hunk ./E/WorkerWrapper.hs 44
-    f e _ (Tup n) ts = return (Just n,e,reverse ts)
+    f e _ (Tup n _) ts = return (Just n,e,reverse ts)