2 % (c) The AQUA Project, Glasgow University, 1998
4 \section[StdIdInfo]{Standard unfoldings}
6 This module contains definitions for the IdInfo for things that
7 have a standard form, namely:
11 * method and superclass selectors
12 * primitive operations
16 mkDictFunId, mkDefaultMethodId,
19 mkDataConId, mkDataConWrapId,
21 mkPrimOpId, mkFCallId,
23 mkReboxingAlt, mkNewTypeBody,
25 -- And some particular Ids; see below for why they are wired in
26 wiredInIds, ghcPrimIds,
27 unsafeCoerceId, realWorldPrimId, voidArgId, nullAddrId, seqId,
28 eRROR_ID, eRROR_CSTRING_ID, rEC_SEL_ERROR_ID, pAT_ERROR_ID,
29 rEC_CON_ERROR_ID, rEC_UPD_ERROR_ID, iRREFUT_PAT_ERROR_ID,
30 nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID,
31 aBSENT_ERROR_ID, pAR_ERROR_ID
34 #include "HsVersions.h"
37 import BasicTypes ( Arity, StrictnessMark(..), isMarkedUnboxed, isMarkedStrict )
38 import TysPrim ( openAlphaTyVars, alphaTyVar, alphaTy, betaTyVar, betaTy,
39 intPrimTy, realWorldStatePrimTy, addrPrimTy
41 import TysWiredIn ( charTy, mkListTy )
42 import PrelRules ( primOpRules )
43 import Rules ( addRule )
44 import TcType ( Type, ThetaType, mkDictTy, mkPredTys, mkTyConApp,
45 mkTyVarTys, mkClassPred, tcEqPred,
46 mkFunTys, mkFunTy, mkSigmaTy, tcSplitSigmaTy,
47 isUnLiftedType, mkForAllTys, mkTyVarTy, tyVarsOfType,
48 tcSplitFunTys, tcSplitForAllTys, mkPredTy
50 import Module ( Module )
51 import CoreUtils ( exprType )
52 import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding, mkOtherCon )
53 import Literal ( Literal(..), nullAddrLit )
54 import TyCon ( TyCon, isNewTyCon, tyConTyVars, tyConDataCons,
55 tyConTheta, isProductTyCon, isDataTyCon, isRecursiveTyCon )
56 import Class ( Class, classTyCon, classTyVars, classSelIds )
57 import Var ( Id, TyVar, Var )
58 import VarSet ( isEmptyVarSet )
59 import Name ( mkWiredInName, mkFCallName, Name )
60 import OccName ( mkVarOcc )
61 import PrimOp ( PrimOp(DataToTagOp), primOpSig, mkPrimOpIdName )
62 import ForeignCall ( ForeignCall )
63 import DataCon ( DataCon,
64 dataConFieldLabels, dataConRepArity, dataConTyCon,
65 dataConArgTys, dataConRepType,
67 dataConName, dataConTheta,
68 dataConSig, dataConStrictMarks, dataConWorkId,
71 import Id ( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal,
72 mkTemplateLocals, mkTemplateLocalsNum,
73 mkTemplateLocal, idNewStrictness, idName
75 import IdInfo ( IdInfo, noCafNoTyGenIdInfo,
77 setArityInfo, setSpecInfo, setCafInfo,
79 GlobalIdDetails(..), CafInfo(..)
81 import NewDemand ( mkStrictSig, strictSigResInfo, DmdResult(..),
82 mkTopDmdType, topDmd, evalDmd, lazyDmd,
83 Demand(..), Demands(..) )
84 import FieldLabel ( mkFieldLabel, fieldLabelName,
85 firstFieldLabelTag, allFieldLabelTags, fieldLabelType
87 import DmdAnal ( dmdAnalTopRhs )
89 import Unique ( mkBuiltinUnique )
92 import Maybe ( isJust )
93 import Util ( dropList, isSingleton )
95 import ListSetOps ( assoc, assocMaybe )
96 import UnicodeUtil ( stringToUtf8 )
101 %************************************************************************
103 \subsection{Wired in Ids}
105 %************************************************************************
109 = [ -- These error-y things are wired in because we don't yet have
110 -- a way to express in an interface file that the result type variable
111 -- is 'open'; that is can be unified with an unboxed type
113 -- [The interface file format now carry such information, but there's
114 -- no way yet of expressing at the definition site for these
115 -- error-reporting functions that they have an 'open'
116 -- result type. -- sof 1/99]
121 iRREFUT_PAT_ERROR_ID,
122 nON_EXHAUSTIVE_GUARDS_ERROR_ID,
123 nO_METHOD_BINDING_ERROR_ID,
130 -- These Ids are exported from GHC.Prim
132 = [ -- These can't be defined in Haskell, but they have
133 -- perfectly reasonable unfoldings in Core
142 %************************************************************************
144 \subsection{Data constructors}
146 %************************************************************************
149 mkDataConId :: Name -> DataCon -> Id
150 -- Makes the *worker* for the data constructor; that is, the function
151 -- that takes the reprsentation arguments and builds the constructor.
152 mkDataConId work_name data_con
153 = mkGlobalId (DataConId data_con) work_name (dataConRepType data_con) info
155 info = noCafNoTyGenIdInfo
157 `setAllStrictnessInfo` Just strict_sig
159 arity = dataConRepArity data_con
161 strict_sig = mkStrictSig (mkTopDmdType (replicate arity topDmd) cpr_info)
162 -- Notice that we do *not* say the worker is strict
163 -- even if the data constructor is declared strict
164 -- e.g. data T = MkT !(Int,Int)
165 -- Why? Because the *wrapper* is strict (and its unfolding has case
166 -- expresssions that do the evals) but the *worker* itself is not.
167 -- If we pretend it is strict then when we see
168 -- case x of y -> $wMkT y
169 -- the simplifier thinks that y is "sure to be evaluated" (because
170 -- $wMkT is strict) and drops the case. No, $wMkT is not strict.
172 -- When the simplifer sees a pattern
173 -- case e of MkT x -> ...
174 -- it uses the dataConRepStrictness of MkT to mark x as evaluated;
175 -- but that's fine... dataConRepStrictness comes from the data con
176 -- not from the worker Id.
178 tycon = dataConTyCon data_con
179 cpr_info | isProductTyCon tycon &&
182 arity <= mAX_CPR_SIZE = RetCPR
184 -- RetCPR is only true for products that are real data types;
185 -- that is, not unboxed tuples or [non-recursive] newtypes
187 mAX_CPR_SIZE :: Arity
189 -- We do not treat very big tuples as CPR-ish:
190 -- a) for a start we get into trouble because there aren't
191 -- "enough" unboxed tuple types (a tiresome restriction,
193 -- b) more importantly, big unboxed tuples get returned mainly
194 -- on the stack, and are often then allocated in the heap
195 -- by the caller. So doing CPR for them may in fact make
199 The wrapper for a constructor is an ordinary top-level binding that evaluates
200 any strict args, unboxes any args that are going to be flattened, and calls
203 We're going to build a constructor that looks like:
205 data (Data a, C b) => T a b = T1 !a !Int b
208 \d1::Data a, d2::C b ->
209 \p q r -> case p of { p ->
211 Con T1 [a,b] [p,q,r]}}
215 * d2 is thrown away --- a context in a data decl is used to make sure
216 one *could* construct dictionaries at the site the constructor
217 is used, but the dictionary isn't actually used.
219 * We have to check that we can construct Data dictionaries for
220 the types a and Int. Once we've done that we can throw d1 away too.
222 * We use (case p of q -> ...) to evaluate p, rather than "seq" because
223 all that matters is that the arguments are evaluated. "seq" is
224 very careful to preserve evaluation order, which we don't need
227 You might think that we could simply give constructors some strictness
228 info, like PrimOps, and let CoreToStg do the let-to-case transformation.
229 But we don't do that because in the case of primops and functions strictness
230 is a *property* not a *requirement*. In the case of constructors we need to
231 do something active to evaluate the argument.
233 Making an explicit case expression allows the simplifier to eliminate
234 it in the (common) case where the constructor arg is already evaluated.
237 mkDataConWrapId data_con
238 = mkGlobalId (DataConWrapId data_con) (dataConName data_con) wrap_ty info
240 work_id = dataConWorkId data_con
242 info = noCafNoTyGenIdInfo
243 `setUnfoldingInfo` wrap_unf
244 -- The NoCaf-ness is set by noCafNoTyGenIdInfo
246 -- It's important to specify the arity, so that partial
247 -- applications are treated as values
248 `setAllStrictnessInfo` Just wrap_sig
250 wrap_sig = mkStrictSig (mkTopDmdType arg_dmds res_info)
251 res_info = strictSigResInfo (idNewStrictness work_id)
252 arg_dmds = map mk_dmd strict_marks
253 mk_dmd str | isMarkedStrict str = evalDmd
254 | otherwise = lazyDmd
255 -- The Cpr info can be important inside INLINE rhss, where the
256 -- wrapper constructor isn't inlined.
257 -- And the argument strictness can be important too; we
258 -- may not inline a contructor when it is partially applied.
260 -- data W = C !Int !Int !Int
261 -- ...(let w = C x in ...(w p q)...)...
262 -- we want to see that w is strict in its two arguments
264 wrap_unf | isNewTyCon tycon
265 = ASSERT( null ex_tyvars && null ex_dict_args && isSingleton orig_arg_tys )
266 -- No existentials on a newtype, but it can have a context
267 -- e.g. newtype Eq a => T a = MkT (...)
268 mkTopUnfolding $ Note InlineMe $
269 mkLams tyvars $ Lam id_arg1 $
270 mkNewTypeBody tycon result_ty (Var id_arg1)
272 | not (any isMarkedStrict strict_marks)
273 = mkCompulsoryUnfolding (Var work_id)
274 -- The common case. Not only is this efficient,
275 -- but it also ensures that the wrapper is replaced
276 -- by the worker even when there are no args.
280 -- This is really important in rule matching,
281 -- (We could match on the wrappers,
282 -- but that makes it less likely that rules will match
283 -- when we bring bits of unfoldings together.)
285 -- NB: because of this special case, (map (:) ys) turns into
286 -- (map $w: ys). The top-level defn for (:) is never used.
287 -- This is somewhat of a bore, but I'm currently leaving it
288 -- as is, so that there still is a top level curried (:) for
289 -- the interpreter to call.
292 = mkTopUnfolding $ Note InlineMe $
294 mkLams ex_dict_args $ mkLams id_args $
295 foldr mk_case con_app
296 (zip (ex_dict_args++id_args) strict_marks) i3 []
298 con_app i rep_ids = mkApps (Var work_id)
299 (map varToCoreExpr (all_tyvars ++ reverse rep_ids))
301 (tyvars, _, ex_tyvars, ex_theta, orig_arg_tys, tycon) = dataConSig data_con
302 all_tyvars = ex_tyvars ++ tyvars
304 ex_dict_tys = mkPredTys ex_theta
305 all_arg_tys = ex_dict_tys ++ orig_arg_tys
306 result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
308 wrap_ty = mkForAllTys all_tyvars (mkFunTys all_arg_tys result_ty)
309 -- We used to include the stupid theta in the wrapper's args
310 -- but now we don't. Instead the type checker just injects these
311 -- extra constraints where necessary.
313 mkLocals i tys = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
317 (ex_dict_args,i2) = mkLocals 1 ex_dict_tys
318 (id_args,i3) = mkLocals i2 orig_arg_tys
320 (id_arg1:_) = id_args -- Used for newtype only
322 strict_marks = dataConStrictMarks data_con
325 :: (Id, StrictnessMark) -- Arg, strictness
326 -> (Int -> [Id] -> CoreExpr) -- Body
327 -> Int -- Next rep arg id
328 -> [Id] -- Rep args so far, reversed
330 mk_case (arg,strict) body i rep_args
332 NotMarkedStrict -> body i (arg:rep_args)
334 | isUnLiftedType (idType arg) -> body i (arg:rep_args)
336 Case (Var arg) arg [(DEFAULT,[], body i (arg:rep_args))]
339 -> case splitProductType "do_unbox" (idType arg) of
340 (tycon, tycon_args, con, tys) ->
341 Case (Var arg) arg [(DataAlt con, con_args,
342 body i' (reverse con_args ++ rep_args))]
344 (con_args, i') = mkLocals i tys
348 %************************************************************************
350 \subsection{Record selectors}
352 %************************************************************************
354 We're going to build a record selector unfolding that looks like this:
356 data T a b c = T1 { ..., op :: a, ...}
357 | T2 { ..., op :: a, ...}
360 sel = /\ a b c -> \ d -> case d of
365 Similarly for newtypes
367 newtype N a = MkN { unN :: a->a }
370 unN n = coerce (a->a) n
372 We need to take a little care if the field has a polymorphic type:
374 data R = R { f :: forall a. a->a }
378 f :: forall a. R -> a -> a
379 f = /\ a \ r = case r of
382 (not f :: R -> forall a. a->a, which gives the type inference mechanism
383 problems at call sites)
385 Similarly for newtypes
387 newtype N = MkN { unN :: forall a. a->a }
389 unN :: forall a. N -> a -> a
390 unN = /\a -> \n:N -> coerce (a->a) n
393 mkRecordSelId tycon field_label unpack_id unpackUtf8_id
394 -- Assumes that all fields with the same field label have the same type
396 -- Annoyingly, we have to pass in the unpackCString# Id, because
397 -- we can't conjure it up out of thin air
400 sel_id = mkGlobalId (RecordSelId field_label) (fieldLabelName field_label) selector_ty info
401 field_ty = fieldLabelType field_label
402 data_cons = tyConDataCons tycon
403 tyvars = tyConTyVars tycon -- These scope over the types in
404 -- the FieldLabels of constructors of this type
405 data_ty = mkTyConApp tycon tyvar_tys
406 tyvar_tys = mkTyVarTys tyvars
408 -- Very tiresomely, the selectors are (unnecessarily!) overloaded over
409 -- just the dictionaries in the types of the constructors that contain
410 -- the relevant field. [The Report says that pattern matching on a
411 -- constructor gives the same constraints as applying it.] Urgh.
413 -- However, not all data cons have all constraints (because of
414 -- TcTyDecls.thinContext). So we need to find all the data cons
415 -- involved in the pattern match and take the union of their constraints.
417 -- NB: this code relies on the fact that DataCons are quantified over
418 -- the identical type variables as their parent TyCon
419 tycon_theta = tyConTheta tycon -- The context on the data decl
420 -- eg data (Eq a, Ord b) => T a b = ...
421 needed_preds = [pred | (DataAlt dc, _, _) <- the_alts, pred <- dataConTheta dc]
422 dict_tys = map mkPredTy (nubBy tcEqPred needed_preds)
423 n_dict_tys = length dict_tys
425 (field_tyvars,field_theta,field_tau) = tcSplitSigmaTy field_ty
426 field_dict_tys = map mkPredTy field_theta
427 n_field_dict_tys = length field_dict_tys
428 -- If the field has a universally quantified type we have to
429 -- be a bit careful. Suppose we have
430 -- data R = R { op :: forall a. Foo a => a -> a }
431 -- Then we can't give op the type
432 -- op :: R -> forall a. Foo a => a -> a
433 -- because the typechecker doesn't understand foralls to the
434 -- right of an arrow. The "right" type to give it is
435 -- op :: forall a. Foo a => R -> a -> a
436 -- But then we must generate the right unfolding too:
437 -- op = /\a -> \dfoo -> \ r ->
440 -- Note that this is exactly the type we'd infer from a user defn
444 selector_ty = mkForAllTys tyvars $ mkForAllTys field_tyvars $
445 mkFunTys dict_tys $ mkFunTys field_dict_tys $
446 mkFunTy data_ty field_tau
448 arity = 1 + n_dict_tys + n_field_dict_tys
450 (strict_sig, rhs_w_str) = dmdAnalTopRhs sel_rhs
451 -- Use the demand analyser to work out strictness.
452 -- With all this unpackery it's not easy!
454 info = noCafNoTyGenIdInfo
455 `setCafInfo` caf_info
457 `setUnfoldingInfo` mkTopUnfolding rhs_w_str
458 `setAllStrictnessInfo` Just strict_sig
460 -- Allocate Ids. We do it a funny way round because field_dict_tys is
461 -- almost always empty. Also note that we use length_tycon_theta
462 -- rather than n_dict_tys, because the latter gives an infinite loop:
463 -- n_dict tys depends on the_alts, which depens on arg_ids, which depends
464 -- on arity, which depends on n_dict tys. Sigh! Mega sigh!
465 field_dict_base = length tycon_theta + 1
466 dict_id_base = field_dict_base + n_field_dict_tys
467 field_base = dict_id_base + 1
468 dict_ids = mkTemplateLocalsNum 1 dict_tys
469 field_dict_ids = mkTemplateLocalsNum field_dict_base field_dict_tys
470 data_id = mkTemplateLocal dict_id_base data_ty
472 alts = map mk_maybe_alt data_cons
473 the_alts = catMaybes alts
475 no_default = all isJust alts -- No default needed
476 default_alt | no_default = []
477 | otherwise = [(DEFAULT, [], error_expr)]
479 -- the default branch may have CAF refs, because it calls recSelError etc.
480 caf_info | no_default = NoCafRefs
481 | otherwise = MayHaveCafRefs
483 sel_rhs = mkLams tyvars $ mkLams field_tyvars $
484 mkLams dict_ids $ mkLams field_dict_ids $
485 Lam data_id $ sel_body
487 sel_body | isNewTyCon tycon = mkNewTypeBody tycon field_tau (mk_result data_id)
488 | otherwise = Case (Var data_id) data_id (default_alt ++ the_alts)
490 mk_result result_id = mkVarApps (mkVarApps (Var result_id) field_tyvars) field_dict_ids
491 -- We pull the field lambdas to the top, so we need to
492 -- apply them in the body. For example:
493 -- data T = MkT { foo :: forall a. a->a }
495 -- foo :: forall a. T -> a -> a
496 -- foo = /\a. \t:T. case t of { MkT f -> f a }
498 mk_maybe_alt data_con
499 = case maybe_the_arg_id of
501 Just the_arg_id -> Just (mkReboxingAlt uniqs data_con arg_ids body)
503 body = mk_result the_arg_id
505 arg_ids = mkTemplateLocalsNum field_base (dataConOrigArgTys data_con)
506 -- No need to instantiate; same tyvars in datacon as tycon
508 unpack_base = field_base + length arg_ids
509 uniqs = map mkBuiltinUnique [unpack_base..]
511 -- arity+1 avoids all shadowing
512 maybe_the_arg_id = assocMaybe (field_lbls `zip` arg_ids) field_label
513 field_lbls = dataConFieldLabels data_con
515 error_expr = mkApps (Var rEC_SEL_ERROR_ID) [Type field_tau, err_string]
517 | all safeChar full_msg
518 = App (Var unpack_id) (Lit (MachStr (_PK_ full_msg)))
520 = App (Var unpackUtf8_id) (Lit (MachStr (_PK_ (stringToUtf8 (map ord full_msg)))))
522 safeChar c = c >= '\1' && c <= '\xFF'
523 -- TODO: Putting this Unicode stuff here is ugly. Find a better
524 -- generic place to make string literals. This logic is repeated
526 full_msg = showSDoc (sep [text "No match in record selector", ppr sel_id])
529 -- (mkReboxingAlt us con xs rhs) basically constructs the case
530 -- alternative (con, xs, rhs)
531 -- but it does the reboxing necessary to construct the *source*
532 -- arguments, xs, from the representation arguments ys.
534 -- data T = MkT !(Int,Int) Bool
536 -- mkReboxingAlt MkT [x,b] r
537 -- = (DataAlt MkT, [y::Int,z::Int,b], let x = (y,z) in r)
539 -- mkDataAlt should really be in DataCon, but it can't because
540 -- it manipulates CoreSyn.
543 :: [Unique] -- Uniques for the new Ids
545 -> [Var] -- Source-level args
549 mkReboxingAlt us con args rhs
550 | not (any isMarkedUnboxed stricts)
551 = (DataAlt con, args, rhs)
555 (binds, args') = go args stricts us
557 (DataAlt con, args', mkLets binds rhs)
560 stricts = dataConStrictMarks con
562 go [] stricts us = ([], [])
564 -- Type variable case
565 go (arg:args) stricts us
567 = let (binds, args') = go args stricts us
568 in (binds, arg:args')
570 -- Term variable case
571 go (arg:args) (str:stricts) us
572 | isMarkedUnboxed str
574 (_, tycon_args, pack_con, con_arg_tys)
575 = splitProductType "mkReboxingAlt" (idType arg)
577 unpacked_args = zipWith (mkSysLocal FSLIT("rb")) us con_arg_tys
578 (binds, args') = go args stricts (dropList con_arg_tys us)
579 con_app = mkConApp pack_con (map Type tycon_args ++ map Var unpacked_args)
581 (NonRec arg con_app : binds, unpacked_args ++ args')
584 = let (binds, args') = go args stricts us
585 in (binds, arg:args')
589 %************************************************************************
591 \subsection{Dictionary selectors}
593 %************************************************************************
595 Selecting a field for a dictionary. If there is just one field, then
596 there's nothing to do.
598 ToDo: unify with mkRecordSelId.
601 mkDictSelId :: Name -> Class -> Id
602 mkDictSelId name clas
603 = mkGlobalId (RecordSelId field_lbl) name sel_ty info
605 sel_ty = mkForAllTys tyvars (mkFunTy (idType dict_id) (idType the_arg_id))
606 -- We can't just say (exprType rhs), because that would give a type
608 -- for a single-op class (after all, the selector is the identity)
609 -- But it's type must expose the representation of the dictionary
610 -- to gat (say) C a -> (a -> a)
612 field_lbl = mkFieldLabel name tycon sel_ty tag
613 tag = assoc "MkId.mkDictSelId" (map idName (classSelIds clas) `zip` allFieldLabelTags) name
615 info = noCafNoTyGenIdInfo
617 `setUnfoldingInfo` mkTopUnfolding rhs
618 `setAllStrictnessInfo` Just strict_sig
620 -- We no longer use 'must-inline' on record selectors. They'll
621 -- inline like crazy if they scrutinise a constructor
623 -- The strictness signature is of the form U(AAAVAAAA) -> T
624 -- where the V depends on which item we are selecting
625 -- It's worth giving one, so that absence info etc is generated
626 -- even if the selector isn't inlined
627 strict_sig = mkStrictSig (mkTopDmdType [arg_dmd] TopRes)
628 arg_dmd | isNewTyCon tycon = evalDmd
629 | otherwise = Eval (Prod [ if the_arg_id == id then evalDmd else Abs
632 tyvars = classTyVars clas
634 tycon = classTyCon clas
635 [data_con] = tyConDataCons tycon
636 tyvar_tys = mkTyVarTys tyvars
637 arg_tys = dataConArgTys data_con tyvar_tys
638 the_arg_id = arg_ids !! (tag - firstFieldLabelTag)
640 pred = mkClassPred clas tyvar_tys
641 (dict_id:arg_ids) = mkTemplateLocals (mkPredTy pred : arg_tys)
643 rhs | isNewTyCon tycon = mkLams tyvars $ Lam dict_id $
644 mkNewTypeBody tycon (head arg_tys) (Var dict_id)
645 | otherwise = mkLams tyvars $ Lam dict_id $
646 Case (Var dict_id) dict_id
647 [(DataAlt data_con, arg_ids, Var the_arg_id)]
649 mkNewTypeBody tycon result_ty result_expr
650 -- Adds a coerce where necessary
651 -- Used for both wrapping and unwrapping
652 | isRecursiveTyCon tycon -- Recursive case; use a coerce
653 = Note (Coerce result_ty (exprType result_expr)) result_expr
654 | otherwise -- Normal case
659 %************************************************************************
661 \subsection{Primitive operations
663 %************************************************************************
666 mkPrimOpId :: PrimOp -> Id
670 (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
671 ty = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
672 name = mkPrimOpIdName prim_op
673 id = mkGlobalId (PrimOpId prim_op) name ty info
675 info = noCafNoTyGenIdInfo
678 `setAllStrictnessInfo` Just strict_sig
680 rules = foldl (addRule id) emptyCoreRules (primOpRules prim_op)
683 -- For each ccall we manufacture a separate CCallOpId, giving it
684 -- a fresh unique, a type that is correct for this particular ccall,
685 -- and a CCall structure that gives the correct details about calling
688 -- The *name* of this Id is a local name whose OccName gives the full
689 -- details of the ccall, type and all. This means that the interface
690 -- file reader can reconstruct a suitable Id
692 mkFCallId :: Unique -> ForeignCall -> Type -> Id
693 mkFCallId uniq fcall ty
694 = ASSERT( isEmptyVarSet (tyVarsOfType ty) )
695 -- A CCallOpId should have no free type variables;
696 -- when doing substitutions won't substitute over it
697 mkGlobalId (FCallId fcall) name ty info
699 occ_str = showSDoc (braces (ppr fcall <+> ppr ty))
700 -- The "occurrence name" of a ccall is the full info about the
701 -- ccall; it is encoded, but may have embedded spaces etc!
703 name = mkFCallName uniq occ_str
705 info = noCafNoTyGenIdInfo
707 `setAllStrictnessInfo` Just strict_sig
709 (_, tau) = tcSplitForAllTys ty
710 (arg_tys, _) = tcSplitFunTys tau
711 arity = length arg_tys
712 strict_sig = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
716 %************************************************************************
718 \subsection{DictFuns and default methods}
720 %************************************************************************
722 Important notes about dict funs and default methods
723 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
724 Dict funs and default methods are *not* ImplicitIds. Their definition
725 involves user-written code, so we can't figure out their strictness etc
726 based on fixed info, as we can for constructors and record selectors (say).
728 We build them as GlobalIds, but when in the module where they are
729 bound, we turn the Id at the *binding site* into an exported LocalId.
730 This ensures that they are taken to account by free-variable finding
731 and dependency analysis (e.g. CoreFVs.exprFreeVars). The simplifier
732 will propagate the LocalId to all occurrence sites.
734 Why shouldn't they be bound as GlobalIds? Because, in particular, if
735 they are globals, the specialiser floats dict uses above their defns,
736 which prevents good simplifications happening. Also the strictness
737 analyser treats a occurrence of a GlobalId as imported and assumes it
738 contains strictness in its IdInfo, which isn't true if the thing is
739 bound in the same module as the occurrence.
741 It's OK for dfuns to be LocalIds, because we form the instance-env to
742 pass on to the next module (md_insts) in CoreTidy, afer tidying
743 and globalising the top-level Ids.
745 BUT make sure they are *exported* LocalIds (setIdLocalExported) so
746 that they aren't discarded by the occurrence analyser.
749 mkDefaultMethodId dm_name ty = mkVanillaGlobal dm_name ty noCafNoTyGenIdInfo
751 mkDictFunId :: Name -- Name to use for the dict fun;
758 mkDictFunId dfun_name clas inst_tyvars inst_tys dfun_theta
759 = mkVanillaGlobal dfun_name dfun_ty noCafNoTyGenIdInfo
761 dfun_ty = mkSigmaTy inst_tyvars dfun_theta (mkDictTy clas inst_tys)
763 {- 1 dec 99: disable the Mark Jones optimisation for the sake
764 of compatibility with Hugs.
765 See `types/InstEnv' for a discussion related to this.
767 (class_tyvars, sc_theta, _, _) = classBigSig clas
768 not_const (clas, tys) = not (isEmptyVarSet (tyVarsOfTypes tys))
769 sc_theta' = substClasses (mkTopTyVarSubst class_tyvars inst_tys) sc_theta
770 dfun_theta = case inst_decl_theta of
771 [] -> [] -- If inst_decl_theta is empty, then we don't
772 -- want to have any dict arguments, so that we can
773 -- expose the constant methods.
775 other -> nub (inst_decl_theta ++ filter not_const sc_theta')
776 -- Otherwise we pass the superclass dictionaries to
777 -- the dictionary function; the Mark Jones optimisation.
779 -- NOTE the "nub". I got caught by this one:
780 -- class Monad m => MonadT t m where ...
781 -- instance Monad m => MonadT (EnvT env) m where ...
782 -- Here, the inst_decl_theta has (Monad m); but so
783 -- does the sc_theta'!
785 -- NOTE the "not_const". I got caught by this one too:
786 -- class Foo a => Baz a b where ...
787 -- instance Wob b => Baz T b where..
788 -- Now sc_theta' has Foo T
793 %************************************************************************
795 \subsection{Un-definable}
797 %************************************************************************
799 These Ids can't be defined in Haskell. They could be defined in
800 unfoldings in the wired-in GHC.Prim interface file, but we'd have to
801 ensure that they were definitely, definitely inlined, because there is
802 no curried identifier for them. That's what mkCompulsoryUnfolding
803 does. If we had a way to get a compulsory unfolding from an interface
804 file, we could do that, but we don't right now.
806 unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
807 just gets expanded into a type coercion wherever it occurs. Hence we
808 add it as a built-in Id with an unfolding here.
810 The type variables we use here are "open" type variables: this means
811 they can unify with both unlifted and lifted types. Hence we provide
812 another gun with which to shoot yourself in the foot.
815 -- unsafeCoerce# :: forall a b. a -> b
817 = pcMiscPrelId unsafeCoerceIdKey gHC_PRIM FSLIT("unsafeCoerce#") ty info
819 info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
822 ty = mkForAllTys [openAlphaTyVar,openBetaTyVar]
823 (mkFunTy openAlphaTy openBetaTy)
824 [x] = mkTemplateLocals [openAlphaTy]
825 rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
826 Note (Coerce openBetaTy openAlphaTy) (Var x)
828 -- nullAddr# :: Addr#
829 -- The reason is is here is because we don't provide
830 -- a way to write this literal in Haskell.
832 = pcMiscPrelId nullAddrIdKey gHC_PRIM FSLIT("nullAddr#") addrPrimTy info
834 info = noCafNoTyGenIdInfo `setUnfoldingInfo`
835 mkCompulsoryUnfolding (Lit nullAddrLit)
838 = pcMiscPrelId seqIdKey gHC_PRIM FSLIT("seq") ty info
840 info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
843 ty = mkForAllTys [alphaTyVar,betaTyVar]
844 (mkFunTy alphaTy (mkFunTy betaTy betaTy))
845 [x,y] = mkTemplateLocals [alphaTy, betaTy]
846 rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x [(DEFAULT, [], Var y)])
849 @getTag#@ is another function which can't be defined in Haskell. It needs to
850 evaluate its argument and call the dataToTag# primitive.
854 = pcMiscPrelId getTagIdKey gHC_PRIM FSLIT("getTag#") ty info
856 info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
857 -- We don't provide a defn for this; you must inline it
859 ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy intPrimTy)
860 [x,y] = mkTemplateLocals [alphaTy,alphaTy]
861 rhs = mkLams [alphaTyVar,x] $
862 Case (Var x) y [ (DEFAULT, [], mkApps (Var dataToTagId) [Type alphaTy, Var y]) ]
864 dataToTagId = mkPrimOpId DataToTagOp
867 @realWorld#@ used to be a magic literal, \tr{void#}. If things get
868 nasty as-is, change it back to a literal (@Literal@).
870 voidArgId is a Local Id used simply as an argument in functions
871 where we just want an arg to avoid having a thunk of unlifted type.
873 x = \ void :: State# RealWorld -> (# p, q #)
875 This comes up in strictness analysis
878 realWorldPrimId -- :: State# RealWorld
879 = pcMiscPrelId realWorldPrimIdKey gHC_PRIM FSLIT("realWorld#")
881 (noCafNoTyGenIdInfo `setUnfoldingInfo` mkOtherCon [])
882 -- The mkOtherCon makes it look that realWorld# is evaluated
883 -- which in turn makes Simplify.interestingArg return True,
884 -- which in turn makes INLINE things applied to realWorld# likely
887 voidArgId -- :: State# RealWorld
888 = mkSysLocal FSLIT("void") voidArgIdKey realWorldStatePrimTy
892 %************************************************************************
894 \subsection[PrelVals-error-related]{@error@ and friends; @trace@}
896 %************************************************************************
898 GHC randomly injects these into the code.
900 @patError@ is just a version of @error@ for pattern-matching
901 failures. It knows various ``codes'' which expand to longer
902 strings---this saves space!
904 @absentErr@ is a thing we put in for ``absent'' arguments. They jolly
905 well shouldn't be yanked on, but if one is, then you will get a
906 friendly message from @absentErr@ (rather than a totally random
909 @parError@ is a special version of @error@ which the compiler does
910 not know to be a bottoming Id. It is used in the @_par_@ and @_seq_@
911 templates, but we don't ever expect to generate code for it.
915 = pc_bottoming_Id errorIdKey pREL_ERR FSLIT("error") errorTy
917 = pc_bottoming_Id errorCStringIdKey pREL_ERR FSLIT("errorCString")
918 (mkSigmaTy [openAlphaTyVar] [] (mkFunTy addrPrimTy openAlphaTy))
920 = generic_ERROR_ID patErrorIdKey FSLIT("patError")
922 = generic_ERROR_ID recSelErrIdKey FSLIT("recSelError")
924 = generic_ERROR_ID recConErrorIdKey FSLIT("recConError")
926 = generic_ERROR_ID recUpdErrorIdKey FSLIT("recUpdError")
928 = generic_ERROR_ID irrefutPatErrorIdKey FSLIT("irrefutPatError")
929 nON_EXHAUSTIVE_GUARDS_ERROR_ID
930 = generic_ERROR_ID nonExhaustiveGuardsErrorIdKey FSLIT("nonExhaustiveGuardsError")
931 nO_METHOD_BINDING_ERROR_ID
932 = generic_ERROR_ID noMethodBindingErrorIdKey FSLIT("noMethodBindingError")
935 = pc_bottoming_Id absentErrorIdKey pREL_ERR FSLIT("absentErr")
936 (mkSigmaTy [openAlphaTyVar] [] openAlphaTy)
939 = pcMiscPrelId parErrorIdKey pREL_ERR FSLIT("parError")
940 (mkSigmaTy [openAlphaTyVar] [] openAlphaTy) noCafNoTyGenIdInfo
944 %************************************************************************
946 \subsection{Utilities}
948 %************************************************************************
951 pcMiscPrelId :: Unique{-IdKey-} -> Module -> FAST_STRING -> Type -> IdInfo -> Id
952 pcMiscPrelId key mod str ty info
954 name = mkWiredInName mod (mkVarOcc str) key
955 imp = mkVanillaGlobal name ty info -- the usual case...
958 -- We lie and say the thing is imported; otherwise, we get into
959 -- a mess with dependency analysis; e.g., core2stg may heave in
960 -- random calls to GHCbase.unpackPS__. If GHCbase is the module
961 -- being compiled, then it's just a matter of luck if the definition
962 -- will be in "the right place" to be in scope.
964 pc_bottoming_Id key mod name ty
965 = pcMiscPrelId key mod name ty bottoming_info
967 strict_sig = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
968 bottoming_info = noCafNoTyGenIdInfo `setAllStrictnessInfo` Just strict_sig
969 -- these "bottom" out, no matter what their arguments
971 generic_ERROR_ID u n = pc_bottoming_Id u pREL_ERR n errorTy
973 (openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars
974 openAlphaTy = mkTyVarTy openAlphaTyVar
975 openBetaTy = mkTyVarTy openBetaTyVar
978 errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy]
980 -- Notice the openAlphaTyVar. It says that "error" can be applied
981 -- to unboxed as well as boxed types. This is OK because it never
982 -- returns, so the return type is irrelevant.