[project @ 1998-06-08 11:45:09 by simonpj]

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

diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index 5ab2d1d..cb56629 100644 (file)
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -16,9 +16,7 @@ import {-# SOURCE #-} TcExpr  ( tcExpr )
 import HsSyn           ( HsExpr(..), HsBinds(..), MonoBinds(..), Sig(..), InPat(..),
                          collectMonoBinders, andMonoBinds
                        )
-import RnHsSyn         ( RenamedHsBinds, RenamedSig(..), 
-                         RenamedMonoBinds
-                       )
+import RnHsSyn         ( RenamedHsBinds, RenamedSig, RenamedMonoBinds )
 import TcHsSyn         ( TcHsBinds, TcMonoBinds,
                          TcIdOcc(..), TcIdBndr, 
                          tcIdType
@@ -270,11 +268,11 @@ tcBindWithSigs top_lvl binder_names mbind tc_ty_sigs is_rec prag_info_fn
        -- The tyvars_not_to_gen are free in the environment, and hence
        -- candidates for generalisation, but sometimes the monomorphism
        -- restriction means we can't generalise them nevertheless
-    getTyVarsToGen is_unrestricted mono_id_tys lie     `thenTc` \ (tyvars_not_to_gen, tyvars_to_gen) ->
+    getTyVarsToGen is_unrestricted mono_id_tys lie     `thenNF_Tc` \ (tyvars_not_to_gen, tyvars_to_gen) ->
 
        -- DEAL WITH TYPE VARIABLE KINDS
        -- **** This step can do unification => keep other zonking after this ****
-    mapTc defaultUncommittedTyVar (tyVarSetToList tyvars_to_gen)       `thenTc` \ real_tyvars_to_gen_list ->
+    mapTc defaultUncommittedTyVar (tyVarSetToList tyvars_to_gen)  `thenTc` \ real_tyvars_to_gen_list ->
     let
        real_tyvars_to_gen = mkTyVarSet real_tyvars_to_gen_list
                -- It's important that the final list 
@@ -489,8 +487,13 @@ getTyVarsToGen is_unrestricted mono_id_tys lie
     in
     if is_unrestricted
     then
-       returnTc (emptyTyVarSet, tyvars_to_gen)
+       returnNF_Tc (emptyTyVarSet, tyvars_to_gen)
     else
+       -- This recover and discard-errs is to avoid duplicate error
+       -- messages; this, after all, is an "extra" call to tcSimplify
+       recoverNF_Tc (returnNF_Tc (emptyTyVarSet, tyvars_to_gen))       $
+       discardErrsTc                                                   $
+
        tcSimplify (text "getTVG") NotTopLevel tyvars_to_gen lie    `thenTc` \ (_, _, constrained_dicts) ->
        let
          -- ASSERT: dicts_sig is already zonked!
@@ -861,6 +864,9 @@ tcPragmaSig (SpecInstSig _ _) = returnTc (Nothing, EmptyMonoBinds, emptyLIE)
 tcPragmaSig (InlineSig name loc)
   = returnTc (Just (name, setInlinePragInfo IWantToBeINLINEd), EmptyMonoBinds, emptyLIE)
 
+tcPragmaSig (NoInlineSig name loc)
+  = returnTc (Just (name, setInlinePragInfo IDontWantToBeINLINEd), EmptyMonoBinds, emptyLIE)
+
 tcPragmaSig (SpecSig name poly_ty maybe_spec_name src_loc)
   =    -- SPECIALISE f :: forall b. theta => tau  =  g
     tcAddSrcLoc src_loc                                $