[don't erase rules during type analysis
John Meacham <john@repetae.net>**20080229101957] hunk ./E/Rules.hs 13
+    mapRBodyArgs,
hunk ./E/Rules.hs 157
+mapRBodyArgs :: Monad m => (E -> m E) -> Rule -> m Rule
+mapRBodyArgs g r = do
+    let f rule = do
+            b <- g (ruleBody rule)
+            as <- mapM g (ruleArgs rule)
+            return rule { ruleArgs = as, ruleBody = b }
+    f r
+
hunk ./E/Type.hs 66
-    {-!derive: update !-}
hunk ./E/Type.hs 77
-
+combBody_u f r@Comb{combBody  = x} = r{combBody = f x}
+combHead_u f r@Comb{combHead  = x} = r{combHead = f x}
+combRules_u f r@Comb{combRules  = x} = r{combRules = f x}
+combBody_s v =  combBody_u  (const v)
+combHead_s v =  combHead_u  (const v)
+combRules_s v =  combRules_u  (const v)
hunk ./E/Type.hs 275
+
+--  Imported from other files :-
+
hunk ./E/TypeAnalysis.hs 245
-    (nds,_) <- specializeDs doSpecialize SpecEnv { senvUnusedRules = unusedRules, senvUnusedVars = unusedValues, senvDataTable = progDataTable prog, senvArgs = mempty } (programDs prog)
-    return $ programSetDs nds prog
+    (nds,_) <- specializeCombs doSpecialize SpecEnv { senvUnusedRules = unusedRules, senvUnusedVars = unusedValues, senvDataTable = progDataTable prog, senvArgs = mempty } (progCombinators prog)
+    return $ progCombinators_s nds prog
hunk ./E/TypeAnalysis.hs 252
+specializeComb doSpecialize env comb = do
+    ((t,e),nds) <- specializeDef doSpecialize env (combHead comb,combBody comb)
+    return (combHead_s t . combBody_s e $ comb,nds)
+
hunk ./E/TypeAnalysis.hs 358
+--specializeDs :: MonadStats m => DataTable -> Map.Map TVr [Int] -> [(TVr,E)] -> m ([(TVr,E)]
+specializeCombs doSpecialize env@SpecEnv { senvUnusedRules = unusedRules, senvDataTable = dataTable }  ds = do
+    (ds,nenv) <- mapAndUnzipM (specializeComb doSpecialize env) ds
+    let tenv = env { senvArgs = unions nenv `union` senvArgs env }
+        sb = specBody doSpecialize tenv
+    let f comb = do
+            e <- sb (combBody comb)
+            rs <- mapM (mapRBodyArgs sb) (combRules comb)
+            let rs' =  filter ( not . (`member` unusedRules) . ruleUniq) rs
+            return . combBody_s e . combRules_s rs' $ comb
+    ds <- mapM f ds
+    return (ds,tenv)