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 mkDataConWorkId, 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 lazyId, lazyIdUnfolding, lazyIdKey,
31 rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID, rUNTIME_ERROR_ID,
32 nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID,
36 #include "HsVersions.h"
39 import BasicTypes ( Arity, StrictnessMark(..), isMarkedUnboxed, isMarkedStrict )
40 import TysPrim ( openAlphaTyVars, alphaTyVar, alphaTy,
41 realWorldStatePrimTy, addrPrimTy
43 import TysWiredIn ( charTy, mkListTy )
44 import PrelRules ( primOpRules )
45 import Rules ( addRule )
46 import TcType ( Type, ThetaType, mkDictTy, mkPredTys, mkTyConApp,
47 mkTyVarTys, mkClassPred, tcEqPred,
48 mkFunTys, mkFunTy, mkSigmaTy, tcSplitSigmaTy,
49 isUnLiftedType, mkForAllTys, mkTyVarTy, tyVarsOfType,
50 tcSplitFunTys, tcSplitForAllTys, mkPredTy
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 ( mkFCallName, Name )
61 import PrimOp ( PrimOp, primOpSig, mkPrimOpIdName )
62 import ForeignCall ( ForeignCall )
63 import DataCon ( DataCon,
64 dataConFieldLabels, dataConRepArity, dataConTyCon,
65 dataConArgTys, dataConRepType,
68 dataConSig, dataConStrictMarks, dataConWorkId,
71 import Id ( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal, mkLocalId,
72 mkTemplateLocals, mkTemplateLocalsNum, setIdLocalExported,
73 mkTemplateLocal, idNewStrictness, idName
75 import IdInfo ( IdInfo, noCafIdInfo, setUnfoldingInfo,
76 setArityInfo, setSpecInfo, setCafInfo,
77 setAllStrictnessInfo, vanillaIdInfo,
78 GlobalIdDetails(..), CafInfo(..)
80 import NewDemand ( mkStrictSig, strictSigResInfo, DmdResult(..),
81 mkTopDmdType, topDmd, evalDmd, lazyDmd, retCPR,
82 Demand(..), Demands(..) )
83 import FieldLabel ( mkFieldLabel, fieldLabelName,
84 firstFieldLabelTag, allFieldLabelTags, fieldLabelType
86 import DmdAnal ( dmdAnalTopRhs )
88 import Unique ( mkBuiltinUnique )
91 import Maybe ( isJust )
92 import Util ( dropList, isSingleton )
95 import ListSetOps ( assoc, assocMaybe )
96 import UnicodeUtil ( stringToUtf8 )
100 %************************************************************************
102 \subsection{Wired in Ids}
104 %************************************************************************
108 = [ -- These error-y things are wired in because we don't yet have
109 -- a way to express in an interface file that the result type variable
110 -- is 'open'; that is can be unified with an unboxed type
112 -- [The interface file format now carry such information, but there's
113 -- no way yet of expressing at the definition site for these
114 -- error-reporting functions that they have an 'open'
115 -- result type. -- sof 1/99]
117 eRROR_ID, -- This one isn't used anywhere else in the compiler
118 -- But we still need it in wiredInIds so that when GHC
119 -- compiles a program that mentions 'error' we don't
120 -- import its type from the interface file; we just get
121 -- the Id defined here. Which has an 'open-tyvar' type.
124 iRREFUT_PAT_ERROR_ID,
125 nON_EXHAUSTIVE_GUARDS_ERROR_ID,
126 nO_METHOD_BINDING_ERROR_ID,
133 -- These Ids are exported from GHC.Prim
135 = [ -- These can't be defined in Haskell, but they have
136 -- perfectly reasonable unfoldings in Core
144 %************************************************************************
146 \subsection{Data constructors}
148 %************************************************************************
151 mkDataConWorkId :: Name -> DataCon -> Id
152 -- Makes the *worker* for the data constructor; that is, the function
153 -- that takes the reprsentation arguments and builds the constructor.
154 mkDataConWorkId wkr_name data_con
155 = mkGlobalId (DataConWorkId data_con) wkr_name
156 (dataConRepType data_con) info
160 `setAllStrictnessInfo` Just strict_sig
162 arity = dataConRepArity data_con
163 strict_sig = mkStrictSig (mkTopDmdType (replicate arity topDmd) cpr_info)
164 -- Notice that we do *not* say the worker is strict
165 -- even if the data constructor is declared strict
166 -- e.g. data T = MkT !(Int,Int)
167 -- Why? Because the *wrapper* is strict (and its unfolding has case
168 -- expresssions that do the evals) but the *worker* itself is not.
169 -- If we pretend it is strict then when we see
170 -- case x of y -> $wMkT y
171 -- the simplifier thinks that y is "sure to be evaluated" (because
172 -- $wMkT is strict) and drops the case. No, $wMkT is not strict.
174 -- When the simplifer sees a pattern
175 -- case e of MkT x -> ...
176 -- it uses the dataConRepStrictness of MkT to mark x as evaluated;
177 -- but that's fine... dataConRepStrictness comes from the data con
178 -- not from the worker Id.
180 tycon = dataConTyCon data_con
181 cpr_info | isProductTyCon tycon &&
184 arity <= mAX_CPR_SIZE = retCPR
186 -- RetCPR is only true for products that are real data types;
187 -- that is, not unboxed tuples or [non-recursive] newtypes
189 mAX_CPR_SIZE :: Arity
191 -- We do not treat very big tuples as CPR-ish:
192 -- a) for a start we get into trouble because there aren't
193 -- "enough" unboxed tuple types (a tiresome restriction,
195 -- b) more importantly, big unboxed tuples get returned mainly
196 -- on the stack, and are often then allocated in the heap
197 -- by the caller. So doing CPR for them may in fact make
201 The wrapper for a constructor is an ordinary top-level binding that evaluates
202 any strict args, unboxes any args that are going to be flattened, and calls
205 We're going to build a constructor that looks like:
207 data (Data a, C b) => T a b = T1 !a !Int b
210 \d1::Data a, d2::C b ->
211 \p q r -> case p of { p ->
213 Con T1 [a,b] [p,q,r]}}
217 * d2 is thrown away --- a context in a data decl is used to make sure
218 one *could* construct dictionaries at the site the constructor
219 is used, but the dictionary isn't actually used.
221 * We have to check that we can construct Data dictionaries for
222 the types a and Int. Once we've done that we can throw d1 away too.
224 * We use (case p of q -> ...) to evaluate p, rather than "seq" because
225 all that matters is that the arguments are evaluated. "seq" is
226 very careful to preserve evaluation order, which we don't need
229 You might think that we could simply give constructors some strictness
230 info, like PrimOps, and let CoreToStg do the let-to-case transformation.
231 But we don't do that because in the case of primops and functions strictness
232 is a *property* not a *requirement*. In the case of constructors we need to
233 do something active to evaluate the argument.
235 Making an explicit case expression allows the simplifier to eliminate
236 it in the (common) case where the constructor arg is already evaluated.
239 mkDataConWrapId :: Name -> DataCon -> Maybe Id
240 -- Only make a wrapper Id if necessary
242 mkDataConWrapId wrap_name data_con
243 | is_newtype || any isMarkedStrict strict_marks
244 = -- We need a wrapper function
245 Just (mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty info)
248 = Nothing -- The common case, where there is no point in
249 -- having a wrapper function. Not only is this efficient,
250 -- but it also ensures that the wrapper is replaced
251 -- by the worker (becuase it *is* the wroker)
252 -- even when there are no args. E.g. in
254 -- the (:) *is* the worker.
255 -- This is really important in rule matching,
256 -- (We could match on the wrappers,
257 -- but that makes it less likely that rules will match
258 -- when we bring bits of unfoldings together.)
260 (tyvars, _, ex_tyvars, ex_theta, orig_arg_tys, tycon) = dataConSig data_con
261 is_newtype = isNewTyCon tycon
262 all_tyvars = tyvars ++ ex_tyvars
263 work_id = dataConWorkId data_con
265 common_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo
267 -- It's important to specify the arity, so that partial
268 -- applications are treated as values
270 info | is_newtype = common_info `setUnfoldingInfo` newtype_unf
271 | otherwise = common_info `setUnfoldingInfo` data_unf
272 `setAllStrictnessInfo` Just wrap_sig
274 wrap_sig = mkStrictSig (mkTopDmdType arg_dmds res_info)
275 res_info = strictSigResInfo (idNewStrictness work_id)
276 arg_dmds = map mk_dmd strict_marks
277 mk_dmd str | isMarkedStrict str = evalDmd
278 | otherwise = lazyDmd
279 -- The Cpr info can be important inside INLINE rhss, where the
280 -- wrapper constructor isn't inlined.
281 -- And the argument strictness can be important too; we
282 -- may not inline a contructor when it is partially applied.
284 -- data W = C !Int !Int !Int
285 -- ...(let w = C x in ...(w p q)...)...
286 -- we want to see that w is strict in its two arguments
288 newtype_unf = ASSERT( null ex_tyvars && null ex_dict_args &&
289 isSingleton orig_arg_tys )
290 -- No existentials on a newtype, but it can have a context
291 -- e.g. newtype Eq a => T a = MkT (...)
292 mkTopUnfolding $ Note InlineMe $
293 mkLams tyvars $ Lam id_arg1 $
294 mkNewTypeBody tycon result_ty (Var id_arg1)
296 data_unf = mkTopUnfolding $ Note InlineMe $
298 mkLams ex_dict_args $ mkLams id_args $
299 foldr mk_case con_app
300 (zip (ex_dict_args++id_args) strict_marks) i3 []
302 con_app i rep_ids = mkApps (Var work_id)
303 (map varToCoreExpr (all_tyvars ++ reverse rep_ids))
305 ex_dict_tys = mkPredTys ex_theta
306 all_arg_tys = ex_dict_tys ++ orig_arg_tys
307 result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
309 wrap_ty = mkForAllTys all_tyvars (mkFunTys all_arg_tys result_ty)
310 -- We used to include the stupid theta in the wrapper's args
311 -- but now we don't. Instead the type checker just injects these
312 -- extra constraints where necessary.
314 mkLocals i tys = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
318 (ex_dict_args,i2) = mkLocals 1 ex_dict_tys
319 (id_args,i3) = mkLocals i2 orig_arg_tys
321 (id_arg1:_) = id_args -- Used for newtype only
323 strict_marks = dataConStrictMarks data_con
326 :: (Id, StrictnessMark) -- Arg, strictness
327 -> (Int -> [Id] -> CoreExpr) -- Body
328 -> Int -- Next rep arg id
329 -> [Id] -- Rep args so far, reversed
331 mk_case (arg,strict) body i rep_args
333 NotMarkedStrict -> body i (arg:rep_args)
335 | isUnLiftedType (idType arg) -> body i (arg:rep_args)
337 Case (Var arg) arg [(DEFAULT,[], body i (arg:rep_args))]
340 -> case splitProductType "do_unbox" (idType arg) of
341 (tycon, tycon_args, con, tys) ->
342 Case (Var arg) arg [(DataAlt con, con_args,
343 body i' (reverse con_args ++ rep_args))]
345 (con_args, i') = mkLocals i tys
349 %************************************************************************
351 \subsection{Record selectors}
353 %************************************************************************
355 We're going to build a record selector unfolding that looks like this:
357 data T a b c = T1 { ..., op :: a, ...}
358 | T2 { ..., op :: a, ...}
361 sel = /\ a b c -> \ d -> case d of
366 Similarly for newtypes
368 newtype N a = MkN { unN :: a->a }
371 unN n = coerce (a->a) n
373 We need to take a little care if the field has a polymorphic type:
375 data R = R { f :: forall a. a->a }
379 f :: forall a. R -> a -> a
380 f = /\ a \ r = case r of
383 (not f :: R -> forall a. a->a, which gives the type inference mechanism
384 problems at call sites)
386 Similarly for (recursive) newtypes
388 newtype N = MkN { unN :: forall a. a->a }
390 unN :: forall b. N -> b -> b
391 unN = /\b -> \n:N -> (coerce (forall a. a->a) n)
394 mkRecordSelId tycon field_label
395 -- Assumes that all fields with the same field label have the same type
397 -- Annoyingly, we have to pass in the unpackCString# Id, because
398 -- we can't conjure it up out of thin air
401 sel_id = mkGlobalId (RecordSelId field_label) (fieldLabelName field_label) selector_ty info
402 field_ty = fieldLabelType field_label
403 data_cons = tyConDataCons tycon
404 tyvars = tyConTyVars tycon -- These scope over the types in
405 -- the FieldLabels of constructors of this type
406 data_ty = mkTyConApp tycon tyvar_tys
407 tyvar_tys = mkTyVarTys tyvars
409 -- Very tiresomely, the selectors are (unnecessarily!) overloaded over
410 -- just the dictionaries in the types of the constructors that contain
411 -- the relevant field. [The Report says that pattern matching on a
412 -- constructor gives the same constraints as applying it.] Urgh.
414 -- However, not all data cons have all constraints (because of
415 -- TcTyDecls.thinContext). So we need to find all the data cons
416 -- involved in the pattern match and take the union of their constraints.
418 -- NB: this code relies on the fact that DataCons are quantified over
419 -- the identical type variables as their parent TyCon
420 tycon_theta = tyConTheta tycon -- The context on the data decl
421 -- eg data (Eq a, Ord b) => T a b = ...
422 needed_preds = [pred | (DataAlt dc, _, _) <- the_alts, pred <- dataConTheta dc]
423 dict_tys = map mkPredTy (nubBy tcEqPred needed_preds)
424 n_dict_tys = length dict_tys
426 (field_tyvars,field_theta,field_tau) = tcSplitSigmaTy field_ty
427 field_dict_tys = map mkPredTy field_theta
428 n_field_dict_tys = length field_dict_tys
429 -- If the field has a universally quantified type we have to
430 -- be a bit careful. Suppose we have
431 -- data R = R { op :: forall a. Foo a => a -> a }
432 -- Then we can't give op the type
433 -- op :: R -> forall a. Foo a => a -> a
434 -- because the typechecker doesn't understand foralls to the
435 -- right of an arrow. The "right" type to give it is
436 -- op :: forall a. Foo a => R -> a -> a
437 -- But then we must generate the right unfolding too:
438 -- op = /\a -> \dfoo -> \ r ->
441 -- Note that this is exactly the type we'd infer from a user defn
445 selector_ty = mkForAllTys tyvars $ mkForAllTys field_tyvars $
446 mkFunTys dict_tys $ mkFunTys field_dict_tys $
447 mkFunTy data_ty field_tau
449 arity = 1 + n_dict_tys + n_field_dict_tys
451 (strict_sig, rhs_w_str) = dmdAnalTopRhs sel_rhs
452 -- Use the demand analyser to work out strictness.
453 -- With all this unpackery it's not easy!
456 `setCafInfo` caf_info
458 `setUnfoldingInfo` mkTopUnfolding rhs_w_str
459 `setAllStrictnessInfo` Just strict_sig
461 -- Allocate Ids. We do it a funny way round because field_dict_tys is
462 -- almost always empty. Also note that we use length_tycon_theta
463 -- rather than n_dict_tys, because the latter gives an infinite loop:
464 -- n_dict tys depends on the_alts, which depens on arg_ids, which depends
465 -- on arity, which depends on n_dict tys. Sigh! Mega sigh!
466 field_dict_base = length tycon_theta + 1
467 dict_id_base = field_dict_base + n_field_dict_tys
468 field_base = dict_id_base + 1
469 dict_ids = mkTemplateLocalsNum 1 dict_tys
470 field_dict_ids = mkTemplateLocalsNum field_dict_base field_dict_tys
471 data_id = mkTemplateLocal dict_id_base data_ty
473 alts = map mk_maybe_alt data_cons
474 the_alts = catMaybes alts
476 no_default = all isJust alts -- No default needed
477 default_alt | no_default = []
478 | otherwise = [(DEFAULT, [], error_expr)]
480 -- The default branch may have CAF refs, because it calls recSelError etc.
481 caf_info | no_default = NoCafRefs
482 | otherwise = MayHaveCafRefs
484 sel_rhs = mkLams tyvars $ mkLams field_tyvars $
485 mkLams dict_ids $ mkLams field_dict_ids $
486 Lam data_id $ sel_body
488 sel_body | isNewTyCon tycon = mk_result (mkNewTypeBody tycon field_ty (Var data_id))
489 | otherwise = Case (Var data_id) data_id (default_alt ++ the_alts)
491 mk_result poly_result = mkVarApps (mkVarApps poly_result field_tyvars) field_dict_ids
492 -- We pull the field lambdas to the top, so we need to
493 -- apply them in the body. For example:
494 -- data T = MkT { foo :: forall a. a->a }
496 -- foo :: forall a. T -> a -> a
497 -- foo = /\a. \t:T. case t of { MkT f -> f a }
499 mk_maybe_alt data_con
500 = case maybe_the_arg_id of
502 Just the_arg_id -> Just (mkReboxingAlt uniqs data_con arg_ids body)
504 body = mk_result (Var the_arg_id)
506 arg_ids = mkTemplateLocalsNum field_base (dataConOrigArgTys data_con)
507 -- No need to instantiate; same tyvars in datacon as tycon
509 unpack_base = field_base + length arg_ids
510 uniqs = map mkBuiltinUnique [unpack_base..]
512 -- arity+1 avoids all shadowing
513 maybe_the_arg_id = assocMaybe (field_lbls `zip` arg_ids) field_label
514 field_lbls = dataConFieldLabels data_con
516 error_expr = mkRuntimeErrorApp rEC_SEL_ERROR_ID field_tau full_msg
517 full_msg = showSDoc (sep [text "No match in record selector", ppr sel_id])
520 -- (mkReboxingAlt us con xs rhs) basically constructs the case
521 -- alternative (con, xs, rhs)
522 -- but it does the reboxing necessary to construct the *source*
523 -- arguments, xs, from the representation arguments ys.
525 -- data T = MkT !(Int,Int) Bool
527 -- mkReboxingAlt MkT [x,b] r
528 -- = (DataAlt MkT, [y::Int,z::Int,b], let x = (y,z) in r)
530 -- mkDataAlt should really be in DataCon, but it can't because
531 -- it manipulates CoreSyn.
534 :: [Unique] -- Uniques for the new Ids
536 -> [Var] -- Source-level args
540 mkReboxingAlt us con args rhs
541 | not (any isMarkedUnboxed stricts)
542 = (DataAlt con, args, rhs)
546 (binds, args') = go args stricts us
548 (DataAlt con, args', mkLets binds rhs)
551 stricts = dataConStrictMarks con
553 go [] stricts us = ([], [])
555 -- Type variable case
556 go (arg:args) stricts us
558 = let (binds, args') = go args stricts us
559 in (binds, arg:args')
561 -- Term variable case
562 go (arg:args) (str:stricts) us
563 | isMarkedUnboxed str
565 (_, tycon_args, pack_con, con_arg_tys)
566 = splitProductType "mkReboxingAlt" (idType arg)
568 unpacked_args = zipWith (mkSysLocal FSLIT("rb")) us con_arg_tys
569 (binds, args') = go args stricts (dropList con_arg_tys us)
570 con_app = mkConApp pack_con (map Type tycon_args ++ map Var unpacked_args)
572 (NonRec arg con_app : binds, unpacked_args ++ args')
575 = let (binds, args') = go args stricts us
576 in (binds, arg:args')
580 %************************************************************************
582 \subsection{Dictionary selectors}
584 %************************************************************************
586 Selecting a field for a dictionary. If there is just one field, then
587 there's nothing to do.
589 Dictionary selectors may get nested forall-types. Thus:
592 op :: forall b. Ord b => a -> b -> b
594 Then the top-level type for op is
596 op :: forall a. Foo a =>
600 This is unlike ordinary record selectors, which have all the for-alls
601 at the outside. When dealing with classes it's very convenient to
602 recover the original type signature from the class op selector.
605 mkDictSelId :: Name -> Class -> Id
606 mkDictSelId name clas
607 = mkGlobalId (ClassOpId clas) name sel_ty info
609 sel_ty = mkForAllTys tyvars (mkFunTy (idType dict_id) (idType the_arg_id))
610 -- We can't just say (exprType rhs), because that would give a type
612 -- for a single-op class (after all, the selector is the identity)
613 -- But it's type must expose the representation of the dictionary
614 -- to gat (say) C a -> (a -> a)
616 field_lbl = mkFieldLabel name tycon sel_ty tag
617 tag = assoc "MkId.mkDictSelId" (map idName (classSelIds clas) `zip` allFieldLabelTags) name
621 `setUnfoldingInfo` mkTopUnfolding rhs
622 `setAllStrictnessInfo` Just strict_sig
624 -- We no longer use 'must-inline' on record selectors. They'll
625 -- inline like crazy if they scrutinise a constructor
627 -- The strictness signature is of the form U(AAAVAAAA) -> T
628 -- where the V depends on which item we are selecting
629 -- It's worth giving one, so that absence info etc is generated
630 -- even if the selector isn't inlined
631 strict_sig = mkStrictSig (mkTopDmdType [arg_dmd] TopRes)
632 arg_dmd | isNewTyCon tycon = evalDmd
633 | otherwise = Eval (Prod [ if the_arg_id == id then evalDmd else Abs
636 tyvars = classTyVars clas
638 tycon = classTyCon clas
639 [data_con] = tyConDataCons tycon
640 tyvar_tys = mkTyVarTys tyvars
641 arg_tys = dataConArgTys data_con tyvar_tys
642 the_arg_id = arg_ids !! (tag - firstFieldLabelTag)
644 pred = mkClassPred clas tyvar_tys
645 (dict_id:arg_ids) = mkTemplateLocals (mkPredTy pred : arg_tys)
647 rhs | isNewTyCon tycon = mkLams tyvars $ Lam dict_id $
648 mkNewTypeBody tycon (head arg_tys) (Var dict_id)
649 | otherwise = mkLams tyvars $ Lam dict_id $
650 Case (Var dict_id) dict_id
651 [(DataAlt data_con, arg_ids, Var the_arg_id)]
653 mkNewTypeBody tycon result_ty result_expr
654 -- Adds a coerce where necessary
655 -- Used for both wrapping and unwrapping
656 | isRecursiveTyCon tycon -- Recursive case; use a coerce
657 = Note (Coerce result_ty (exprType result_expr)) result_expr
658 | otherwise -- Normal case
663 %************************************************************************
665 \subsection{Primitive operations
667 %************************************************************************
670 mkPrimOpId :: PrimOp -> Id
674 (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
675 ty = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
676 name = mkPrimOpIdName prim_op
677 id = mkGlobalId (PrimOpId prim_op) name ty info
682 `setAllStrictnessInfo` Just strict_sig
684 rules = foldl (addRule id) emptyCoreRules (primOpRules prim_op)
687 -- For each ccall we manufacture a separate CCallOpId, giving it
688 -- a fresh unique, a type that is correct for this particular ccall,
689 -- and a CCall structure that gives the correct details about calling
692 -- The *name* of this Id is a local name whose OccName gives the full
693 -- details of the ccall, type and all. This means that the interface
694 -- file reader can reconstruct a suitable Id
696 mkFCallId :: Unique -> ForeignCall -> Type -> Id
697 mkFCallId uniq fcall ty
698 = ASSERT( isEmptyVarSet (tyVarsOfType ty) )
699 -- A CCallOpId should have no free type variables;
700 -- when doing substitutions won't substitute over it
701 mkGlobalId (FCallId fcall) name ty info
703 occ_str = showSDoc (braces (ppr fcall <+> ppr ty))
704 -- The "occurrence name" of a ccall is the full info about the
705 -- ccall; it is encoded, but may have embedded spaces etc!
707 name = mkFCallName uniq occ_str
711 `setAllStrictnessInfo` Just strict_sig
713 (_, tau) = tcSplitForAllTys ty
714 (arg_tys, _) = tcSplitFunTys tau
715 arity = length arg_tys
716 strict_sig = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
720 %************************************************************************
722 \subsection{DictFuns and default methods}
724 %************************************************************************
726 Important notes about dict funs and default methods
727 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
728 Dict funs and default methods are *not* ImplicitIds. Their definition
729 involves user-written code, so we can't figure out their strictness etc
730 based on fixed info, as we can for constructors and record selectors (say).
732 We build them as GlobalIds, but when in the module where they are
733 bound, we turn the Id at the *binding site* into an exported LocalId.
734 This ensures that they are taken to account by free-variable finding
735 and dependency analysis (e.g. CoreFVs.exprFreeVars). The simplifier
736 will propagate the LocalId to all occurrence sites.
738 Why shouldn't they be bound as GlobalIds? Because, in particular, if
739 they are globals, the specialiser floats dict uses above their defns,
740 which prevents good simplifications happening. Also the strictness
741 analyser treats a occurrence of a GlobalId as imported and assumes it
742 contains strictness in its IdInfo, which isn't true if the thing is
743 bound in the same module as the occurrence.
745 It's OK for dfuns to be LocalIds, because we form the instance-env to
746 pass on to the next module (md_insts) in CoreTidy, afer tidying
747 and globalising the top-level Ids.
749 BUT make sure they are *exported* LocalIds (setIdLocalExported) so
750 that they aren't discarded by the occurrence analyser.
753 mkDefaultMethodId dm_name ty
754 = setIdLocalExported (mkLocalId dm_name ty)
756 mkDictFunId :: Name -- Name to use for the dict fun;
763 mkDictFunId dfun_name inst_tyvars dfun_theta clas inst_tys
764 = setIdLocalExported (mkLocalId dfun_name dfun_ty)
766 dfun_ty = mkSigmaTy inst_tyvars dfun_theta (mkDictTy clas inst_tys)
768 {- 1 dec 99: disable the Mark Jones optimisation for the sake
769 of compatibility with Hugs.
770 See `types/InstEnv' for a discussion related to this.
772 (class_tyvars, sc_theta, _, _) = classBigSig clas
773 not_const (clas, tys) = not (isEmptyVarSet (tyVarsOfTypes tys))
774 sc_theta' = substClasses (mkTopTyVarSubst class_tyvars inst_tys) sc_theta
775 dfun_theta = case inst_decl_theta of
776 [] -> [] -- If inst_decl_theta is empty, then we don't
777 -- want to have any dict arguments, so that we can
778 -- expose the constant methods.
780 other -> nub (inst_decl_theta ++ filter not_const sc_theta')
781 -- Otherwise we pass the superclass dictionaries to
782 -- the dictionary function; the Mark Jones optimisation.
784 -- NOTE the "nub". I got caught by this one:
785 -- class Monad m => MonadT t m where ...
786 -- instance Monad m => MonadT (EnvT env) m where ...
787 -- Here, the inst_decl_theta has (Monad m); but so
788 -- does the sc_theta'!
790 -- NOTE the "not_const". I got caught by this one too:
791 -- class Foo a => Baz a b where ...
792 -- instance Wob b => Baz T b where..
793 -- Now sc_theta' has Foo T
798 %************************************************************************
800 \subsection{Un-definable}
802 %************************************************************************
804 These Ids can't be defined in Haskell. They could be defined in
805 unfoldings in the wired-in GHC.Prim interface file, but we'd have to
806 ensure that they were definitely, definitely inlined, because there is
807 no curried identifier for them. That's what mkCompulsoryUnfolding
808 does. If we had a way to get a compulsory unfolding from an interface
809 file, we could do that, but we don't right now.
811 unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
812 just gets expanded into a type coercion wherever it occurs. Hence we
813 add it as a built-in Id with an unfolding here.
815 The type variables we use here are "open" type variables: this means
816 they can unify with both unlifted and lifted types. Hence we provide
817 another gun with which to shoot yourself in the foot.
820 -- unsafeCoerce# :: forall a b. a -> b
822 = pcMiscPrelId unsafeCoerceName ty info
824 info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
827 ty = mkForAllTys [openAlphaTyVar,openBetaTyVar]
828 (mkFunTy openAlphaTy openBetaTy)
829 [x] = mkTemplateLocals [openAlphaTy]
830 rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
831 Note (Coerce openBetaTy openAlphaTy) (Var x)
833 -- nullAddr# :: Addr#
834 -- The reason is is here is because we don't provide
835 -- a way to write this literal in Haskell.
837 = pcMiscPrelId nullAddrName addrPrimTy info
839 info = noCafIdInfo `setUnfoldingInfo`
840 mkCompulsoryUnfolding (Lit nullAddrLit)
843 = pcMiscPrelId seqName ty info
845 info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
848 ty = mkForAllTys [alphaTyVar,openBetaTyVar]
849 (mkFunTy alphaTy (mkFunTy openBetaTy openBetaTy))
850 [x,y] = mkTemplateLocals [alphaTy, openBetaTy]
851 rhs = mkLams [alphaTyVar,openBetaTyVar,x,y] (Case (Var x) x [(DEFAULT, [], Var y)])
853 -- lazy :: forall a?. a? -> a? (i.e. works for unboxed types too)
854 -- Used to lazify pseq: pseq a b = a `seq` lazy b
855 -- No unfolding: it gets "inlined" by the worker/wrapper pass
856 -- Also, no strictness: by being a built-in Id, it overrides all
857 -- the info in PrelBase.hi. This is important, because the strictness
858 -- analyser will spot it as strict!
860 = pcMiscPrelId lazyIdName ty info
863 ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
865 lazyIdUnfolding :: CoreExpr -- Used to expand LazyOp after strictness anal
866 lazyIdUnfolding = mkLams [openAlphaTyVar,x] (Var x)
868 [x] = mkTemplateLocals [openAlphaTy]
871 @realWorld#@ used to be a magic literal, \tr{void#}. If things get
872 nasty as-is, change it back to a literal (@Literal@).
874 voidArgId is a Local Id used simply as an argument in functions
875 where we just want an arg to avoid having a thunk of unlifted type.
877 x = \ void :: State# RealWorld -> (# p, q #)
879 This comes up in strictness analysis
882 realWorldPrimId -- :: State# RealWorld
883 = pcMiscPrelId realWorldName realWorldStatePrimTy
884 (noCafIdInfo `setUnfoldingInfo` mkOtherCon [])
885 -- The mkOtherCon makes it look that realWorld# is evaluated
886 -- which in turn makes Simplify.interestingArg return True,
887 -- which in turn makes INLINE things applied to realWorld# likely
890 voidArgId -- :: State# RealWorld
891 = mkSysLocal FSLIT("void") voidArgIdKey realWorldStatePrimTy
895 %************************************************************************
897 \subsection[PrelVals-error-related]{@error@ and friends; @trace@}
899 %************************************************************************
901 GHC randomly injects these into the code.
903 @patError@ is just a version of @error@ for pattern-matching
904 failures. It knows various ``codes'' which expand to longer
905 strings---this saves space!
907 @absentErr@ is a thing we put in for ``absent'' arguments. They jolly
908 well shouldn't be yanked on, but if one is, then you will get a
909 friendly message from @absentErr@ (rather than a totally random
912 @parError@ is a special version of @error@ which the compiler does
913 not know to be a bottoming Id. It is used in the @_par_@ and @_seq_@
914 templates, but we don't ever expect to generate code for it.
918 :: Id -- Should be of type (forall a. Addr# -> a)
919 -- where Addr# points to a UTF8 encoded string
920 -> Type -- The type to instantiate 'a'
921 -> String -- The string to print
924 mkRuntimeErrorApp err_id res_ty err_msg
925 = mkApps (Var err_id) [Type res_ty, err_string]
927 err_string = Lit (MachStr (mkFastString (stringToUtf8 err_msg)))
929 rEC_SEL_ERROR_ID = mkRuntimeErrorId recSelErrorName
930 rUNTIME_ERROR_ID = mkRuntimeErrorId runtimeErrorName
931 iRREFUT_PAT_ERROR_ID = mkRuntimeErrorId irrefutPatErrorName
932 rEC_CON_ERROR_ID = mkRuntimeErrorId recConErrorName
933 nON_EXHAUSTIVE_GUARDS_ERROR_ID = mkRuntimeErrorId nonExhaustiveGuardsErrorName
934 pAT_ERROR_ID = mkRuntimeErrorId patErrorName
935 nO_METHOD_BINDING_ERROR_ID = mkRuntimeErrorId noMethodBindingErrorName
937 -- The runtime error Ids take a UTF8-encoded string as argument
938 mkRuntimeErrorId name = pc_bottoming_Id name runtimeErrorTy
939 runtimeErrorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTy addrPrimTy openAlphaTy)
943 eRROR_ID = pc_bottoming_Id errorName errorTy
946 errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy)
947 -- Notice the openAlphaTyVar. It says that "error" can be applied
948 -- to unboxed as well as boxed types. This is OK because it never
949 -- returns, so the return type is irrelevant.
953 %************************************************************************
955 \subsection{Utilities}
957 %************************************************************************
960 pcMiscPrelId :: Name -> Type -> IdInfo -> Id
961 pcMiscPrelId name ty info
962 = mkVanillaGlobal name ty info
963 -- We lie and say the thing is imported; otherwise, we get into
964 -- a mess with dependency analysis; e.g., core2stg may heave in
965 -- random calls to GHCbase.unpackPS__. If GHCbase is the module
966 -- being compiled, then it's just a matter of luck if the definition
967 -- will be in "the right place" to be in scope.
969 pc_bottoming_Id name ty
970 = pcMiscPrelId name ty bottoming_info
972 bottoming_info = vanillaIdInfo `setAllStrictnessInfo` Just strict_sig
973 -- Do *not* mark them as NoCafRefs, because they can indeed have
974 -- CAF refs. For example, pAT_ERROR_ID calls GHC.Err.untangle,
975 -- which has some CAFs
976 -- In due course we may arrange that these error-y things are
977 -- regarded by the GC as permanently live, in which case we
978 -- can give them NoCaf info. As it is, any function that calls
979 -- any pc_bottoming_Id will itself have CafRefs, which bloats
982 strict_sig = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
983 -- These "bottom" out, no matter what their arguments
985 (openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars
986 openAlphaTy = mkTyVarTy openAlphaTyVar
987 openBetaTy = mkTyVarTy openBetaTyVar