Commit e31827c6 authored by simonpj's avatar simonpj

[project @ 2006-01-18 12:15:37 by simonpj]

Expunge all mention of CCallable/CReturnable
parent edf6bdfb
......@@ -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,
......
......@@ -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}
......@@ -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
......
......@@ -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}
%************************************************************************
......
......@@ -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
......
......@@ -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 "<no rhs>"
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]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment