[make type analysis not count instances which will be discarded
John Meacham <john@repetae.net>**20060124052720] hunk ./E/TypeAnalysis.hs 18
-import E.Inline(emapE')
+import E.Inline(emapE',emapE_)
hunk ./E/TypeAnalysis.hs 28
+type Env = (Value (Set.Set TVr),Map.Map Id [Value Typ])
hunk ./E/TypeAnalysis.hs 35
-typeAnalyze :: [(TVr,E)] -> IO [(TVr,E)]
-typeAnalyze ds = do
+-- all variables _must_ be unique before running this
+typeAnalyze :: [(TVr,E)] -> E -> IO [(TVr,E)]
+typeAnalyze ds seed = do
hunk ./E/TypeAnalysis.hs 39
+    usedVals <- newValue fixer Set.empty
hunk ./E/TypeAnalysis.hs 48
-    calcDs (extractValMap ds) ds
+    calcDs (usedVals,extractValMap ds) ds
+    calcE (usedVals,extractValMap ds) seed
hunk ./E/TypeAnalysis.hs 55
-calcDs :: Map.Map Id [Value Typ] -> [(TVr,E)] -> IO ()
-calcDs env ds = mapM_ d ds >> mapM_ (calcE env) (snds ds) where
+calcDs ::  Env -> [(TVr,E)] -> IO ()
+calcDs env@(usedVals,_) ds = do
+    mapM_ d ds
+    flip mapM_ ds $ \ (v,e) -> do
+        conditionalRule (v `Set.member`) usedVals (calcE env e)
+     where
+        --mapM_ d ds >> mapM_ (calcE env) (snds ds) where
hunk ./E/TypeAnalysis.hs 92
-calcE :: Map.Map Id [Value Typ] -> E -> IO ()
-calcE env (ELetRec ds e) = calcDs nenv ds >> calcE nenv e where
-    nenv = extractValMap ds `Map.union` env
+calcE :: Env -> E -> IO ()
+calcE (usedVals,env) (ELetRec ds e) = calcDs nenv ds >> calcE nenv e where
+    nenv = (usedVals,extractValMap ds `Map.union` env)
hunk ./E/TypeAnalysis.hs 101
-    calcScrut (eCaseScrutinee ec)
hunk ./E/TypeAnalysis.hs 104
-calcE _ ELit {} = return ()
-calcE _ EPrim {} = return ()
+calcE env e@ELit {} = tagE env e
+calcE env e@EPrim {} = tagE env e
hunk ./E/TypeAnalysis.hs 109
-calcE env e | (EVar v,as@(_:_)) <- fromAp e, Just ts <- Map.lookup (tvrIdent v) env = do
+calcE env e | (EVar v,as@(_:_)) <- fromAp e, Just ts <- Map.lookup (tvrIdent v) (snd env) = do
+    tagE env e
hunk ./E/TypeAnalysis.hs 115
-calcE _ EVar {} = return ()
-calcE _ EAp {} = return ()
+calcE env e@EVar {} = tagE env e
+calcE env e@EAp {} = tagE env e
hunk ./E/TypeAnalysis.hs 119
-calcScrut _ = return ()
+tagE (usedVals,_) (EVar v) = usedVals `isSuperSetOf` value (Set.singleton v)
+tagE env e  = emapE_ (tagE env) e
hunk ./Main.hs 369
-            ds' <- typeAnalyze ds
+            ds' <- typeAnalyze ds mn