From e31827c6f8e3dc8aee72500cd224c7bdb4f6a764 Mon Sep 17 00:00:00 2001 From: simonpj Date: Wed, 18 Jan 2006 12:15:37 +0000 Subject: [PATCH] [project @ 2006-01-18 12:15:37 by simonpj] Expunge all mention of CCallable/CReturnable --- ghc/compiler/deSugar/DsCCall.lhs | 1 - ghc/compiler/prelude/PrelInfo.lhs | 8 +++----- ghc/compiler/prelude/PrelNames.lhs | 2 -- ghc/compiler/typecheck/Inst.lhs | 12 ------------ ghc/compiler/typecheck/TcInstDcls.lhs | 16 ---------------- ghc/compiler/typecheck/TcSimplify.lhs | 25 ++++--------------------- 6 files changed, 7 insertions(+), 57 deletions(-) diff --git a/ghc/compiler/deSugar/DsCCall.lhs b/ghc/compiler/deSugar/DsCCall.lhs index e630f04..3554197 100644 --- a/ghc/compiler/deSugar/DsCCall.lhs +++ b/ghc/compiler/deSugar/DsCCall.lhs @@ -196,7 +196,6 @@ unboxArg arg maybeToBool maybe_arg3_tycon && (arg3_tycon == byteArrayPrimTyCon || arg3_tycon == mutableByteArrayPrimTyCon) - -- and, of course, it is an instance of CCallable = newSysLocalDs arg_ty `thenDs` \ case_bndr -> newSysLocalsDs data_con_arg_tys `thenDs` \ vars@[l_var, r_var, arr_cts_var] -> returnDs (Var arr_cts_var, diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs index 5ed26fc..31457b2 100644 --- a/ghc/compiler/prelude/PrelInfo.lhs +++ b/ghc/compiler/prelude/PrelInfo.lhs @@ -15,7 +15,7 @@ module PrelInfo ( maybeCharLikeCon, maybeIntLikeCon, -- Class categories - isNoDictClass, isNumericClass, isStandardClass + isNumericClass, isStandardClass ) where @@ -23,8 +23,7 @@ module PrelInfo ( import PrelNames ( basicKnownKeyNames, hasKey, charDataConKey, intDataConKey, - numericClassKeys, standardClassKeys, - noDictClassKeys ) + numericClassKeys, standardClassKeys ) import PrimOp ( PrimOp, allThePrimOps, primOpOcc, primOpTag, maxPrimOpTag ) import DataCon ( DataCon ) @@ -132,10 +131,9 @@ maybeIntLikeCon con = con `hasKey` intDataConKey %************************************************************************ \begin{code} -isNoDictClass, isNumericClass, isStandardClass :: Class -> Bool +isNumericClass, isStandardClass :: Class -> Bool isNumericClass clas = classKey clas `is_elem` numericClassKeys isStandardClass clas = classKey clas `is_elem` standardClassKeys -isNoDictClass clas = classKey clas `is_elem` noDictClassKeys is_elem = isIn "is_X_Class" \end{code} diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs index eb26d34..23b5dfe 100644 --- a/ghc/compiler/prelude/PrelNames.lhs +++ b/ghc/compiler/prelude/PrelNames.lhs @@ -1040,8 +1040,6 @@ standardClassKeys = derivableClassKeys ++ numericClassKeys ++ [randomClassKey, randomGenClassKey, functorClassKey, monadClassKey, monadPlusClassKey] - -noDictClassKeys = [] -- ToDo: remove? \end{code} @derivableClassKeys@ is also used in checking \tr{deriving} constructs diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs index d6cf344..b270a59 100644 --- a/ghc/compiler/typecheck/Inst.lhs +++ b/ghc/compiler/typecheck/Inst.lhs @@ -28,7 +28,6 @@ module Inst ( isDict, isClassDict, isMethod, isLinearInst, linearInstType, isIPDict, isInheritableInst, isTyVarDict, isMethodFor, - instBindingRequired, zonkInst, zonkInsts, instToId, instName, @@ -77,7 +76,6 @@ import HscTypes ( ExternalPackageState(..) ) import CoreFVs ( idFreeTyVars ) import DataCon ( DataCon, dataConTyVars, dataConStupidTheta, dataConName, dataConWrapId ) import Id ( Id, idName, idType, mkUserLocal, mkLocalId ) -import PrelInfo ( isNoDictClass ) import Name ( Name, mkMethodOcc, getOccName, getSrcLoc, nameModule, isInternalName, setNameUnique, mkSystemVarName ) import NameSet ( addOneToNameSet ) @@ -195,16 +193,6 @@ linearInstType :: Inst -> TcType -- %x::t --> t linearInstType (Dict _ (IParam _ ty) _) = ty \end{code} -Two predicates which deal with the case where class constraints don't -necessarily result in bindings. The first tells whether an @Inst@ -must be witnessed by an actual binding; the second tells whether an -@Inst@ can be generalised over. - -\begin{code} -instBindingRequired :: Inst -> Bool -instBindingRequired (Dict _ (ClassP clas _) _) = not (isNoDictClass clas) -instBindingRequired other = True -\end{code} %************************************************************************ diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs index 04fbafb..88dcd8e 100644 --- a/ghc/compiler/typecheck/TcInstDcls.lhs +++ b/ghc/compiler/typecheck/TcInstDcls.lhs @@ -179,10 +179,6 @@ tcLocalInstDecl1 :: LInstDecl Name -- Type-check all the stuff before the "where" -- -- We check for respectable instance type, and context - -- but only do this for non-imported instance decls. - -- Imported ones should have been checked already, and may indeed - -- contain something illegal in normal Haskell, notably - -- instance CCallable [Char] tcLocalInstDecl1 decl@(L loc (InstDecl poly_ty binds uprags)) = -- Prime error recovery, set source location recoverM (returnM Nothing) $ @@ -395,18 +391,6 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = binds }) -- See Note [Inline dfuns] below dict_rhs - | null scs_and_meths - = -- Blatant special case for CCallable, CReturnable - -- If the dictionary is empty then we should never - -- select anything from it, so we make its RHS just - -- emit an error message. This in turn means that we don't - -- mention the constructor, which doesn't exist for CCallable, CReturnable - -- Hardly beautiful, but only three extra lines. - nlHsApp (noLoc $ TyApp (nlHsVar rUNTIME_ERROR_ID) - [idType this_dict_id]) - (nlHsLit (HsStringPrim (mkFastString msg))) - - | otherwise -- The common case = mkHsConApp dict_constr inst_tys' (map HsVar scs_and_meths) -- We don't produce a binding for the dict_constr; instead we -- rely on the simplifier to unfold this saturated application diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs index 0660a68..8ff7474 100644 --- a/ghc/compiler/typecheck/TcSimplify.lhs +++ b/ghc/compiler/typecheck/TcSimplify.lhs @@ -31,7 +31,7 @@ import Inst ( lookupInst, LookupInstResult(..), isMethodFor, isMethod, instToId, tyVarsOfInsts, cloneDict, ipNamesOfInsts, ipNamesOfInst, dictPred, - instBindingRequired, fdPredsOfInst, + fdPredsOfInst, newDictsAtLoc, tcInstClassOp, getDictClassTys, isTyVarDict, instLoc, zonkInst, tidyInsts, tidyMoreInsts, @@ -1350,10 +1350,6 @@ data Avail -- e.g. those "given" in a signature Bool -- True <=> actually consumed (splittable IPs only) - | NoRhs -- Used for Insts like (CCallable f) - -- where no witness is required. - -- ToDo: remove? - | Rhs -- Used when there is a RHS (LHsExpr TcId) -- The RHS [Inst] -- Insts free in the RHS; we need these too @@ -1375,7 +1371,6 @@ pprAvails avails = vcat [sep [ppr inst, nest 2 (equals <+> pprAvail avail)] instance Outputable Avail where ppr = pprAvail -pprAvail NoRhs = text "" pprAvail IsFree = text "Free" pprAvail Irred = text "Irred" pprAvail (Given x b) = text "Given" <+> ppr x <+> @@ -1409,7 +1404,6 @@ extractResults avails wanteds Nothing -> pprTrace "Urk: extractResults" (ppr w) $ go avails binds irreds frees ws - Just NoRhs -> go avails binds irreds frees ws Just IsFree -> go (add_free avails w) binds irreds (w:frees) ws Just Irred -> go (add_given avails w) binds (w:irreds) frees ws @@ -1443,11 +1437,7 @@ extractResults avails wanteds get_root irreds frees IsFree w = cloneDict w `thenM` \ w' -> returnM (irreds, w':frees, instToId w') - add_given avails w - | instBindingRequired w = addToFM avails w (Given (instToId w) True) - | otherwise = addToFM avails w NoRhs - -- NB: make sure that CCallable/CReturnable use NoRhs rather - -- than Given, else we end up with bogus bindings. + add_given avails w = addToFM avails w (Given (instToId w) True) add_free avails w | isMethod w = avails | otherwise = add_given avails w @@ -1828,8 +1818,7 @@ addWanted :: WantSCs -> Avails -> Inst -> LHsExpr TcId -> [Inst] -> TcM Avails addWanted want_scs avails wanted rhs_expr wanteds = addAvailAndSCs want_scs avails wanted avail where - avail | instBindingRequired wanted = Rhs rhs_expr wanteds - | otherwise = ASSERT( null wanteds ) NoRhs + avail = Rhs rhs_expr wanteds addGiven :: Avails -> Inst -> TcM Avails addGiven avails given = addAvailAndSCs AddSCs avails given (Given (instToId given) False) @@ -2197,9 +2186,7 @@ get_default_tys When typechecking _ccall_s, TcExpr ensures that the external function is only passed arguments (and in the other direction, -results) of a restricted set of 'native' types. This is -implemented via the help of the pseudo-type classes, -@CReturnable@ (CR) and @CCallable@ (CC.) +results) of a restricted set of 'native' types. The interaction between the defaulting mechanism for numeric values and CC & CR can be a bit puzzling to the user at times. @@ -2218,10 +2205,6 @@ is not an instance of CR. If the default list is equal to Haskell 1.4's default-default of (Int, Double), 'x' has type Int. -To try to minimise the potential for surprises here, the -defaulting mechanism is turned off in the presence of -CCallable and CReturnable. - End of aside] -- 1.7.10.4