[unbox the world and don't generate code to pass it around.
John Meacham <john@repetae.net>**20060221090111] hunk ./DataConstructors.hs 58
+    tipe' (TCon (Tycon n k)) | n == tc_World__ = return $ ELit (LitCons rt_Worldzh [] eHash)
hunk ./DataConstructors.hs 111
-getConstructor n (DataTable dt) | n == tc_World__, Just c <- Map.lookup n dt = return c { conChildren = Nothing }
hunk ./DataConstructors.hs 120
-getProduct dataTable e | (ELit (LitCons cn _ _)) <- followAliases dataTable e, cn /= tc_World__, Just c <- getConstructor cn dataTable = f c where
+getProduct dataTable e | (ELit (LitCons cn _ _)) <- followAliases dataTable e, Just c <- getConstructor cn dataTable = f c where
hunk ./DataConstructors.hs 164
+worlds = [(rt_Worldzh,tWorld__),(tc_World__,tWorld__)] where
+    tWorld__ = Constructor {
+                conName = rt_Worldzh,
+                conType = eHash,
+                conSlots = [],
+                conDeriving = [],
+                conExpr = ELit (LitCons rt_Worldzh [] eHash),
+                conAlias = False,
+                conInhabits = tHash,
+                conChildren = Nothing
+        }
+{-
+    tWorld__ = Constructor {
+                conName = tc_World__,
+                conType = eStar,
+                conSlots = [],
+                conDeriving = [],
+                conExpr = ELit (LitCons tc_World__ [] eStar),
+                conAlias = False,
+                conInhabits = tStar,
+                conChildren = Just [conName dWorld__]
+        }
+
+    dWorld__ = Constructor {
+                conName = dc_World__,
+                conType = conExpr tWorld__,
+                conSlots = [conType tWorldzh],
+                conDeriving = [],
+                conExpr = ELam dtvr (ELit (LitCons dc_World__ [EVar dtvr] (conExpr tWorld__))),
+                conAlias = False,
+                conInhabits = tStar,
+                conChildren = Nothing
+        }
+    dtvr = (tVr 10 (conType tWorldzh))
+    -}
+
+
+
hunk ./DataConstructors.hs 330
-dataTablePrims = DataTable $ Map.fromList [ (conName x,x) | x <- tabsurd:tarrow:primitiveTable ]
+dataTablePrims = DataTable $ Map.fromList ([ (conName x,x) | x <- tabsurd:tarrow:primitiveTable ] ++ worlds)
hunk ./E/E.hs 213
-    tWorld__ = ELit (LitCons tWorld__ [] eStar)
+    tWorld__ = ELit (LitCons tWorld__ [] eHash)
hunk ./E/E.hs 334
-vWorld__ = ELit (LitCons dc_World__ [] tWorld__)
hunk ./E/FromHs.hs 88
+    f (TCon (Tycon n k)) | n == tc_World__ =  ELit (LitCons rt_Worldzh [] eHash)
hunk ./E/FromHs.hs 190
-            be = eAp (eAp e (EVar errorCont)) vWorld__
+            be = (eAp e (EVar errorCont))
hunk ./E/FromHs.hs 308
-sillyName = toName Val ("Jhc@","silly")
-sillyName' = nameName sillyName
+sillyName' = nameName v_silly
hunk ./E/FromHs.hs 310
-tCont = ELit $ LitCons tc_IOCont [tWorld__,ELit $ LitCons tc_IOError [] eStar] eStar
-tvrCont = tvr { tvrIdent = 0, tvrType = tCont }
hunk ./E/FromHs.hs 363
-        in [(sillyName,tvr,cExpr exp)]
+        in [(v_silly,tvr,cExpr exp)]
hunk ./E/Show.hs 136
-        f e | e == tWorld__  = return $ atom $ text "World__"
+        --f e | e == tWorld__  = return $ atom $ text "World__"
hunk ./E/Values.hs 45
+-- the IOErrorCont type from Jhc.IO
+tCont = ltTuple [ELit $ LitCons tc_JumpPoint [] eStar, ELit $ LitCons tc_IOError [] eStar]
+tvrCont = tvr { tvrIdent = 0, tvrType = tCont }
+
hunk ./E/Values.hs 176
-tTag = rawType "tag#"
hunk ./E/Values.hs 197
-rawType s  = ELit (LitCons (toName RawType s) [] eHash)
+rawType s = ELit (LitCons (toName RawType s) [] eHash)
+
+tWorldzh = ELit (LitCons rt_Worldzh [] eHash)
+tTag = ELit (LitCons rt_tag [] eHash)
+vWorld__ = EPrim (APrim (PrimPrim "theWorld__") mempty) [] tWorld__
hunk ./Grin/FromE.hs 6
-import Data.Map as Map hiding(map,null)
+import qualified Data.Map as Map
+import Data.Map(Map)
hunk ./Grin/FromE.hs 107
-        f x = (x,map (toType (TyPtr TyNode) . tvrType ) as,toType TyNode (getType (e::E) :: E))
+        f x = (x,map (toType (TyPtr TyNode) . tvrType ) $ filter (shouldKeep . getType )as,toType TyNode (getType (e::E) :: E))
hunk ./Grin/FromE.hs 111
-    toty (ELit (LitCons n es ty)) |  ty == eHash, TypeConstructor <- nameType n, Just _ <- fromUnboxedNameTuple n = (TyTup (map (toType (TyPtr TyNode) ) es))
+    toty e | e == tWorld__ = TyTup []
+    toty (ELit (LitCons n es ty)) |  ty == eHash, TypeConstructor <- nameType n, Just _ <- fromUnboxedNameTuple n = (tuple (map (toType (TyPtr TyNode) ) (filter shouldKeep es)))
hunk ./Grin/FromE.hs 168
-    scMap = fromList [ (tvrNum t,toEntry x) |  x@(t,_,_) <- progCombinators prog]
-    initTyEnv = mappend primTyEnv $ TyEnv $ fromList $ [ (a,(b,c)) | (_,(a,b,c)) <-  Map.toList scMap] ++ [con x| x <- Map.elems $ constructorMap dataTable, conType x /= eHash]
+    scMap = Map.fromList [ (tvrNum t,toEntry x) |  x@(t,_,_) <- map stripTheWorld $ progCombinators prog]
+    initTyEnv = mappend primTyEnv $ TyEnv $ Map.fromList $ [ (a,(b,c)) | (_,(a,b,c)) <-  Map.toList scMap] ++ [con x| x <- Map.elems $ constructorMap dataTable, conType x /= eHash]
hunk ./Grin/FromE.hs 174
-        as = [ toType (TyPtr TyNode) (getType s) |  s <- conSlots c]
+        as = [ toType (TyPtr TyNode) (getType s) |  s <- conSlots c, shouldKeep s]
+
+
+stripTheWorld :: (TVr,[TVr],E) ->  (TVr,[TVr],E)
+stripTheWorld (t,as,e) = (t,filter (shouldKeep . getType) as,e)
+
+
+shouldKeep :: E -> Bool
+shouldKeep e = e /= tWorld__
hunk ./Grin/FromE.hs 212
-    canidate e | (EVar x,as) <- fromAp e, Just vs <- Map.lookup x res, vs > length as = True
+    canidate e | (EVar x,as) <- fromAp e, Just vs <- Map.lookup x res, vs > length (ff as) = True
hunk ./Grin/FromE.hs 215
-    res = Map.fromList [ (v,length vs) | (v,vs,_) <- ds]
+    res = Map.fromList [ (v,length $ ff vs) | (v,vs,_) <- ds]
hunk ./Grin/FromE.hs 224
-    conv e | (EVar x,as) <- fromAp e, Just vs <- Map.lookup x res, vs > length as = Const (NodeC (partialTag (scTag x) (vs - length as)) (map conv as))
+    conv e | (EVar x,as) <- fromAp e, Just vs <- Map.lookup x res, vs > length (ff as) = Const (NodeC (partialTag (scTag x) (vs - length (ff as))) (map conv (ff as)))
hunk ./Grin/FromE.hs 229
+    ff x = filter (shouldKeep . getType) x
hunk ./Grin/FromE.hs 246
+    toVal (TVr { tvrIdent = num, tvrType = w}) | w == tWorld__ = Tup []-- Var v0 tyUnit -- es == eHash, RawType <- nameType n  = Var (V num) (Ty $ toAtom (show n))
hunk ./Grin/FromE.hs 270
-        return (nn,(Tup (map toVal as) :-> x))
+        return (nn,(Tup (map toVal (filter (shouldKeep . getType) as)) :-> x))
hunk ./Grin/FromE.hs 279
+    --ce e | getType e == tWorld__ = return $ Return unit
hunk ./Grin/FromE.hs 316
-        return $ Store (NodeC (toAtom "@hole") []) :>>= var :-> Return (tuple [pworld__,var])
+        return $ Store (NodeC (toAtom "@hole") []) :>>= var :-> Return (tuple [var])
hunk ./Grin/FromE.hs 320
-        return $ gEval v' :>>= n1 :-> Update r' n1 :>>= unit :-> Return world__
+        return $ gEval v' :>>= n1 :-> Update r' n1
hunk ./Grin/FromE.hs 322
-        return $ Return world__
+        return $ Return unit
+    ce (EPrim ap@(APrim (PrimPrim "theWorld__") _) [] _) = do
+        return $ Return unit
hunk ./Grin/FromE.hs 328
-        return $  Prim p (args es) :>>= unit :-> Return world__
+        return $  Prim p (args es)
hunk ./Grin/FromE.hs 333
-        return $ Prim p (args es) :>>= ptv :-> Return (Tup [pworld__,ptv])
+        return $ Prim p (args es) :>>= ptv :-> Return (tuple [ptv])
hunk ./Grin/FromE.hs 341
-        return $  Prim p (args [addr]) :>>= ptv :-> Return (Tup [pworld__,ptv])
+        return $  Prim p (args [addr]) :>>= ptv :-> Return (tuple [ptv])
hunk ./Grin/FromE.hs 345
-        return $  Prim p (args [addr,val]) :>>= unit :-> Return world__
+        return $  Prim p (args [addr,val])
hunk ./Grin/FromE.hs 365
-        return $ e :>>= Tup (map toVal xs) :-> wh
-
+        return $ e :>>= tuple (map toVal (filter (shouldKeep . getType) xs)) :-> wh
+    ce (ECase e _ [] (Just r)) | getType e == tWorld__ = do
+        e <- ce e
+        r <- ce r
+        return $ e :>>= unit :-> r
hunk ./Grin/FromE.hs 388
-    fromIORT e | ELit (LitCons tn [x,y] star) <- followAliases dataTable e, tn == tupNamet2, star == eStar, x == tWorld__ = lookupCType dataTable y
-    fromIORT e = fail $ "fromIORT: " ++ show e
-    retIO v = Return (NodeC tn_2Tup [pworld__,v])
-    tupNamet2 = (nameTuple TypeConstructor 2)
hunk ./Grin/FromE.hs 394
-    cp (Alt lc@(LitCons n es _) e) | Just v <- fromUnboxedNameTuple n, DataConstructor <- nameType n = do
-        putStrLn $ "Print alt: " ++ show lc
-        x <- ce e
-        return (Tup (map toVal es) :-> x)
+--    cp (Alt lc@(LitCons n es _) e) | Just v <- fromUnboxedNameTuple n, DataConstructor <- nameType n = do
+--        putStrLn $ "Print alt: " ++ show lc
+--        x <- ce e
+--        return (Tup (map toVal es) :-> x)
hunk ./Grin/FromE.hs 401
-        return (NodeC nn (map toVal es) :-> x)
+        return (NodeC nn (map toVal (filter (shouldKeep . getType) es)) :-> x)
hunk ./Grin/FromE.hs 450
-    cc (EPrim (APrim (PrimPrim "newWorld__") _) [_] _) = return $ Return pworld__
+    cc (EPrim (APrim (PrimPrim "newWorld__") _) [_] _) = return $ Return unit
+    cc (EPrim (APrim (PrimPrim "theWorld__") _) [] _) = return $ Return unit
hunk ./Grin/FromE.hs 522
-    args es = map f es where
+    args es = map f (filter (shouldKeep . getType) es) where
hunk ./Grin/FromE.hs 553
-    constant (ELit lc@(LitCons n es _)) | Just es <- mapM constant es, Just nn <- getName lc = (return $ Const (NodeC nn es))
+    constant (ELit lc@(LitCons n es _)) | Just es <- mapM constant (filter (shouldKeep . getType) es), Just nn <- getName lc = (return $ Const (NodeC nn es))
hunk ./Grin/FromE.hs 565
-            return (Tup (args es))
+            return (tuple (args (filter (shouldKeep . getType) es)))
hunk ./Grin/Simplify.hs 155
+    --getCS (b@Var {},Store v@(NodeC t as)) | Just (0,fn) <- tagUnfunction t = return $ Map.fromList [(Store v,Return b),(App funcEval [b] TyNode, App fn as TyNode :>>= n1 :-> Update b n1 :>>= unit :-> Return n1)]
+    getCS (b@Var {},Store v@(NodeC t as)) | Just (0,fn) <- tagUnfunction t = return $ Map.fromList [(Store v,Return b)]
hunk ./Grin/Val.hs 26
-world__ = NodeC (convertName $ dc_World__) []
+world__ = NodeC (toAtom "World#") []
hunk ./Name/Names.hs 28
-    tWorld__ = tc_World__
+    tWorld__ = rt_Worldzh
hunk ./Name/Names.hs 72
-dc_World__ = toName DataConstructor ("Jhc.IO","World__")
hunk ./Name/Names.hs 75
-tc_IOCont = toName TypeConstructor ("Jhc.JumpPoint","IOCont")
+--tc_IOCont = toName TypeConstructor ("Jhc.JumpPoint","IOCont")
+tc_JumpPoint = toName TypeConstructor ("Jhc.JumpPoint","JumpPoint")
hunk ./Name/Names.hs 98
+rt_Worldzh = toName RawType "World#"
+rt_tag = toName RawType "tag#"
+
hunk ./Name/Names.hs 117
+v_silly = toName Val ("Jhc@","silly")
hunk ./data/PrimitiveOperators-in.hs 107
-tCont = ELit $ LitCons tc_IOCont [tWorld__,ELit $ LitCons tc_IOError [] eStar] eStar
-tvrCont = tvr { tvrIdent = 0, tvrType = tCont }
hunk ./lib/Jhc/Hole.hs 16
-readHole :: Hole a -> a
-readHole (Hole x) = x
+readHole :: Hole a -> IO a
+readHole (Hole x) = return x
hunk ./lib/Jhc/IO.hs 8
--- this is treated specially by the compiler. it won't treat it as a product type.
-data World__ = World__
+-- this is treated very specially by the compiler. it is unboxed.
+data World__
hunk ./lib/Jhc/IO.hs 77
-        True -> fn (readHole hole)
+        True -> readHole hole >>= fn
hunk ./lib/System/IO/Continuation.hs 13
-        True  -> do cc (readHole ref)
+        True  -> do readHole ref >>= cc
hunk ./utils/op_process.prl 193
+push @names, "(\"Jhc.IO.World__\",\"void\",\"void\")";