[move grin optimizations to transformation framework, make grin dump pre and post code on type error
John Meacham <john@repetae.net>**20120117083158
 Ignore-this: 383fde200b0439c2daf66e6aa8b81cf8
] hunk ./src/Grin/Lint.hs 28
-
hunk ./src/Grin/Lint.hs 160
-
-
hunk ./src/Grin/Lint.hs 171
-
hunk ./src/Grin/Lint.hs 173
-
-
hunk ./src/Grin/Lint.hs 229
+tcErr :: String -> Tc a
+tcErr s = Tc $ lift (Left s)
hunk ./src/Grin/Lint.hs 236
-same msg t1 t2 = fail $ "Types not the same:" <+> parens msg <+> parens (tshow t1) <+> parens (tshow t2)
+same msg t1 t2 = tcErr $ "Types not the same:" <+> parens msg <+> parens (tshow t1) <+> parens (tshow t2)
hunk ./src/Grin/Lint.hs 257
-         else fail $ "App apply arg doesn't match: " ++ show ap
+         else tcErr $ "App apply arg doesn't match: " ++ show ap
hunk ./src/Grin/Lint.hs 261
-         else fail $ "App eval arg doesn't match: " ++ show ap
+         else tcErr $ "App eval arg doesn't match: " ++ show ap
hunk ./src/Grin/Lint.hs 268
-                fail $ "App: arguments do not match: " ++ show (a,as',t')
-         else fail $ "App: results do not match: " ++ show (a,t,(as',t'))
+                tcErr $ "App: arguments do not match: " ++ show (a,as',t')
+         else tcErr $ "App: results do not match: " ++ show (a,t,(as',t'))
hunk ./src/Grin/Lint.hs 296
-            fail "PokeVal: types don't match"
+            tcErr "PokeVal: types don't match"
hunk ./src/Grin/Lint.hs 301
-    f (Case _ []) = fail "empty case"
+    f (Case _ []) = tcErr "empty case"
hunk ./src/Grin/Lint.hs 318
-            False -> fail $ "variable not in scope: " ++ show e
+            False -> tcErr $ "variable not in scope: " ++ show e
hunk ./src/Grin/Lint.hs 337
-            fail $ "NodeC: arguments do not match " ++ show n ++ show (as'',as')
+            tcErr $ "NodeC: arguments do not match " ++ show n ++ show (as'',as')
hunk ./src/Grin/Lint.hs 339
-
-
hunk ./src/Grin/Main.hs 4
+import Data.Monoid(mappend)
hunk ./src/Grin/Main.hs 6
-import qualified Data.ByteString.Lazy.UTF8 as LBS
hunk ./src/Grin/Main.hs 7
+import qualified Data.ByteString.Lazy.UTF8 as LBS
hunk ./src/Grin/Main.hs 22
-import Grin.Whiz(normalizeGrin')
hunk ./src/Grin/Main.hs 41
-    let pushGrin grin = do
-            nf   <- mapMsnd (grinPush undefined) (grinFuncs grin)
-            return $ setGrinFunctions nf grin
-    putProgressLn "-- Dead Code Analysis"
-    x <- deadCode stats (grinEntryPointNames x) x  -- XXX
+    x <- transformGrin deadCodeParms x
hunk ./src/Grin/Main.hs 43
-    x <- pushGrin x
-    lintCheckGrin x
+    x <- transformGrin pushParms x
hunk ./src/Grin/Main.hs 48
-    x <- deadCode stats (grinEntryPointNames x) x  -- XXX
-    lintCheckGrin x
+    x <- transformGrin deadCodeParms x
hunk ./src/Grin/Main.hs 50
-    x <- pushGrin x
-    lintCheckGrin x
+    x <- transformGrin pushParms x
hunk ./src/Grin/Main.hs 62
-    lintCheckGrin x
hunk ./src/Grin/Main.hs 110
-simplifyParms = transformParms {
+grinParms = transformParms {
hunk ./src/Grin/Main.hs 112
+    transformPass = "Grin"
+    }
+
+simplifyParms = grinParms {
hunk ./src/Grin/Main.hs 117
-    transformPass = "Grin",
hunk ./src/Grin/Main.hs 121
-nodeAnalyzeParms = transformParms {
-    transformDumpProgress = verbose,
+nodeAnalyzeParms = grinParms {
hunk ./src/Grin/Main.hs 123
-    transformPass = "Grin",
hunk ./src/Grin/Main.hs 124
-    }  where
+    } where
hunk ./src/Grin/Main.hs 129
-            return g
+            st <- Stats.readStat stats
+            return g { grinStats = grinStats grin `mappend` st }
+
+pushParms = grinParms {
+    transformCategory = "Push",
+    transformOperation = pushGrin
+    } where
+        pushGrin grin = do
+            nf   <- mapMsnd (grinPush undefined) (grinFuncs grin)
+            return $ setGrinFunctions nf grin
hunk ./src/Grin/Main.hs 140
+deadCodeParms = grinParms {
+    transformCategory = "DeadCode",
+    transformOperation = op
+    } where
+        op grin = do
+            stats <- Stats.new
+            g <- deadCode stats (grinEntryPointNames grin) grin
+            st <- Stats.readStat stats
+            return g { grinStats = grinStats grin `mappend` st }
hunk ./src/Stats.hs 31
-    tickStat
+    tickStat,
+    readStat
hunk ./src/Stats.hs 35
-
hunk ./src/Stats.hs 72
-
-
-
hunk ./src/Stats.hs 93
-
-
hunk ./src/Stats.hs 113
-
-
-
hunk ./src/Stats.hs 122
-
-
hunk ./src/Stats.hs 125
-
hunk ./src/Stats.hs 128
-
hunk ./src/Stats.hs 143
-
-
hunk ./src/Stats.hs 146
-
hunk ./src/Stats.hs 153
-
hunk ./src/Stats.hs 189
-
-
hunk ./src/Stats.hs 230
-
hunk ./src/Stats.hs 240
+readStat :: Stats -> IO Stat
+readStat (Stats r) = readIORef r