[project @ 2003-09-23 15:10:23 by simonpj]

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

diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs
index 5790e7b..61bfd60 100644 (file)
--- a/ghc/compiler/typecheck/Inst.lhs
+++ b/ghc/compiler/typecheck/Inst.lhs
@@ -15,7 +15,8 @@ module Inst (
        newDictsFromOld, newDicts, cloneDict, 
        newOverloadedLit, newIPDict, 
        newMethod, newMethodFromName, newMethodWithGivenTy, 
-       tcInstClassOp, tcInstCall, tcInstDataCon, tcSyntaxName,
+       tcInstClassOp, tcInstCall, tcInstDataCon, 
+       tcSyntaxName, tcStdSyntaxName,
 
        tyVarsOfInst, tyVarsOfInsts, tyVarsOfLIE, 
        ipNamesOfInst, ipNamesOfInsts, fdPredsOfInst, fdPredsOfInsts,
@@ -26,7 +27,7 @@ module Inst (
        isDict, isClassDict, isMethod, 
        isLinearInst, linearInstType, isIPDict, isInheritableInst,
        isTyVarDict, isStdClassTyVarDict, isMethodFor, 
-       instBindingRequired, instCanBeGeneralised,
+       instBindingRequired,
 
        zonkInst, zonkInsts,
        instToId, instName,
@@ -64,7 +65,7 @@ import TcType ( Type, TcType, TcThetaType, TcTyVarSet,
 import CoreFVs ( idFreeTyVars )
 import DataCon ( DataCon,dataConSig )
 import Id      ( Id, idName, idType, mkUserLocal, mkSysLocal, mkLocalId, setIdUnique )
-import PrelInfo        ( isStandardClass, isCcallishClass, isNoDictClass )
+import PrelInfo        ( isStandardClass, isNoDictClass )
 import Name    ( Name, mkMethodOcc, getOccName )
 import PprType ( pprPred, pprParendType )      
 import Subst   ( substTy, substTyWith, substTheta, mkTyVarSubst )
@@ -193,10 +194,6 @@ must be witnessed by an actual binding; the second tells whether an
 instBindingRequired :: Inst -> Bool
 instBindingRequired (Dict _ (ClassP clas _) _) = not (isNoDictClass clas)
 instBindingRequired other                     = True
-
-instCanBeGeneralised :: Inst -> Bool
-instCanBeGeneralised (Dict _ (ClassP clas _) _) = not (isCcallishClass clas)
-instCanBeGeneralised other                     = True
 \end{code}
 
 
@@ -653,8 +650,7 @@ tcSyntaxName :: InstOrigin
 
 tcSyntaxName orig ty (std_nm, HsVar user_nm)
   | std_nm == user_nm
-  = newMethodFromName orig ty std_nm   `thenM` \ id ->
-    returnM (std_nm, HsVar id)
+  = tcStdSyntaxName orig ty std_nm
 
 tcSyntaxName orig ty (std_nm, user_nm_expr)
   = tcLookupId std_nm          `thenM` \ std_id ->
@@ -669,6 +665,15 @@ tcSyntaxName orig ty (std_nm, user_nm_expr)
     tcCheckSigma user_nm_expr tau1                     `thenM` \ expr ->
     returnM (std_nm, expr)
 
+tcStdSyntaxName :: InstOrigin
+               -> TcType               -- Type to instantiate it at
+               -> Name                 -- Standard name
+               -> TcM (Name, TcExpr)   -- (Standard name, suitable expression)
+
+tcStdSyntaxName orig ty std_nm
+  = newMethodFromName orig ty std_nm   `thenM` \ id ->
+    returnM (std_nm, HsVar id)
+
 syntaxNameCtxt name orig ty tidy_env
   = getInstLoc orig            `thenM` \ inst_loc ->
     let