[add initial optimization pass that performs type analysis and floating
John Meacham <john@repetae.net>**20060322042925] hunk ./Main.hs 26
+import E.Inline
hunk ./Main.hs 253
-    prog <- return $ etaAnnotateProgram prog
+    let initMap = Map.fromList [ (tvrIdent t, Just (EVar t)) | (t,_) <- (Map.elems (hoEs ho))]
+
+    -- initial pass, performs
+    -- eta expansion of definitons
+    -- simplify
+    -- type analysis
+    -- floating outward
+    -- simplify
+    -- floating inward
+
+    let fint (rec,ns) = do
+        let names = [ n | (n,_) <- ns]
+        stats <- Stats.new
+        let mprog = programSetDs ns prog { progStats = mempty, progEntryPoints = fsts ns, progExternalNames = progExternalNames prog `mappend` (Set.fromList $ map tvrIdent $ fsts (programDs prog)) }
+        mprog <- return $ etaAnnotateProgram mprog
+        let cm stats e = do
+            let sopt = mempty { SS.so_rules = allRules, SS.so_exports = map tvrIdent $ progEntryPoints mprog, SS.so_dataTable = fullDataTable }
+            let (stat, e'') = SS.simplifyE sopt e
+            Stats.tickStat stats stat
+            return e''
+        let mangle = mangle' Nothing fullDataTable
+        ns <- flip mapM (programDs mprog) $ \ (v,lc) -> do
+            (v,lc) <- Stats.runStatIO stats (etaExpandDef' fullDataTable v lc)
+            lc <- doopt mangle False stats "SuperSimplify" cm lc
+            lc <- mangle (return ()) False ("Barendregt: " ++ pprint v) (return . barendregt) lc
+            return (v,lc)
+        mprog <- return $ programSetDs ns mprog
+        (mprog,_) <- typeAnalyze mprog
+
+        wdump FD.Lambdacube $ mapM_ (\ (v,lc) -> printCheckName'' fullDataTable v lc) (programDs mprog)
+        lintCheckProgram mprog
+        mprog <- floatOutward mprog
+        wdump FD.Lambdacube $ mapM_ (\ (v,lc) -> printCheckName'' fullDataTable v lc) (programDs mprog)
+        lintCheckProgram mprog
+        ns <- flip mapM (programDs mprog) $ \ (v,lc) -> do
+            (v,lc) <- Stats.runStatIO stats (etaExpandDef' fullDataTable v lc)
+            lc <- doopt mangle False stats "SuperSimplify" cm lc
+            lc <- mangle (return ()) False ("Barendregt: " ++ pprint v) (return . barendregt) lc
+            lc <- doopt mangle False stats "Float Inward..." (\stats x -> return (floatInward allRules x)) lc
+            return (v,lc)
+        ns <- E.Strictness.solveDs ns
+        mprog <- return $ programSetDs ns mprog
+        ns <- flip mapM (programDs mprog) $ \ (v,lc) -> do
+            --(v,lc) <- Stats.runStatIO stats (etaExpandDef' fullDataTable v lc)
+            lc <- doopt mangle False stats "SuperSimplify" cm lc
+            lc <- mangle (return ()) False ("Barendregt: " ++ pprint v) (return . barendregt) lc
+            return (v,lc)
+        mprog <- return $ programSetDs ns mprog
+
+        Stats.tickStat stats (progStats mprog)
+        wdump FD.Lambdacube $ mapM_ (\ (v,lc) -> printCheckName'' fullDataTable v lc) (programDs mprog)
+        Stats.print ("InitialOptimize:" ++ pprint names) stats
+        return (programDs mprog)
+    lintCheckProgram prog
+    prog <- programMapRecGroups initMap (const return) (const return) (const return) fint prog
+    lintCheckProgram prog
hunk ./Main.hs 320
-            let sopt = mempty { SS.so_superInline = True, SS.so_exports = inscope, SS.so_boundVars = smap, SS.so_rules = allRules, SS.so_dataTable = fullDataTable }
+            let sopt = mempty { SS.so_exports = inscope, SS.so_boundVars = smap, SS.so_rules = allRules, SS.so_dataTable = fullDataTable }
hunk ./Main.hs 382
-    let initMap = Map.fromList [ (tvrIdent t, Just (EVar t)) | (t,_) <- (Map.elems (hoEs ho))]
-        graph =  (newGraph (programDs prog) (\ (b,_) -> tvrIdent b) (\ (b,c) -> bindingFreeVars b c))
+    let graph =  (newGraph (programDs prog) (\ (b,_) -> tvrIdent b) (\ (b,c) -> bindingFreeVars b c))
hunk ./Main.hs 390
-    lintCheckProgram prog
-    prog <- floatOutward prog
-    lintCheckProgram prog
hunk ./Main.hs 516
-        let sopt = mempty { SS.so_superInline = True, SS.so_rules = rules, SS.so_dataTable = dataTable }
+        let sopt = mempty { SS.so_rules = rules, SS.so_dataTable = dataTable }