[include RULES in type analysis
John Meacham <john@repetae.net>**20060224145519] hunk ./E/FromHs.hs 213
-        rule t = emptyRule { ruleHead = methodVar, ruleArgs = valToPat' (tipe t):map EVar args, ruleBinds = [ t | ~(EVar t) <- vs] ++ args, ruleBody = foldl EAp body (map EVar args), ruleUniq = (Module (show name),0), ruleName = toAtom $ "Rule.{" ++ show name ++ "}"}  where
+        rule t = emptyRule { ruleHead = methodVar, ruleArgs = valToPat' (tipe t):map EVar args, ruleBinds = [ t | ~(EVar t) <- vs] ++ args, ruleBody = body, ruleUniq = (Module (show name),0), ruleName = toAtom $ "Rule.{" ++ show name ++ "}"}  where
hunk ./E/FromHs.hs 215
-            ELit LitCons { litArgs =  vs } = valToPat' (tipe t)
+            vp@(ELit LitCons { litArgs =  vs }) = valToPat' (tipe t)
hunk ./E/FromHs.hs 217
-                Just (n,_) -> foldl EAp (EVar n) vs
+                Just (n,_) -> foldl EAp (EVar n) (vs ++ map EVar args)
hunk ./E/FromHs.hs 219
-                    Just (deftvr,_) -> EAp (EVar deftvr) (valToPat' (tipe t))
-                    Nothing -> EError ( show methodName ++ ": undefined at type " ++  PPrint.render (pprint t)) (eAp ty (valToPat' (tipe t)))
+                    Just (deftvr,_) | null vs -> foldl EAp (EAp (EVar deftvr) vp) (map EVar args)
+                    Just (deftvr,_) -> eLet tv vp $ foldl EAp (EAp (EVar deftvr) (EVar tv)) (map EVar args) where
+                        tv = tvr { tvrIdent = head [ n | n <- [2,4..], n `notElem` freeVars vp], tvrType = getType vp }
+                    Nothing -> foldl EAp (EError ( show methodName ++ ": undefined at type " ++  PPrint.render (pprint t)) (eAp ty (valToPat' (tipe t)))) (map EVar args)
hunk ./E/SSimplify.hs 19
+import Doc.PPrint
hunk ./E/SSimplify.hs 426
-                return $ EError "match falls off bottom" t
+                return $ EError ("match falls off bottom: " ++ pprint l) t
hunk ./E/Show.hs 47
+instance PPrint String (Lit E E) where
+    pprint x = prettyE (ELit x)
hunk ./E/TypeAnalysis.hs 4
-module E.TypeAnalysis(typeAnalyze, Typ(), pruneE) where
+module E.TypeAnalysis(typeAnalyze, Typ()) where
hunk ./E/TypeAnalysis.hs 18
+import E.Subst
hunk ./E/TypeAnalysis.hs 21
+import Support.FreeVars
hunk ./E/TypeAnalysis.hs 46
+{-# NOINLINE typeAnalyze #-}
hunk ./E/TypeAnalysis.hs 62
-        entries = progEntryPoints prog ++ [ t | (t,_) <- ds, getProperty prop_INSTANCE t]
+        entries = progEntryPoints prog
hunk ./E/TypeAnalysis.hs 80
+
+calcDef :: Env -> (TVr,E) -> IO ()
+calcDef env (t,e) = do
+    let (_,ls) = fromLam e
+        tls = takeWhile (sortStarLike . getType) ls
+        rs = rulesFromARules (Info.fetch (tvrInfo t))
+        hr r = do
+            let vs = concatMap (hrg r) (zip tls (ruleArgs r))
+            calcE env (substMap (Map.fromList vs) $ ruleBody r)
+        hrg r (t,EVar a) | a `elem` ruleBinds r = [(tvrIdent a,EVar t)]
+        hrg r (t,e) =  [ (tvrIdent t, EVar $ tvrInfo_u (Info.insert (value (vmapPlaceholder () :: Typ))) t) | t <- freeVars e, t `elem` ruleBinds r ]
+    mapM_ hr rs
+    calcE env e
+
hunk ./E/TypeAnalysis.hs 98
-        addRule $ conditionalRule (v `Set.member`) usedVals (ioToRule $ calcE env e)
+        addRule $ conditionalRule (v `Set.member`) usedVals (ioToRule $ calcDef env (v,e))
hunk ./E/TypeAnalysis.hs 165
-tagE (usedVals,_) (EVar v) = addRule $ usedVals `isSuperSetOf` value (Set.singleton v)
+tagE (usedVals,_) (EVar v) | not $ getProperty prop_RULEBINDER v = addRule $ usedVals `isSuperSetOf` value (Set.singleton v)
hunk ./E/TypeAnalysis.hs 226
-specializeDef _dataTable (t,e) | getProperty prop_PLACEHOLDER t = return (t,e)
+specializeDef _dataTable (t,e) | getProperty prop_PLACEHOLDER t || getProperty prop_INSTANCE t = return (t,e)
hunk ./Main.hs 381
-    mapM_ (\ (t,e) -> let (_,ts) = fromLam e in putStrLn $  (prettyE (EVar t)) ++ " \\" ++ concat [ "(" ++ show  (tvrInfo t) ++ ")" | t <- ts, sortStarLike (getType t) ] ) (filter (getProperty prop_METHOD . fst) (programDs prog))
+    mapM_ (\ (t,e) -> let (_,ts) = fromLam e in putStrLn $  (prettyE (EVar t)) ++ " \\" ++ concat [ "(" ++ show  (Info.fetch (tvrInfo t) :: Typ) ++ ")" | t <- ts, sortStarLike (getType t) ] ) ({-filter (getProperty prop_METHOD . fst)-} (programDs prog))