[fix up handling of world for main function and grin generation
John Meacham <john@repetae.net>**20060317025647] {
hunk ./E/FromHs.hs 195
-        errorCont <- findName v_undefinedIOErrorCont
-        let e | not (fopts FO.Wrapper) = maine
-              | otherwise = case ioLike (getType maine) of
+        runNoWrapper <- findName (func_runNoWrapper sFuncNames)
+        let e = case ioLike (getType maine) of
+                Just x | not (fopts FO.Wrapper) -> EAp (EAp (EVar runNoWrapper) x) maine
hunk ./E/FromHs.hs 200
-            be = (eAp e (EVar errorCont))
-            theMain = (theMainName,setProperty prop_EXPORTED theMainTvr,be)
-            theMainTvr =  tVr (toId theMainName) (infertype dataTable be)
+            theMain = (theMainName,setProperty prop_EXPORTED theMainTvr,e)
+            theMainTvr =  tVr (toId theMainName) (infertype dataTable e)
hunk ./E/FromHs.hs 203
-            maine = foldl EAp (EVar tvm) [ tAbsurd k |  TVr { tvrType = k } <- xs ]
+            maine = foldl EAp (EVar tvm) [ tAbsurd k |  TVr { tvrType = k } <- xs, sortStarLike k ]
hunk ./E/FromHs.hs 206
-    ioLike ty = case smplE ty of
-        ELit (LitCons n [x] _) -> if n ==  tc_IO then Just x else Nothing
+    ioLike ty = case followAliases dataTable ty of
+        ELit (LitCons n [x] _) | n ==  tc_IO -> Just x
+        (EPi ioc (EPi tvr (ELit (LitCons n [x] _)))) | n == tc_IOResult -> Just x 
hunk ./E/FromHs.hs 210
-    smplE = id
hunk ./E/Values.hs 177
-vWorld__ = EPrim (APrim (PrimPrim "theWorld__") mempty) [] tWorld__
hunk ./E/Values.hs 255
+whnfOrBot ELam {} = True
hunk ./Grin/FromE.hs 173
-            grinFunctions = (funcMain ,(Tup [] :-> App funcInitCafs [] tyUnit :>>= unit :->  theMain :>>= n0 :-> Return unit )) : ds',
+            grinFunctions = (funcMain ,(Tup [] :-> App funcInitCafs [] tyUnit :>>= unit :->  theMain )) : ds',
hunk ./Grin/FromE.hs 328
-    ce (EPrim ap@(APrim (PrimPrim "theWorld__") _) [] _) = do
-        return $ Return unit
hunk ./Name/Names.hs 124
-    func_negate = toName Val ("Prelude","negate"),
-    func_runMain = toName Val ("Jhc.IO","runMain"),
-    func_fromInt = toName Val ("Prelude","fromInt"),
+    func_concatMap = toName Val ("Prelude","concatMap"),
+    func_equals = toName Val ("Prelude","=="),
hunk ./Name/Names.hs 127
+    func_fromInt = toName Val ("Prelude","fromInt"),
hunk ./Name/Names.hs 129
+    func_negate = toName Val ("Prelude","negate"),
hunk ./Name/Names.hs 131
-    func_equals = toName Val ("Prelude","=="),
-    func_concatMap = toName Val ("Prelude","concatMap")
+    func_runMain = toName Val ("Jhc.IO","runMain"),
+    func_runNoWrapper = toName Val ("Jhc.IO","runNoWrapper")
hunk ./Name/VConsts.hs 80
-    func_negate :: a,
-    func_runMain :: a,
-    func_runExpr :: a,
+    func_concatMap :: a,
+    func_equals :: a,
hunk ./Name/VConsts.hs 85
-    func_equals :: a,
-    func_concatMap :: a
+    func_negate :: a,
+    func_runExpr :: a,
+    func_runMain :: a,
+    func_runNoWrapper :: a
hunk ./lib/base/Jhc/IO.hs 12
+    runNoWrapper,
hunk ./lib/base/Jhc/IO.hs 116
-runMain :: IO a -> IO ()
-runMain main = do
-    catch main $ \e -> do
-        putStrLn "\nUncaught Exception:"
-        putStrLn $ showIOError e
-        exitFailure
-    return ()
+runMain :: IO a -> World__ -> World__
+runMain main w = case run undefinedIOErrorCont w of
+        JustIO w _ -> w
+    where
+    IO run = catch main $ \e -> do
+            putStrLn "\nUncaught Exception:"
+            putStrLn $ showIOError e
+            exitFailure
+
hunk ./lib/base/Jhc/IO.hs 127
-runExpr :: Show a => a -> IO ()
-runExpr x = runMain (print x)
+runExpr :: Show a => a -> World__ -> World__
+runExpr x w = runMain (print x) w
+
+-- | when no exception wrapper is wanted
+runNoWrapper :: IO a -> World__ -> World__
+runNoWrapper (IO run) w =
+    case run undefinedIOErrorCont w of
+        JustIO w _ -> w
}
