[give unboxed and boxed types different sorts
John Meacham <john@repetae.net>**20051002090621] hunk ./DataConstructors.hs 110
-            conInhabits = tStar,
+            conInhabits = tHash,
hunk ./DataConstructors.hs 116
-        tipe = ELit (LitCons tc [] eStar)
+        tipe = ELit (LitCons tc [] eHash)
hunk ./DataConstructors.hs 147
-        conType = eStar,
+        conType = eHash,
hunk ./DataConstructors.hs 150
-        conExpr = ELit (LitCons rn [] eStar),
+        conExpr = ELit (LitCons rn [] eHash),
hunk ./DataConstructors.hs 153
-        conInhabits = tStar,
+        conInhabits = tHash,
hunk ./DataConstructors.hs 181
-        rt = ELit (LitCons rn [] eStar)
+        rt = ELit (LitCons rn [] eHash)
hunk ./E/E.hs 36
-    show (LitInt x _) = show x
-    show (LitCons n es t) = parens $  hsep (show n:map show es) <> "::" <> show t
+    showsPrec _ (LitInt x t) = parens $  shows x <> showString "::" <> shows t
+    showsPrec _ (LitCons n es t) = parens $  hsep (shows n:map shows es) <> showString "::" <> shows t
hunk ./E/E.hs 52
+    deriving(Data,Eq, Ord, Typeable, Show)
+    {-! derive: is, GhcBinary !-}
hunk ./E/E.hs 60
-    | ESort !Int
+    | ESort ESort
hunk ./E/E.hs 200
-    tStar = ESort 0
+    tStar = eStar
hunk ./E/E.hs 209
-    tIntzh = ELit (LitCons tIntzh [] eStar)
-    tIntegerzh = ELit (LitCons tIntegerzh [] eStar)
-    tCharzh = ELit (LitCons tCharzh [] eStar)
+    tIntzh = ELit (LitCons tIntzh [] eHash)
+    tIntegerzh = ELit (LitCons tIntegerzh [] eHash)
+    tCharzh = ELit (LitCons tCharzh [] eHash)
hunk ./E/E.hs 249
-eBox = ESort 1
+eBox = ESort EBox
hunk ./E/E.hs 252
-eStar = ESort 0
+eStar = ESort EStar
+
+eHash :: E
+eHash = ESort EHash
hunk ./E/E.hs 348
+dc_Int = toName DataConstructor ("Prelude","Int")
+dc_Integer = toName DataConstructor ("Prelude","Integer")
hunk ./E/FromHs.hs 442
-intConvert i | abs i > integer_cutoff  =  ELit (LitCons (toName DataConstructor ("Prelude","Integer")) [ELit $ LitInt (fromInteger i) (ELit (LitCons (toName RawType "intmax_t") [] eStar))] tInteger)
-intConvert i =  ELit (LitCons (toName DataConstructor ("Prelude","Int")) [ELit $ LitInt (fromInteger i) (ELit (LitCons (toName RawType "int") [] eStar))] tInt)
+intConvert i | abs i > integer_cutoff  =  ELit (LitCons dc_Integer [ELit $ LitInt (fromInteger i) (rawType "intmax_t")] tInteger)
+intConvert i =  ELit (LitCons dc_Int [ELit $ LitInt (fromInteger i) (rawType "int")] tInt)
hunk ./E/Pretty.hs 110
-rawType s  = ELit (LitCons (toName RawType s) [] eStar)
+rawType s  = ELit (LitCons (toName RawType s) [] eHash)
hunk ./E/Pretty.hs 157
-        (ESort n) -> symbol $ text "Sort" <> tshow n
+        e | e == eHash -> symbol (text "#")
hunk ./E/Strictness.hs 11
+import Data.Typeable
hunk ./E/Strictness.hs 39
-        deriving(Ord,Eq,Show)
+        deriving(Ord,Eq,Show,Typeable)
hunk ./E/TypeCheck.hs 20
-typ (ESort 0) =  eBox
-typ (ESort 1) = error "Box inhabits nowhere."
+typ (ESort EStar) =  eBox
+typ (ESort EHash) =  eBox
+typ (ESort EBox) = error "Box inhabits nowhere."
hunk ./E/Values.hs 31
-ltTuple' ts = ELit $ LitCons (unboxedNameTuple TypeConstructor (length ts)) ts eStar
+ltTuple' ts = ELit $ LitCons (unboxedNameTuple TypeConstructor (length ts)) ts eHash
hunk ./E/Values.hs 146
-rawType s  = ELit (LitCons (toName RawType s) [] eStar)
+rawType s  = ELit (LitCons (toName RawType s) [] eHash)
hunk ./E/WorkerWrapper.hs 18
+wrapable (Fun x) = f x where
+    f (Fun x) = f x
+    f (Tup _) = True
+    f _ = False
hunk ./E/WorkerWrapper.hs 24
-workWrap dataTable tvr e
-    | topLike cpr && sa == L = [(tvr,e)]
-    | otherwise = ans where
-        cpr = maybe Top id (Info.lookup (tvrInfo tvr))
-        sa = maybe L id (Info.lookup (tvrInfo tvr))
-        ans = [(setProperty prop_WRAPPER tvr,wrapper),(setProperty prop_WORKER tvr',worker)]
-        tvr' = TVr { tvrIdent = workerName (tvrIdent tvr), tvrInfo = mempty, tvrType = wt }
-        workerName x = case fromId x of
-            Just y -> toId (toName Val ("W@",'f':show y))
-            Nothing -> toId (toName Val ("W@",'f':show x))
-        wt = undefined
-        worker = undefined
-        wrapper = undefined
+workWrap dataTable tvr e | wrapable cpr = ans where
+    cpr = maybe Top id (Info.lookup (tvrInfo tvr))
+    sa = maybe L id (Info.lookup (tvrInfo tvr))
+    ans = [(setProperty prop_WRAPPER tvr,wrapper),(setProperty prop_WORKER tvr',worker)]
+    tvr' = TVr { tvrIdent = workerName (tvrIdent tvr), tvrInfo = mempty, tvrType = wt }
+    workerName x = case fromId x of
+        Just y -> toId (toName Val ("W@",'f':show y))
+        Nothing -> toId (toName Val ("W@",'f':show x))
+    wt = undefined
+    worker = undefined
+    wrapper = undefined
+    Just c = getConstructor cname dataTable
+    (cname,args,body) = f cpr e []
+    f (Fun x) (ELam a e) as = f x e (a:as)
+    f (Tup n) e as = (n,as,e)
+workWrap _dataTable tvr e = [(tvr,e)]
hunk ./Grin/FromE.hs 106
-        toty node (ELit (LitCons n [] es)) |  es == eStar, RawType <- nameType n = (Ty $ toAtom (show n))
+        toty node (ELit (LitCons n [] es)) |  es == eHash, RawType <- nameType n = (Ty $ toAtom (show n))
hunk ./Grin/FromE.hs 222
-    conv (ELit (LitInt i (ELit (LitCons n [] (ESort 0))))) | RawType <- nameType n =  Lit i (Ty $ toAtom (show n))
-    conv (ELit (LitInt i (ELit (LitCons n [] (ESort 0))))) | Just pt <- Prelude.lookup (show n) allCTypes = ( Const (NodeC (toAtom $ 'C':show n) [(Lit i (Ty (toAtom pt)))]))
+    conv (ELit (LitInt i (ELit (LitCons n [] (ESort EHash))))) | RawType <- nameType n =  Lit i (Ty $ toAtom (show n))
+    conv (ELit (LitInt i (ELit (LitCons n [] (ESort EStar))))) | Just pt <- Prelude.lookup (show n) allCTypes = ( Const (NodeC (toAtom $ 'C':show n) [(Lit i (Ty (toAtom pt)))]))
hunk ./Grin/FromE.hs 232
+    conv x = error $ "conv: " ++ show x
hunk ./Grin/FromE.hs 249
-    toVal (TVr { tvrIdent = num, tvrType = (ELit (LitCons n [] es))}) | es == eStar, RawType <- nameType n  = Var (V num) (Ty $ toAtom (show n))
+    toVal (TVr { tvrIdent = num, tvrType = (ELit (LitCons n [] es))}) | es == eHash, RawType <- nameType n  = Var (V num) (Ty $ toAtom (show n))
hunk ./Grin/FromE.hs 727
-    constant (ELit (LitInt i (ELit (LitCons n [] (ESort 0))))) | RawType <- nameType n = return $ Lit i (Ty $ toAtom (show n))
-    constant (ELit (LitInt i (ELit (LitCons n [] (ESort 0))))) | Just pt <- Prelude.lookup (show n) allCTypes = (return $ Const (NodeC (toAtom $ 'C':show n) [(Lit i (Ty (toAtom pt)))]))
+    constant (ELit (LitInt i (ELit (LitCons n [] (ESort EHash))))) | RawType <- nameType n = return $ Lit i (Ty $ toAtom (show n))
+    constant (ELit (LitInt i (ELit (LitCons n [] (ESort EStar))))) | Just pt <- Prelude.lookup (show n) allCTypes = (return $ Const (NodeC (toAtom $ 'C':show n) [(Lit i (Ty (toAtom pt)))]))
hunk ./Main.hs 36
+import E.WorkerWrapper
hunk ./Main.hs 129
-    let Identity (ELetRec ds (ESort 0)) = annotate imap (idann (hoRules ho) (hoProps ho) ) letann lamann (ELetRec (Map.elems $ hoEs ho) eStar)
+    let Identity (ELetRec ds (ESort EStar)) = annotate imap (idann (hoRules ho) (hoProps ho) ) letann lamann (ELetRec (Map.elems $ hoEs ho) eStar)
hunk ./Main.hs 236
-    let Identity (ELetRec es'' (ESort 0)) = annotate initMap (idann (hoRules ho) (hoProps ho) ) letann lamann (ELetRec [ (y,z) | (x,y,z) <- es']  eStar)
+    let Identity (ELetRec es'' (ESort EStar)) = annotate initMap (idann (hoRules ho) (hoProps ho) ) letann lamann (ELetRec [ (y,z) | (x,y,z) <- es']  eStar)
hunk ./Name.hs 184
-    tStar = toName SortName $ hsname "Prelude" "*"
+    tStar = toName SortName $ hsname "Jhc@" "*"
+    tHash = toName SortName $ hsname "Jhc@" "#"
hunk ./VConsts.hs 15
+    tHash :: a
hunk ./VConsts.hs 33
+    tHash = error "tHash"
hunk ./data/PrimitiveOperators-in.hs 138
-prim_number v t et@(ELit (LitCons cn' _ _)) = ELit (LitCons cn [ELit (LitInt v st)] et) where
-    st = ELit (LitCons (toName RawType t) [] eStar)
+prim_number v t et@(ELit (LitCons cn' _ _)) = ELit (LitCons cn [ELit (LitInt v (rawType t))] et) where
hunk ./data/PrimitiveOperators-in.hs 144
-    st = ELit (LitCons (toName RawType t) [] eStar)
+    st = rawType t