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,
30 rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID, rUNTIME_ERROR_ID,
31 nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID,
35 #include "HsVersions.h"
38 import BasicTypes ( Arity, StrictnessMark(..), isMarkedUnboxed, isMarkedStrict )
39 import TysPrim ( openAlphaTyVars, alphaTyVar, alphaTy, betaTyVar, betaTy,
40 intPrimTy, realWorldStatePrimTy, addrPrimTy
42 import TysWiredIn ( charTy, mkListTy )
43 import PrelRules ( primOpRules )
44 import Rules ( addRule )
45 import TcType ( Type, ThetaType, mkDictTy, mkPredTys, mkTyConApp,
46 mkTyVarTys, mkClassPred, tcEqPred,
47 mkFunTys, mkFunTy, mkSigmaTy, tcSplitSigmaTy,
48 isUnLiftedType, mkForAllTys, mkTyVarTy, tyVarsOfType,
49 tcSplitFunTys, tcSplitForAllTys, mkPredTy
51 import Module ( Module )
52 import CoreUtils ( exprType )
53 import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding, mkOtherCon )
54 import Literal ( Literal(..), nullAddrLit )
55 import TyCon ( TyCon, isNewTyCon, tyConTyVars, tyConDataCons,
56 tyConTheta, isProductTyCon, isDataTyCon, isRecursiveTyCon )
57 import Class ( Class, classTyCon, classTyVars, classSelIds )
58 import Var ( Id, TyVar, Var )
59 import VarSet ( isEmptyVarSet )
60 import Name ( mkWiredInName, mkFCallName, Name )
61 import OccName ( mkVarOcc )
62 import PrimOp ( PrimOp(DataToTagOp), primOpSig, mkPrimOpIdName )
63 import ForeignCall ( ForeignCall )
64 import DataCon ( DataCon,
65 dataConFieldLabels, dataConRepArity, dataConTyCon,
66 dataConArgTys, dataConRepType,
68 dataConName, dataConTheta,
69 dataConSig, dataConStrictMarks, dataConWorkId,
72 import Id ( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal,
73 mkTemplateLocals, mkTemplateLocalsNum,
74 mkTemplateLocal, idNewStrictness, idName
76 import IdInfo ( IdInfo, noCafNoTyGenIdInfo,
78 setArityInfo, setSpecInfo, setCafInfo,
80 GlobalIdDetails(..), CafInfo(..)
82 import NewDemand ( mkStrictSig, strictSigResInfo, DmdResult(..),
83 mkTopDmdType, topDmd, evalDmd, lazyDmd,
84 Demand(..), Demands(..) )
85 import FieldLabel ( mkFieldLabel, fieldLabelName,
86 firstFieldLabelTag, allFieldLabelTags, fieldLabelType
88 import DmdAnal ( dmdAnalTopRhs )
90 import Unique ( mkBuiltinUnique )
93 import Maybe ( isJust )
94 import Util ( dropList, isSingleton )
96 import ListSetOps ( assoc, assocMaybe )
97 import UnicodeUtil ( stringToUtf8 )
102 %************************************************************************
104 \subsection{Wired in Ids}
106 %************************************************************************
110 = [ -- These error-y things are wired in because we don't yet have
111 -- a way to express in an interface file that the result type variable
112 -- is 'open'; that is can be unified with an unboxed type
114 -- [The interface file format now carry such information, but there's
115 -- no way yet of expressing at the definition site for these
116 -- error-reporting functions that they have an 'open'
117 -- result type. -- sof 1/99]
120 iRREFUT_PAT_ERROR_ID,
121 nON_EXHAUSTIVE_GUARDS_ERROR_ID,
122 nO_METHOD_BINDING_ERROR_ID,
127 -- These Ids are exported from GHC.Prim
129 = [ -- These can't be defined in Haskell, but they have
130 -- perfectly reasonable unfoldings in Core
139 %************************************************************************
141 \subsection{Data constructors}
143 %************************************************************************
146 mkDataConId :: Name -> DataCon -> Id
147 -- Makes the *worker* for the data constructor; that is, the function
148 -- that takes the reprsentation arguments and builds the constructor.
149 mkDataConId work_name data_con
150 = mkGlobalId (DataConId data_con) work_name (dataConRepType data_con) info
152 info = noCafNoTyGenIdInfo
154 `setAllStrictnessInfo` Just strict_sig
156 arity = dataConRepArity data_con
158 strict_sig = mkStrictSig (mkTopDmdType (replicate arity topDmd) cpr_info)
159 -- Notice that we do *not* say the worker is strict
160 -- even if the data constructor is declared strict
161 -- e.g. data T = MkT !(Int,Int)
162 -- Why? Because the *wrapper* is strict (and its unfolding has case
163 -- expresssions that do the evals) but the *worker* itself is not.
164 -- If we pretend it is strict then when we see
165 -- case x of y -> $wMkT y
166 -- the simplifier thinks that y is "sure to be evaluated" (because
167 -- $wMkT is strict) and drops the case. No, $wMkT is not strict.
169 -- When the simplifer sees a pattern
170 -- case e of MkT x -> ...
171 -- it uses the dataConRepStrictness of MkT to mark x as evaluated;
172 -- but that's fine... dataConRepStrictness comes from the data con
173 -- not from the worker Id.
175 tycon = dataConTyCon data_con
176 cpr_info | isProductTyCon tycon &&
179 arity <= mAX_CPR_SIZE = RetCPR
181 -- RetCPR is only true for products that are real data types;
182 -- that is, not unboxed tuples or [non-recursive] newtypes
184 mAX_CPR_SIZE :: Arity
186 -- We do not treat very big tuples as CPR-ish:
187 -- a) for a start we get into trouble because there aren't
188 -- "enough" unboxed tuple types (a tiresome restriction,
190 -- b) more importantly, big unboxed tuples get returned mainly
191 -- on the stack, and are often then allocated in the heap
192 -- by the caller. So doing CPR for them may in fact make
196 The wrapper for a constructor is an ordinary top-level binding that evaluates
197 any strict args, unboxes any args that are going to be flattened, and calls
200 We're going to build a constructor that looks like:
202 data (Data a, C b) => T a b = T1 !a !Int b
205 \d1::Data a, d2::C b ->
206 \p q r -> case p of { p ->
208 Con T1 [a,b] [p,q,r]}}
212 * d2 is thrown away --- a context in a data decl is used to make sure
213 one *could* construct dictionaries at the site the constructor
214 is used, but the dictionary isn't actually used.
216 * We have to check that we can construct Data dictionaries for
217 the types a and Int. Once we've done that we can throw d1 away too.
219 * We use (case p of q -> ...) to evaluate p, rather than "seq" because
220 all that matters is that the arguments are evaluated. "seq" is
221 very careful to preserve evaluation order, which we don't need
224 You might think that we could simply give constructors some strictness
225 info, like PrimOps, and let CoreToStg do the let-to-case transformation.
226 But we don't do that because in the case of primops and functions strictness
227 is a *property* not a *requirement*. In the case of constructors we need to
228 do something active to evaluate the argument.
230 Making an explicit case expression allows the simplifier to eliminate
231 it in the (common) case where the constructor arg is already evaluated.
234 mkDataConWrapId data_con
235 = mkGlobalId (DataConWrapId data_con) (dataConName data_con) wrap_ty info
237 work_id = dataConWorkId data_con
239 info = noCafNoTyGenIdInfo
240 `setUnfoldingInfo` wrap_unf
241 -- The NoCaf-ness is set by noCafNoTyGenIdInfo
243 -- It's important to specify the arity, so that partial
244 -- applications are treated as values
245 `setAllStrictnessInfo` Just wrap_sig
247 wrap_sig = mkStrictSig (mkTopDmdType arg_dmds res_info)
248 res_info = strictSigResInfo (idNewStrictness work_id)
249 arg_dmds = map mk_dmd strict_marks
250 mk_dmd str | isMarkedStrict str = evalDmd
251 | otherwise = lazyDmd
252 -- The Cpr info can be important inside INLINE rhss, where the
253 -- wrapper constructor isn't inlined.
254 -- And the argument strictness can be important too; we
255 -- may not inline a contructor when it is partially applied.
257 -- data W = C !Int !Int !Int
258 -- ...(let w = C x in ...(w p q)...)...
259 -- we want to see that w is strict in its two arguments
261 wrap_unf | isNewTyCon tycon
262 = ASSERT( null ex_tyvars && null ex_dict_args && isSingleton orig_arg_tys )
263 -- No existentials on a newtype, but it can have a context
264 -- e.g. newtype Eq a => T a = MkT (...)
265 mkTopUnfolding $ Note InlineMe $
266 mkLams tyvars $ Lam id_arg1 $
267 mkNewTypeBody tycon result_ty (Var id_arg1)
269 | not (any isMarkedStrict strict_marks)
270 = mkCompulsoryUnfolding (Var work_id)
271 -- The common case. Not only is this efficient,
272 -- but it also ensures that the wrapper is replaced
273 -- by the worker even when there are no args.
277 -- This is really important in rule matching,
278 -- (We could match on the wrappers,
279 -- but that makes it less likely that rules will match
280 -- when we bring bits of unfoldings together.)
282 -- NB: because of this special case, (map (:) ys) turns into
283 -- (map $w: ys). The top-level defn for (:) is never used.
284 -- This is somewhat of a bore, but I'm currently leaving it
285 -- as is, so that there still is a top level curried (:) for
286 -- the interpreter to call.
289 = mkTopUnfolding $ Note InlineMe $
291 mkLams ex_dict_args $ mkLams id_args $
292 foldr mk_case con_app
293 (zip (ex_dict_args++id_args) strict_marks) i3 []
295 con_app i rep_ids = mkApps (Var work_id)
296 (map varToCoreExpr (all_tyvars ++ reverse rep_ids))
298 (tyvars, _, ex_tyvars, ex_theta, orig_arg_tys, tycon) = dataConSig data_con
299 all_tyvars = tyvars ++ ex_tyvars
301 ex_dict_tys = mkPredTys ex_theta
302 all_arg_tys = ex_dict_tys ++ orig_arg_tys
303 result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
305 wrap_ty = mkForAllTys all_tyvars (mkFunTys all_arg_tys result_ty)
306 -- We used to include the stupid theta in the wrapper's args
307 -- but now we don't. Instead the type checker just injects these
308 -- extra constraints where necessary.
310 mkLocals i tys = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
314 (ex_dict_args,i2) = mkLocals 1 ex_dict_tys
315 (id_args,i3) = mkLocals i2 orig_arg_tys
317 (id_arg1:_) = id_args -- Used for newtype only
319 strict_marks = dataConStrictMarks data_con
322 :: (Id, StrictnessMark) -- Arg, strictness
323 -> (Int -> [Id] -> CoreExpr) -- Body
324 -> Int -- Next rep arg id
325 -> [Id] -- Rep args so far, reversed
327 mk_case (arg,strict) body i rep_args
329 NotMarkedStrict -> body i (arg:rep_args)
331 | isUnLiftedType (idType arg) -> body i (arg:rep_args)
333 Case (Var arg) arg [(DEFAULT,[], body i (arg:rep_args))]
336 -> case splitProductType "do_unbox" (idType arg) of
337 (tycon, tycon_args, con, tys) ->
338 Case (Var arg) arg [(DataAlt con, con_args,
339 body i' (reverse con_args ++ rep_args))]
341 (con_args, i') = mkLocals i tys
345 %************************************************************************
347 \subsection{Record selectors}
349 %************************************************************************
351 We're going to build a record selector unfolding that looks like this:
353 data T a b c = T1 { ..., op :: a, ...}
354 | T2 { ..., op :: a, ...}
357 sel = /\ a b c -> \ d -> case d of
362 Similarly for newtypes
364 newtype N a = MkN { unN :: a->a }
367 unN n = coerce (a->a) n
369 We need to take a little care if the field has a polymorphic type:
371 data R = R { f :: forall a. a->a }
375 f :: forall a. R -> a -> a
376 f = /\ a \ r = case r of
379 (not f :: R -> forall a. a->a, which gives the type inference mechanism
380 problems at call sites)
382 Similarly for newtypes
384 newtype N = MkN { unN :: forall a. a->a }
386 unN :: forall a. N -> a -> a
387 unN = /\a -> \n:N -> coerce (a->a) n
390 mkRecordSelId tycon field_label
391 -- Assumes that all fields with the same field label have the same type
393 -- Annoyingly, we have to pass in the unpackCString# Id, because
394 -- we can't conjure it up out of thin air
397 sel_id = mkGlobalId (RecordSelId field_label) (fieldLabelName field_label) selector_ty info
398 field_ty = fieldLabelType field_label
399 data_cons = tyConDataCons tycon
400 tyvars = tyConTyVars tycon -- These scope over the types in
401 -- the FieldLabels of constructors of this type
402 data_ty = mkTyConApp tycon tyvar_tys
403 tyvar_tys = mkTyVarTys tyvars
405 -- Very tiresomely, the selectors are (unnecessarily!) overloaded over
406 -- just the dictionaries in the types of the constructors that contain
407 -- the relevant field. [The Report says that pattern matching on a
408 -- constructor gives the same constraints as applying it.] Urgh.
410 -- However, not all data cons have all constraints (because of
411 -- TcTyDecls.thinContext). So we need to find all the data cons
412 -- involved in the pattern match and take the union of their constraints.
414 -- NB: this code relies on the fact that DataCons are quantified over
415 -- the identical type variables as their parent TyCon
416 tycon_theta = tyConTheta tycon -- The context on the data decl
417 -- eg data (Eq a, Ord b) => T a b = ...
418 needed_preds = [pred | (DataAlt dc, _, _) <- the_alts, pred <- dataConTheta dc]
419 dict_tys = map mkPredTy (nubBy tcEqPred needed_preds)
420 n_dict_tys = length dict_tys
422 (field_tyvars,field_theta,field_tau) = tcSplitSigmaTy field_ty
423 field_dict_tys = map mkPredTy field_theta
424 n_field_dict_tys = length field_dict_tys
425 -- If the field has a universally quantified type we have to
426 -- be a bit careful. Suppose we have
427 -- data R = R { op :: forall a. Foo a => a -> a }
428 -- Then we can't give op the type
429 -- op :: R -> forall a. Foo a => a -> a
430 -- because the typechecker doesn't understand foralls to the
431 -- right of an arrow. The "right" type to give it is
432 -- op :: forall a. Foo a => R -> a -> a
433 -- But then we must generate the right unfolding too:
434 -- op = /\a -> \dfoo -> \ r ->
437 -- Note that this is exactly the type we'd infer from a user defn
441 selector_ty = mkForAllTys tyvars $ mkForAllTys field_tyvars $
442 mkFunTys dict_tys $ mkFunTys field_dict_tys $
443 mkFunTy data_ty field_tau
445 arity = 1 + n_dict_tys + n_field_dict_tys
447 (strict_sig, rhs_w_str) = dmdAnalTopRhs sel_rhs
448 -- Use the demand analyser to work out strictness.
449 -- With all this unpackery it's not easy!
451 info = noCafNoTyGenIdInfo
452 `setCafInfo` caf_info
454 `setUnfoldingInfo` mkTopUnfolding rhs_w_str
455 `setAllStrictnessInfo` Just strict_sig
457 -- Allocate Ids. We do it a funny way round because field_dict_tys is
458 -- almost always empty. Also note that we use length_tycon_theta
459 -- rather than n_dict_tys, because the latter gives an infinite loop:
460 -- n_dict tys depends on the_alts, which depens on arg_ids, which depends
461 -- on arity, which depends on n_dict tys. Sigh! Mega sigh!
462 field_dict_base = length tycon_theta + 1
463 dict_id_base = field_dict_base + n_field_dict_tys
464 field_base = dict_id_base + 1
465 dict_ids = mkTemplateLocalsNum 1 dict_tys
466 field_dict_ids = mkTemplateLocalsNum field_dict_base field_dict_tys
467 data_id = mkTemplateLocal dict_id_base data_ty
469 alts = map mk_maybe_alt data_cons
470 the_alts = catMaybes alts
472 no_default = all isJust alts -- No default needed
473 default_alt | no_default = []
474 | otherwise = [(DEFAULT, [], error_expr)]
476 -- the default branch may have CAF refs, because it calls recSelError etc.
477 caf_info | no_default = NoCafRefs
478 | otherwise = MayHaveCafRefs
480 sel_rhs = mkLams tyvars $ mkLams field_tyvars $
481 mkLams dict_ids $ mkLams field_dict_ids $
482 Lam data_id $ sel_body
484 sel_body | isNewTyCon tycon = mkNewTypeBody tycon field_tau (mk_result data_id)
485 | otherwise = Case (Var data_id) data_id (default_alt ++ the_alts)
487 mk_result result_id = mkVarApps (mkVarApps (Var result_id) field_tyvars) field_dict_ids
488 -- We pull the field lambdas to the top, so we need to
489 -- apply them in the body. For example:
490 -- data T = MkT { foo :: forall a. a->a }
492 -- foo :: forall a. T -> a -> a
493 -- foo = /\a. \t:T. case t of { MkT f -> f a }
495 mk_maybe_alt data_con
496 = case maybe_the_arg_id of
498 Just the_arg_id -> Just (mkReboxingAlt uniqs data_con arg_ids body)
500 body = mk_result the_arg_id
502 arg_ids = mkTemplateLocalsNum field_base (dataConOrigArgTys data_con)
503 -- No need to instantiate; same tyvars in datacon as tycon
505 unpack_base = field_base + length arg_ids
506 uniqs = map mkBuiltinUnique [unpack_base..]
508 -- arity+1 avoids all shadowing
509 maybe_the_arg_id = assocMaybe (field_lbls `zip` arg_ids) field_label
510 field_lbls = dataConFieldLabels data_con
512 error_expr = mkRuntimeErrorApp rEC_SEL_ERROR_ID field_tau full_msg
513 full_msg = showSDoc (sep [text "No match in record selector", ppr sel_id])
516 -- (mkReboxingAlt us con xs rhs) basically constructs the case
517 -- alternative (con, xs, rhs)
518 -- but it does the reboxing necessary to construct the *source*
519 -- arguments, xs, from the representation arguments ys.
521 -- data T = MkT !(Int,Int) Bool
523 -- mkReboxingAlt MkT [x,b] r
524 -- = (DataAlt MkT, [y::Int,z::Int,b], let x = (y,z) in r)
526 -- mkDataAlt should really be in DataCon, but it can't because
527 -- it manipulates CoreSyn.
530 :: [Unique] -- Uniques for the new Ids
532 -> [Var] -- Source-level args
536 mkReboxingAlt us con args rhs
537 | not (any isMarkedUnboxed stricts)
538 = (DataAlt con, args, rhs)
542 (binds, args') = go args stricts us
544 (DataAlt con, args', mkLets binds rhs)
547 stricts = dataConStrictMarks con
549 go [] stricts us = ([], [])
551 -- Type variable case
552 go (arg:args) stricts us
554 = let (binds, args') = go args stricts us
555 in (binds, arg:args')
557 -- Term variable case
558 go (arg:args) (str:stricts) us
559 | isMarkedUnboxed str
561 (_, tycon_args, pack_con, con_arg_tys)
562 = splitProductType "mkReboxingAlt" (idType arg)
564 unpacked_args = zipWith (mkSysLocal FSLIT("rb")) us con_arg_tys
565 (binds, args') = go args stricts (dropList con_arg_tys us)
566 con_app = mkConApp pack_con (map Type tycon_args ++ map Var unpacked_args)
568 (NonRec arg con_app : binds, unpacked_args ++ args')
571 = let (binds, args') = go args stricts us
572 in (binds, arg:args')
576 %************************************************************************
578 \subsection{Dictionary selectors}
580 %************************************************************************
582 Selecting a field for a dictionary. If there is just one field, then
583 there's nothing to do.
585 ToDo: unify with mkRecordSelId.
588 mkDictSelId :: Name -> Class -> Id
589 mkDictSelId name clas
590 = mkGlobalId (RecordSelId field_lbl) name sel_ty info
592 sel_ty = mkForAllTys tyvars (mkFunTy (idType dict_id) (idType the_arg_id))
593 -- We can't just say (exprType rhs), because that would give a type
595 -- for a single-op class (after all, the selector is the identity)
596 -- But it's type must expose the representation of the dictionary
597 -- to gat (say) C a -> (a -> a)
599 field_lbl = mkFieldLabel name tycon sel_ty tag
600 tag = assoc "MkId.mkDictSelId" (map idName (classSelIds clas) `zip` allFieldLabelTags) name
602 info = noCafNoTyGenIdInfo
604 `setUnfoldingInfo` mkTopUnfolding rhs
605 `setAllStrictnessInfo` Just strict_sig
607 -- We no longer use 'must-inline' on record selectors. They'll
608 -- inline like crazy if they scrutinise a constructor
610 -- The strictness signature is of the form U(AAAVAAAA) -> T
611 -- where the V depends on which item we are selecting
612 -- It's worth giving one, so that absence info etc is generated
613 -- even if the selector isn't inlined
614 strict_sig = mkStrictSig (mkTopDmdType [arg_dmd] TopRes)
615 arg_dmd | isNewTyCon tycon = evalDmd
616 | otherwise = Eval (Prod [ if the_arg_id == id then evalDmd else Abs
619 tyvars = classTyVars clas
621 tycon = classTyCon clas
622 [data_con] = tyConDataCons tycon
623 tyvar_tys = mkTyVarTys tyvars
624 arg_tys = dataConArgTys data_con tyvar_tys
625 the_arg_id = arg_ids !! (tag - firstFieldLabelTag)
627 pred = mkClassPred clas tyvar_tys
628 (dict_id:arg_ids) = mkTemplateLocals (mkPredTy pred : arg_tys)
630 rhs | isNewTyCon tycon = mkLams tyvars $ Lam dict_id $
631 mkNewTypeBody tycon (head arg_tys) (Var dict_id)
632 | otherwise = mkLams tyvars $ Lam dict_id $
633 Case (Var dict_id) dict_id
634 [(DataAlt data_con, arg_ids, Var the_arg_id)]
636 mkNewTypeBody tycon result_ty result_expr
637 -- Adds a coerce where necessary
638 -- Used for both wrapping and unwrapping
639 | isRecursiveTyCon tycon -- Recursive case; use a coerce
640 = Note (Coerce result_ty (exprType result_expr)) result_expr
641 | otherwise -- Normal case
646 %************************************************************************
648 \subsection{Primitive operations
650 %************************************************************************
653 mkPrimOpId :: PrimOp -> Id
657 (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
658 ty = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
659 name = mkPrimOpIdName prim_op
660 id = mkGlobalId (PrimOpId prim_op) name ty info
662 info = noCafNoTyGenIdInfo
665 `setAllStrictnessInfo` Just strict_sig
667 rules = foldl (addRule id) emptyCoreRules (primOpRules prim_op)
670 -- For each ccall we manufacture a separate CCallOpId, giving it
671 -- a fresh unique, a type that is correct for this particular ccall,
672 -- and a CCall structure that gives the correct details about calling
675 -- The *name* of this Id is a local name whose OccName gives the full
676 -- details of the ccall, type and all. This means that the interface
677 -- file reader can reconstruct a suitable Id
679 mkFCallId :: Unique -> ForeignCall -> Type -> Id
680 mkFCallId uniq fcall ty
681 = ASSERT( isEmptyVarSet (tyVarsOfType ty) )
682 -- A CCallOpId should have no free type variables;
683 -- when doing substitutions won't substitute over it
684 mkGlobalId (FCallId fcall) name ty info
686 occ_str = showSDoc (braces (ppr fcall <+> ppr ty))
687 -- The "occurrence name" of a ccall is the full info about the
688 -- ccall; it is encoded, but may have embedded spaces etc!
690 name = mkFCallName uniq occ_str
692 info = noCafNoTyGenIdInfo
694 `setAllStrictnessInfo` Just strict_sig
696 (_, tau) = tcSplitForAllTys ty
697 (arg_tys, _) = tcSplitFunTys tau
698 arity = length arg_tys
699 strict_sig = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
703 %************************************************************************
705 \subsection{DictFuns and default methods}
707 %************************************************************************
709 Important notes about dict funs and default methods
710 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
711 Dict funs and default methods are *not* ImplicitIds. Their definition
712 involves user-written code, so we can't figure out their strictness etc
713 based on fixed info, as we can for constructors and record selectors (say).
715 We build them as GlobalIds, but when in the module where they are
716 bound, we turn the Id at the *binding site* into an exported LocalId.
717 This ensures that they are taken to account by free-variable finding
718 and dependency analysis (e.g. CoreFVs.exprFreeVars). The simplifier
719 will propagate the LocalId to all occurrence sites.
721 Why shouldn't they be bound as GlobalIds? Because, in particular, if
722 they are globals, the specialiser floats dict uses above their defns,
723 which prevents good simplifications happening. Also the strictness
724 analyser treats a occurrence of a GlobalId as imported and assumes it
725 contains strictness in its IdInfo, which isn't true if the thing is
726 bound in the same module as the occurrence.
728 It's OK for dfuns to be LocalIds, because we form the instance-env to
729 pass on to the next module (md_insts) in CoreTidy, afer tidying
730 and globalising the top-level Ids.
732 BUT make sure they are *exported* LocalIds (setIdLocalExported) so
733 that they aren't discarded by the occurrence analyser.
736 mkDefaultMethodId dm_name ty = mkVanillaGlobal dm_name ty noCafNoTyGenIdInfo
738 mkDictFunId :: Name -- Name to use for the dict fun;
745 mkDictFunId dfun_name clas inst_tyvars inst_tys dfun_theta
746 = mkVanillaGlobal dfun_name dfun_ty noCafNoTyGenIdInfo
748 dfun_ty = mkSigmaTy inst_tyvars dfun_theta (mkDictTy clas inst_tys)
750 {- 1 dec 99: disable the Mark Jones optimisation for the sake
751 of compatibility with Hugs.
752 See `types/InstEnv' for a discussion related to this.
754 (class_tyvars, sc_theta, _, _) = classBigSig clas
755 not_const (clas, tys) = not (isEmptyVarSet (tyVarsOfTypes tys))
756 sc_theta' = substClasses (mkTopTyVarSubst class_tyvars inst_tys) sc_theta
757 dfun_theta = case inst_decl_theta of
758 [] -> [] -- If inst_decl_theta is empty, then we don't
759 -- want to have any dict arguments, so that we can
760 -- expose the constant methods.
762 other -> nub (inst_decl_theta ++ filter not_const sc_theta')
763 -- Otherwise we pass the superclass dictionaries to
764 -- the dictionary function; the Mark Jones optimisation.
766 -- NOTE the "nub". I got caught by this one:
767 -- class Monad m => MonadT t m where ...
768 -- instance Monad m => MonadT (EnvT env) m where ...
769 -- Here, the inst_decl_theta has (Monad m); but so
770 -- does the sc_theta'!
772 -- NOTE the "not_const". I got caught by this one too:
773 -- class Foo a => Baz a b where ...
774 -- instance Wob b => Baz T b where..
775 -- Now sc_theta' has Foo T
780 %************************************************************************
782 \subsection{Un-definable}
784 %************************************************************************
786 These Ids can't be defined in Haskell. They could be defined in
787 unfoldings in the wired-in GHC.Prim interface file, but we'd have to
788 ensure that they were definitely, definitely inlined, because there is
789 no curried identifier for them. That's what mkCompulsoryUnfolding
790 does. If we had a way to get a compulsory unfolding from an interface
791 file, we could do that, but we don't right now.
793 unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
794 just gets expanded into a type coercion wherever it occurs. Hence we
795 add it as a built-in Id with an unfolding here.
797 The type variables we use here are "open" type variables: this means
798 they can unify with both unlifted and lifted types. Hence we provide
799 another gun with which to shoot yourself in the foot.
802 -- unsafeCoerce# :: forall a b. a -> b
804 = pcMiscPrelId unsafeCoerceIdKey gHC_PRIM FSLIT("unsafeCoerce#") ty info
806 info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
809 ty = mkForAllTys [openAlphaTyVar,openBetaTyVar]
810 (mkFunTy openAlphaTy openBetaTy)
811 [x] = mkTemplateLocals [openAlphaTy]
812 rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
813 Note (Coerce openBetaTy openAlphaTy) (Var x)
815 -- nullAddr# :: Addr#
816 -- The reason is is here is because we don't provide
817 -- a way to write this literal in Haskell.
819 = pcMiscPrelId nullAddrIdKey gHC_PRIM FSLIT("nullAddr#") addrPrimTy info
821 info = noCafNoTyGenIdInfo `setUnfoldingInfo`
822 mkCompulsoryUnfolding (Lit nullAddrLit)
825 = pcMiscPrelId seqIdKey gHC_PRIM FSLIT("seq") ty info
827 info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
830 ty = mkForAllTys [alphaTyVar,betaTyVar]
831 (mkFunTy alphaTy (mkFunTy betaTy betaTy))
832 [x,y] = mkTemplateLocals [alphaTy, betaTy]
833 rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x [(DEFAULT, [], Var y)])
836 @getTag#@ is another function which can't be defined in Haskell. It needs to
837 evaluate its argument and call the dataToTag# primitive.
841 = pcMiscPrelId getTagIdKey gHC_PRIM FSLIT("getTag#") ty info
843 info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
844 -- We don't provide a defn for this; you must inline it
846 ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy intPrimTy)
847 [x,y] = mkTemplateLocals [alphaTy,alphaTy]
848 rhs = mkLams [alphaTyVar,x] $
849 Case (Var x) y [ (DEFAULT, [], mkApps (Var dataToTagId) [Type alphaTy, Var y]) ]
851 dataToTagId = mkPrimOpId DataToTagOp
854 @realWorld#@ used to be a magic literal, \tr{void#}. If things get
855 nasty as-is, change it back to a literal (@Literal@).
857 voidArgId is a Local Id used simply as an argument in functions
858 where we just want an arg to avoid having a thunk of unlifted type.
860 x = \ void :: State# RealWorld -> (# p, q #)
862 This comes up in strictness analysis
865 realWorldPrimId -- :: State# RealWorld
866 = pcMiscPrelId realWorldPrimIdKey gHC_PRIM FSLIT("realWorld#")
868 (noCafNoTyGenIdInfo `setUnfoldingInfo` mkOtherCon [])
869 -- The mkOtherCon makes it look that realWorld# is evaluated
870 -- which in turn makes Simplify.interestingArg return True,
871 -- which in turn makes INLINE things applied to realWorld# likely
874 voidArgId -- :: State# RealWorld
875 = mkSysLocal FSLIT("void") voidArgIdKey realWorldStatePrimTy
879 %************************************************************************
881 \subsection[PrelVals-error-related]{@error@ and friends; @trace@}
883 %************************************************************************
885 GHC randomly injects these into the code.
887 @patError@ is just a version of @error@ for pattern-matching
888 failures. It knows various ``codes'' which expand to longer
889 strings---this saves space!
891 @absentErr@ is a thing we put in for ``absent'' arguments. They jolly
892 well shouldn't be yanked on, but if one is, then you will get a
893 friendly message from @absentErr@ (rather than a totally random
896 @parError@ is a special version of @error@ which the compiler does
897 not know to be a bottoming Id. It is used in the @_par_@ and @_seq_@
898 templates, but we don't ever expect to generate code for it.
902 :: Id -- Should be of type (forall a. Addr# -> a)
903 -- where Addr# points to a UTF8 encoded string
904 -> Type -- The type to instantiate 'a'
905 -> String -- The string to print
908 mkRuntimeErrorApp err_id res_ty err_msg
909 = mkApps (Var err_id) [Type res_ty, err_string]
911 err_string = Lit (MachStr (_PK_ (stringToUtf8 err_msg)))
913 rEC_SEL_ERROR_ID = mkRuntimeErrorId recSelErrIdKey FSLIT("recSelError")
914 rUNTIME_ERROR_ID = mkRuntimeErrorId runtimeErrorIdKey FSLIT("runtimeError")
916 iRREFUT_PAT_ERROR_ID = mkRuntimeErrorId irrefutPatErrorIdKey FSLIT("irrefutPatError")
917 rEC_CON_ERROR_ID = mkRuntimeErrorId recConErrorIdKey FSLIT("recConError")
918 nON_EXHAUSTIVE_GUARDS_ERROR_ID = mkRuntimeErrorId nonExhaustiveGuardsErrorIdKey FSLIT("nonExhaustiveGuardsError")
919 pAT_ERROR_ID = mkRuntimeErrorId patErrorIdKey FSLIT("patError")
920 nO_METHOD_BINDING_ERROR_ID = mkRuntimeErrorId noMethodBindingErrorIdKey FSLIT("noMethodBindingError")
922 -- The runtime error Ids take a UTF8-encoded string as argument
923 mkRuntimeErrorId key name = pc_bottoming_Id key pREL_ERR name runtimeErrorTy
924 runtimeErrorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTy addrPrimTy openAlphaTy)
928 %************************************************************************
930 \subsection{Utilities}
932 %************************************************************************
935 pcMiscPrelId :: Unique{-IdKey-} -> Module -> FAST_STRING -> Type -> IdInfo -> Id
936 pcMiscPrelId key mod str ty info
938 name = mkWiredInName mod (mkVarOcc str) key
939 imp = mkVanillaGlobal name ty info -- the usual case...
942 -- We lie and say the thing is imported; otherwise, we get into
943 -- a mess with dependency analysis; e.g., core2stg may heave in
944 -- random calls to GHCbase.unpackPS__. If GHCbase is the module
945 -- being compiled, then it's just a matter of luck if the definition
946 -- will be in "the right place" to be in scope.
948 pc_bottoming_Id key mod name ty
949 = pcMiscPrelId key mod name ty bottoming_info
951 strict_sig = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
952 bottoming_info = noCafNoTyGenIdInfo `setAllStrictnessInfo` Just strict_sig
953 -- these "bottom" out, no matter what their arguments
955 generic_ERROR_ID u n = pc_bottoming_Id u pREL_ERR n errorTy
957 (openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars
958 openAlphaTy = mkTyVarTy openAlphaTyVar
959 openBetaTy = mkTyVarTy openBetaTyVar
962 errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy]
964 -- Notice the openAlphaTyVar. It says that "error" can be applied
965 -- to unboxed as well as boxed types. This is OK because it never
966 -- returns, so the return type is irrelevant.