[add 'dumpCore' to dump jhc core to a file
John Meacham <john@repetae.net>**20070606022529] hunk ./E/Program.hs 23
+import qualified IO
hunk ./E/Program.hs 111
-
-printProgram prog@Program {progCombinators = cs, progDataTable = dataTable } = do
-    sequence_ $ intersperse (putErrLn "") [ printCheckName'' dataTable v (foldr ELam e as) | (v,as,e) <- cs]
+hPrintProgram fh prog@Program {progCombinators = cs, progDataTable = dataTable } = do
+    sequence_ $ intersperse (hPutStrLn fh "") [ hPrintCheckName fh dataTable v (foldr ELam e as) | (v,as,e) <- cs]
hunk ./E/Program.hs 114
-        putErrLn $ "MainEntry: " ++ pprint (progMainEntry prog)
+        hPutStrLn fh $ "MainEntry: " ++ pprint (progMainEntry prog)
hunk ./E/Program.hs 116
-        putErrLn $ "EntryPoints: " ++ hsep (map pprint (progEntryPoints prog))
+        hPutStrLn fh $ "EntryPoints: " ++ hsep (map pprint (progEntryPoints prog))
+
+printProgram prog = hPrintProgram IO.stderr prog
+
+printCheckName'' = hPrintCheckName IO.stderr
hunk ./E/Program.hs 122
-printCheckName'' :: DataTable -> TVr -> E -> IO ()
-printCheckName'' dataTable tvr e = do
+hPrintCheckName :: IO.Handle -> DataTable -> TVr -> E -> IO ()
+hPrintCheckName fh dataTable tvr e = do
hunk ./E/Program.hs 128
-    when (dump FD.EInfo || verbose2) $ putErrLn (show $ tvrInfo tvr)
-    putErrLn (render $ hang 4 (pprint tvr <+> text "::" <+> (pprint $ tvrType tvr)))
+    when (dump FD.EInfo || verbose2) $ hPutStrLn fh (show $ tvrInfo tvr)
+    hPutStrLn fh (render $ hang 4 (pprint tvr <+> text "::" <+> (pprint $ tvrType tvr)))
hunk ./E/Program.hs 131
-        putErrLn (render $ hang 4 (pprint tvr <+> text "::" <+> pty))
-    putErrLn (render $ hang 4 (pprint tvr <+> equals <+> pprint e))
+        hPutStrLn fh (render $ hang 4 (pprint tvr <+> text "::" <+> pty))
+    hPutStrLn fh (render $ hang 4 (pprint tvr <+> equals <+> pprint e))
hunk ./Main.hs 81
+import qualified IO
hunk ./Main.hs 779
+dumpCore pname prog = do
+    let fn = optOutName options ++ "_" ++ pname ++ ".jhc_core"
+    putErrLn $ "Writing: " ++ fn
+    h <- IO.openFile fn IO.WriteMode
+    (argstring,sversion) <- getArgString
+    IO.hPutStrLn h $ unlines [ "-- " ++ argstring,"-- " ++ sversion,""]
+    hPrintProgram h prog
+    IO.hClose h
+    wdump FD.Core $ do
+        putErrLn $ "v-- " ++ pname ++ " Core"
+        printProgram prog
+        putErrLn $ "^-- " ++ pname ++ " Core"