[make type analysis work on combinator rules
John Meacham <john@repetae.net>**20080229122316] hunk ./E/TypeAnalysis.hs 7
-import Control.Monad.Writer
hunk ./E/TypeAnalysis.hs 72
-    calcDs env ds
+    calcCombs env $ progCombinators prog
hunk ./E/TypeAnalysis.hs 98
-calcDef :: Env -> (TVr,E) -> IO ()
-calcDef env@Env { envRuleSupply = ur, envValSupply = uv } (t,e) = do
-    let (_,ls) = fromLam e
+calcComb :: Env -> Comb -> IO ()
+calcComb env@Env { envRuleSupply = ur, envValSupply = uv } comb = do
+    let (_,ls) = fromLam $ combBody comb
hunk ./E/TypeAnalysis.hs 102
-        rs = rulesFromARules (Info.fetch (tvrInfo t))
+        rs = combRules comb
+        t = combHead comb
hunk ./E/TypeAnalysis.hs 126
+        calcE env $ combBody comb
+
+
+calcDef :: Env -> (TVr,E) -> IO ()
+calcDef env@Env { envValSupply = uv } (t,e) = do
+    valUsed <- supplyValue uv t
+    addRule $ conditionalRule id valUsed $ ioToRule $ do
hunk ./E/TypeAnalysis.hs 135
-calcDs ::  Env -> [(TVr,E)] -> IO ()
-calcDs env@Env { envRuleSupply = ur, envValSupply = uv } ds = do
-    mapM_ d ds
-    forM_ ds $ \ (v,e) -> do calcDef env (v,e)
-      --  addRule $ conditionalRule id nv (ioToRule $ calcDef env (v,e))
-     where
+calcCombs ::  Env -> [Comb] -> IO ()
+calcCombs env@Env { envRuleSupply = ur, envValSupply = uv } ds = do
+    mapM_ (calcTE env) [ (combHead c,combBody c) | c <- ds ]
+    mapM_ (calcComb env) ds
+
+calcTE ::  Env -> (TVr,E) -> IO ()
+calcTE env@Env { envRuleSupply = ur, envValSupply = uv } ds = d ds where
hunk ./E/TypeAnalysis.hs 162
+calcDs ::  Env -> [(TVr,E)] -> IO ()
+calcDs env@Env { envRuleSupply = ur, envValSupply = uv } ds = do
+    mapM_ (calcTE env) ds
+    forM_ ds $ \ (v,e) -> do calcDef env (v,e)
+
hunk ./E/TypeAnalysis.hs 239
-getTyp kind dataTable vm = f 10 kind vm where
+getTyp kind dataTable vm = f (10::Int) kind vm where
hunk ./E/TypeAnalysis.hs 404
-        calt rule@Rule { ruleArgs = (arg:rs) } = Alt vp (substMap (fromList [ (tvrIdent v,EVar r) | ~(EVar v) <- rs | r <- ras ]) $ ruleBody rule) where
+        calt rule@Rule { ruleArgs = ~(arg:rs) } = Alt vp (substMap (fromList [ (tvrIdent v,EVar r) | ~(EVar v) <- rs | r <- ras ]) $ ruleBody rule) where