[project @ 2002-09-09 12:50:26 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcModule.lhs

diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs
index 9251283..342c623 100644 (file)
--- a/ghc/compiler/typecheck/TcModule.lhs
+++ b/ghc/compiler/typecheck/TcModule.lhs
@@ -18,7 +18,7 @@ import HsSyn          ( HsBinds(..), MonoBinds(..), HsDecl(..), HsExpr(..),
                          isSourceInstDecl, mkSimpleMatch, placeHolderType, isCoreDecl
                        )
 import PrelNames       ( ioTyConName, printName,
-                         returnIOName, bindIOName, failIOName, thenIOName, runMainName, 
+                         returnIOName, bindIOName, failIOName, thenIOName, runIOName, 
                          dollarMainName, itName
                        )
 import MkId            ( unsafeCoerceId )
@@ -213,8 +213,8 @@ tc_stmts names stmts
     traceTc (text "tcs 4") `thenNF_Tc_`
 
     returnTc (mkHsLet const_binds $
-             HsDoOut DoExpr tc_stmts io_ids
-                     (mkTyConApp ioTyCon [mkListTy unitTy]) noSrcLoc,
+             HsDo DoExpr tc_stmts io_ids
+                  (mkTyConApp ioTyCon [mkListTy unitTy]) noSrcLoc,
              ids)
   where
     combine stmt (ids, stmts) = (ids, stmt:stmts)
@@ -445,8 +445,9 @@ tcModule pcs hst (RnResult { rr_decls = decls, rr_mod = this_mod,
                           lie_rules     `plusLIE`
                           lie_main
        in
-       tcSimplifyTop lie_alldecls      `thenTc` \ const_inst_binds ->
-        traceTc (text "endsimpltop")   `thenTc_`
+       tcSimplifyTop lie_alldecls              `thenTc` \ const_inst_binds ->
+        traceTc (text "endsimpltop")           `thenTc_`
+       
        
            -- Backsubstitution.    This must be done last.
            -- Even tcSimplifyTop may do some unification.
@@ -750,10 +751,10 @@ We must check that in module Main,
        b) Main.main :: forall a1...an. IO t,  for some type t
 
 Then we build
-       $main = PrelTopHandler.runMain Main.main
+       $main = GHC.TopHandler.runIO Main.main
 
 The function
-  PrelTopHandler :: IO a -> IO ()
+  GHC.TopHandler.runIO :: IO a -> IO a
 catches the top level exceptions.  
 It accepts a Main.main of any type (IO a).
 
@@ -769,17 +770,17 @@ tcCheckMain (Just main_name)
     newTyVarTy liftedTypeKind          `thenNF_Tc` \ ty ->
     tcMonoExpr rhs ty                  `thenTc` \ (main_expr, lie) ->
     zonkTcType ty                      `thenNF_Tc` \ ty ->
-    ASSERT( is_io_unit ty )
+    ASSERT( is_io ty )
     let
        dollar_main_id = setIdLocalExported (mkLocalId dollarMainName ty)
     in
     returnTc (VarMonoBind dollar_main_id main_expr, lie)
   where
-    rhs = HsApp (HsVar runMainName) (HsVar main_name)
+    rhs = HsApp (HsVar runIOName) (HsVar main_name)
 
-is_io_unit :: Type -> Bool     -- True for IO ()
-is_io_unit tau = case tcSplitTyConApp_maybe tau of
-                  Just (tc, [arg]) -> getName tc == ioTyConName && isUnitTy arg
+is_io :: Type -> Bool  -- True for IO a
+is_io tau = case tcSplitTyConApp_maybe tau of
+                  Just (tc, [_]) -> getName tc == ioTyConName
                   other            -> False
 
 mainCtxt = ptext SLIT("When checking the type of 'main'")