[create concept of conjured types, make Box and Absurd into conjured types
John Meacham <john@repetae.net>**20080306050759] hunk ./DataConstructors.hs 15
+    mktBox,
+    modBox,
hunk ./DataConstructors.hs 198
-getConstructor n _ | Just e <- fromAbsurd  n = return emptyConstructor { conName = n, conType = e, conExpr = tAbsurd e, conInhabits = tStar }
+getConstructor n _ | Just e <- fromConjured modAbsurd  n = return emptyConstructor { conName = n, conType = e, conExpr = tAbsurd e, conInhabits = tStar }
+getConstructor n _ | Just e <- fromConjured modBox  n = return emptyConstructor { conName = n, conType = e, conExpr = mktBox e, conInhabits = tStar }
hunk ./DataConstructors.hs 243
--- | Jhc@.Box can hold any boxed value (something whose type inhabits *, or is a function)
--- so, there is a bit of subtyping that goes on.
+-- | conjured data types, these data types are created as needed and can be of any type, their
+-- actual type is encoded in their names.
+--
+-- Absurd - this is a type that it used to default otherwise unconstrained
+-- types, it is not special in any particular way but is just an arbitrary type
+-- to give to things.
+--
+-- Box - this type can be used to represent any boxed values. It is considered
+-- equivalent to all boxed values so is not a very precise type. It is used in
+-- the final stages of compilation before core mangling so that optimizations
+-- that were previously blocked by type variables can be carried out.
hunk ./DataConstructors.hs 263
-tAbsurd k = ELit (litCons { litName = nameAbsurd k, litArgs = [], litType = k })
-
-nameAbsurd :: E -> Name
-nameAbsurd n = toName TypeConstructor ("Jhc@.Absurd",f n "") where
-    f (ESort s) = shows s
-    f (EPi TVr { tvrType = t1 } t2) = ('^':) . shows t1 . shows t2
-    f _ = error $ "nameAbsurd: " ++ show n
-
-fromAbsurd :: Monad m => Name -> m E
-fromAbsurd n = maybeM ("fromAbsurd: " ++ show n) $ do
-    let f s = funit s `mplus` flam s
-        flam ('^':xs) = do (x,rs) <- f xs; (y,gs) <- f rs; return (EPi tvr { tvrType = x } y,gs)
-        flam _ = Nothing
-        funit ('*':xs) = return (eStar,xs)
-        funit ('#':xs) = return (eHash,xs)
-        funit ('!':xs) = return (ESort EBang,xs)
-        funit ('(':'#':')':xs) = return (ESort ETuple,xs)
-        funit _ = Nothing
-    (TypeConstructor,("Jhc@.Absurd",an)) <- return $  fromName n
-    (r,"") <- f an
-    return r
+tAbsurd k = ELit (litCons { litName = nameConjured modAbsurd k, litArgs = [], litType = k })
+mktBox k = ELit (litCons { litName = nameConjured modBox k, litArgs = [], litType = k, litAliasFor = af }) where
+    af = case k of
+        EPi TVr { tvrType = t1 } t2 -> Just (ELam tvr { tvrType = t1 } (mktBox t2))
+        _ -> Nothing
hunk ./DataConstructors.hs 335
-        f c a b | a == tBox && canBeBox b = return ()
-        f c a b | b == tBox && canBeBox a = return ()
+        f _ a b | boxCompat a b || boxCompat b a = return ()
hunk ./DataConstructors.hs 342
+        boxCompat (ELit (LitCons { litName = n }))  t | Just e <- fromConjured modBox n =  e == getType t
+        boxCompat _ _ = False
hunk ./E/E.hs 25
+import Util.Gen
hunk ./E/E.hs 103
+modAbsurd = "Jhc@.Absurd"
+modBox    = "Jhc@.Box"
+
+
+nameConjured :: String -> E -> Name
+nameConjured mod n = toName TypeConstructor (mod,f n "") where
+    f (ESort s) = shows s
+    f (EPi TVr { tvrType = t1 } t2) = ('^':) . shows t1 . shows t2
+    f _ = error $ "nameConjured: " ++ show (mod,n)
+
+fromConjured :: Monad m => String -> Name -> m E
+fromConjured mod n = maybeM ("fromConjured: " ++ show (mod,n)) $ do
+    let f s = funit s `mplus` flam s
+        flam ('^':xs) = do (x,rs) <- f xs; (y,gs) <- f rs; return (EPi tvr { tvrType = x } y,gs)
+        flam _ = Nothing
+        funit ('*':xs) = return (eStar,xs)
+        funit ('#':xs) = return (eHash,xs)
+        funit ('!':xs) = return (ESort EBang,xs)
+        funit ('(':'#':')':xs) = return (ESort ETuple,xs)
+        funit _ = Nothing
+    (TypeConstructor,(mod',an)) <- return $  fromName n
+    guard (mod' == mod)
+    (r,"") <- f an
+    return r
+
hunk ./E/TypeCheck.hs 130
+--    getType (EAp a _) | a == tBox = getType a
hunk ./E/TypeCheck.hs 282
-    eq box t2 | box == tBox, canBeBox t2 = return t2
-    eq t1 box | box == tBox, canBeBox t1 = return t1
+    eq box t2 | boxCompat box t2 = return t2
+    eq t1 box | boxCompat box t1 = return t1
+   -- box == tBox, canBeBox t2 = return t2
+   -- eq t1 box | box == tBox, canBeBox t1 = return t1
hunk ./E/TypeCheck.hs 299
+    boxCompat (ELit (LitCons { litName = n }))  t | Just e <- fromConjured modBox n =  e == getType t
+    boxCompat _ _ = False
hunk ./Main.hs 660
-    boxify v@EVar {} | canBeBox v = tBox
+    boxify v@EVar {} | canBeBox v = mktBox (getType v)
hunk ./Main.hs 662
-    boxify v@(EAp _ _) | canBeBox v = tBox
+    boxify v@(EAp _ _) | canBeBox v = mktBox (getType v)