[project @ 2001-10-23 14:46:25 by rrt]

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

diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs
index ce99069..c16ba2c 100644 (file)
--- a/ghc/compiler/typecheck/Inst.lhs
+++ b/ghc/compiler/typecheck/Inst.lhs
@@ -9,7 +9,7 @@ module Inst (
        plusLIEs, mkLIE, isEmptyLIE, lieToList, listToLIE,
 
        Inst, 
-       pprInst, pprInsts, pprInstsInFull, tidyInsts,
+       pprInst, pprInsts, pprInstsInFull, tidyInsts, tidyMoreInsts,
 
        newDictsFromOld, newDicts, 
        newMethod, newMethodWithGivenTy, newOverloadedLit,
@@ -64,7 +64,7 @@ import Name   ( Name, mkMethodOcc, getOccName )
 import NameSet ( NameSet )
 import PprType ( pprPred )     
 import Subst   ( emptyInScopeSet, mkSubst, 
-                 substTy, substTheta, mkTyVarSubst, mkTopTyVarSubst
+                 substTy, substTyWith, substTheta, mkTyVarSubst, mkTopTyVarSubst
                )
 import Literal ( inIntRange )
 import VarEnv  ( TidyEnv, lookupSubstEnv, SubstResult(..) )
@@ -99,7 +99,7 @@ zonkLIE :: LIE -> NF_TcM LIE
 zonkLIE lie = mapBagNF_Tc zonkInst lie
 
 pprInsts :: [Inst] -> SDoc
-pprInsts insts = parens (sep (punctuate comma (map pprInst insts)))
+pprInsts insts  = parens (sep (punctuate comma (map pprInst insts)))
 
 
 pprInstsInFull insts
@@ -391,7 +391,7 @@ newMethod orig id tys
   =    -- Get the Id type and instantiate it at the specified types
     let
        (tyvars, rho) = tcSplitForAllTys (idType id)
-       rho_ty        = substTy (mkTyVarSubst tyvars tys) rho
+       rho_ty        = substTyWith tyvars tys rho
        (pred, tau)   = tcSplitMethodTy rho_ty
     in
     newMethodWithGivenTy orig id tys [pred] tau
@@ -532,13 +532,16 @@ tidyInst env (LitInst u lit ty loc)            = LitInst u lit (tidyType env ty) loc
 tidyInst env (Dict u pred loc)              = Dict u (tidyPred env pred) loc
 tidyInst env (Method u id tys theta tau loc) = Method u id (tidyTypes env tys) theta tau loc
 
-tidyInsts :: [Inst] -> (TidyEnv, [Inst])
+tidyMoreInsts :: TidyEnv -> [Inst] -> (TidyEnv, [Inst])
 -- This function doesn't assume that the tyvars are in scope
 -- so it works like tidyOpenType, returning a TidyEnv
-tidyInsts insts 
-  = (env, map (tidyInst env) insts)
+tidyMoreInsts env insts
+  = (env', map (tidyInst env') insts)
   where
-    env = tidyFreeTyVars emptyTidyEnv (tyVarsOfInsts insts)
+    env' = tidyFreeTyVars env (tyVarsOfInsts insts)
+
+tidyInsts :: [Inst] -> (TidyEnv, [Inst])
+tidyInsts insts = tidyMoreInsts emptyTidyEnv insts
 \end{code}
 
 
@@ -648,5 +651,3 @@ lookupSimpleInst clas tys
 
       other  -> returnNF_Tc Nothing
 \end{code}
-
-