[improve Hs code generation to include boolean primitives. add a couple more numeric ones
John Meacham <john@repetae.net>**20061111034840] hunk ./E/ToHs.hs 80
-        Just childs = conChildren con
-        dchildren | null childs = empty
-                  | otherwise =  text "=" <+> hcat (punctuate (text " | ") (map dc childs))
+        childs = conChildren con
+        dchildren | Just [] <- childs = empty
+                  | Nothing <- childs = empty
+                  | Just childs <- childs  =  text "=" <+> hcat (punctuate (text " | ") (map dc childs))
hunk ./E/ToHs.hs 114
+showCon c ts | Just 0 <- fromUnboxedNameTuple c, nameType c == TypeConstructor = text "Nothing"
+showCon c ts | Just 0 <- fromUnboxedNameTuple c, nameType c == DataConstructor = text "theNothing"
hunk ./E/ToHs.hs 119
+showCon c [] | (RawType,v) <- fromName c = text $ showCType v
hunk ./E/ToHs.hs 149
+transType e = return $ text "{- ERROR " <> tshow e <> text " -} Type"
hunk ./E/ToHs.hs 201
+transE e@(EPrim (APrim (PrimPrim prim) _) args _) = case (prim,args) of
+    ("drop__",[_x,y]) -> transE y  -- XXX
+    _ -> return $ parens $ text "error" <+> tshow (show e)
hunk ./E/ToHs.hs 208
+transE (EPrim (APrim Operator { primOp = op, primArgTypes = [at,_] } _) [x,y] _) | Just z <- op2TableCmp (op,showCType at) = mparen $ do
+    x <- transE x
+    y <- transE y
+    return $ text "fromBool" <+> (parens $ hsep [text z,x,y])
hunk ./E/ToHs.hs 229
-transE e = return $ text "{- ERROR " <> tshow e <> text " -} undefined"
+transE e = return $ parens $ text "error" <+> tshow (show e)
hunk ./E/ToHs.hs 238
-        ("*","(*#)")
+        ("*","(*#)"),
+        ("%","remInt#"),
+        ("/","quotInt#")
+        ]
+
+op2TableCmp (op,rt) = lookup rt table >>= lookup op where
+    table = [ ("Int#",intTable), ("Char#",charTable)]
+    intTable = [
+        (">","(>#)"),
+        ("==","(==#)"),
+        ("<","(<#)"),
+        (">=","(>=#)"),
+        ("<=","(<=#)")
+        ]
+    charTable = [
+        (">","gtChar#"),
+        ("==","eqChar#"),
+        ("<","ltChar#"),
+        (">=","gteChar#"),
+        ("<=","lteChar#")
hunk ./E/ToHs.hs 273
+transTVr TVr { tvrIdent = 0 } = return $ char '_'
hunk ./data/ViaGhc.hs 1
-{-# OPTIONS_GHC -fglasgow-exts #-}
+{-# OPTIONS_GHC -fglasgow-exts -fno-implicit-prelude #-}
hunk ./data/ViaGhc.hs 11
+type Nothing = ()
+
+theNothing :: Nothing
+theNothing = ()
+
hunk ./data/ViaGhc.hs 27
+fromBool :: Bool -> Int#
+fromBool b = case b of
+    False -> 0#
+    True -> 1#
+
+gteChar# a b = gtChar# a b || eqChar# a b
+lteChar# a b = ltChar# a b || eqChar# a b
+