X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=ghc%2Fcompiler%2Freader%2FReadPrefix.lhs;h=90732706f15ead6ef77080ab3faf83a8d7fc0105;hp=3e3fb44415fa9d361c2b03510dc6c6e9e7565b5f;hb=573ef10b2afd99d3c6a36370a9367609716c97d2;hpb=30f15b4e7d579dc142537342161c460c6b80290b

diff --git a/ghc/compiler/reader/ReadPrefix.lhs b/ghc/compiler/reader/ReadPrefix.lhs
index 3e3fb44..9073270 100644
--- a/ghc/compiler/reader/ReadPrefix.lhs
+++ b/ghc/compiler/reader/ReadPrefix.lhs
@@ -15,7 +15,7 @@ IMPORT_1_3(GHCio(stThen))
 import UgenAll		-- all Yacc parser gumpff...
 import PrefixSyn	-- and various syntaxen.
 import HsSyn
-import HsPragmas	( noDataPragmas, noClassPragmas, noInstancePragmas )
+import HsPragmas	( noDataPragmas, noClassPragmas, noInstancePragmas, noGenPragmas )
 import RdrHsSyn
 import PrefixToHs
 
@@ -25,7 +25,7 @@ import Name		( RdrName(..), isRdrLexConOrSpecial, preludeQual )
 import PprStyle		( PprStyle(..) )
 import PrelMods		( pRELUDE )
 import Pretty
-import SrcLoc		( SrcLoc )
+import SrcLoc		( mkBuiltinSrcLoc, SrcLoc )
 import Util		( nOfThem, pprError, panic )
 \end{code}
 
@@ -118,15 +118,37 @@ rdModule
 	      		  imports
 	      		  fixities
 	      		  tydecls
-	      		  tysigs
+			  tysigs
 	      		  classdecls
 	      		  instdecls
 	      		  instsigs
 	      		  defaultdecls
-	      		  (cvSepdBinds srcfile cvValSig binds)
+			  (add_main_sig modname (cvSepdBinds srcfile cvValSig binds))
 	      		  [{-no interface sigs yet-}]
 	      		  src_loc
        		)
+  where
+    add_main_sig modname binds
+      = if modname == SLIT("Main") then
+	    let
+	       s = Sig (Unqual SLIT("main")) (io_ty SLIT("IO")) noGenPragmas mkBuiltinSrcLoc
+	    in
+	    add_sig binds s
+
+	else if modname == SLIT("GHCmain") then
+	    let
+	       s = Sig (Unqual SLIT("mainPrimIO")) (io_ty SLIT("PrimIO")) noGenPragmas mkBuiltinSrcLoc
+	    in
+	    add_sig binds s
+
+	else -- add nothing
+	    binds
+      where
+	add_sig (SingleBind b)  s = BindWith b [s]
+	add_sig (BindWith b ss) s = BindWith b (s:ss)
+	add_sig _		_ = panic "rdModule:add_sig"
+
+	io_ty t = HsForAllTy [] [] (MonoTyApp (Unqual t) [MonoTupleTy []])
 \end{code}
 
 %************************************************************************