[project @ 2001-04-12 21:29:43 by lewie]

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

diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index 64a7d2f..5bd9cae 100644 (file)
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -13,8 +13,9 @@ import {-# SOURCE #-} TcMatches ( tcGRHSs, tcMatchesFun )
 import {-# SOURCE #-} TcExpr  ( tcExpr )
 
 import CmdLineOpts     ( opt_NoMonomorphismRestriction )
-import HsSyn           ( HsExpr(..), HsBinds(..), MonoBinds(..), Sig(..), StmtCtxt(..),
-                         Match(..), collectMonoBinders, andMonoBinds
+import HsSyn           ( HsExpr(..), HsBinds(..), MonoBinds(..), Sig(..), 
+                         Match(..), HsMatchContext(..), 
+                         collectMonoBinders, andMonoBinds
                        )
 import RnHsSyn         ( RenamedHsBinds, RenamedSig, RenamedMonoBinds )
 import TcHsSyn         ( TcMonoBinds, TcId, zonkId, mkHsLet )
@@ -26,7 +27,7 @@ import Inst           ( LIE, emptyLIE, mkLIE, plusLIE, InstOrigin(..),
 import TcEnv           ( tcExtendLocalValEnv,
                          newSpecPragmaId, newLocalId
                        )
-import TcSimplify      ( tcSimplifyInfer, tcSimplifyInferCheck, tcSimplifyCheck, tcSimplifyToDicts )
+import TcSimplify      ( tcSimplifyInfer, tcSimplifyInferCheck, tcSimplifyCheck, tcSimplifyRestricted, tcSimplifyToDicts )
 import TcMonoType      ( tcHsSigType, checkSigTyVars,
                          TcSigInfo(..), tcTySig, maybeSig, sigCtxt
                        )
@@ -38,7 +39,7 @@ import TcType         ( newTyVarTy, newTyVar,
 import TcUnify         ( unifyTauTy, unifyTauTyLists )
 
 import CoreFVs         ( idFreeTyVars )
-import Id              ( mkVanillaId, setInlinePragma )
+import Id              ( mkLocalId, setInlinePragma )
 import Var             ( idType, idName )
 import IdInfo          ( InlinePragInfo(..) )
 import Name            ( Name, getOccName, getSrcLoc )
@@ -216,7 +217,7 @@ tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec
          poly_ids      = map mk_dummy binder_names
          mk_dummy name = case maybeSig tc_ty_sigs name of
                            Just (TySigInfo _ poly_id _ _ _ _ _ _) -> poly_id   -- Signature
-                           Nothing -> mkVanillaId name forall_a_a              -- No signature
+                           Nothing -> mkLocalId name forall_a_a                -- No signature
        in
        returnTc (EmptyMonoBinds, emptyLIE, poly_ids)
     )                                          $
@@ -277,7 +278,7 @@ tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec
                        (sig_tyvars, sig_poly_id)
                  Nothing -> (real_tyvars_to_gen, new_poly_id)
 
-           new_poly_id = mkVanillaId binder_name poly_ty
+           new_poly_id = mkLocalId binder_name poly_ty
            poly_ty = mkForAllTys real_tyvars_to_gen
                        $ mkFunTys dict_tys 
                        $ idType zonked_mono_id
@@ -288,10 +289,11 @@ tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec
                -- at all.
     in
 
+    traceTc (text "binding:" <+> ppr ((zonked_dict_ids, dict_binds),
+            exports, [idType poly_id | (_, poly_id, _) <- exports])) `thenTc_`
+
         -- BUILD RESULTS
     returnTc (
-       -- pprTrace "binding.." (ppr ((zonked_dict_ids, dict_binds), 
-       --                              exports, [idType poly_id | (_, poly_id, _) <- exports])) $
        AbsBinds real_tyvars_to_gen
                 zonked_dict_ids
                 exports
@@ -461,7 +463,7 @@ generalise binder_names mbind tau_tvs lie_req sigs
 
        -- Now simplify with exactly that set of tyvars
        -- We have to squash those Methods
-    tcSimplifyCheck doc final_forall_tvs [] lie_req    `thenTc` \ (lie_free, binds) ->
+    tcSimplifyRestricted doc final_forall_tvs [] lie_req       `thenTc` \ (lie_free, binds) ->
 
     returnTc (final_forall_tvs, lie_free, binds, [])