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,
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,
33 pAT_ERROR_ID, 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 Type ( TyThing(..) )
47 import TcType ( Type, ThetaType, mkDictTy, mkPredTys, mkTyConApp,
48 mkTyVarTys, mkClassPred, tcEqPred,
49 mkFunTys, mkFunTy, mkSigmaTy, tcSplitSigmaTy,
50 isUnLiftedType, mkForAllTys, mkTyVarTy, tyVarsOfType,
51 tcSplitFunTys, tcSplitForAllTys, mkPredTy
53 import CoreUtils ( exprType )
54 import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding, mkOtherCon )
55 import Literal ( Literal(..), nullAddrLit )
56 import TyCon ( TyCon, isNewTyCon, tyConTyVars, tyConDataCons,
57 tyConTheta, isProductTyCon, isDataTyCon, isRecursiveTyCon )
58 import Class ( Class, classTyCon, classTyVars, classSelIds )
59 import Var ( Id, TyVar, Var )
60 import VarSet ( isEmptyVarSet )
61 import Name ( mkFCallName, mkWiredInName, Name )
62 import OccName ( mkOccFS, varName )
63 import PrimOp ( PrimOp, primOpSig, primOpOcc, primOpTag )
64 import ForeignCall ( ForeignCall )
65 import DataCon ( DataCon, DataConIds(..),
66 dataConFieldLabels, dataConRepArity,
67 dataConArgTys, dataConRepType,
68 dataConOrigArgTys, dataConTheta,
69 dataConSig, dataConStrictMarks, dataConExStricts,
72 import Id ( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal,
73 mkTemplateLocals, mkTemplateLocalsNum, mkExportedLocalId,
74 mkTemplateLocal, idName
76 import IdInfo ( IdInfo, noCafIdInfo, setUnfoldingInfo,
77 setArityInfo, setSpecInfo, setCafInfo,
78 setAllStrictnessInfo, vanillaIdInfo,
79 GlobalIdDetails(..), CafInfo(..)
81 import NewDemand ( mkStrictSig, DmdResult(..),
82 mkTopDmdType, topDmd, evalDmd, lazyDmd, retCPR,
83 Demand(..), Demands(..) )
84 import FieldLabel ( fieldLabelName, firstFieldLabelTag,
85 allFieldLabelTags, fieldLabelType
87 import DmdAnal ( dmdAnalTopRhs )
89 import Unique ( mkBuiltinUnique, mkPrimOpIdUnique )
92 import Maybe ( isJust )
93 import Util ( dropList, isSingleton )
96 import ListSetOps ( assoc, assocMaybe )
97 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]
118 eRROR_ID, -- This one isn't used anywhere else in the compiler
119 -- But we still need it in wiredInIds so that when GHC
120 -- compiles a program that mentions 'error' we don't
121 -- import its type from the interface file; we just get
122 -- the Id defined here. Which has an 'open-tyvar' type.
125 iRREFUT_PAT_ERROR_ID,
126 nON_EXHAUSTIVE_GUARDS_ERROR_ID,
127 nO_METHOD_BINDING_ERROR_ID,
134 -- These Ids are exported from GHC.Prim
136 = [ -- These can't be defined in Haskell, but they have
137 -- perfectly reasonable unfoldings in Core
145 %************************************************************************
147 \subsection{Data constructors}
149 %************************************************************************
151 The wrapper for a constructor is an ordinary top-level binding that evaluates
152 any strict args, unboxes any args that are going to be flattened, and calls
155 We're going to build a constructor that looks like:
157 data (Data a, C b) => T a b = T1 !a !Int b
160 \d1::Data a, d2::C b ->
161 \p q r -> case p of { p ->
163 Con T1 [a,b] [p,q,r]}}
167 * d2 is thrown away --- a context in a data decl is used to make sure
168 one *could* construct dictionaries at the site the constructor
169 is used, but the dictionary isn't actually used.
171 * We have to check that we can construct Data dictionaries for
172 the types a and Int. Once we've done that we can throw d1 away too.
174 * We use (case p of q -> ...) to evaluate p, rather than "seq" because
175 all that matters is that the arguments are evaluated. "seq" is
176 very careful to preserve evaluation order, which we don't need
179 You might think that we could simply give constructors some strictness
180 info, like PrimOps, and let CoreToStg do the let-to-case transformation.
181 But we don't do that because in the case of primops and functions strictness
182 is a *property* not a *requirement*. In the case of constructors we need to
183 do something active to evaluate the argument.
185 Making an explicit case expression allows the simplifier to eliminate
186 it in the (common) case where the constructor arg is already evaluated.
190 mkDataConIds :: Name -> Name -> DataCon -> DataConIds
191 -- Makes the *worker* for the data constructor; that is, the function
192 -- that takes the reprsentation arguments and builds the constructor.
193 mkDataConIds wrap_name wkr_name data_con
197 | any isMarkedStrict all_strict_marks -- Algebraic, needs wrapper
198 = AlgDC (Just alg_wrap_id) wrk_id
200 | otherwise -- Algebraic, no wrapper
201 = AlgDC Nothing wrk_id
203 (tyvars, _, ex_tyvars, ex_theta, orig_arg_tys, tycon) = dataConSig data_con
204 all_tyvars = tyvars ++ ex_tyvars
206 ex_dict_tys = mkPredTys ex_theta
207 all_arg_tys = ex_dict_tys ++ orig_arg_tys
208 result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
210 wrap_ty = mkForAllTys all_tyvars (mkFunTys all_arg_tys result_ty)
211 -- We used to include the stupid theta in the wrapper's args
212 -- but now we don't. Instead the type checker just injects these
213 -- extra constraints where necessary.
215 ----------- Worker (algebraic data types only) --------------
216 wrk_id = mkGlobalId (DataConWorkId data_con) wkr_name
217 (dataConRepType data_con) wkr_info
219 wkr_arity = dataConRepArity data_con
220 wkr_info = noCafIdInfo
221 `setArityInfo` wkr_arity
222 `setAllStrictnessInfo` Just wkr_sig
224 wkr_sig = mkStrictSig (mkTopDmdType (replicate wkr_arity topDmd) cpr_info)
225 -- Notice that we do *not* say the worker is strict
226 -- even if the data constructor is declared strict
227 -- e.g. data T = MkT !(Int,Int)
228 -- Why? Because the *wrapper* is strict (and its unfolding has case
229 -- expresssions that do the evals) but the *worker* itself is not.
230 -- If we pretend it is strict then when we see
231 -- case x of y -> $wMkT y
232 -- the simplifier thinks that y is "sure to be evaluated" (because
233 -- $wMkT is strict) and drops the case. No, $wMkT is not strict.
235 -- When the simplifer sees a pattern
236 -- case e of MkT x -> ...
237 -- it uses the dataConRepStrictness of MkT to mark x as evaluated;
238 -- but that's fine... dataConRepStrictness comes from the data con
239 -- not from the worker Id.
241 cpr_info | isProductTyCon tycon &&
244 wkr_arity <= mAX_CPR_SIZE = retCPR
246 -- RetCPR is only true for products that are real data types;
247 -- that is, not unboxed tuples or [non-recursive] newtypes
249 ----------- Wrappers for newtypes --------------
250 nt_wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty nt_wrap_info
251 nt_wrap_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo
252 `setArityInfo` 1 -- Arity 1
253 `setUnfoldingInfo` newtype_unf
254 newtype_unf = ASSERT( null ex_tyvars && null ex_theta &&
255 isSingleton orig_arg_tys )
256 -- No existentials on a newtype, but it can have a context
257 -- e.g. newtype Eq a => T a = MkT (...)
258 mkTopUnfolding $ Note InlineMe $
259 mkLams tyvars $ Lam id_arg1 $
260 mkNewTypeBody tycon result_ty (Var id_arg1)
262 id_arg1 = mkTemplateLocal 1 (head orig_arg_tys)
264 ----------- Wrappers for algebraic data types --------------
265 alg_wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty alg_wrap_info
266 alg_wrap_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo
267 `setArityInfo` alg_arity
268 -- It's important to specify the arity, so that partial
269 -- applications are treated as values
270 `setUnfoldingInfo` alg_unf
271 `setAllStrictnessInfo` Just wrap_sig
273 all_strict_marks = dataConExStricts data_con ++ dataConStrictMarks data_con
274 wrap_sig = mkStrictSig (mkTopDmdType arg_dmds cpr_info)
275 arg_dmds = map mk_dmd all_strict_marks
276 mk_dmd str | isMarkedStrict str = evalDmd
277 | otherwise = lazyDmd
278 -- The Cpr info can be important inside INLINE rhss, where the
279 -- wrapper constructor isn't inlined.
280 -- And the argument strictness can be important too; we
281 -- may not inline a contructor when it is partially applied.
283 -- data W = C !Int !Int !Int
284 -- ...(let w = C x in ...(w p q)...)...
285 -- we want to see that w is strict in its two arguments
287 alg_unf = mkTopUnfolding $ Note InlineMe $
289 mkLams ex_dict_args $ mkLams id_args $
290 foldr mk_case con_app
291 (zip (ex_dict_args ++ id_args) all_strict_marks)
294 con_app i rep_ids = mkApps (Var wrk_id)
295 (map varToCoreExpr (all_tyvars ++ reverse rep_ids))
297 (ex_dict_args,i2) = mkLocals 1 ex_dict_tys
298 (id_args,i3) = mkLocals i2 orig_arg_tys
302 :: (Id, StrictnessMark) -- Arg, strictness
303 -> (Int -> [Id] -> CoreExpr) -- Body
304 -> Int -- Next rep arg id
305 -> [Id] -- Rep args so far, reversed
307 mk_case (arg,strict) body i rep_args
309 NotMarkedStrict -> body i (arg:rep_args)
311 | isUnLiftedType (idType arg) -> body i (arg:rep_args)
313 Case (Var arg) arg [(DEFAULT,[], body i (arg:rep_args))]
316 -> case splitProductType "do_unbox" (idType arg) of
317 (tycon, tycon_args, con, tys) ->
318 Case (Var arg) arg [(DataAlt con, con_args,
319 body i' (reverse con_args ++ rep_args))]
321 (con_args, i') = mkLocals i tys
323 mAX_CPR_SIZE :: Arity
325 -- We do not treat very big tuples as CPR-ish:
326 -- a) for a start we get into trouble because there aren't
327 -- "enough" unboxed tuple types (a tiresome restriction,
329 -- b) more importantly, big unboxed tuples get returned mainly
330 -- on the stack, and are often then allocated in the heap
331 -- by the caller. So doing CPR for them may in fact make
334 mkLocals i tys = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
340 %************************************************************************
342 \subsection{Record selectors}
344 %************************************************************************
346 We're going to build a record selector unfolding that looks like this:
348 data T a b c = T1 { ..., op :: a, ...}
349 | T2 { ..., op :: a, ...}
352 sel = /\ a b c -> \ d -> case d of
357 Similarly for newtypes
359 newtype N a = MkN { unN :: a->a }
362 unN n = coerce (a->a) n
364 We need to take a little care if the field has a polymorphic type:
366 data R = R { f :: forall a. a->a }
370 f :: forall a. R -> a -> a
371 f = /\ a \ r = case r of
374 (not f :: R -> forall a. a->a, which gives the type inference mechanism
375 problems at call sites)
377 Similarly for (recursive) newtypes
379 newtype N = MkN { unN :: forall a. a->a }
381 unN :: forall b. N -> b -> b
382 unN = /\b -> \n:N -> (coerce (forall a. a->a) n)
385 mkRecordSelId tycon field_label
386 -- Assumes that all fields with the same field label have the same type
389 sel_id = mkGlobalId (RecordSelId field_label) (fieldLabelName field_label) selector_ty info
390 field_ty = fieldLabelType field_label
391 data_cons = tyConDataCons tycon
392 tyvars = tyConTyVars tycon -- These scope over the types in
393 -- the FieldLabels of constructors of this type
394 data_ty = mkTyConApp tycon tyvar_tys
395 tyvar_tys = mkTyVarTys tyvars
397 -- Very tiresomely, the selectors are (unnecessarily!) overloaded over
398 -- just the dictionaries in the types of the constructors that contain
399 -- the relevant field. [The Report says that pattern matching on a
400 -- constructor gives the same constraints as applying it.] Urgh.
402 -- However, not all data cons have all constraints (because of
403 -- TcTyDecls.thinContext). So we need to find all the data cons
404 -- involved in the pattern match and take the union of their constraints.
406 -- NB: this code relies on the fact that DataCons are quantified over
407 -- the identical type variables as their parent TyCon
408 tycon_theta = tyConTheta tycon -- The context on the data decl
409 -- eg data (Eq a, Ord b) => T a b = ...
410 needed_preds = [pred | (DataAlt dc, _, _) <- the_alts, pred <- dataConTheta dc]
411 dict_tys = map mkPredTy (nubBy tcEqPred needed_preds)
412 n_dict_tys = length dict_tys
414 (field_tyvars,field_theta,field_tau) = tcSplitSigmaTy field_ty
415 field_dict_tys = map mkPredTy field_theta
416 n_field_dict_tys = length field_dict_tys
417 -- If the field has a universally quantified type we have to
418 -- be a bit careful. Suppose we have
419 -- data R = R { op :: forall a. Foo a => a -> a }
420 -- Then we can't give op the type
421 -- op :: R -> forall a. Foo a => a -> a
422 -- because the typechecker doesn't understand foralls to the
423 -- right of an arrow. The "right" type to give it is
424 -- op :: forall a. Foo a => R -> a -> a
425 -- But then we must generate the right unfolding too:
426 -- op = /\a -> \dfoo -> \ r ->
429 -- Note that this is exactly the type we'd infer from a user defn
433 selector_ty = mkForAllTys tyvars $ mkForAllTys field_tyvars $
434 mkFunTys dict_tys $ mkFunTys field_dict_tys $
435 mkFunTy data_ty field_tau
437 arity = 1 + n_dict_tys + n_field_dict_tys
439 (strict_sig, rhs_w_str) = dmdAnalTopRhs sel_rhs
440 -- Use the demand analyser to work out strictness.
441 -- With all this unpackery it's not easy!
444 `setCafInfo` caf_info
446 `setUnfoldingInfo` mkTopUnfolding rhs_w_str
447 `setAllStrictnessInfo` Just strict_sig
449 -- Allocate Ids. We do it a funny way round because field_dict_tys is
450 -- almost always empty. Also note that we use length_tycon_theta
451 -- rather than n_dict_tys, because the latter gives an infinite loop:
452 -- n_dict tys depends on the_alts, which depens on arg_ids, which depends
453 -- on arity, which depends on n_dict tys. Sigh! Mega sigh!
454 field_dict_base = length tycon_theta + 1
455 dict_id_base = field_dict_base + n_field_dict_tys
456 field_base = dict_id_base + 1
457 dict_ids = mkTemplateLocalsNum 1 dict_tys
458 field_dict_ids = mkTemplateLocalsNum field_dict_base field_dict_tys
459 data_id = mkTemplateLocal dict_id_base data_ty
461 alts = map mk_maybe_alt data_cons
462 the_alts = catMaybes alts
464 no_default = all isJust alts -- No default needed
465 default_alt | no_default = []
466 | otherwise = [(DEFAULT, [], error_expr)]
468 -- The default branch may have CAF refs, because it calls recSelError etc.
469 caf_info | no_default = NoCafRefs
470 | otherwise = MayHaveCafRefs
472 sel_rhs = mkLams tyvars $ mkLams field_tyvars $
473 mkLams dict_ids $ mkLams field_dict_ids $
474 Lam data_id $ sel_body
476 sel_body | isNewTyCon tycon = mk_result (mkNewTypeBody tycon field_ty (Var data_id))
477 | otherwise = Case (Var data_id) data_id (default_alt ++ the_alts)
479 mk_result poly_result = mkVarApps (mkVarApps poly_result field_tyvars) field_dict_ids
480 -- We pull the field lambdas to the top, so we need to
481 -- apply them in the body. For example:
482 -- data T = MkT { foo :: forall a. a->a }
484 -- foo :: forall a. T -> a -> a
485 -- foo = /\a. \t:T. case t of { MkT f -> f a }
487 mk_maybe_alt data_con
488 = case maybe_the_arg_id of
490 Just the_arg_id -> Just (mkReboxingAlt uniqs data_con arg_ids body)
492 body = mk_result (Var the_arg_id)
494 arg_ids = mkTemplateLocalsNum field_base (dataConOrigArgTys data_con)
495 -- No need to instantiate; same tyvars in datacon as tycon
496 -- Records can't be existential, so no existential tyvars or dicts
498 unpack_base = field_base + length arg_ids
499 uniqs = map mkBuiltinUnique [unpack_base..]
501 -- arity+1 avoids all shadowing
502 maybe_the_arg_id = assocMaybe (field_lbls `zip` arg_ids) field_label
503 field_lbls = dataConFieldLabels data_con
505 error_expr = mkRuntimeErrorApp rEC_SEL_ERROR_ID field_tau full_msg
506 full_msg = showSDoc (sep [text "No match in record selector", ppr sel_id])
509 -- (mkReboxingAlt us con xs rhs) basically constructs the case
510 -- alternative (con, xs, rhs)
511 -- but it does the reboxing necessary to construct the *source*
512 -- arguments, xs, from the representation arguments ys.
514 -- data T = MkT !(Int,Int) Bool
516 -- mkReboxingAlt MkT [x,b] r
517 -- = (DataAlt MkT, [y::Int,z::Int,b], let x = (y,z) in r)
519 -- mkDataAlt should really be in DataCon, but it can't because
520 -- it manipulates CoreSyn.
523 :: [Unique] -- Uniques for the new Ids
525 -> [Var] -- Source-level args
529 mkReboxingAlt us con args rhs
530 | not (any isMarkedUnboxed stricts)
531 = (DataAlt con, args, rhs)
535 (binds, args') = go args stricts us
537 (DataAlt con, args', mkLets binds rhs)
540 stricts = dataConExStricts con ++ dataConStrictMarks con
542 go [] stricts us = ([], [])
544 -- Type variable case
545 go (arg:args) stricts us
547 = let (binds, args') = go args stricts us
548 in (binds, arg:args')
550 -- Term variable case
551 go (arg:args) (str:stricts) us
552 | isMarkedUnboxed str
554 (_, tycon_args, pack_con, con_arg_tys)
555 = splitProductType "mkReboxingAlt" (idType arg)
557 unpacked_args = zipWith (mkSysLocal FSLIT("rb")) us con_arg_tys
558 (binds, args') = go args stricts (dropList con_arg_tys us)
559 con_app = mkConApp pack_con (map Type tycon_args ++ map Var unpacked_args)
561 (NonRec arg con_app : binds, unpacked_args ++ args')
564 = let (binds, args') = go args stricts us
565 in (binds, arg:args')
569 %************************************************************************
571 \subsection{Dictionary selectors}
573 %************************************************************************
575 Selecting a field for a dictionary. If there is just one field, then
576 there's nothing to do.
578 Dictionary selectors may get nested forall-types. Thus:
581 op :: forall b. Ord b => a -> b -> b
583 Then the top-level type for op is
585 op :: forall a. Foo a =>
589 This is unlike ordinary record selectors, which have all the for-alls
590 at the outside. When dealing with classes it's very convenient to
591 recover the original type signature from the class op selector.
594 mkDictSelId :: Name -> Class -> Id
595 mkDictSelId name clas
596 = mkGlobalId (ClassOpId clas) name sel_ty info
598 sel_ty = mkForAllTys tyvars (mkFunTy (idType dict_id) (idType the_arg_id))
599 -- We can't just say (exprType rhs), because that would give a type
601 -- for a single-op class (after all, the selector is the identity)
602 -- But it's type must expose the representation of the dictionary
603 -- to gat (say) C a -> (a -> a)
605 tag = assoc "MkId.mkDictSelId" (map idName (classSelIds clas) `zip` allFieldLabelTags) name
609 `setUnfoldingInfo` mkTopUnfolding rhs
610 `setAllStrictnessInfo` Just strict_sig
612 -- We no longer use 'must-inline' on record selectors. They'll
613 -- inline like crazy if they scrutinise a constructor
615 -- The strictness signature is of the form U(AAAVAAAA) -> T
616 -- where the V depends on which item we are selecting
617 -- It's worth giving one, so that absence info etc is generated
618 -- even if the selector isn't inlined
619 strict_sig = mkStrictSig (mkTopDmdType [arg_dmd] TopRes)
620 arg_dmd | isNewTyCon tycon = evalDmd
621 | otherwise = Eval (Prod [ if the_arg_id == id then evalDmd else Abs
624 tyvars = classTyVars clas
626 tycon = classTyCon clas
627 [data_con] = tyConDataCons tycon
628 tyvar_tys = mkTyVarTys tyvars
629 arg_tys = dataConArgTys data_con tyvar_tys
630 the_arg_id = arg_ids !! (tag - firstFieldLabelTag)
632 pred = mkClassPred clas tyvar_tys
633 (dict_id:arg_ids) = mkTemplateLocals (mkPredTy pred : arg_tys)
635 rhs | isNewTyCon tycon = mkLams tyvars $ Lam dict_id $
636 mkNewTypeBody tycon (head arg_tys) (Var dict_id)
637 | otherwise = mkLams tyvars $ Lam dict_id $
638 Case (Var dict_id) dict_id
639 [(DataAlt data_con, arg_ids, Var the_arg_id)]
641 mkNewTypeBody tycon result_ty result_expr
642 -- Adds a coerce where necessary
643 -- Used for both wrapping and unwrapping
644 | isRecursiveTyCon tycon -- Recursive case; use a coerce
645 = Note (Coerce result_ty (exprType result_expr)) result_expr
646 | otherwise -- Normal case
651 %************************************************************************
653 \subsection{Primitive operations
655 %************************************************************************
658 mkPrimOpId :: PrimOp -> Id
662 (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
663 ty = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
664 name = mkWiredInName gHC_PRIM (primOpOcc prim_op)
665 (mkPrimOpIdUnique (primOpTag prim_op))
667 id = mkGlobalId (PrimOpId prim_op) name ty info
672 `setAllStrictnessInfo` Just strict_sig
674 rules = foldl (addRule id) emptyCoreRules (primOpRules prim_op)
677 -- For each ccall we manufacture a separate CCallOpId, giving it
678 -- a fresh unique, a type that is correct for this particular ccall,
679 -- and a CCall structure that gives the correct details about calling
682 -- The *name* of this Id is a local name whose OccName gives the full
683 -- details of the ccall, type and all. This means that the interface
684 -- file reader can reconstruct a suitable Id
686 mkFCallId :: Unique -> ForeignCall -> Type -> Id
687 mkFCallId uniq fcall ty
688 = ASSERT( isEmptyVarSet (tyVarsOfType ty) )
689 -- A CCallOpId should have no free type variables;
690 -- when doing substitutions won't substitute over it
691 mkGlobalId (FCallId fcall) name ty info
693 occ_str = showSDoc (braces (ppr fcall <+> ppr ty))
694 -- The "occurrence name" of a ccall is the full info about the
695 -- ccall; it is encoded, but may have embedded spaces etc!
697 name = mkFCallName uniq occ_str
701 `setAllStrictnessInfo` Just strict_sig
703 (_, tau) = tcSplitForAllTys ty
704 (arg_tys, _) = tcSplitFunTys tau
705 arity = length arg_tys
706 strict_sig = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
710 %************************************************************************
712 \subsection{DictFuns and default methods}
714 %************************************************************************
716 Important notes about dict funs and default methods
717 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
718 Dict funs and default methods are *not* ImplicitIds. Their definition
719 involves user-written code, so we can't figure out their strictness etc
720 based on fixed info, as we can for constructors and record selectors (say).
722 We build them as GlobalIds, but when in the module where they are
723 bound, we turn the Id at the *binding site* into an exported LocalId.
724 This ensures that they are taken to account by free-variable finding
725 and dependency analysis (e.g. CoreFVs.exprFreeVars). The simplifier
726 will propagate the LocalId to all occurrence sites.
728 Why shouldn't they be bound as GlobalIds? Because, in particular, if
729 they are globals, the specialiser floats dict uses above their defns,
730 which prevents good simplifications happening. Also the strictness
731 analyser treats a occurrence of a GlobalId as imported and assumes it
732 contains strictness in its IdInfo, which isn't true if the thing is
733 bound in the same module as the occurrence.
735 It's OK for dfuns to be LocalIds, because we form the instance-env to
736 pass on to the next module (md_insts) in CoreTidy, afer tidying
737 and globalising the top-level Ids.
739 BUT make sure they are *exported* LocalIds (setIdLocalExported) so
740 that they aren't discarded by the occurrence analyser.
743 mkDefaultMethodId dm_name ty = mkExportedLocalId dm_name ty
745 mkDictFunId :: Name -- Name to use for the dict fun;
752 mkDictFunId dfun_name inst_tyvars dfun_theta clas inst_tys
753 = mkExportedLocalId dfun_name dfun_ty
755 dfun_ty = mkSigmaTy inst_tyvars dfun_theta (mkDictTy clas inst_tys)
757 {- 1 dec 99: disable the Mark Jones optimisation for the sake
758 of compatibility with Hugs.
759 See `types/InstEnv' for a discussion related to this.
761 (class_tyvars, sc_theta, _, _) = classBigSig clas
762 not_const (clas, tys) = not (isEmptyVarSet (tyVarsOfTypes tys))
763 sc_theta' = substClasses (mkTopTyVarSubst class_tyvars inst_tys) sc_theta
764 dfun_theta = case inst_decl_theta of
765 [] -> [] -- If inst_decl_theta is empty, then we don't
766 -- want to have any dict arguments, so that we can
767 -- expose the constant methods.
769 other -> nub (inst_decl_theta ++ filter not_const sc_theta')
770 -- Otherwise we pass the superclass dictionaries to
771 -- the dictionary function; the Mark Jones optimisation.
773 -- NOTE the "nub". I got caught by this one:
774 -- class Monad m => MonadT t m where ...
775 -- instance Monad m => MonadT (EnvT env) m where ...
776 -- Here, the inst_decl_theta has (Monad m); but so
777 -- does the sc_theta'!
779 -- NOTE the "not_const". I got caught by this one too:
780 -- class Foo a => Baz a b where ...
781 -- instance Wob b => Baz T b where..
782 -- Now sc_theta' has Foo T
787 %************************************************************************
789 \subsection{Un-definable}
791 %************************************************************************
793 These Ids can't be defined in Haskell. They could be defined in
794 unfoldings in the wired-in GHC.Prim interface file, but we'd have to
795 ensure that they were definitely, definitely inlined, because there is
796 no curried identifier for them. That's what mkCompulsoryUnfolding
797 does. If we had a way to get a compulsory unfolding from an interface
798 file, we could do that, but we don't right now.
800 unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
801 just gets expanded into a type coercion wherever it occurs. Hence we
802 add it as a built-in Id with an unfolding here.
804 The type variables we use here are "open" type variables: this means
805 they can unify with both unlifted and lifted types. Hence we provide
806 another gun with which to shoot yourself in the foot.
809 mkWiredInIdName mod fs uniq id
810 = mkWiredInName mod (mkOccFS varName fs) uniq Nothing (AnId id)
812 unsafeCoerceName = mkWiredInIdName gHC_PRIM FSLIT("unsafeCoerce#") unsafeCoerceIdKey unsafeCoerceId
813 nullAddrName = mkWiredInIdName gHC_PRIM FSLIT("nullAddr#") nullAddrIdKey nullAddrId
814 seqName = mkWiredInIdName gHC_PRIM FSLIT("seq") seqIdKey seqId
815 realWorldName = mkWiredInIdName gHC_PRIM FSLIT("realWorld#") realWorldPrimIdKey realWorldPrimId
816 lazyIdName = mkWiredInIdName pREL_BASE FSLIT("lazy") lazyIdKey lazyId
818 errorName = mkWiredInIdName pREL_ERR FSLIT("error") errorIdKey eRROR_ID
819 recSelErrorName = mkWiredInIdName pREL_ERR FSLIT("recSelError") recSelErrorIdKey rEC_SEL_ERROR_ID
820 runtimeErrorName = mkWiredInIdName pREL_ERR FSLIT("runtimeError") runtimeErrorIdKey rUNTIME_ERROR_ID
821 irrefutPatErrorName = mkWiredInIdName pREL_ERR FSLIT("irrefutPatError") irrefutPatErrorIdKey iRREFUT_PAT_ERROR_ID
822 recConErrorName = mkWiredInIdName pREL_ERR FSLIT("recConError") recConErrorIdKey rEC_CON_ERROR_ID
823 patErrorName = mkWiredInIdName pREL_ERR FSLIT("patError") patErrorIdKey pAT_ERROR_ID
824 noMethodBindingErrorName = mkWiredInIdName pREL_ERR FSLIT("noMethodBindingError")
825 noMethodBindingErrorIdKey nO_METHOD_BINDING_ERROR_ID
826 nonExhaustiveGuardsErrorName
827 = mkWiredInIdName pREL_ERR FSLIT("nonExhaustiveGuardsError")
828 nonExhaustiveGuardsErrorIdKey nON_EXHAUSTIVE_GUARDS_ERROR_ID
832 -- unsafeCoerce# :: forall a b. a -> b
834 = pcMiscPrelId unsafeCoerceName ty info
836 info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
839 ty = mkForAllTys [openAlphaTyVar,openBetaTyVar]
840 (mkFunTy openAlphaTy openBetaTy)
841 [x] = mkTemplateLocals [openAlphaTy]
842 rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
843 Note (Coerce openBetaTy openAlphaTy) (Var x)
845 -- nullAddr# :: Addr#
846 -- The reason is is here is because we don't provide
847 -- a way to write this literal in Haskell.
849 = pcMiscPrelId nullAddrName addrPrimTy info
851 info = noCafIdInfo `setUnfoldingInfo`
852 mkCompulsoryUnfolding (Lit nullAddrLit)
855 = pcMiscPrelId seqName ty info
857 info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
860 ty = mkForAllTys [alphaTyVar,openBetaTyVar]
861 (mkFunTy alphaTy (mkFunTy openBetaTy openBetaTy))
862 [x,y] = mkTemplateLocals [alphaTy, openBetaTy]
863 rhs = mkLams [alphaTyVar,openBetaTyVar,x,y] (Case (Var x) x [(DEFAULT, [], Var y)])
865 -- lazy :: forall a?. a? -> a? (i.e. works for unboxed types too)
866 -- Used to lazify pseq: pseq a b = a `seq` lazy b
867 -- No unfolding: it gets "inlined" by the worker/wrapper pass
868 -- Also, no strictness: by being a built-in Id, it overrides all
869 -- the info in PrelBase.hi. This is important, because the strictness
870 -- analyser will spot it as strict!
872 = pcMiscPrelId lazyIdName ty info
875 ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
877 lazyIdUnfolding :: CoreExpr -- Used to expand LazyOp after strictness anal
878 lazyIdUnfolding = mkLams [openAlphaTyVar,x] (Var x)
880 [x] = mkTemplateLocals [openAlphaTy]
883 @realWorld#@ used to be a magic literal, \tr{void#}. If things get
884 nasty as-is, change it back to a literal (@Literal@).
886 voidArgId is a Local Id used simply as an argument in functions
887 where we just want an arg to avoid having a thunk of unlifted type.
889 x = \ void :: State# RealWorld -> (# p, q #)
891 This comes up in strictness analysis
894 realWorldPrimId -- :: State# RealWorld
895 = pcMiscPrelId realWorldName realWorldStatePrimTy
896 (noCafIdInfo `setUnfoldingInfo` mkOtherCon [])
897 -- The mkOtherCon makes it look that realWorld# is evaluated
898 -- which in turn makes Simplify.interestingArg return True,
899 -- which in turn makes INLINE things applied to realWorld# likely
902 voidArgId -- :: State# RealWorld
903 = mkSysLocal FSLIT("void") voidArgIdKey realWorldStatePrimTy
907 %************************************************************************
909 \subsection[PrelVals-error-related]{@error@ and friends; @trace@}
911 %************************************************************************
913 GHC randomly injects these into the code.
915 @patError@ is just a version of @error@ for pattern-matching
916 failures. It knows various ``codes'' which expand to longer
917 strings---this saves space!
919 @absentErr@ is a thing we put in for ``absent'' arguments. They jolly
920 well shouldn't be yanked on, but if one is, then you will get a
921 friendly message from @absentErr@ (rather than a totally random
924 @parError@ is a special version of @error@ which the compiler does
925 not know to be a bottoming Id. It is used in the @_par_@ and @_seq_@
926 templates, but we don't ever expect to generate code for it.
930 :: Id -- Should be of type (forall a. Addr# -> a)
931 -- where Addr# points to a UTF8 encoded string
932 -> Type -- The type to instantiate 'a'
933 -> String -- The string to print
936 mkRuntimeErrorApp err_id res_ty err_msg
937 = mkApps (Var err_id) [Type res_ty, err_string]
939 err_string = Lit (MachStr (mkFastString (stringToUtf8 err_msg)))
941 rEC_SEL_ERROR_ID = mkRuntimeErrorId recSelErrorName
942 rUNTIME_ERROR_ID = mkRuntimeErrorId runtimeErrorName
943 iRREFUT_PAT_ERROR_ID = mkRuntimeErrorId irrefutPatErrorName
944 rEC_CON_ERROR_ID = mkRuntimeErrorId recConErrorName
945 pAT_ERROR_ID = mkRuntimeErrorId patErrorName
946 nO_METHOD_BINDING_ERROR_ID = mkRuntimeErrorId noMethodBindingErrorName
947 nON_EXHAUSTIVE_GUARDS_ERROR_ID = mkRuntimeErrorId nonExhaustiveGuardsErrorName
949 -- The runtime error Ids take a UTF8-encoded string as argument
950 mkRuntimeErrorId name = pc_bottoming_Id name runtimeErrorTy
951 runtimeErrorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTy addrPrimTy openAlphaTy)
955 eRROR_ID = pc_bottoming_Id errorName errorTy
958 errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy)
959 -- Notice the openAlphaTyVar. It says that "error" can be applied
960 -- to unboxed as well as boxed types. This is OK because it never
961 -- returns, so the return type is irrelevant.
965 %************************************************************************
967 \subsection{Utilities}
969 %************************************************************************
972 pcMiscPrelId :: Name -> Type -> IdInfo -> Id
973 pcMiscPrelId name ty info
974 = mkVanillaGlobal name ty info
975 -- We lie and say the thing is imported; otherwise, we get into
976 -- a mess with dependency analysis; e.g., core2stg may heave in
977 -- random calls to GHCbase.unpackPS__. If GHCbase is the module
978 -- being compiled, then it's just a matter of luck if the definition
979 -- will be in "the right place" to be in scope.
981 pc_bottoming_Id name ty
982 = pcMiscPrelId name ty bottoming_info
984 bottoming_info = vanillaIdInfo `setAllStrictnessInfo` Just strict_sig
985 -- Do *not* mark them as NoCafRefs, because they can indeed have
986 -- CAF refs. For example, pAT_ERROR_ID calls GHC.Err.untangle,
987 -- which has some CAFs
988 -- In due course we may arrange that these error-y things are
989 -- regarded by the GC as permanently live, in which case we
990 -- can give them NoCaf info. As it is, any function that calls
991 -- any pc_bottoming_Id will itself have CafRefs, which bloats
994 strict_sig = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
995 -- These "bottom" out, no matter what their arguments
997 (openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars
998 openAlphaTy = mkTyVarTy openAlphaTyVar
999 openBetaTy = mkTyVarTy openBetaTyVar