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,
maybeCharLikeCon, maybeIntLikeCon,
-- Class categories
- isNoDictClass, isNumericClass, isStandardClass
+ isNumericClass, isStandardClass
) where
import PrelNames ( basicKnownKeyNames,
hasKey, charDataConKey, intDataConKey,
- numericClassKeys, standardClassKeys,
- noDictClassKeys )
+ numericClassKeys, standardClassKeys )
import PrimOp ( PrimOp, allThePrimOps, primOpOcc, primOpTag, maxPrimOpTag )
import DataCon ( DataCon )
%************************************************************************
\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}
++ [randomClassKey, randomGenClassKey,
functorClassKey,
monadClassKey, monadPlusClassKey]
-
-noDictClassKeys = [] -- ToDo: remove?
\end{code}
@derivableClassKeys@ is also used in checking \tr{deriving} constructs
isDict, isClassDict, isMethod,
isLinearInst, linearInstType, isIPDict, isInheritableInst,
isTyVarDict, isMethodFor,
- instBindingRequired,
zonkInst, zonkInsts,
instToId, instName,
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 )
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}
%************************************************************************
-- 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) $
-- 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
isMethodFor, isMethod,
instToId, tyVarsOfInsts, cloneDict,
ipNamesOfInsts, ipNamesOfInst, dictPred,
- instBindingRequired, fdPredsOfInst,
+ fdPredsOfInst,
newDictsAtLoc, tcInstClassOp,
getDictClassTys, isTyVarDict, instLoc,
zonkInst, tidyInsts, tidyMoreInsts,
-- 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
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 <+>
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
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
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)
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.
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]
projects / ghc-hetmet.git / commitdiff