[use new type analysis, clean up E generation
John Meacham <john@repetae.net>**20060224073811] hunk ./Main.hs 209
-    wdump FD.Lambdacube $ printProgram prog
-
-    if (fopts  FO.TypeAnalysis) then do
-            prog <- typeAnalyze prog
-            putStrLn "-- Type analyzed methods"
-            flip mapM_  (programDs prog) $ \ (t,e) -> case fromLam e of
-                (_,ts@(ft:_)) | sortStarLike (getType ft) -> putStrLn $  (prettyE (EVar t)) ++ " \\" ++ concat [ "(" ++ show  (Info.fetch (tvrInfo t) :: Typ) ++ ")" | t <- ts, sortStarLike (getType t) ]
-                _ -> return ()
-            prog <- programMapBodies pruneE prog
-            return $ programPruneUnreachable prog
-        else return prog
hunk ./Main.hs 212
-        let names = [ n | (n,_,_) <- ns]
+        let names = [ n | (n,_) <- ns]
hunk ./Main.hs 214
-        when (dump FD.Lambdacube || dump FD.Pass) $ putErrLn ("----\n" ++ show names)
-        cds <- annotateDs annmap (idann (hoRules allHo) mempty) letann lamann [ (t,e) | (_,t,e) <- ns]
+        when (dump FD.Lambdacube || dump FD.Pass) $ putErrLn ("----\n" ++ pprint names)
+        cds <- annotateDs annmap (idann (hoRules allHo) mempty) letann lamann [ (t,e) | (t,e) <- ns]
hunk ./Main.hs 226
-        cds <- flip mapM (zip names cds) $ \ (n,(v,lc)) -> do
+        cds <- flip mapM cds $ \ (v,lc) -> do
hunk ./Main.hs 229
-            lc <- mangle (return ()) False ("Barendregt: " ++ show n) (return . barendregt) lc
+            lc <- mangle (return ()) False ("Barendregt: " ++ pprint v) (return . barendregt) lc
hunk ./Main.hs 233
-        cds <- flip mapM (zip names cds) $ \ (n,(v,lc)) -> do
+        cds <- flip mapM cds $ \ (v,lc) -> do
hunk ./Main.hs 235
-            lc <- mangle (return ()) False ("Barendregt: " ++ show n) (return . barendregt) lc
+            lc <- mangle (return ()) False ("Barendregt: " ++ pprint v) (return . barendregt) lc
hunk ./Main.hs 272
-        let nvls = [ (toName t,t,e)  | (t,e) <- cds ]
+        let nvls = [ (t,e)  | (t,e) <- cds ]
hunk ./Main.hs 276
-        return (nvls ++ retds, (Map.fromList [ (tvrIdent v,lc) | (_,v,lc) <- nvls] `Map.union` smap, Map.fromList [ (tvrIdent v,(Just (EVar v))) | (_,v,_) <- nvls] `Map.union` annmap , idHist' ))
+        return (nvls ++ retds, (Map.fromList [ (tvrIdent v,lc) | (v,lc) <- nvls] `Map.union` smap, Map.fromList [ (tvrIdent v,(Just (EVar v))) | (v,_) <- nvls] `Map.union` annmap , idHist' ))
hunk ./Main.hs 279
-        graph =  (newGraph ds (\ (_,b,_) -> tvrIdent b) (\ (_,b,c) -> bindingFreeVars b c))
+        graph =  (newGraph (programDs prog) (\ (b,_) -> tvrIdent b) (\ (b,c) -> bindingFreeVars b c))
hunk ./Main.hs 284
+    prog <- return $ programSetDs ds prog
+    prog <- return $ programPruneUnreachable prog
+    Stats.print "Optimization" stats
hunk ./Main.hs 288
+    prog <- if (fopts FO.TypeAnalysis) then do typeAnalyze prog else return prog
+    wdump FD.Lambdacube $ printProgram prog
+    prog <- if null $ programDs prog then return prog else do
+        ne <- (return . barendregt) (programE prog)
+        return $ programSetE ne prog
hunk ./Main.hs 294
-    prog <- return $ programSetDs [ (t,e) | (_,t,e) <- ds] prog
+    Stats.clear stats
+
+    let graph =  (newGraph (programDs prog) (\ (b,_) -> tvrIdent b) (\ (b,c) -> bindingFreeVars b c))
+        fscc (Left n) = (False,[n])
+        fscc (Right ns) = (True,ns)
+    (ds,_) <- foldM f ([],(Map.fromList [ (tvrIdent v,e) | (v,e) <- Map.elems (hoEs ho)], initMap, Set.empty)) (map fscc $ scc graph)
+    progress "!"
+    prog <- return $ programSetDs ds prog
hunk ./Main.hs 303
+    Stats.print "Optimization" stats
+
+
hunk ./Main.hs 626
-            Right _ |  xs@(_:_) <- ufreevars e' -> do
-                putErrLn $ "\n>>> internal error: Unaccountable Free Variables\n" ++ render (pprint (xs:: [TVr]))
-                putErrLn $ "\n>>>Before" <+> s
-                printEStats e
-                putDocM CharIO.putErr (ePretty e)
-                putErrLn $ "\n>>>After" <+> s
-                printEStats e'
-                erraction
-                --let (_,e'') = E.Diff.diff e e'
-                let e''' = findOddFreeVars xs e'
-                putDocM CharIO.putErr (ePrettyEx e''')
-                putErrLn $ "\n>>> internal error: Unaccountable Free Variables\n" ++ render (pprint (xs:: [TVr]))
-                case optKeepGoing options of
-                    True -> return e'
-                    False -> putErrDie "Unusual free vars in E"
+        -- temporarily disabled due to newtypes of functions
+--            Right _ |  xs@(_:_) <- ufreevars e' -> do
+--                putErrLn $ "\n>>> internal error: Unaccountable Free Variables\n" ++ render (pprint (xs:: [TVr]))
+--                putErrLn $ "\n>>>Before" <+> s
+--                printEStats e
+--                putDocM CharIO.putErr (ePretty e)
+--                putErrLn $ "\n>>>After" <+> s
+--                printEStats e'
+--                erraction
+--                --let (_,e'') = E.Diff.diff e e'
+--                let e''' = findOddFreeVars xs e'
+--                putDocM CharIO.putErr (ePrettyEx e''')
+--                putErrLn $ "\n>>> internal error: Unaccountable Free Variables\n" ++ render (pprint (xs:: [TVr]))
+--                case optKeepGoing options of
+--                    True -> return e'
+--                    False -> putErrDie "Unusual free vars in E"