[project @ 1999-02-18 17:13:54 by simonpj]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcBinds.lhs
index ba0fa38..49dfed2 100644 (file)
@@ -692,17 +692,24 @@ now (ToDo).
 \begin{code}
 checkSigMatch top_lvl binder_names mono_ids sigs
   | main_bound_here
-  = mapTc check_one_sig sigs                   `thenTc_`
-    mapTc check_main_ctxt sigs                 `thenTc_` 
-
-       -- Now unify the main_id with IO t, for any old t
+  =    -- First unify the main_id with IO t, for any old t
     tcSetErrCtxt mainTyCheckCtxt (
        tcLookupTyCon ioTyCon_NAME              `thenTc`    \ ioTyCon ->
        newTyVarTy boxedTypeKind                `thenNF_Tc` \ t_tv ->
        unifyTauTy ((mkTyConApp ioTyCon [t_tv]))
                   (idType main_mono_id)
     )                                          `thenTc_`
-    returnTc (Just ([], emptyLIE))
+
+       -- Now check the signatures
+       -- Must do this after the unification with IO t, 
+       -- in case of a silly signature like
+       --      main :: forall a. a
+       -- The unification to IO t will bind the type variable 'a',
+       -- which is just waht check_one_sig looks for
+    mapTc check_one_sig sigs                   `thenTc_`
+    mapTc check_main_ctxt sigs                 `thenTc_` 
+
+           returnTc (Just ([], emptyLIE))
 
   | not (null sigs)
   = mapTc check_one_sig sigs                   `thenTc_`
@@ -954,7 +961,8 @@ sigContextsCtxt s1 s2
 mainContextsErr id
   | getName id == main_NAME = ptext SLIT("Main.main cannot be overloaded")
   | otherwise
-  = quotes (ppr id) <+> ptext SLIT("cannot be overloaded, because it is mutually recursive with Main.main")
+  = quotes (ppr id) <+> ptext SLIT("cannot be overloaded") <> char ',' <> -- sigh; workaround for cpp's inability to deal
+    ptext SLIT("because it is mutually recursive with Main.main")         -- with commas inside SLIT strings.
 
 mainTyCheckCtxt
   = hsep [ptext SLIT("When checking that"), ppr main_NAME, ptext SLIT("has the required type")]