[clean up Main.hs
John Meacham <john@repetae.net>**20090812061523
 Ignore-this: 75f574f8251cfcad6227bc48ac74b2f7
] hunk ./src/Main.hs 80
-
----------------
--- ∀α∃β . α → β
----------------
-
-progressM c  = wdump FD.Progress $ (c >>= putErrLn) >> hFlush stderr
-
-
-collectPassStats = verbose
-
hunk ./src/Main.hs 85
-
-main =  runMain $ bracketHtml $ do
+main = runMain $ bracketHtml $ do
hunk ./src/Main.hs 120
-       ('s':'h':'.':_)     -> Right f
-       ('s':'h':'l':'.':_) -> Right f
-       _                   -> Left $ Module f
-
-
+        ('s':'h':'.':_)     -> Right f
+        ('s':'h':'l':'.':_) -> Right f
+        _                   -> Left $ Module f
hunk ./src/Main.hs 156
-        --(mod:_) = Map.keys $ hoExports $ hoTcInfo aho
hunk ./src/Main.hs 171
+progressM c  = wdump FD.Progress $ (c >>= putErrLn) >> hFlush stderr
+collectPassStats = verbose
hunk ./src/Main.hs 174
+dumpRules rules = do
+    wdump FD.Rules $ putStrLn "  ---- user rules ---- " >> printRules RuleUser rules
+    wdump FD.Rules $ putStrLn "  ---- user catalysts ---- " >> printRules RuleCatalyst rules
+    wdump FD.RulesSpec $ putStrLn "  ---- specializations ---- " >> printRules RuleSpecialization rules
hunk ./src/Main.hs 180
-    CollectedHo          -- ^ Collected ho
+    CollectedHo             -- ^ Collected ho
hunk ./src/Main.hs 227
-    wdump FD.Rules $ putStrLn "  ---- user rules ---- " >> printRules RuleUser rules
-    wdump FD.Rules $ putStrLn "  ---- user catalysts ---- " >> printRules RuleCatalyst rules
-    wdump FD.RulesSpec $ putStrLn "  ---- specializations ---- " >> printRules RuleSpecialization rules
+    dumpRules rules
hunk ./src/Main.hs 434
---idHistogram e = execWriter $ annotate mempty (\id nfo -> tell (Histogram.singleton id) >> return nfo) (\_ -> return) (\_ -> return) e
-
hunk ./src/Main.hs 457
-        rules' = Rules $ fromList [ (combIdent x,combRules x) | x <- combinators, not $ null (combRules x) ]
hunk ./src/Main.hs 460
-    wdump FD.Rules $ putStrLn "  ---- user rules ---- " >> printRules RuleUser rules'
-    wdump FD.Rules $ putStrLn "  ---- user catalysts ---- " >> printRules RuleCatalyst rules'
-    wdump FD.RulesSpec $ putStrLn "  ---- specializations ---- " >> printRules RuleSpecialization rules'
+    dumpRules (Rules $ fromList [ (combIdent x,combRules x) | x <- combinators, not $ null (combRules x) ])
hunk ./src/Main.hs 471
-    let dataTable = progDataTable prog
-
hunk ./src/Main.hs 475
-
-    let mainFunc = parseName Val (maybe "Main.main" snd (optMainFunc options))
hunk ./src/Main.hs 476
+    let mainFunc = parseName Val (maybe "Main.main" snd (optMainFunc options))
+        dataTable = progDataTable prog
+        ffiExportNames = [ tv | tv <- map combHead $ progCombinators prog, name <- tvrName tv, "FE@" `isPrefixOf` show name ]
hunk ./src/Main.hs 480
-    let ffiExportNames = [tv | tv <- map combHead $  progCombinators prog,
-                               name <- tvrName tv,
-                               "FE@" `isPrefixOf` show name]
-    prog <- return $ programUpdate prog { progMain   = tvrIdent main,
-                          progEntry = fromList $ map tvrIdent (main:ffiExportNames),
-                          progCombinators = emptyComb { combHead = main, combBody = mainv }:map (unsetProperty prop_EXPORTED) (progCombinators prog)
-                        }
-    prog <- transformProgram transformParms { transformCategory = "PruneUnreachable", transformOperation = evaluate . programPruneUnreachable } prog
-
---    (viaGhc,fn,_,_) <- determineArch
---    wdump FD.Progress $ putStrLn $ "Arch: " ++ fn
+    prog <- return $ programUpdate prog {
+        progMain   = tvrIdent main,
+        progEntry = fromList $ map tvrIdent (main:ffiExportNames),
+        progCombinators = emptyComb { combHead = main, combBody = mainv }:map (unsetProperty prop_EXPORTED) (progCombinators prog)
+        }
+    prog <- transformProgram transformParms {
+        transformCategory = "PruneUnreachable",
+        transformOperation = evaluate . programPruneUnreachable
+        } prog
hunk ./src/Main.hs 490
-    --wdump FD.Core $ printProgram prog
hunk ./src/Main.hs 498
-    when (verbose) $ do putStrLn "Type analyzed methods"
-                        flip mapM_ (programDs prog) $ \ (t,e) -> do
-                        let (_,ts) = fromLam e
-                            ts' = takeWhile (sortKindLike . getType) ts
-                        when (not (null ts')) $ putStrLn $ (pprint t) ++ " \\" ++ concat [ "(" ++ show  (Info.fetch (tvrInfo t) :: Typ) ++ ")" | t <- ts' ]
+    when verbose $ do
+        putStrLn "Type analyzed methods"
+        flip mapM_ (programDs prog) $ \ (t,e) -> do
+        let (_,ts) = fromLam e
+            ts' = takeWhile (sortKindLike . getType) ts
+        when (not (null ts')) $ putStrLn $ (pprint t) ++ " \\" ++ concat [ "(" ++ show  (Info.fetch (tvrInfo t) :: Typ) ++ ")" | t <- ts' ]
hunk ./src/Main.hs 506
-    --wdump FD.Core $ printProgram prog
hunk ./src/Main.hs 515
-
-
hunk ./src/Main.hs 517
-
hunk ./src/Main.hs 521
-        wdump FD.CoreAfterlift $ printProgram prog -- printCheckName dataTable (programE prog)
+        wdump FD.CoreAfterlift $ printProgram prog
hunk ./src/Main.hs 527
-
-
hunk ./src/Main.hs 528
-
-
hunk ./src/Main.hs 530
-
-
hunk ./src/Main.hs 532
-
hunk ./src/Main.hs 533
-
-    -- delete rules
hunk ./src/Main.hs 538
-
hunk ./src/Main.hs 556
---    when viaGhc $ do
- --       wdump FD.Core $ printProgram prog
- --       fail "Compiling to GHC currently disabled"
-        --compileToHs prog
- --       exitSuccess
-
hunk ./src/Main.hs 561
-
hunk ./src/Main.hs 589
--- | this gets rid of all type variables, replacing them with boxes that can hold any type
--- the program is still type-safe, but all polymorphism has been removed in favor of
--- implicit coercion to a universal type.
---
--- also, all rules are deleted.
+-- | this gets rid of all type variables, replacing them with boxes that can hold any type.
+-- The program is still type-safe, but all polymorphism has been removed in favor of
+-- implicit coercion to a universal type in preparation for the grin transformation.
hunk ./src/Main.hs 597
---        putStrLn $ ">>> " ++ pprint t
hunk ./src/Main.hs 601
-  --      putStrLn $ "g: " ++ pprint e