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,
20 mkRecordSelId, rebuildConArgs,
21 mkPrimOpId, mkFCallId,
23 -- And some particular Ids; see below for why they are wired in
24 wiredInIds, ghcPrimIds,
25 unsafeCoerceId, realWorldPrimId, voidArgId, nullAddrId, seqId,
26 eRROR_ID, eRROR_CSTRING_ID, rEC_SEL_ERROR_ID, pAT_ERROR_ID,
27 rEC_CON_ERROR_ID, rEC_UPD_ERROR_ID, iRREFUT_PAT_ERROR_ID,
28 nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID,
29 aBSENT_ERROR_ID, pAR_ERROR_ID
32 #include "HsVersions.h"
35 import BasicTypes ( Arity, StrictnessMark(..), isMarkedUnboxed, isMarkedStrict )
36 import TysPrim ( openAlphaTyVars, alphaTyVar, alphaTy, betaTyVar, betaTy,
37 intPrimTy, realWorldStatePrimTy, addrPrimTy
39 import TysWiredIn ( charTy, mkListTy )
40 import PrelRules ( primOpRules )
41 import Rules ( addRule )
42 import TcType ( Type, ThetaType, mkDictTy, mkPredTys, mkTyConApp,
43 mkTyVarTys, mkClassPred, tcEqPred,
44 mkFunTys, mkFunTy, mkSigmaTy, tcSplitSigmaTy,
45 isUnLiftedType, mkForAllTys, mkTyVarTy, tyVarsOfType,
46 tcSplitFunTys, tcSplitForAllTys, mkPredTy
48 import Module ( Module )
49 import CoreUtils ( exprType )
50 import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding, mkOtherCon )
51 import Literal ( Literal(..), nullAddrLit )
52 import TyCon ( TyCon, isNewTyCon, tyConTyVars, tyConDataCons,
53 tyConTheta, isProductTyCon, isDataTyCon, isRecursiveTyCon )
54 import Class ( Class, classTyCon, classTyVars, classSelIds )
55 import Var ( Id, TyVar )
56 import VarSet ( isEmptyVarSet )
57 import Name ( mkWiredInName, mkFCallName, Name )
58 import OccName ( mkVarOcc )
59 import PrimOp ( PrimOp(DataToTagOp), primOpSig, mkPrimOpIdName )
60 import ForeignCall ( ForeignCall )
61 import DataCon ( DataCon,
62 dataConFieldLabels, dataConRepArity, dataConTyCon,
63 dataConArgTys, dataConRepType,
64 dataConInstOrigArgTys,
65 dataConName, dataConTheta,
66 dataConSig, dataConStrictMarks, dataConId,
69 import Id ( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal,
70 mkTemplateLocals, mkTemplateLocalsNum,
71 mkTemplateLocal, idNewStrictness, idName
73 import IdInfo ( IdInfo, noCafNoTyGenIdInfo,
75 setArityInfo, setSpecInfo, setCafInfo,
77 GlobalIdDetails(..), CafInfo(..)
79 import NewDemand ( mkStrictSig, strictSigResInfo, DmdResult(..),
80 mkTopDmdType, topDmd, evalDmd, lazyDmd,
81 Demand(..), Demands(..) )
82 import FieldLabel ( mkFieldLabel, fieldLabelName,
83 firstFieldLabelTag, allFieldLabelTags, fieldLabelType
85 import DmdAnal ( dmdAnalTopRhs )
87 import Unique ( mkBuiltinUnique )
90 import Maybe ( isJust )
91 import Util ( dropList, isSingleton )
93 import ListSetOps ( assoc, assocMaybe )
94 import UnicodeUtil ( stringToUtf8 )
98 %************************************************************************
100 \subsection{Wired in Ids}
102 %************************************************************************
106 = [ -- These error-y things are wired in because we don't yet have
107 -- a way to express in an interface file that the result type variable
108 -- is 'open'; that is can be unified with an unboxed type
110 -- [The interface file format now carry such information, but there's
111 -- no way yet of expressing at the definition site for these
112 -- error-reporting functions that they have an 'open'
113 -- result type. -- sof 1/99]
118 iRREFUT_PAT_ERROR_ID,
119 nON_EXHAUSTIVE_GUARDS_ERROR_ID,
120 nO_METHOD_BINDING_ERROR_ID,
127 -- These Ids are exported from GHC.Prim
129 = [ -- These can't be defined in Haskell, but they have
130 -- perfectly reasonable unfoldings in Core
139 %************************************************************************
141 \subsection{Data constructors}
143 %************************************************************************
146 mkDataConId :: Name -> DataCon -> Id
147 -- Makes the *worker* for the data constructor; that is, the function
148 -- that takes the reprsentation arguments and builds the constructor.
149 mkDataConId work_name data_con
150 = mkGlobalId (DataConId data_con) work_name (dataConRepType data_con) info
152 info = noCafNoTyGenIdInfo
154 `setAllStrictnessInfo` Just strict_sig
156 arity = dataConRepArity data_con
158 strict_sig = mkStrictSig (mkTopDmdType (replicate arity topDmd) cpr_info)
159 -- Notice that we do *not* say the worker is strict
160 -- even if the data constructor is declared strict
161 -- e.g. data T = MkT !(Int,Int)
162 -- Why? Because the *wrapper* is strict (and its unfolding has case
163 -- expresssions that do the evals) but the *worker* itself is not.
164 -- If we pretend it is strict then when we see
165 -- case x of y -> $wMkT y
166 -- the simplifier thinks that y is "sure to be evaluated" (because
167 -- $wMkT is strict) and drops the case. No, $wMkT is not strict.
169 -- When the simplifer sees a pattern
170 -- case e of MkT x -> ...
171 -- it uses the dataConRepStrictness of MkT to mark x as evaluated;
172 -- but that's fine... dataConRepStrictness comes from the data con
173 -- not from the worker Id.
175 tycon = dataConTyCon data_con
176 cpr_info | isProductTyCon tycon &&
179 arity <= mAX_CPR_SIZE = RetCPR
181 -- RetCPR is only true for products that are real data types;
182 -- that is, not unboxed tuples or [non-recursive] newtypes
184 mAX_CPR_SIZE :: Arity
186 -- We do not treat very big tuples as CPR-ish:
187 -- a) for a start we get into trouble because there aren't
188 -- "enough" unboxed tuple types (a tiresome restriction,
190 -- b) more importantly, big unboxed tuples get returned mainly
191 -- on the stack, and are often then allocated in the heap
192 -- by the caller. So doing CPR for them may in fact make
196 The wrapper for a constructor is an ordinary top-level binding that evaluates
197 any strict args, unboxes any args that are going to be flattened, and calls
200 We're going to build a constructor that looks like:
202 data (Data a, C b) => T a b = T1 !a !Int b
205 \d1::Data a, d2::C b ->
206 \p q r -> case p of { p ->
208 Con T1 [a,b] [p,q,r]}}
212 * d2 is thrown away --- a context in a data decl is used to make sure
213 one *could* construct dictionaries at the site the constructor
214 is used, but the dictionary isn't actually used.
216 * We have to check that we can construct Data dictionaries for
217 the types a and Int. Once we've done that we can throw d1 away too.
219 * We use (case p of q -> ...) to evaluate p, rather than "seq" because
220 all that matters is that the arguments are evaluated. "seq" is
221 very careful to preserve evaluation order, which we don't need
224 You might think that we could simply give constructors some strictness
225 info, like PrimOps, and let CoreToStg do the let-to-case transformation.
226 But we don't do that because in the case of primops and functions strictness
227 is a *property* not a *requirement*. In the case of constructors we need to
228 do something active to evaluate the argument.
230 Making an explicit case expression allows the simplifier to eliminate
231 it in the (common) case where the constructor arg is already evaluated.
234 mkDataConWrapId data_con
235 = mkGlobalId (DataConWrapId data_con) (dataConName data_con) wrap_ty info
237 work_id = dataConId data_con
239 info = noCafNoTyGenIdInfo
240 `setUnfoldingInfo` wrap_unf
241 -- The NoCaf-ness is set by noCafNoTyGenIdInfo
243 -- It's important to specify the arity, so that partial
244 -- applications are treated as values
245 `setAllStrictnessInfo` Just wrap_sig
247 wrap_ty = mkForAllTys all_tyvars (mkFunTys all_arg_tys result_ty)
249 wrap_sig = mkStrictSig (mkTopDmdType arg_dmds res_info)
250 res_info = strictSigResInfo (idNewStrictness work_id)
251 arg_dmds = [Abs | d <- dict_args] ++ map mk_dmd strict_marks
252 mk_dmd str | isMarkedStrict str = evalDmd
253 | otherwise = lazyDmd
254 -- The Cpr info can be important inside INLINE rhss, where the
255 -- wrapper constructor isn't inlined.
256 -- And the argument strictness can be important too; we
257 -- may not inline a contructor when it is partially applied.
259 -- data W = C !Int !Int !Int
260 -- ...(let w = C x in ...(w p q)...)...
261 -- we want to see that w is strict in its two arguments
263 wrap_unf | isNewTyCon tycon
264 = ASSERT( null ex_tyvars && null ex_dict_args && isSingleton orig_arg_tys )
265 -- No existentials on a newtype, but it can have a context
266 -- e.g. newtype Eq a => T a = MkT (...)
267 mkTopUnfolding $ Note InlineMe $
268 mkLams tyvars $ mkLams dict_args $ Lam id_arg1 $
269 mkNewTypeBody tycon result_ty (Var id_arg1)
271 | null dict_args && not (any isMarkedStrict strict_marks)
272 = mkCompulsoryUnfolding (Var work_id)
273 -- The common case. Not only is this efficient,
274 -- but it also ensures that the wrapper is replaced
275 -- by the worker even when there are no args.
279 -- This is really important in rule matching,
280 -- (We could match on the wrappers,
281 -- but that makes it less likely that rules will match
282 -- when we bring bits of unfoldings together.)
284 -- NB: because of this special case, (map (:) ys) turns into
285 -- (map $w: ys). The top-level defn for (:) is never used.
286 -- This is somewhat of a bore, but I'm currently leaving it
287 -- as is, so that there still is a top level curried (:) for
288 -- the interpreter to call.
291 = mkTopUnfolding $ Note InlineMe $
292 mkLams all_tyvars $ mkLams dict_args $
293 mkLams ex_dict_args $ mkLams id_args $
294 foldr mk_case con_app
295 (zip (ex_dict_args++id_args) strict_marks) i3 []
297 con_app i rep_ids = mkApps (Var work_id)
298 (map varToCoreExpr (all_tyvars ++ reverse rep_ids))
300 (tyvars, theta, ex_tyvars, ex_theta, orig_arg_tys, tycon) = dataConSig data_con
301 all_tyvars = tyvars ++ ex_tyvars
303 dict_tys = mkPredTys theta
304 ex_dict_tys = mkPredTys ex_theta
305 all_arg_tys = dict_tys ++ ex_dict_tys ++ orig_arg_tys
306 result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
308 mkLocals i tys = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
312 (dict_args, i1) = mkLocals 1 dict_tys
313 (ex_dict_args,i2) = mkLocals i1 ex_dict_tys
314 (id_args,i3) = mkLocals i2 orig_arg_tys
316 (id_arg1:_) = id_args -- Used for newtype only
318 strict_marks = dataConStrictMarks data_con
321 :: (Id, StrictnessMark) -- Arg, strictness
322 -> (Int -> [Id] -> CoreExpr) -- Body
323 -> Int -- Next rep arg id
324 -> [Id] -- Rep args so far, reversed
326 mk_case (arg,strict) body i rep_args
328 NotMarkedStrict -> body i (arg:rep_args)
330 | isUnLiftedType (idType arg) -> body i (arg:rep_args)
332 Case (Var arg) arg [(DEFAULT,[], body i (arg:rep_args))]
335 -> case splitProductType "do_unbox" (idType arg) of
336 (tycon, tycon_args, con, tys) ->
337 Case (Var arg) arg [(DataAlt con, con_args,
338 body i' (reverse con_args ++ rep_args))]
340 (con_args, i') = mkLocals i tys
344 %************************************************************************
346 \subsection{Record selectors}
348 %************************************************************************
350 We're going to build a record selector unfolding that looks like this:
352 data T a b c = T1 { ..., op :: a, ...}
353 | T2 { ..., op :: a, ...}
356 sel = /\ a b c -> \ d -> case d of
361 Similarly for newtypes
363 newtype N a = MkN { unN :: a->a }
366 unN n = coerce (a->a) n
368 We need to take a little care if the field has a polymorphic type:
370 data R = R { f :: forall a. a->a }
374 f :: forall a. R -> a -> a
375 f = /\ a \ r = case r of
378 (not f :: R -> forall a. a->a, which gives the type inference mechanism
379 problems at call sites)
381 Similarly for newtypes
383 newtype N = MkN { unN :: forall a. a->a }
385 unN :: forall a. N -> a -> a
386 unN = /\a -> \n:N -> coerce (a->a) n
389 mkRecordSelId tycon field_label unpack_id unpackUtf8_id
390 -- Assumes that all fields with the same field label have the same type
392 -- Annoyingly, we have to pass in the unpackCString# Id, because
393 -- we can't conjure it up out of thin air
396 sel_id = mkGlobalId (RecordSelId field_label) (fieldLabelName field_label) selector_ty info
397 field_ty = fieldLabelType field_label
398 data_cons = tyConDataCons tycon
399 tyvars = tyConTyVars tycon -- These scope over the types in
400 -- the FieldLabels of constructors of this type
401 data_ty = mkTyConApp tycon tyvar_tys
402 tyvar_tys = mkTyVarTys tyvars
404 tycon_theta = tyConTheta tycon -- The context on the data decl
405 -- eg data (Eq a, Ord b) => T a b = ...
406 dict_tys = [mkPredTy pred | pred <- tycon_theta,
408 needed_dict pred = or [ tcEqPred pred p
409 | (DataAlt dc, _, _) <- the_alts, p <- dataConTheta dc]
410 n_dict_tys = length dict_tys
412 (field_tyvars,field_theta,field_tau) = tcSplitSigmaTy field_ty
413 field_dict_tys = map mkPredTy field_theta
414 n_field_dict_tys = length field_dict_tys
415 -- If the field has a universally quantified type we have to
416 -- be a bit careful. Suppose we have
417 -- data R = R { op :: forall a. Foo a => a -> a }
418 -- Then we can't give op the type
419 -- op :: R -> forall a. Foo a => a -> a
420 -- because the typechecker doesn't understand foralls to the
421 -- right of an arrow. The "right" type to give it is
422 -- op :: forall a. Foo a => R -> a -> a
423 -- But then we must generate the right unfolding too:
424 -- op = /\a -> \dfoo -> \ r ->
427 -- Note that this is exactly the type we'd infer from a user defn
430 -- Very tiresomely, the selectors are (unnecessarily!) overloaded over
431 -- just the dictionaries in the types of the constructors that contain
432 -- the relevant field. Urgh.
433 -- NB: this code relies on the fact that DataCons are quantified over
434 -- the identical type variables as their parent TyCon
437 selector_ty = mkForAllTys tyvars $ mkForAllTys field_tyvars $
438 mkFunTys dict_tys $ mkFunTys field_dict_tys $
439 mkFunTy data_ty field_tau
441 arity = 1 + n_dict_tys + n_field_dict_tys
443 (strict_sig, rhs_w_str) = dmdAnalTopRhs sel_rhs
444 -- Use the demand analyser to work out strictness.
445 -- With all this unpackery it's not easy!
447 info = noCafNoTyGenIdInfo
448 `setCafInfo` caf_info
450 `setUnfoldingInfo` mkTopUnfolding rhs_w_str
451 `setAllStrictnessInfo` Just strict_sig
453 -- Allocate Ids. We do it a funny way round because field_dict_tys is
454 -- almost always empty. Also note that we use length_tycon_theta
455 -- rather than n_dict_tys, because the latter gives an infinite loop:
456 -- n_dict tys depends on the_alts, which depens on arg_ids, which depends
457 -- on arity, which depends on n_dict tys. Sigh! Mega sigh!
458 field_dict_base = length tycon_theta + 1
459 dict_id_base = field_dict_base + n_field_dict_tys
460 field_base = dict_id_base + 1
461 dict_ids = mkTemplateLocalsNum 1 dict_tys
462 field_dict_ids = mkTemplateLocalsNum field_dict_base field_dict_tys
463 data_id = mkTemplateLocal dict_id_base data_ty
465 alts = map mk_maybe_alt data_cons
466 the_alts = catMaybes alts
468 no_default = all isJust alts -- No default needed
469 default_alt | no_default = []
470 | otherwise = [(DEFAULT, [], error_expr)]
472 -- the default branch may have CAF refs, because it calls recSelError etc.
473 caf_info | no_default = NoCafRefs
474 | otherwise = MayHaveCafRefs
476 sel_rhs = mkLams tyvars $ mkLams field_tyvars $
477 mkLams dict_ids $ mkLams field_dict_ids $
478 Lam data_id $ sel_body
480 sel_body | isNewTyCon tycon = mkNewTypeBody tycon field_tau (mk_result data_id)
481 | otherwise = Case (Var data_id) data_id (default_alt ++ the_alts)
483 mk_result result_id = mkVarApps (mkVarApps (Var result_id) field_tyvars) field_dict_ids
484 -- We pull the field lambdas to the top, so we need to
485 -- apply them in the body. For example:
486 -- data T = MkT { foo :: forall a. a->a }
488 -- foo :: forall a. T -> a -> a
489 -- foo = /\a. \t:T. case t of { MkT f -> f a }
491 mk_maybe_alt data_con
492 = case maybe_the_arg_id of
494 Just the_arg_id -> Just (DataAlt data_con, real_args, mkLets binds body)
496 body = mk_result the_arg_id
497 strict_marks = dataConStrictMarks data_con
498 (binds, real_args) = rebuildConArgs arg_ids strict_marks
499 (map mkBuiltinUnique [unpack_base..])
501 arg_ids = mkTemplateLocalsNum field_base (dataConInstOrigArgTys data_con tyvar_tys)
503 unpack_base = field_base + length arg_ids
505 -- arity+1 avoids all shadowing
506 maybe_the_arg_id = assocMaybe (field_lbls `zip` arg_ids) field_label
507 field_lbls = dataConFieldLabels data_con
509 error_expr = mkApps (Var rEC_SEL_ERROR_ID) [Type field_tau, err_string]
511 | all safeChar full_msg
512 = App (Var unpack_id) (Lit (MachStr (_PK_ full_msg)))
514 = App (Var unpackUtf8_id) (Lit (MachStr (_PK_ (stringToUtf8 (map ord full_msg)))))
516 safeChar c = c >= '\1' && c <= '\xFF'
517 -- TODO: Putting this Unicode stuff here is ugly. Find a better
518 -- generic place to make string literals. This logic is repeated
520 full_msg = showSDoc (sep [text "No match in record selector", ppr sel_id])
523 -- This rather ugly function converts the unpacked data con
524 -- arguments back into their packed form.
527 :: [Id] -- Source-level args
528 -> [StrictnessMark] -- Strictness annotations (per-arg)
529 -> [Unique] -- Uniques for the new Ids
530 -> ([CoreBind], [Id]) -- A binding for each source-level arg, plus
531 -- a list of the representation-level arguments
532 -- e.g. data T = MkT Int !Int
534 -- rebuild [x::Int, y::Int] [Not, Unbox]
535 -- = ([ y = I# t ], [x,t])
537 rebuildConArgs [] stricts us = ([], [])
539 -- Type variable case
540 rebuildConArgs (arg:args) stricts us
542 = let (binds, args') = rebuildConArgs args stricts us
543 in (binds, arg:args')
545 -- Term variable case
546 rebuildConArgs (arg:args) (str:stricts) us
547 | isMarkedUnboxed str
551 (_, tycon_args, pack_con, con_arg_tys)
552 = splitProductType "rebuildConArgs" arg_ty
554 unpacked_args = zipWith (mkSysLocal FSLIT("rb")) us con_arg_tys
555 (binds, args') = rebuildConArgs args stricts (dropList con_arg_tys us)
556 con_app = mkConApp pack_con (map Type tycon_args ++ map Var unpacked_args)
558 (NonRec arg con_app : binds, unpacked_args ++ args')
561 = let (binds, args') = rebuildConArgs args stricts us
562 in (binds, arg:args')
566 %************************************************************************
568 \subsection{Dictionary selectors}
570 %************************************************************************
572 Selecting a field for a dictionary. If there is just one field, then
573 there's nothing to do.
575 ToDo: unify with mkRecordSelId.
578 mkDictSelId :: Name -> Class -> Id
579 mkDictSelId name clas
580 = mkGlobalId (RecordSelId field_lbl) name sel_ty info
582 sel_ty = mkForAllTys tyvars (mkFunTy (idType dict_id) (idType the_arg_id))
583 -- We can't just say (exprType rhs), because that would give a type
585 -- for a single-op class (after all, the selector is the identity)
586 -- But it's type must expose the representation of the dictionary
587 -- to gat (say) C a -> (a -> a)
589 field_lbl = mkFieldLabel name tycon sel_ty tag
590 tag = assoc "MkId.mkDictSelId" (map idName (classSelIds clas) `zip` allFieldLabelTags) name
592 info = noCafNoTyGenIdInfo
594 `setUnfoldingInfo` mkTopUnfolding rhs
595 `setAllStrictnessInfo` Just strict_sig
597 -- We no longer use 'must-inline' on record selectors. They'll
598 -- inline like crazy if they scrutinise a constructor
600 -- The strictness signature is of the form U(AAAVAAAA) -> T
601 -- where the V depends on which item we are selecting
602 -- It's worth giving one, so that absence info etc is generated
603 -- even if the selector isn't inlined
604 strict_sig = mkStrictSig (mkTopDmdType [arg_dmd] TopRes)
605 arg_dmd | isNewTyCon tycon = evalDmd
606 | otherwise = Eval (Prod [ if the_arg_id == id then evalDmd else Abs
609 tyvars = classTyVars clas
611 tycon = classTyCon clas
612 [data_con] = tyConDataCons tycon
613 tyvar_tys = mkTyVarTys tyvars
614 arg_tys = dataConArgTys data_con tyvar_tys
615 the_arg_id = arg_ids !! (tag - firstFieldLabelTag)
617 pred = mkClassPred clas tyvar_tys
618 (dict_id:arg_ids) = mkTemplateLocals (mkPredTy pred : arg_tys)
620 rhs | isNewTyCon tycon = mkLams tyvars $ Lam dict_id $
621 mkNewTypeBody tycon (head arg_tys) (Var dict_id)
622 | otherwise = mkLams tyvars $ Lam dict_id $
623 Case (Var dict_id) dict_id
624 [(DataAlt data_con, arg_ids, Var the_arg_id)]
626 mkNewTypeBody tycon result_ty result_expr
627 -- Adds a coerce where necessary
628 -- Used for both wrapping and unwrapping
629 | isRecursiveTyCon tycon -- Recursive case; use a coerce
630 = Note (Coerce result_ty (exprType result_expr)) result_expr
631 | otherwise -- Normal case
636 %************************************************************************
638 \subsection{Primitive operations
640 %************************************************************************
643 mkPrimOpId :: PrimOp -> Id
647 (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
648 ty = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
649 name = mkPrimOpIdName prim_op
650 id = mkGlobalId (PrimOpId prim_op) name ty info
652 info = noCafNoTyGenIdInfo
655 `setAllStrictnessInfo` Just strict_sig
657 rules = foldl (addRule id) emptyCoreRules (primOpRules prim_op)
660 -- For each ccall we manufacture a separate CCallOpId, giving it
661 -- a fresh unique, a type that is correct for this particular ccall,
662 -- and a CCall structure that gives the correct details about calling
665 -- The *name* of this Id is a local name whose OccName gives the full
666 -- details of the ccall, type and all. This means that the interface
667 -- file reader can reconstruct a suitable Id
669 mkFCallId :: Unique -> ForeignCall -> Type -> Id
670 mkFCallId uniq fcall ty
671 = ASSERT( isEmptyVarSet (tyVarsOfType ty) )
672 -- A CCallOpId should have no free type variables;
673 -- when doing substitutions won't substitute over it
674 mkGlobalId (FCallId fcall) name ty info
676 occ_str = showSDoc (braces (ppr fcall <+> ppr ty))
677 -- The "occurrence name" of a ccall is the full info about the
678 -- ccall; it is encoded, but may have embedded spaces etc!
680 name = mkFCallName uniq occ_str
682 info = noCafNoTyGenIdInfo
684 `setAllStrictnessInfo` Just strict_sig
686 (_, tau) = tcSplitForAllTys ty
687 (arg_tys, _) = tcSplitFunTys tau
688 arity = length arg_tys
689 strict_sig = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
693 %************************************************************************
695 \subsection{DictFuns and default methods}
697 %************************************************************************
699 Important notes about dict funs and default methods
700 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
701 Dict funs and default methods are *not* ImplicitIds. Their definition
702 involves user-written code, so we can't figure out their strictness etc
703 based on fixed info, as we can for constructors and record selectors (say).
705 We build them as GlobalIds, but when in the module where they are
706 bound, we turn the Id at the *binding site* into an exported LocalId.
707 This ensures that they are taken to account by free-variable finding
708 and dependency analysis (e.g. CoreFVs.exprFreeVars). The simplifier
709 will propagate the LocalId to all occurrence sites.
711 Why shouldn't they be bound as GlobalIds? Because, in particular, if
712 they are globals, the specialiser floats dict uses above their defns,
713 which prevents good simplifications happening. Also the strictness
714 analyser treats a occurrence of a GlobalId as imported and assumes it
715 contains strictness in its IdInfo, which isn't true if the thing is
716 bound in the same module as the occurrence.
718 It's OK for dfuns to be LocalIds, because we form the instance-env to
719 pass on to the next module (md_insts) in CoreTidy, afer tidying
720 and globalising the top-level Ids.
722 BUT make sure they are *exported* LocalIds (setIdLocalExported) so
723 that they aren't discarded by the occurrence analyser.
726 mkDefaultMethodId dm_name ty = mkVanillaGlobal dm_name ty noCafNoTyGenIdInfo
728 mkDictFunId :: Name -- Name to use for the dict fun;
735 mkDictFunId dfun_name clas inst_tyvars inst_tys dfun_theta
736 = mkVanillaGlobal dfun_name dfun_ty noCafNoTyGenIdInfo
738 dfun_ty = mkSigmaTy inst_tyvars dfun_theta (mkDictTy clas inst_tys)
740 {- 1 dec 99: disable the Mark Jones optimisation for the sake
741 of compatibility with Hugs.
742 See `types/InstEnv' for a discussion related to this.
744 (class_tyvars, sc_theta, _, _) = classBigSig clas
745 not_const (clas, tys) = not (isEmptyVarSet (tyVarsOfTypes tys))
746 sc_theta' = substClasses (mkTopTyVarSubst class_tyvars inst_tys) sc_theta
747 dfun_theta = case inst_decl_theta of
748 [] -> [] -- If inst_decl_theta is empty, then we don't
749 -- want to have any dict arguments, so that we can
750 -- expose the constant methods.
752 other -> nub (inst_decl_theta ++ filter not_const sc_theta')
753 -- Otherwise we pass the superclass dictionaries to
754 -- the dictionary function; the Mark Jones optimisation.
756 -- NOTE the "nub". I got caught by this one:
757 -- class Monad m => MonadT t m where ...
758 -- instance Monad m => MonadT (EnvT env) m where ...
759 -- Here, the inst_decl_theta has (Monad m); but so
760 -- does the sc_theta'!
762 -- NOTE the "not_const". I got caught by this one too:
763 -- class Foo a => Baz a b where ...
764 -- instance Wob b => Baz T b where..
765 -- Now sc_theta' has Foo T
770 %************************************************************************
772 \subsection{Un-definable}
774 %************************************************************************
776 These Ids can't be defined in Haskell. They could be defined in
777 unfoldings in PrelGHC.hi-boot, but we'd have to ensure that they
778 were definitely, definitely inlined, because there is no curried
779 identifier for them. That's what mkCompulsoryUnfolding does.
780 If we had a way to get a compulsory unfolding from an interface file,
781 we could do that, but we don't right now.
783 unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
784 just gets expanded into a type coercion wherever it occurs. Hence we
785 add it as a built-in Id with an unfolding here.
787 The type variables we use here are "open" type variables: this means
788 they can unify with both unlifted and lifted types. Hence we provide
789 another gun with which to shoot yourself in the foot.
792 -- unsafeCoerce# :: forall a b. a -> b
794 = pcMiscPrelId unsafeCoerceIdKey gHC_PRIM FSLIT("unsafeCoerce#") ty info
796 info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
799 ty = mkForAllTys [openAlphaTyVar,openBetaTyVar]
800 (mkFunTy openAlphaTy openBetaTy)
801 [x] = mkTemplateLocals [openAlphaTy]
802 rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
803 Note (Coerce openBetaTy openAlphaTy) (Var x)
805 -- nullAddr# :: Addr#
806 -- The reason is is here is because we don't provide
807 -- a way to write this literal in Haskell.
809 = pcMiscPrelId nullAddrIdKey gHC_PRIM FSLIT("nullAddr#") addrPrimTy info
811 info = noCafNoTyGenIdInfo `setUnfoldingInfo`
812 mkCompulsoryUnfolding (Lit nullAddrLit)
815 = pcMiscPrelId seqIdKey gHC_PRIM FSLIT("seq") ty info
817 info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
820 ty = mkForAllTys [alphaTyVar,betaTyVar]
821 (mkFunTy alphaTy (mkFunTy betaTy betaTy))
822 [x,y] = mkTemplateLocals [alphaTy, betaTy]
823 rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x [(DEFAULT, [], Var y)])
826 @getTag#@ is another function which can't be defined in Haskell. It needs to
827 evaluate its argument and call the dataToTag# primitive.
831 = pcMiscPrelId getTagIdKey gHC_PRIM FSLIT("getTag#") ty info
833 info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
834 -- We don't provide a defn for this; you must inline it
836 ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy intPrimTy)
837 [x,y] = mkTemplateLocals [alphaTy,alphaTy]
838 rhs = mkLams [alphaTyVar,x] $
839 Case (Var x) y [ (DEFAULT, [], mkApps (Var dataToTagId) [Type alphaTy, Var y]) ]
841 dataToTagId = mkPrimOpId DataToTagOp
844 @realWorld#@ used to be a magic literal, \tr{void#}. If things get
845 nasty as-is, change it back to a literal (@Literal@).
847 voidArgId is a Local Id used simply as an argument in functions
848 where we just want an arg to avoid having a thunk of unlifted type.
850 x = \ void :: State# RealWorld -> (# p, q #)
852 This comes up in strictness analysis
855 realWorldPrimId -- :: State# RealWorld
856 = pcMiscPrelId realWorldPrimIdKey gHC_PRIM FSLIT("realWorld#")
858 (noCafNoTyGenIdInfo `setUnfoldingInfo` mkOtherCon [])
859 -- The mkOtherCon makes it look that realWorld# is evaluated
860 -- which in turn makes Simplify.interestingArg return True,
861 -- which in turn makes INLINE things applied to realWorld# likely
864 voidArgId -- :: State# RealWorld
865 = mkSysLocal FSLIT("void") voidArgIdKey realWorldStatePrimTy
869 %************************************************************************
871 \subsection[PrelVals-error-related]{@error@ and friends; @trace@}
873 %************************************************************************
875 GHC randomly injects these into the code.
877 @patError@ is just a version of @error@ for pattern-matching
878 failures. It knows various ``codes'' which expand to longer
879 strings---this saves space!
881 @absentErr@ is a thing we put in for ``absent'' arguments. They jolly
882 well shouldn't be yanked on, but if one is, then you will get a
883 friendly message from @absentErr@ (rather than a totally random
886 @parError@ is a special version of @error@ which the compiler does
887 not know to be a bottoming Id. It is used in the @_par_@ and @_seq_@
888 templates, but we don't ever expect to generate code for it.
892 = pc_bottoming_Id errorIdKey pREL_ERR FSLIT("error") errorTy
894 = pc_bottoming_Id errorCStringIdKey pREL_ERR FSLIT("errorCString")
895 (mkSigmaTy [openAlphaTyVar] [] (mkFunTy addrPrimTy openAlphaTy))
897 = generic_ERROR_ID patErrorIdKey FSLIT("patError")
899 = generic_ERROR_ID recSelErrIdKey FSLIT("recSelError")
901 = generic_ERROR_ID recConErrorIdKey FSLIT("recConError")
903 = generic_ERROR_ID recUpdErrorIdKey FSLIT("recUpdError")
905 = generic_ERROR_ID irrefutPatErrorIdKey FSLIT("irrefutPatError")
906 nON_EXHAUSTIVE_GUARDS_ERROR_ID
907 = generic_ERROR_ID nonExhaustiveGuardsErrorIdKey FSLIT("nonExhaustiveGuardsError")
908 nO_METHOD_BINDING_ERROR_ID
909 = generic_ERROR_ID noMethodBindingErrorIdKey FSLIT("noMethodBindingError")
912 = pc_bottoming_Id absentErrorIdKey pREL_ERR FSLIT("absentErr")
913 (mkSigmaTy [openAlphaTyVar] [] openAlphaTy)
916 = pcMiscPrelId parErrorIdKey pREL_ERR FSLIT("parError")
917 (mkSigmaTy [openAlphaTyVar] [] openAlphaTy) noCafNoTyGenIdInfo
921 %************************************************************************
923 \subsection{Utilities}
925 %************************************************************************
928 pcMiscPrelId :: Unique{-IdKey-} -> Module -> FAST_STRING -> Type -> IdInfo -> Id
929 pcMiscPrelId key mod str ty info
931 name = mkWiredInName mod (mkVarOcc str) key
932 imp = mkVanillaGlobal name ty info -- the usual case...
935 -- We lie and say the thing is imported; otherwise, we get into
936 -- a mess with dependency analysis; e.g., core2stg may heave in
937 -- random calls to GHCbase.unpackPS__. If GHCbase is the module
938 -- being compiled, then it's just a matter of luck if the definition
939 -- will be in "the right place" to be in scope.
941 pc_bottoming_Id key mod name ty
942 = pcMiscPrelId key mod name ty bottoming_info
944 strict_sig = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
945 bottoming_info = noCafNoTyGenIdInfo `setAllStrictnessInfo` Just strict_sig
946 -- these "bottom" out, no matter what their arguments
948 generic_ERROR_ID u n = pc_bottoming_Id u pREL_ERR n errorTy
950 (openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars
951 openAlphaTy = mkTyVarTy openAlphaTyVar
952 openBetaTy = mkTyVarTy openBetaTyVar
955 errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy]
957 -- Notice the openAlphaTyVar. It says that "error" can be applied
958 -- to unboxed as well as boxed types. This is OK because it never
959 -- returns, so the return type is irrelevant.