2 % (c) The AQUA Project, Glasgow University, 1998
4 \section[StdIdInfo]{Standard unfoldings}
6 This module contains definitions for the IdInfo for things that
7 have a standard form, namely:
11 * method and superclass selectors
12 * primitive operations
16 mkDictFunId, mkDefaultMethodId,
19 mkDataConId, mkDataConWrapId,
21 mkPrimOpId, mkFCallId,
23 mkReboxingAlt, mkNewTypeBody,
25 -- And some particular Ids; see below for why they are wired in
26 wiredInIds, ghcPrimIds,
27 unsafeCoerceId, realWorldPrimId, voidArgId, nullAddrId, seqId,
28 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, betaTyVar, betaTy,
41 intPrimTy, 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(DataToTagOp), primOpSig, mkPrimOpIdName )
62 import ForeignCall ( ForeignCall )
63 import DataCon ( DataCon,
64 dataConFieldLabels, dataConRepArity, dataConTyCon,
65 dataConArgTys, dataConRepType,
67 dataConName, dataConTheta,
68 dataConSig, dataConStrictMarks, dataConWorkId,
71 import Id ( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal,
72 mkTemplateLocals, mkTemplateLocalsNum,
73 mkTemplateLocal, idNewStrictness, idName
75 import IdInfo ( IdInfo, noCafIdInfo, hasCafIdInfo,
77 setArityInfo, setSpecInfo, setCafInfo,
79 GlobalIdDetails(..), CafInfo(..)
81 import NewDemand ( mkStrictSig, strictSigResInfo, DmdResult(..),
82 mkTopDmdType, topDmd, evalDmd, lazyDmd, retCPR,
83 Demand(..), Demands(..) )
84 import FieldLabel ( mkFieldLabel, fieldLabelName,
85 firstFieldLabelTag, allFieldLabelTags, fieldLabelType
87 import DmdAnal ( dmdAnalTopRhs )
89 import Unique ( mkBuiltinUnique )
92 import Maybe ( isJust )
93 import Util ( dropList, isSingleton )
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
146 %************************************************************************
148 \subsection{Data constructors}
150 %************************************************************************
153 mkDataConId :: Name -> DataCon -> Id
154 -- Makes the *worker* for the data constructor; that is, the function
155 -- that takes the reprsentation arguments and builds the constructor.
156 mkDataConId work_name data_con
157 = mkGlobalId (DataConId data_con) work_name (dataConRepType data_con) info
161 `setAllStrictnessInfo` Just strict_sig
163 arity = dataConRepArity data_con
165 strict_sig = mkStrictSig (mkTopDmdType (replicate arity topDmd) cpr_info)
166 -- Notice that we do *not* say the worker is strict
167 -- even if the data constructor is declared strict
168 -- e.g. data T = MkT !(Int,Int)
169 -- Why? Because the *wrapper* is strict (and its unfolding has case
170 -- expresssions that do the evals) but the *worker* itself is not.
171 -- If we pretend it is strict then when we see
172 -- case x of y -> $wMkT y
173 -- the simplifier thinks that y is "sure to be evaluated" (because
174 -- $wMkT is strict) and drops the case. No, $wMkT is not strict.
176 -- When the simplifer sees a pattern
177 -- case e of MkT x -> ...
178 -- it uses the dataConRepStrictness of MkT to mark x as evaluated;
179 -- but that's fine... dataConRepStrictness comes from the data con
180 -- not from the worker Id.
182 tycon = dataConTyCon data_con
183 cpr_info | isProductTyCon tycon &&
186 arity <= mAX_CPR_SIZE = retCPR
188 -- RetCPR is only true for products that are real data types;
189 -- that is, not unboxed tuples or [non-recursive] newtypes
191 mAX_CPR_SIZE :: Arity
193 -- We do not treat very big tuples as CPR-ish:
194 -- a) for a start we get into trouble because there aren't
195 -- "enough" unboxed tuple types (a tiresome restriction,
197 -- b) more importantly, big unboxed tuples get returned mainly
198 -- on the stack, and are often then allocated in the heap
199 -- by the caller. So doing CPR for them may in fact make
203 The wrapper for a constructor is an ordinary top-level binding that evaluates
204 any strict args, unboxes any args that are going to be flattened, and calls
207 We're going to build a constructor that looks like:
209 data (Data a, C b) => T a b = T1 !a !Int b
212 \d1::Data a, d2::C b ->
213 \p q r -> case p of { p ->
215 Con T1 [a,b] [p,q,r]}}
219 * d2 is thrown away --- a context in a data decl is used to make sure
220 one *could* construct dictionaries at the site the constructor
221 is used, but the dictionary isn't actually used.
223 * We have to check that we can construct Data dictionaries for
224 the types a and Int. Once we've done that we can throw d1 away too.
226 * We use (case p of q -> ...) to evaluate p, rather than "seq" because
227 all that matters is that the arguments are evaluated. "seq" is
228 very careful to preserve evaluation order, which we don't need
231 You might think that we could simply give constructors some strictness
232 info, like PrimOps, and let CoreToStg do the let-to-case transformation.
233 But we don't do that because in the case of primops and functions strictness
234 is a *property* not a *requirement*. In the case of constructors we need to
235 do something active to evaluate the argument.
237 Making an explicit case expression allows the simplifier to eliminate
238 it in the (common) case where the constructor arg is already evaluated.
241 mkDataConWrapId data_con
242 = mkGlobalId (DataConWrapId data_con) (dataConName data_con) wrap_ty info
244 work_id = dataConWorkId data_con
247 `setUnfoldingInfo` wrap_unf
248 -- The NoCaf-ness is set by noCafIdInfo
250 -- It's important to specify the arity, so that partial
251 -- applications are treated as values
252 `setAllStrictnessInfo` Just wrap_sig
254 wrap_sig = mkStrictSig (mkTopDmdType arg_dmds res_info)
255 res_info = strictSigResInfo (idNewStrictness work_id)
256 arg_dmds = map mk_dmd strict_marks
257 mk_dmd str | isMarkedStrict str = evalDmd
258 | otherwise = lazyDmd
259 -- The Cpr info can be important inside INLINE rhss, where the
260 -- wrapper constructor isn't inlined.
261 -- And the argument strictness can be important too; we
262 -- may not inline a contructor when it is partially applied.
264 -- data W = C !Int !Int !Int
265 -- ...(let w = C x in ...(w p q)...)...
266 -- we want to see that w is strict in its two arguments
268 wrap_unf | isNewTyCon tycon
269 = ASSERT( null ex_tyvars && null ex_dict_args && isSingleton orig_arg_tys )
270 -- No existentials on a newtype, but it can have a context
271 -- e.g. newtype Eq a => T a = MkT (...)
272 mkTopUnfolding $ Note InlineMe $
273 mkLams tyvars $ Lam id_arg1 $
274 mkNewTypeBody tycon result_ty (Var id_arg1)
276 | not (any isMarkedStrict strict_marks)
277 = mkCompulsoryUnfolding (Var work_id)
278 -- The common case. Not only is this efficient,
279 -- but it also ensures that the wrapper is replaced
280 -- by the worker even when there are no args.
284 -- This is really important in rule matching,
285 -- (We could match on the wrappers,
286 -- but that makes it less likely that rules will match
287 -- when we bring bits of unfoldings together.)
289 -- NB: because of this special case, (map (:) ys) turns into
290 -- (map $w: ys). The top-level defn for (:) is never used.
291 -- This is somewhat of a bore, but I'm currently leaving it
292 -- as is, so that there still is a top level curried (:) for
293 -- the interpreter to call.
296 = 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 (tyvars, _, ex_tyvars, ex_theta, orig_arg_tys, tycon) = dataConSig data_con
306 all_tyvars = tyvars ++ ex_tyvars
308 ex_dict_tys = mkPredTys ex_theta
309 all_arg_tys = ex_dict_tys ++ orig_arg_tys
310 result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
312 wrap_ty = mkForAllTys all_tyvars (mkFunTys all_arg_tys result_ty)
313 -- We used to include the stupid theta in the wrapper's args
314 -- but now we don't. Instead the type checker just injects these
315 -- extra constraints where necessary.
317 mkLocals i tys = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
321 (ex_dict_args,i2) = mkLocals 1 ex_dict_tys
322 (id_args,i3) = mkLocals i2 orig_arg_tys
324 (id_arg1:_) = id_args -- Used for newtype only
326 strict_marks = dataConStrictMarks data_con
329 :: (Id, StrictnessMark) -- Arg, strictness
330 -> (Int -> [Id] -> CoreExpr) -- Body
331 -> Int -- Next rep arg id
332 -> [Id] -- Rep args so far, reversed
334 mk_case (arg,strict) body i rep_args
336 NotMarkedStrict -> body i (arg:rep_args)
338 | isUnLiftedType (idType arg) -> body i (arg:rep_args)
340 Case (Var arg) arg [(DEFAULT,[], body i (arg:rep_args))]
343 -> case splitProductType "do_unbox" (idType arg) of
344 (tycon, tycon_args, con, tys) ->
345 Case (Var arg) arg [(DataAlt con, con_args,
346 body i' (reverse con_args ++ rep_args))]
348 (con_args, i') = mkLocals i tys
352 %************************************************************************
354 \subsection{Record selectors}
356 %************************************************************************
358 We're going to build a record selector unfolding that looks like this:
360 data T a b c = T1 { ..., op :: a, ...}
361 | T2 { ..., op :: a, ...}
364 sel = /\ a b c -> \ d -> case d of
369 Similarly for newtypes
371 newtype N a = MkN { unN :: a->a }
374 unN n = coerce (a->a) n
376 We need to take a little care if the field has a polymorphic type:
378 data R = R { f :: forall a. a->a }
382 f :: forall a. R -> a -> a
383 f = /\ a \ r = case r of
386 (not f :: R -> forall a. a->a, which gives the type inference mechanism
387 problems at call sites)
389 Similarly for (recursive) newtypes
391 newtype N = MkN { unN :: forall a. a->a }
393 unN :: forall b. N -> b -> b
394 unN = /\b -> \n:N -> (coerce (forall a. a->a) n)
397 mkRecordSelId tycon field_label
398 -- Assumes that all fields with the same field label have the same type
400 -- Annoyingly, we have to pass in the unpackCString# Id, because
401 -- we can't conjure it up out of thin air
404 sel_id = mkGlobalId (RecordSelId field_label) (fieldLabelName field_label) selector_ty info
405 field_ty = fieldLabelType field_label
406 data_cons = tyConDataCons tycon
407 tyvars = tyConTyVars tycon -- These scope over the types in
408 -- the FieldLabels of constructors of this type
409 data_ty = mkTyConApp tycon tyvar_tys
410 tyvar_tys = mkTyVarTys tyvars
412 -- Very tiresomely, the selectors are (unnecessarily!) overloaded over
413 -- just the dictionaries in the types of the constructors that contain
414 -- the relevant field. [The Report says that pattern matching on a
415 -- constructor gives the same constraints as applying it.] Urgh.
417 -- However, not all data cons have all constraints (because of
418 -- TcTyDecls.thinContext). So we need to find all the data cons
419 -- involved in the pattern match and take the union of their constraints.
421 -- NB: this code relies on the fact that DataCons are quantified over
422 -- the identical type variables as their parent TyCon
423 tycon_theta = tyConTheta tycon -- The context on the data decl
424 -- eg data (Eq a, Ord b) => T a b = ...
425 needed_preds = [pred | (DataAlt dc, _, _) <- the_alts, pred <- dataConTheta dc]
426 dict_tys = map mkPredTy (nubBy tcEqPred needed_preds)
427 n_dict_tys = length dict_tys
429 (field_tyvars,field_theta,field_tau) = tcSplitSigmaTy field_ty
430 field_dict_tys = map mkPredTy field_theta
431 n_field_dict_tys = length field_dict_tys
432 -- If the field has a universally quantified type we have to
433 -- be a bit careful. Suppose we have
434 -- data R = R { op :: forall a. Foo a => a -> a }
435 -- Then we can't give op the type
436 -- op :: R -> forall a. Foo a => a -> a
437 -- because the typechecker doesn't understand foralls to the
438 -- right of an arrow. The "right" type to give it is
439 -- op :: forall a. Foo a => R -> a -> a
440 -- But then we must generate the right unfolding too:
441 -- op = /\a -> \dfoo -> \ r ->
444 -- Note that this is exactly the type we'd infer from a user defn
448 selector_ty = mkForAllTys tyvars $ mkForAllTys field_tyvars $
449 mkFunTys dict_tys $ mkFunTys field_dict_tys $
450 mkFunTy data_ty field_tau
452 arity = 1 + n_dict_tys + n_field_dict_tys
454 (strict_sig, rhs_w_str) = dmdAnalTopRhs sel_rhs
455 -- Use the demand analyser to work out strictness.
456 -- With all this unpackery it's not easy!
459 `setCafInfo` caf_info
461 `setUnfoldingInfo` mkTopUnfolding rhs_w_str
462 `setAllStrictnessInfo` Just strict_sig
464 -- Allocate Ids. We do it a funny way round because field_dict_tys is
465 -- almost always empty. Also note that we use length_tycon_theta
466 -- rather than n_dict_tys, because the latter gives an infinite loop:
467 -- n_dict tys depends on the_alts, which depens on arg_ids, which depends
468 -- on arity, which depends on n_dict tys. Sigh! Mega sigh!
469 field_dict_base = length tycon_theta + 1
470 dict_id_base = field_dict_base + n_field_dict_tys
471 field_base = dict_id_base + 1
472 dict_ids = mkTemplateLocalsNum 1 dict_tys
473 field_dict_ids = mkTemplateLocalsNum field_dict_base field_dict_tys
474 data_id = mkTemplateLocal dict_id_base data_ty
476 alts = map mk_maybe_alt data_cons
477 the_alts = catMaybes alts
479 no_default = all isJust alts -- No default needed
480 default_alt | no_default = []
481 | otherwise = [(DEFAULT, [], error_expr)]
483 -- The default branch may have CAF refs, because it calls recSelError etc.
484 caf_info | no_default = NoCafRefs
485 | otherwise = MayHaveCafRefs
487 sel_rhs = mkLams tyvars $ mkLams field_tyvars $
488 mkLams dict_ids $ mkLams field_dict_ids $
489 Lam data_id $ sel_body
491 sel_body | isNewTyCon tycon = mk_result (mkNewTypeBody tycon field_ty (Var data_id))
492 | otherwise = Case (Var data_id) data_id (default_alt ++ the_alts)
494 mk_result poly_result = mkVarApps (mkVarApps poly_result field_tyvars) field_dict_ids
495 -- We pull the field lambdas to the top, so we need to
496 -- apply them in the body. For example:
497 -- data T = MkT { foo :: forall a. a->a }
499 -- foo :: forall a. T -> a -> a
500 -- foo = /\a. \t:T. case t of { MkT f -> f a }
502 mk_maybe_alt data_con
503 = case maybe_the_arg_id of
505 Just the_arg_id -> Just (mkReboxingAlt uniqs data_con arg_ids body)
507 body = mk_result (Var the_arg_id)
509 arg_ids = mkTemplateLocalsNum field_base (dataConOrigArgTys data_con)
510 -- No need to instantiate; same tyvars in datacon as tycon
512 unpack_base = field_base + length arg_ids
513 uniqs = map mkBuiltinUnique [unpack_base..]
515 -- arity+1 avoids all shadowing
516 maybe_the_arg_id = assocMaybe (field_lbls `zip` arg_ids) field_label
517 field_lbls = dataConFieldLabels data_con
519 error_expr = mkRuntimeErrorApp rEC_SEL_ERROR_ID field_tau full_msg
520 full_msg = showSDoc (sep [text "No match in record selector", ppr sel_id])
523 -- (mkReboxingAlt us con xs rhs) basically constructs the case
524 -- alternative (con, xs, rhs)
525 -- but it does the reboxing necessary to construct the *source*
526 -- arguments, xs, from the representation arguments ys.
528 -- data T = MkT !(Int,Int) Bool
530 -- mkReboxingAlt MkT [x,b] r
531 -- = (DataAlt MkT, [y::Int,z::Int,b], let x = (y,z) in r)
533 -- mkDataAlt should really be in DataCon, but it can't because
534 -- it manipulates CoreSyn.
537 :: [Unique] -- Uniques for the new Ids
539 -> [Var] -- Source-level args
543 mkReboxingAlt us con args rhs
544 | not (any isMarkedUnboxed stricts)
545 = (DataAlt con, args, rhs)
549 (binds, args') = go args stricts us
551 (DataAlt con, args', mkLets binds rhs)
554 stricts = dataConStrictMarks con
556 go [] stricts us = ([], [])
558 -- Type variable case
559 go (arg:args) stricts us
561 = let (binds, args') = go args stricts us
562 in (binds, arg:args')
564 -- Term variable case
565 go (arg:args) (str:stricts) us
566 | isMarkedUnboxed str
568 (_, tycon_args, pack_con, con_arg_tys)
569 = splitProductType "mkReboxingAlt" (idType arg)
571 unpacked_args = zipWith (mkSysLocal FSLIT("rb")) us con_arg_tys
572 (binds, args') = go args stricts (dropList con_arg_tys us)
573 con_app = mkConApp pack_con (map Type tycon_args ++ map Var unpacked_args)
575 (NonRec arg con_app : binds, unpacked_args ++ args')
578 = let (binds, args') = go args stricts us
579 in (binds, arg:args')
583 %************************************************************************
585 \subsection{Dictionary selectors}
587 %************************************************************************
589 Selecting a field for a dictionary. If there is just one field, then
590 there's nothing to do.
592 Dictionary selectors may get nested forall-types. Thus:
595 op :: forall b. Ord b => a -> b -> b
597 Then the top-level type for op is
599 op :: forall a. Foo a =>
603 This is unlike ordinary record selectors, which have all the for-alls
604 at the outside. When dealing with classes it's very convenient to
605 recover the original type signature from the class op selector.
607 ToDo: unify with mkRecordSelId?
610 mkDictSelId :: Name -> Class -> Id
611 mkDictSelId name clas
612 = mkGlobalId (RecordSelId field_lbl) name sel_ty info
614 sel_ty = mkForAllTys tyvars (mkFunTy (idType dict_id) (idType the_arg_id))
615 -- We can't just say (exprType rhs), because that would give a type
617 -- for a single-op class (after all, the selector is the identity)
618 -- But it's type must expose the representation of the dictionary
619 -- to gat (say) C a -> (a -> a)
621 field_lbl = mkFieldLabel name tycon sel_ty tag
622 tag = assoc "MkId.mkDictSelId" (map idName (classSelIds clas) `zip` allFieldLabelTags) name
626 `setUnfoldingInfo` mkTopUnfolding rhs
627 `setAllStrictnessInfo` Just strict_sig
629 -- We no longer use 'must-inline' on record selectors. They'll
630 -- inline like crazy if they scrutinise a constructor
632 -- The strictness signature is of the form U(AAAVAAAA) -> T
633 -- where the V depends on which item we are selecting
634 -- It's worth giving one, so that absence info etc is generated
635 -- even if the selector isn't inlined
636 strict_sig = mkStrictSig (mkTopDmdType [arg_dmd] TopRes)
637 arg_dmd | isNewTyCon tycon = evalDmd
638 | otherwise = Eval (Prod [ if the_arg_id == id then evalDmd else Abs
641 tyvars = classTyVars clas
643 tycon = classTyCon clas
644 [data_con] = tyConDataCons tycon
645 tyvar_tys = mkTyVarTys tyvars
646 arg_tys = dataConArgTys data_con tyvar_tys
647 the_arg_id = arg_ids !! (tag - firstFieldLabelTag)
649 pred = mkClassPred clas tyvar_tys
650 (dict_id:arg_ids) = mkTemplateLocals (mkPredTy pred : arg_tys)
652 rhs | isNewTyCon tycon = mkLams tyvars $ Lam dict_id $
653 mkNewTypeBody tycon (head arg_tys) (Var dict_id)
654 | otherwise = mkLams tyvars $ Lam dict_id $
655 Case (Var dict_id) dict_id
656 [(DataAlt data_con, arg_ids, Var the_arg_id)]
658 mkNewTypeBody tycon result_ty result_expr
659 -- Adds a coerce where necessary
660 -- Used for both wrapping and unwrapping
661 | isRecursiveTyCon tycon -- Recursive case; use a coerce
662 = Note (Coerce result_ty (exprType result_expr)) result_expr
663 | otherwise -- Normal case
668 %************************************************************************
670 \subsection{Primitive operations
672 %************************************************************************
675 mkPrimOpId :: PrimOp -> Id
679 (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
680 ty = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
681 name = mkPrimOpIdName prim_op
682 id = mkGlobalId (PrimOpId prim_op) name ty info
687 `setAllStrictnessInfo` Just strict_sig
689 rules = foldl (addRule id) emptyCoreRules (primOpRules prim_op)
692 -- For each ccall we manufacture a separate CCallOpId, giving it
693 -- a fresh unique, a type that is correct for this particular ccall,
694 -- and a CCall structure that gives the correct details about calling
697 -- The *name* of this Id is a local name whose OccName gives the full
698 -- details of the ccall, type and all. This means that the interface
699 -- file reader can reconstruct a suitable Id
701 mkFCallId :: Unique -> ForeignCall -> Type -> Id
702 mkFCallId uniq fcall ty
703 = ASSERT( isEmptyVarSet (tyVarsOfType ty) )
704 -- A CCallOpId should have no free type variables;
705 -- when doing substitutions won't substitute over it
706 mkGlobalId (FCallId fcall) name ty info
708 occ_str = showSDoc (braces (ppr fcall <+> ppr ty))
709 -- The "occurrence name" of a ccall is the full info about the
710 -- ccall; it is encoded, but may have embedded spaces etc!
712 name = mkFCallName uniq occ_str
716 `setAllStrictnessInfo` Just strict_sig
718 (_, tau) = tcSplitForAllTys ty
719 (arg_tys, _) = tcSplitFunTys tau
720 arity = length arg_tys
721 strict_sig = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
725 %************************************************************************
727 \subsection{DictFuns and default methods}
729 %************************************************************************
731 Important notes about dict funs and default methods
732 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
733 Dict funs and default methods are *not* ImplicitIds. Their definition
734 involves user-written code, so we can't figure out their strictness etc
735 based on fixed info, as we can for constructors and record selectors (say).
737 We build them as GlobalIds, but when in the module where they are
738 bound, we turn the Id at the *binding site* into an exported LocalId.
739 This ensures that they are taken to account by free-variable finding
740 and dependency analysis (e.g. CoreFVs.exprFreeVars). The simplifier
741 will propagate the LocalId to all occurrence sites.
743 Why shouldn't they be bound as GlobalIds? Because, in particular, if
744 they are globals, the specialiser floats dict uses above their defns,
745 which prevents good simplifications happening. Also the strictness
746 analyser treats a occurrence of a GlobalId as imported and assumes it
747 contains strictness in its IdInfo, which isn't true if the thing is
748 bound in the same module as the occurrence.
750 It's OK for dfuns to be LocalIds, because we form the instance-env to
751 pass on to the next module (md_insts) in CoreTidy, afer tidying
752 and globalising the top-level Ids.
754 BUT make sure they are *exported* LocalIds (setIdLocalExported) so
755 that they aren't discarded by the occurrence analyser.
758 mkDefaultMethodId dm_name ty = mkVanillaGlobal dm_name ty noCafIdInfo
760 mkDictFunId :: Name -- Name to use for the dict fun;
767 mkDictFunId dfun_name inst_tyvars dfun_theta clas inst_tys
768 = mkVanillaGlobal dfun_name dfun_ty noCafIdInfo
770 dfun_ty = mkSigmaTy inst_tyvars dfun_theta (mkDictTy clas inst_tys)
772 {- 1 dec 99: disable the Mark Jones optimisation for the sake
773 of compatibility with Hugs.
774 See `types/InstEnv' for a discussion related to this.
776 (class_tyvars, sc_theta, _, _) = classBigSig clas
777 not_const (clas, tys) = not (isEmptyVarSet (tyVarsOfTypes tys))
778 sc_theta' = substClasses (mkTopTyVarSubst class_tyvars inst_tys) sc_theta
779 dfun_theta = case inst_decl_theta of
780 [] -> [] -- If inst_decl_theta is empty, then we don't
781 -- want to have any dict arguments, so that we can
782 -- expose the constant methods.
784 other -> nub (inst_decl_theta ++ filter not_const sc_theta')
785 -- Otherwise we pass the superclass dictionaries to
786 -- the dictionary function; the Mark Jones optimisation.
788 -- NOTE the "nub". I got caught by this one:
789 -- class Monad m => MonadT t m where ...
790 -- instance Monad m => MonadT (EnvT env) m where ...
791 -- Here, the inst_decl_theta has (Monad m); but so
792 -- does the sc_theta'!
794 -- NOTE the "not_const". I got caught by this one too:
795 -- class Foo a => Baz a b where ...
796 -- instance Wob b => Baz T b where..
797 -- Now sc_theta' has Foo T
802 %************************************************************************
804 \subsection{Un-definable}
806 %************************************************************************
808 These Ids can't be defined in Haskell. They could be defined in
809 unfoldings in the wired-in GHC.Prim interface file, but we'd have to
810 ensure that they were definitely, definitely inlined, because there is
811 no curried identifier for them. That's what mkCompulsoryUnfolding
812 does. If we had a way to get a compulsory unfolding from an interface
813 file, we could do that, but we don't right now.
815 unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
816 just gets expanded into a type coercion wherever it occurs. Hence we
817 add it as a built-in Id with an unfolding here.
819 The type variables we use here are "open" type variables: this means
820 they can unify with both unlifted and lifted types. Hence we provide
821 another gun with which to shoot yourself in the foot.
824 -- unsafeCoerce# :: forall a b. a -> b
826 = pcMiscPrelId unsafeCoerceName ty info
828 info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
831 ty = mkForAllTys [openAlphaTyVar,openBetaTyVar]
832 (mkFunTy openAlphaTy openBetaTy)
833 [x] = mkTemplateLocals [openAlphaTy]
834 rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
835 Note (Coerce openBetaTy openAlphaTy) (Var x)
837 -- nullAddr# :: Addr#
838 -- The reason is is here is because we don't provide
839 -- a way to write this literal in Haskell.
841 = pcMiscPrelId nullAddrName addrPrimTy info
843 info = noCafIdInfo `setUnfoldingInfo`
844 mkCompulsoryUnfolding (Lit nullAddrLit)
847 = pcMiscPrelId seqName ty info
849 info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
852 ty = mkForAllTys [alphaTyVar,betaTyVar]
853 (mkFunTy alphaTy (mkFunTy betaTy betaTy))
854 [x,y] = mkTemplateLocals [alphaTy, betaTy]
855 rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x [(DEFAULT, [], Var y)])
857 -- lazy :: forall a?. a? -> a? (i.e. works for unboxed types too)
858 -- Used to lazify pseq: pseq a b = a `seq` lazy b
859 -- No unfolding: it gets "inlined" by the worker/wrapper pass
860 -- Also, no strictness: by being a built-in Id, it overrides all
861 -- the info in PrelBase.hi. This is important, because the strictness
862 -- analyser will spot it as strict!
864 = pcMiscPrelId lazyIdName ty info
867 ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
869 lazyIdUnfolding :: CoreExpr -- Used to expand LazyOp after strictness anal
870 lazyIdUnfolding = mkLams [openAlphaTyVar,x] (Var x)
872 [x] = mkTemplateLocals [openAlphaTy]
875 @getTag#@ is another function which can't be defined in Haskell. It needs to
876 evaluate its argument and call the dataToTag# primitive.
880 = pcMiscPrelId getTagName ty info
882 info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
883 -- We don't provide a defn for this; you must inline it
885 ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy intPrimTy)
886 [x,y] = mkTemplateLocals [alphaTy,alphaTy]
887 rhs = mkLams [alphaTyVar,x] $
888 Case (Var x) y [ (DEFAULT, [], mkApps (Var dataToTagId) [Type alphaTy, Var y]) ]
890 dataToTagId = mkPrimOpId DataToTagOp
893 @realWorld#@ used to be a magic literal, \tr{void#}. If things get
894 nasty as-is, change it back to a literal (@Literal@).
896 voidArgId is a Local Id used simply as an argument in functions
897 where we just want an arg to avoid having a thunk of unlifted type.
899 x = \ void :: State# RealWorld -> (# p, q #)
901 This comes up in strictness analysis
904 realWorldPrimId -- :: State# RealWorld
905 = pcMiscPrelId realWorldName realWorldStatePrimTy
906 (noCafIdInfo `setUnfoldingInfo` mkOtherCon [])
907 -- The mkOtherCon makes it look that realWorld# is evaluated
908 -- which in turn makes Simplify.interestingArg return True,
909 -- which in turn makes INLINE things applied to realWorld# likely
912 voidArgId -- :: State# RealWorld
913 = mkSysLocal FSLIT("void") voidArgIdKey realWorldStatePrimTy
917 %************************************************************************
919 \subsection[PrelVals-error-related]{@error@ and friends; @trace@}
921 %************************************************************************
923 GHC randomly injects these into the code.
925 @patError@ is just a version of @error@ for pattern-matching
926 failures. It knows various ``codes'' which expand to longer
927 strings---this saves space!
929 @absentErr@ is a thing we put in for ``absent'' arguments. They jolly
930 well shouldn't be yanked on, but if one is, then you will get a
931 friendly message from @absentErr@ (rather than a totally random
934 @parError@ is a special version of @error@ which the compiler does
935 not know to be a bottoming Id. It is used in the @_par_@ and @_seq_@
936 templates, but we don't ever expect to generate code for it.
940 :: Id -- Should be of type (forall a. Addr# -> a)
941 -- where Addr# points to a UTF8 encoded string
942 -> Type -- The type to instantiate 'a'
943 -> String -- The string to print
946 mkRuntimeErrorApp err_id res_ty err_msg
947 = mkApps (Var err_id) [Type res_ty, err_string]
949 err_string = Lit (MachStr (mkFastString (stringToUtf8 err_msg)))
951 rEC_SEL_ERROR_ID = mkRuntimeErrorId recSelErrorName
952 rUNTIME_ERROR_ID = mkRuntimeErrorId runtimeErrorName
953 iRREFUT_PAT_ERROR_ID = mkRuntimeErrorId irrefutPatErrorName
954 rEC_CON_ERROR_ID = mkRuntimeErrorId recConErrorName
955 nON_EXHAUSTIVE_GUARDS_ERROR_ID = mkRuntimeErrorId nonExhaustiveGuardsErrorName
956 pAT_ERROR_ID = mkRuntimeErrorId patErrorName
957 nO_METHOD_BINDING_ERROR_ID = mkRuntimeErrorId noMethodBindingErrorName
959 -- The runtime error Ids take a UTF8-encoded string as argument
960 mkRuntimeErrorId name = pc_bottoming_Id name runtimeErrorTy
961 runtimeErrorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTy addrPrimTy openAlphaTy)
965 eRROR_ID = pc_bottoming_Id errorName errorTy
968 errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy)
969 -- Notice the openAlphaTyVar. It says that "error" can be applied
970 -- to unboxed as well as boxed types. This is OK because it never
971 -- returns, so the return type is irrelevant.
975 %************************************************************************
977 \subsection{Utilities}
979 %************************************************************************
982 pcMiscPrelId :: Name -> Type -> IdInfo -> Id
983 pcMiscPrelId name ty info
984 = mkVanillaGlobal name ty info
985 -- We lie and say the thing is imported; otherwise, we get into
986 -- a mess with dependency analysis; e.g., core2stg may heave in
987 -- random calls to GHCbase.unpackPS__. If GHCbase is the module
988 -- being compiled, then it's just a matter of luck if the definition
989 -- will be in "the right place" to be in scope.
991 pc_bottoming_Id name ty
992 = pcMiscPrelId name ty bottoming_info
994 bottoming_info = hasCafIdInfo `setAllStrictnessInfo` Just strict_sig
995 -- Do *not* mark them as NoCafRefs, because they can indeed have
996 -- CAF refs. For example, pAT_ERROR_ID calls GHC.Err.untangle,
997 -- which has some CAFs
998 -- In due course we may arrange that these error-y things are
999 -- regarded by the GC as permanently live, in which case we
1000 -- can give them NoCaf info. As it is, any function that calls
1001 -- any pc_bottoming_Id will itself have CafRefs, which bloats
1004 strict_sig = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
1005 -- These "bottom" out, no matter what their arguments
1007 (openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars
1008 openAlphaTy = mkTyVarTy openAlphaTyVar
1009 openBetaTy = mkTyVarTy openBetaTyVar