[project @ 2000-07-11 16:24:57 by simonmar]

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

diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index 52f1840..7d8b4c3 100644 (file)
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -61,7 +61,6 @@ import Maybes         ( maybeToBool )
 import BasicTypes      ( TopLevelFlag(..), RecFlag(..), isNotTopLevel )
 import FiniteMap       ( listToFM, lookupFM )
 import Unique          ( ioTyConKey, mainKey, hasKey, Uniquable(..) )
-import SrcLoc           ( SrcLoc )
 import Outputable
 \end{code}
 
@@ -260,8 +259,9 @@ tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec
        --   - zonking the generalized type vars
     let lie_avail = case maybe_sig_theta of
                      Nothing      -> emptyLIE
-                     Just (_, la) -> la in
-    tcImprove (lie_avail `plusLIE` lie_req)                    `thenTc_`
+                     Just (_, la) -> la
+       lie_avail_req = lie_avail `plusLIE` lie_req in
+    tcImprove lie_avail_req                            `thenTc_`
 
        -- COMPUTE VARIABLES OVER WHICH TO QUANTIFY, namely tyvars_to_gen
        -- The tyvars_not_to_gen are free in the environment, and hence
@@ -292,7 +292,7 @@ tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec
 
        -- SIMPLIFY THE LIE
     tcExtendGlobalTyVars tyvars_not_to_gen (
-       let ips = getIPsOfLIE lie_req in
+       let ips = getIPsOfLIE lie_avail_req in
        if null real_tyvars_to_gen_list && (null ips || not is_unrestricted) then
                -- No polymorphism, and no IPs, so no need to simplify context
            returnTc (lie_req, EmptyMonoBinds, [])
@@ -554,7 +554,6 @@ getTyVarsToGen is_unrestricted mono_id_tys lie
        let tvFundep        = tyVarFunDep fds'
            extended_tyvars = oclose tvFundep body_tyvars
        in
-       -- pprTrace "gTVTG" (ppr (lie, body_tyvars, extended_tyvars)) $
        returnNF_Tc (emptyVarSet, extended_tyvars)
     else
        -- This recover and discard-errs is to avoid duplicate error
@@ -736,6 +735,7 @@ The error message here is somewhat unsatisfactory, but it'll do for
 now (ToDo).
 
 \begin{code}
+checkSigMatch :: TopLevelFlag -> [Name] -> [TcId] -> [TcSigInfo] -> TcM s (Maybe (TcThetaType, LIE))
 checkSigMatch top_lvl binder_names mono_ids sigs
   | main_bound_here
   =    -- First unify the main_id with IO t, for any old t
@@ -770,7 +770,7 @@ checkSigMatch top_lvl binder_names mono_ids sigs
 
     sig1_dict_tys      = mk_dict_tys theta1
     n_sig1_dict_tys    = length sig1_dict_tys
-    sig_lie            = mkLIE [inst | TySigInfo _ _ _ _ _ _ inst _ <- sigs]
+    sig_lie            = mkLIE (concat [insts | TySigInfo _ _ _ _ _ _ insts _ <- sigs])
 
     maybe_main        = find_main top_lvl binder_names mono_ids
     main_bound_here   = maybeToBool maybe_main