[make Grin.Lint and Support.Transform, move code from Main into them as appropriate to clean things up
John Meacham <john@repetae.net>**20070510025033] addfile ./Grin/Lint.hs
addfile ./Support/Transform.hs
hunk ./Grin/FromE.hs 1
-module Grin.FromE(compile,typecheckGrin) where
+module Grin.FromE(compile) where
hunk ./Grin/FromE.hs 120
-typecheckGrin grin = do
-    let errs = [  (err ++ "\n" ++ render (prettyFun a) ) | (a,Left err) <-  [ (a,typecheck (grinTypeEnv grin) c:: Either String Ty)   | a@(_,(_ :-> c)) <-  grinFuncs grin ]]
-    mapM_ putErrLn  errs
-    unless (null errs || optKeepGoing options) $ fail "There were type errors!"
hunk ./Grin/Lint.hs 1
+module Grin.Lint(
+    lintCheckGrin,
+    typecheckGrin,
+    dumpGrin
+    ) where
+
+import Options
+import Grin.Grin
+import Grin.Show
+import Util.Gen
+import Control.Monad
+import System.IO
+import Support.CanType
+import qualified FlagDump as FD
+import Support.Transform
+
+
+lintCheckGrin grin = when flint $ typecheckGrin grin
+
+typecheckGrin grin = do
+    let errs = [  (err ++ "\n" ++ render (prettyFun a) ) | (a,Left err) <-  [ (a,typecheck (grinTypeEnv grin) c:: Either String Ty)   | a@(_,(_ :-> c)) <-  grinFuncs grin ]]
+    mapM_ putErrLn  errs
+    unless (null errs || optKeepGoing options) $ fail "There were type errors!"
+
+dumpGrin pname grin = do
+    let fn = optOutName options ++ "_" ++ pname ++ ".grin"
+    putErrLn $ "Writing: " ++ fn
+    h <- openFile fn  WriteMode
+    (argstring,sversion) <- getArgString
+    hPutStrLn h $ unlines [ "-- " ++ argstring,"-- " ++ sversion,""]
+    hPrintGrin h grin
+    hClose h
+    wdump FD.Grin $ do
+        putErrLn $ "v-- " ++ pname ++ " Grin"
+        printGrin grin
+        putErrLn $ "^-- " ++ pname ++ " Grin"
+
+
hunk ./Grin/Simplify.hs 92
---        gs (doApply Return True n v typ)
+--        gs (doApply Return True n [v] typ)
hunk ./Grin/Simplify.hs 185
-doApply ret strict (NodeC t xs) y typ | Just (n,v) <- tagUnfunction t = case n of
-    1 | strict -> (App v (xs ++ [y]) typ)
-    _ -> ret (NodeC (partialTag v (n - 1)) (xs ++ [y]))
+doApply ret strict (NodeC t xs) ys typ | Just (n,v) <- tagUnfunction t = case n of
+    1 | strict -> (App v (xs ++ ys) typ)
+    _ -> ret (NodeC (partialTag v (n - 1)) (xs ++ ys))
hunk ./Grin/Simplify.hs 328
---    f (Return t@NodeC {} :>>= v :-> App fa [v',a] typ :>>= lr) | fa == funcApply, v == v' = do
---        mtick "Optimize.optimize.return-apply"
---        f (Return t :>>= v :-> doApply Return True t a typ :>>= lr)
---    f (Return t@NodeC {} :>>= v :-> App fa [v',a] typ) | fa == funcApply, v == v' = do
---        mtick "Optimize.optimize.return-apply"
---        f (Return t :>>= v :-> doApply Return True t a typ)
+    f (Return t@NodeC {} :>>= v :-> App fa [v',a] typ :>>= lr) | fa == funcApply, v == v' = do
+        mtick "Optimize.optimize.return-apply"
+        f (Return t :>>= v :-> doApply Return True t [a] typ :>>= lr)
+    f (Return t@NodeC {} :>>= v :-> App fa [v',a] typ) | fa == funcApply, v == v' = do
+        mtick "Optimize.optimize.return-apply"
+        f (Return t :>>= v :-> doApply Return True t [a] typ)
+    f (Return t@NodeC {} :>>= v :-> App fa [v'] typ :>>= lr) | fa == funcApply, v == v' = do
+
+        mtick "Optimize.optimize.return-apply0"
+        f (Return t :>>= v :-> doApply Return True t [] typ :>>= lr)
+    f (Return t@NodeC {} :>>= v :-> App fa [v'] typ) | fa == funcApply, v == v' = do
+        mtick "Optimize.optimize.return-apply0"
+        f (Return t :>>= v :-> doApply Return True t [] typ)
hunk ./Grin/Simplify.hs 342
+
hunk ./Main.hs 49
+import Grin.Lint
hunk ./Main.hs 72
+import Support.Transform
hunk ./Main.hs 690
-    wdump FD.GrinInitial $ do
-        putErrLn "v-- Initial Grin"
-        dumpGrin (optOutName options) "initial" x
-        printGrin x
-        putErrLn "^-- Initial Grin"
+    wdump FD.GrinInitial $ do dumpGrin "initial" x
hunk ./Main.hs 692
-    wdump FD.GrinNormalized $ do
-        putErrLn "v-- Normalized Grin"
-        dumpGrin (optOutName options) "normalized" x
-        printGrin x
-        putErrLn "^-- Normalized Grin"
+    wdump FD.GrinNormalized $ do dumpGrin "normalized" x
hunk ./Main.hs 721
-    wdump FD.GrinPreeval $ do
-        putErrLn "v-- Preeval Grin"
-        dumpGrin (optOutName options) "preeval" x
-        printGrin x
-        putErrLn "^-- Preeval Grin"
+    wdump FD.GrinPreeval $ dumpGrin "preeval" x
hunk ./Main.hs 735
-dumpGrin fname pname grin = do
-    h <- openFile (fname ++ "_" ++ pname ++ ".grin") WriteMode
-    (argstring,sversion) <- getArgString
-    hPutStrLn h $ unlines [ "-- " ++ argstring,"-- " ++ sversion,""]
-    hPrintGrin h grin
-    hClose h
-
hunk ./Main.hs 737
-    let fn = optOutName options
hunk ./Main.hs 739
+            fn = optOutName options
hunk ./Main.hs 741
-    dumpGrin (optOutName options) "final" grin
-    wdump FD.Grin $ printGrin grin
+    dumpGrin "final" grin
hunk ./Main.hs 743
-getArgString = do
-    name <- System.getProgName
-    args <- getArguments
-    return (simpleQuote (name:args),head $ lines versionString)
hunk ./Main.hs 803
-data Iterate = DontIterate | IterateMax !Int | IterateExactly !Int | IterateDone
-    deriving(Eq)
-
-doIterate (IterateMax _) stat | stat /= mempty = True
-doIterate IterateDone stat | stat /= mempty = True
-doIterate IterateExactly {} _ = True
-doIterate _ _ = False
hunk ./Main.hs 804
-iterateStep (IterateMax n) = IterateMax (n - 1)
-iterateStep (IterateExactly n) = IterateExactly (n - 1)
-iterateStep x = x
hunk ./Main.hs 805
-data TransformParms = TransformParms {
-    transformIterate :: Iterate,
-    transformDumpProgress :: Bool,
-    transformSkipNoStats  :: Bool,
-    transformOperation :: Program -> IO Program,
-    transformCategory :: String,   -- ^ general name of transformation
-    transformPass :: String,       -- ^ what pass we are in
-    transformName :: String        -- ^ name of what we are working on
-    }
hunk ./Main.hs 806
-transformParms = TransformParms {
-    transformIterate = DontIterate,
-    transformDumpProgress = False,
-    transformSkipNoStats = False,
-    transformCategory = "Unknown",
-    transformPass = "",
-    transformOperation = return,
-    transformName = ""
-    }
hunk ./Main.hs 807
-transformProgram :: MonadIO m => TransformParms -> Program -> m Program
+transformProgram :: MonadIO m => TransformParms Program -> Program -> m Program
hunk ./Main.hs 847
-    if doIterate iterate estat then transformProgram tp { transformIterate = iterateStep iterate } prog' { progStats = istat `mappend` estat } else
+    if doIterate iterate (estat /= mempty) then transformProgram tp { transformIterate = iterateStep iterate } prog' { progStats = istat `mappend` estat } else
hunk ./Main.hs 930
-lintCheckGrin grin = when flint $ typecheckGrin grin
hunk ./Options.hs 19
+    getArgString,
hunk ./Options.hs 38
+import Version(versionString)
hunk ./Options.hs 294
+getArgString = do
+    name <- System.getProgName
+    args <- getArguments
+    return (simpleQuote (name:args),head $ lines versionString)
hunk ./Support/Transform.hs 1
+module Support.Transform where
+
+
+data TransformParms p = TransformParms {
+    transformIterate :: Iterate,
+    transformDumpProgress :: Bool,
+    transformSkipNoStats  :: Bool,
+    transformOperation :: p -> IO p,
+    transformCategory :: String,   -- ^ general name of transformation
+    transformPass :: String,       -- ^ what pass we are in
+    transformName :: String        -- ^ name of what we are working on
+    }
+
+transformParms = TransformParms {
+    transformIterate = DontIterate,
+    transformDumpProgress = False,
+    transformSkipNoStats = False,
+    transformCategory = "Unknown",
+    transformPass = "",
+    transformOperation = return,
+    transformName = ""
+    }
+
+data Iterate = DontIterate | IterateMax !Int | IterateExactly !Int | IterateDone
+    deriving(Eq)
+
+doIterate IterateMax {}     True = True
+doIterate IterateDone       True = True
+doIterate IterateExactly {} _    = True
+doIterate _ _ = False
+
+iterateStep (IterateMax n) = IterateMax (n - 1)
+iterateStep (IterateExactly n) = IterateExactly (n - 1)
+iterateStep x = x
+