[project @ 2000-03-24 17:49:29 by simonpj]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcRules.lhs
index f52bba1..1d9edb8 100644 (file)
@@ -13,10 +13,10 @@ import HsCore               ( UfRuleBody(..) )
 import RnHsSyn         ( RenamedHsDecl )
 import TcHsSyn         ( TypecheckedRuleDecl, mkHsLet )
 import TcMonad
-import TcSimplify      ( tcSimplifyRuleLhs, tcSimplifyAndCheck )
+import TcSimplify      ( tcSimplifyToDicts, tcSimplifyAndCheck )
 import TcType          ( zonkTcTypes, newTyVarTy_OpenKind )
 import TcIfaceSig      ( tcCoreExpr, tcCoreLamBndrs, tcVar )
-import TcMonoType      ( tcHsType, tcHsTyVar, checkSigTyVars )
+import TcMonoType      ( tcHsSigType, tcHsTyVar, checkSigTyVars )
 import TcExpr          ( tcExpr )
 import TcEnv           ( tcExtendLocalValEnv, newLocalId,
                          tcExtendTyVarEnv
@@ -66,12 +66,23 @@ tcRule (RuleDecl name sig_tvs vars lhs rhs src_loc)
     )                                          `thenTc` \ (ids, lhs', rhs', lhs_lie, rhs_lie) ->
 
                -- Check that LHS has no overloading at all
-    tcSimplifyRuleLhs lhs_lie                          `thenTc` \ (lhs_dicts, lhs_binds) ->
+    tcSimplifyToDicts lhs_lie                          `thenTc` \ (lhs_dicts, lhs_binds) ->
     checkSigTyVars sig_tyvars                          `thenTc_`
 
        -- Gather the template variables and tyvars
     let
        tpl_ids = map instToId (bagToList lhs_dicts) ++ ids
+
+       -- IMPORTANT!  We *quantify* over any dicts that appear in the LHS
+       -- Reason: 
+       --      a) The particular dictionary isn't important, because its value
+       --         depends only on the type
+       --              e.g     gcd Int $fIntegralInt
+       --         Here we'd like to match against (gcd Int any_d) for any 'any_d'
+       --
+       --      b) We'd like to make available the dictionaries bound 
+       --         on the LHS in the RHS, so quantifying over them is good
+       --         See the 'lhs_dicts' in tcSimplifyAndCheck for the RHS
     in
 
        -- Gather type variables to quantify over
@@ -93,7 +104,7 @@ tcRule (RuleDecl name sig_tvs vars lhs rhs src_loc)
   where
     new_id (RuleBndr var)         = newTyVarTy_OpenKind        `thenNF_Tc` \ ty ->
                                     returnNF_Tc (mkVanillaId var ty)
-    new_id (RuleBndrSig var rn_ty) = tcHsType rn_ty    `thenTc` \ ty ->
+    new_id (RuleBndrSig var rn_ty) = tcHsSigType rn_ty `thenTc` \ ty ->
                                     returnNF_Tc (mkVanillaId var ty)
 
 ruleCtxt name = ptext SLIT("When checking the transformation rule") <+>