[clean up E showing, get rid of -dhtml mode, get rid of ANSI color coding, dump jhc_core to files on error
John Meacham <john@repetae.net>**20100812101452
 Ignore-this: ef81f8c50892ecfdda3b5a450d8fbac0
] hunk ./src/E/Annotate.hs 9
-import E.Rules
hunk ./src/E/Annotate.hs 12
-import qualified Info.Info as Info
hunk ./src/E/Inline.hs 12
-import Data.Monoid
hunk ./src/E/Inline.hs 22
-import Name.Id
hunk ./src/E/Inline.hs 27
-import qualified Info.Info as Info
hunk ./src/E/LambdaLift.hs 8
-import List hiding(insert)
hunk ./src/E/LambdaLift.hs 13
-import E.FreeVars
hunk ./src/E/LetFloat.hs 12
-import Data.Monoid
hunk ./src/E/LetFloat.hs 19
-import E.FreeVars
hunk ./src/E/Lint.hs 52
-        printProgram prog
+        dumpCore ("lint-before-" ++ name) prog
+--        printProgram prog
hunk ./src/E/Lint.hs 62
-            printProgram prog
+            dumpCore ("lint-before-" ++ name) prog
+--            printProgram prog
hunk ./src/E/Lint.hs 66
+            dumpCore ("lint-after-" ++ name) prog'
hunk ./src/E/Program.hs 16
-import FrontEnd.Class
hunk ./src/E/Rules.hs 21
-import List
hunk ./src/E/Show.hs 3
-import Char
hunk ./src/E/Show.hs 6
-import Doc.Attr
hunk ./src/E/Show.hs 62
+{-
+instance PPrint (SEM Doc) a => PPrint (SEM Doc) (Lit a E)  where
+    pprintAssoc a i lit = f lit where
+        f (LitInt i (ELit LitCons { litName = n })) | Just l <- lookup n enumList, i >= 0 && fromIntegral i < length l = text $ l !! (fromIntegral i)
+        f (LitInt i _) = text $ show i
+        f LitCons { litName = s, litArgs = es } | Just n <- fromTupname s , n == length es = do
+            es' <- mapM pprint es
+            return $ tupled es'
+        f LitCons { litName = s, litArgs = es } | Just n <- fromUnboxedNameTuple s, n == length es = do
+            es' <- mapM pprint es
+            return $ encloseSep (text "(# ") (text " #)") (text ", ") es'
+        f LitCons { litName = n, litArgs = [a,b] } | dc_Cons == n  = do
+            a' <- showBind a
+            b' <- showBind b
+            return $ a' `cons` b'
+        f LitCons { litName = n, litArgs = [e] } | tc_List == n = do
+            e <- pprint e
+            return $ (char '[' <> e <> char ']')
+        f LitCons { litName = n, litArgs = [] } | dc_EmptyList == n = return $ text "[]"
+        f LitCons { litName = n, litArgs = [v] }
+            | n == dc_Integer = go "Integer#"
+            | n == dc_Int     = go "Int#"
+            | n == dc_Char    = go "Char#"
+          where go n = do
+                    se <- pprintAssoc AssocNone 10 v
+                    return $ atom (text n) `app` se
+        f LitCons { litName = s, litArgs = es, litType = t, litAliasFor = Just af } | dump FD.EAlias = do
+            es' <- mapM showBind es
+            se <- showE af
+            return $ foldl appCon (atom (tshow s <> char '@' <> parens (unparse se))) es' -- `inhabit` prettye t
+        f LitCons { litName = s, litArgs = es, litType = t } = do
+            es' <- mapM showBind es
+            return $ foldl appCon (atom (tshow s)) es' -- `inhabit` prettye t
+        cons = bop (R,5) (text ":")
+        -}
+
hunk ./src/E/Show.hs 103
-    let const_color = col "blue"
-    let --f (LitInt c t) | t == tCharzh = return $ atom $ (const_color (tshow $ chr i)) where
-        --    i = fromIntegral c
-        f (LitInt i (ELit LitCons { litName = n })) | Just l <- lookup n enumList, i >= 0 && fromIntegral i < length l =
-            return $ atom $ (const_color (text $ l !! (fromIntegral i)))
-        f (LitInt i _) = return $ atom $ (const_color (text $ show i))
+    let f (LitInt i (ELit LitCons { litName = n })) | Just l <- lookup n enumList, i >= 0 && fromIntegral i < length l =
+            return $ atom $ ((text $ l !! (fromIntegral i)))
+        f (LitInt i _) = return $ atom $ ((text $ show i))
hunk ./src/E/Show.hs 139
-col n x = attrColor (attr oob) n x
-attr = if dump FD.Html then html else ansi
+
+--class EPrint a where
+--    eprint :: a -> SEM Doc
+--    eprintAssoc :: Assoc -> a -> Int -> SEM Doc
+--    eprintAssoc _ _ a = eprint a
+--    eprint a = eprintAssoc AssocNone (-1) a
hunk ./src/E/Show.hs 192
-    let const_color = col "blue"
-    let f e | Just s <- E.E.toString e = return $ atom $ const_color (text $ show s)
+    let f e | Just s <- E.E.toString e = return $ atom $ (text $ show s)
hunk ./src/E/Show.hs 220
-                                    return (retOp c <> unparse tvr <> retOp (char '.'))
+                                    return (c <> unparse tvr <> (char '.'))
hunk ./src/E/Show.hs 238
-            return $ fixitize (L,(-10)) $ atom $ nest 4 (group ( keyword "let"
-                                                                  <$> (align $ sep (map (<> bc ';') ds))
+            return $ fixitize (L,(101)) $ atom $ nest 2 (group ( keyword "let"
+                                                                  <$> (align $ sep (map (<> char ';') ds))
hunk ./src/E/Show.hs 252
-                    return [unparse db <+> UC.rArrow <+> unparse e]
-            let alts' = map (<> bc ';') (alts ++ dcase)
+                    return [unparse db <+> UC.rArrow </> unparse e]
+            let alts' = map (\a -> nest 2 (group (a <> char ';'))) (alts ++ dcase)
hunk ./src/E/Show.hs 257
-            return $ fixitize ((L,(-10))) $ atom $
-                group (nest 4 ( keyword "case" <> mbind <+> scrut <+> keyword "of" <$>  (align $ vcat (alts'))) )
+            return $ fixitize ((L,(101))) $ atom $
+                group (nest 2 ( keyword "case" <> mbind <+> scrut <+> keyword "of" <$>  (align $ vcat alts')) )
hunk ./src/E/Show.hs 264
-                return $ fill 10 ((unparse l) <+>  UC.rArrow </> (unparse e))
+                return $ unparse l <+> UC.rArrow </> unparse e
hunk ./src/E/Show.hs 268
-            return $ atom $ unparse t <+> retOp (char '=') </> unparse e
-        bold' = bold
-        bc = bold' . char
-        keyword x = col "magenta" (text x)
-        symbol x = atom (bold' x)
-        arr = bop (R,0) $ retOp (space <> UC.rArrow <> space)
-
+            return $ atom $ nest 2 $ group $ unparse t <+> (char '=') </> unparse e
+        keyword x = text x
+        symbol x = atom x
+        arr = bop (R,0) $ (space <> UC.rArrow <> space)
hunk ./src/E/Show.hs 282
-
-
-retOp x = col "lightgreen" x
-inhabit = bop (N,-2) $ retOp UC.coloncolon
-bold :: Doc -> Doc
-bold = attrBold (attr oob)
+inhabit = bop (N,-2) $ UC.coloncolon
hunk ./src/FlagDump.flags 78
-html         use html escape codes in output
hunk ./src/Main.hs 28
-bracketHtml action = do
-    (argstring,_) <- getArgString
-    wdump FD.Html $ putStrLn $ "<html><head><title>" ++ argstring ++ "</title><meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\"></head><body style=\"background: black; color: lightgrey\"><pre>"
-    action `finally` (wdump FD.Html $ putStrLn "</pre></body></html>")
hunk ./src/Main.hs 29
-main = bracketHtml $ do
+main = do