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 Module ( Module )
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 ( mkWiredInName, mkFCallName, Name )
62 import OccName ( mkVarOcc )
63 import PrimOp ( PrimOp(DataToTagOp), primOpSig, mkPrimOpIdName )
64 import ForeignCall ( ForeignCall )
65 import DataCon ( DataCon,
66 dataConFieldLabels, dataConRepArity, dataConTyCon,
67 dataConArgTys, dataConRepType,
69 dataConName, dataConTheta,
70 dataConSig, dataConStrictMarks, dataConWorkId,
73 import Id ( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal,
74 mkTemplateLocals, mkTemplateLocalsNum,
75 mkTemplateLocal, idNewStrictness, idName
77 import IdInfo ( IdInfo, noCafIdInfo,
79 setArityInfo, setSpecInfo, setCafInfo,
81 GlobalIdDetails(..), CafInfo(..)
83 import NewDemand ( mkStrictSig, strictSigResInfo, DmdResult(..),
84 mkTopDmdType, topDmd, evalDmd, lazyDmd, retCPR,
85 Demand(..), Demands(..) )
86 import FieldLabel ( mkFieldLabel, fieldLabelName,
87 firstFieldLabelTag, allFieldLabelTags, fieldLabelType
89 import DmdAnal ( dmdAnalTopRhs )
91 import Unique ( mkBuiltinUnique )
94 import Maybe ( isJust )
95 import Util ( dropList, isSingleton )
98 import ListSetOps ( assoc, assocMaybe )
99 import UnicodeUtil ( stringToUtf8 )
100 import List ( nubBy )
104 %************************************************************************
106 \subsection{Wired in Ids}
108 %************************************************************************
112 = [ -- These error-y things are wired in because we don't yet have
113 -- a way to express in an interface file that the result type variable
114 -- is 'open'; that is can be unified with an unboxed type
116 -- [The interface file format now carry such information, but there's
117 -- no way yet of expressing at the definition site for these
118 -- error-reporting functions that they have an 'open'
119 -- result type. -- sof 1/99]
121 eRROR_ID, -- This one isn't used anywhere else in the compiler
122 -- But we still need it in wiredInIds so that when GHC
123 -- compiles a program that mentions 'error' we don't
124 -- import its type from the interface file; we just get
125 -- the Id defined here. Which has an 'open-tyvar' type.
128 iRREFUT_PAT_ERROR_ID,
129 nON_EXHAUSTIVE_GUARDS_ERROR_ID,
130 nO_METHOD_BINDING_ERROR_ID,
137 -- These Ids are exported from GHC.Prim
139 = [ -- These can't be defined in Haskell, but they have
140 -- perfectly reasonable unfoldings in Core
149 %************************************************************************
151 \subsection{Data constructors}
153 %************************************************************************
156 mkDataConId :: Name -> DataCon -> Id
157 -- Makes the *worker* for the data constructor; that is, the function
158 -- that takes the reprsentation arguments and builds the constructor.
159 mkDataConId work_name data_con
160 = mkGlobalId (DataConId data_con) work_name (dataConRepType data_con) info
164 `setAllStrictnessInfo` Just strict_sig
166 arity = dataConRepArity data_con
168 strict_sig = mkStrictSig (mkTopDmdType (replicate arity topDmd) cpr_info)
169 -- Notice that we do *not* say the worker is strict
170 -- even if the data constructor is declared strict
171 -- e.g. data T = MkT !(Int,Int)
172 -- Why? Because the *wrapper* is strict (and its unfolding has case
173 -- expresssions that do the evals) but the *worker* itself is not.
174 -- If we pretend it is strict then when we see
175 -- case x of y -> $wMkT y
176 -- the simplifier thinks that y is "sure to be evaluated" (because
177 -- $wMkT is strict) and drops the case. No, $wMkT is not strict.
179 -- When the simplifer sees a pattern
180 -- case e of MkT x -> ...
181 -- it uses the dataConRepStrictness of MkT to mark x as evaluated;
182 -- but that's fine... dataConRepStrictness comes from the data con
183 -- not from the worker Id.
185 tycon = dataConTyCon data_con
186 cpr_info | isProductTyCon tycon &&
189 arity <= mAX_CPR_SIZE = retCPR
191 -- RetCPR is only true for products that are real data types;
192 -- that is, not unboxed tuples or [non-recursive] newtypes
194 mAX_CPR_SIZE :: Arity
196 -- We do not treat very big tuples as CPR-ish:
197 -- a) for a start we get into trouble because there aren't
198 -- "enough" unboxed tuple types (a tiresome restriction,
200 -- b) more importantly, big unboxed tuples get returned mainly
201 -- on the stack, and are often then allocated in the heap
202 -- by the caller. So doing CPR for them may in fact make
206 The wrapper for a constructor is an ordinary top-level binding that evaluates
207 any strict args, unboxes any args that are going to be flattened, and calls
210 We're going to build a constructor that looks like:
212 data (Data a, C b) => T a b = T1 !a !Int b
215 \d1::Data a, d2::C b ->
216 \p q r -> case p of { p ->
218 Con T1 [a,b] [p,q,r]}}
222 * d2 is thrown away --- a context in a data decl is used to make sure
223 one *could* construct dictionaries at the site the constructor
224 is used, but the dictionary isn't actually used.
226 * We have to check that we can construct Data dictionaries for
227 the types a and Int. Once we've done that we can throw d1 away too.
229 * We use (case p of q -> ...) to evaluate p, rather than "seq" because
230 all that matters is that the arguments are evaluated. "seq" is
231 very careful to preserve evaluation order, which we don't need
234 You might think that we could simply give constructors some strictness
235 info, like PrimOps, and let CoreToStg do the let-to-case transformation.
236 But we don't do that because in the case of primops and functions strictness
237 is a *property* not a *requirement*. In the case of constructors we need to
238 do something active to evaluate the argument.
240 Making an explicit case expression allows the simplifier to eliminate
241 it in the (common) case where the constructor arg is already evaluated.
244 mkDataConWrapId data_con
245 = mkGlobalId (DataConWrapId data_con) (dataConName data_con) wrap_ty info
247 work_id = dataConWorkId data_con
250 `setUnfoldingInfo` wrap_unf
251 -- The NoCaf-ness is set by noCafIdInfo
253 -- It's important to specify the arity, so that partial
254 -- applications are treated as values
255 `setAllStrictnessInfo` Just wrap_sig
257 wrap_sig = mkStrictSig (mkTopDmdType arg_dmds res_info)
258 res_info = strictSigResInfo (idNewStrictness work_id)
259 arg_dmds = map mk_dmd strict_marks
260 mk_dmd str | isMarkedStrict str = evalDmd
261 | otherwise = lazyDmd
262 -- The Cpr info can be important inside INLINE rhss, where the
263 -- wrapper constructor isn't inlined.
264 -- And the argument strictness can be important too; we
265 -- may not inline a contructor when it is partially applied.
267 -- data W = C !Int !Int !Int
268 -- ...(let w = C x in ...(w p q)...)...
269 -- we want to see that w is strict in its two arguments
271 wrap_unf | isNewTyCon tycon
272 = ASSERT( null ex_tyvars && null ex_dict_args && isSingleton orig_arg_tys )
273 -- No existentials on a newtype, but it can have a context
274 -- e.g. newtype Eq a => T a = MkT (...)
275 mkTopUnfolding $ Note InlineMe $
276 mkLams tyvars $ Lam id_arg1 $
277 mkNewTypeBody tycon result_ty (Var id_arg1)
279 | not (any isMarkedStrict strict_marks)
280 = mkCompulsoryUnfolding (Var work_id)
281 -- The common case. Not only is this efficient,
282 -- but it also ensures that the wrapper is replaced
283 -- by the worker even when there are no args.
287 -- This is really important in rule matching,
288 -- (We could match on the wrappers,
289 -- but that makes it less likely that rules will match
290 -- when we bring bits of unfoldings together.)
292 -- NB: because of this special case, (map (:) ys) turns into
293 -- (map $w: ys). The top-level defn for (:) is never used.
294 -- This is somewhat of a bore, but I'm currently leaving it
295 -- as is, so that there still is a top level curried (:) for
296 -- the interpreter to call.
299 = mkTopUnfolding $ Note InlineMe $
301 mkLams ex_dict_args $ mkLams id_args $
302 foldr mk_case con_app
303 (zip (ex_dict_args++id_args) strict_marks) i3 []
305 con_app i rep_ids = mkApps (Var work_id)
306 (map varToCoreExpr (all_tyvars ++ reverse rep_ids))
308 (tyvars, _, ex_tyvars, ex_theta, orig_arg_tys, tycon) = dataConSig data_con
309 all_tyvars = tyvars ++ ex_tyvars
311 ex_dict_tys = mkPredTys ex_theta
312 all_arg_tys = ex_dict_tys ++ orig_arg_tys
313 result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
315 wrap_ty = mkForAllTys all_tyvars (mkFunTys all_arg_tys result_ty)
316 -- We used to include the stupid theta in the wrapper's args
317 -- but now we don't. Instead the type checker just injects these
318 -- extra constraints where necessary.
320 mkLocals i tys = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
324 (ex_dict_args,i2) = mkLocals 1 ex_dict_tys
325 (id_args,i3) = mkLocals i2 orig_arg_tys
327 (id_arg1:_) = id_args -- Used for newtype only
329 strict_marks = dataConStrictMarks data_con
332 :: (Id, StrictnessMark) -- Arg, strictness
333 -> (Int -> [Id] -> CoreExpr) -- Body
334 -> Int -- Next rep arg id
335 -> [Id] -- Rep args so far, reversed
337 mk_case (arg,strict) body i rep_args
339 NotMarkedStrict -> body i (arg:rep_args)
341 | isUnLiftedType (idType arg) -> body i (arg:rep_args)
343 Case (Var arg) arg [(DEFAULT,[], body i (arg:rep_args))]
346 -> case splitProductType "do_unbox" (idType arg) of
347 (tycon, tycon_args, con, tys) ->
348 Case (Var arg) arg [(DataAlt con, con_args,
349 body i' (reverse con_args ++ rep_args))]
351 (con_args, i') = mkLocals i tys
355 %************************************************************************
357 \subsection{Record selectors}
359 %************************************************************************
361 We're going to build a record selector unfolding that looks like this:
363 data T a b c = T1 { ..., op :: a, ...}
364 | T2 { ..., op :: a, ...}
367 sel = /\ a b c -> \ d -> case d of
372 Similarly for newtypes
374 newtype N a = MkN { unN :: a->a }
377 unN n = coerce (a->a) n
379 We need to take a little care if the field has a polymorphic type:
381 data R = R { f :: forall a. a->a }
385 f :: forall a. R -> a -> a
386 f = /\ a \ r = case r of
389 (not f :: R -> forall a. a->a, which gives the type inference mechanism
390 problems at call sites)
392 Similarly for newtypes
394 newtype N = MkN { unN :: forall a. a->a }
396 unN :: forall a. N -> a -> a
397 unN = /\a -> \n:N -> coerce (a->a) n
400 mkRecordSelId tycon field_label
401 -- Assumes that all fields with the same field label have the same type
403 -- Annoyingly, we have to pass in the unpackCString# Id, because
404 -- we can't conjure it up out of thin air
407 sel_id = mkGlobalId (RecordSelId field_label) (fieldLabelName field_label) selector_ty info
408 field_ty = fieldLabelType field_label
409 data_cons = tyConDataCons tycon
410 tyvars = tyConTyVars tycon -- These scope over the types in
411 -- the FieldLabels of constructors of this type
412 data_ty = mkTyConApp tycon tyvar_tys
413 tyvar_tys = mkTyVarTys tyvars
415 -- Very tiresomely, the selectors are (unnecessarily!) overloaded over
416 -- just the dictionaries in the types of the constructors that contain
417 -- the relevant field. [The Report says that pattern matching on a
418 -- constructor gives the same constraints as applying it.] Urgh.
420 -- However, not all data cons have all constraints (because of
421 -- TcTyDecls.thinContext). So we need to find all the data cons
422 -- involved in the pattern match and take the union of their constraints.
424 -- NB: this code relies on the fact that DataCons are quantified over
425 -- the identical type variables as their parent TyCon
426 tycon_theta = tyConTheta tycon -- The context on the data decl
427 -- eg data (Eq a, Ord b) => T a b = ...
428 needed_preds = [pred | (DataAlt dc, _, _) <- the_alts, pred <- dataConTheta dc]
429 dict_tys = map mkPredTy (nubBy tcEqPred needed_preds)
430 n_dict_tys = length dict_tys
432 (field_tyvars,field_theta,field_tau) = tcSplitSigmaTy field_ty
433 field_dict_tys = map mkPredTy field_theta
434 n_field_dict_tys = length field_dict_tys
435 -- If the field has a universally quantified type we have to
436 -- be a bit careful. Suppose we have
437 -- data R = R { op :: forall a. Foo a => a -> a }
438 -- Then we can't give op the type
439 -- op :: R -> forall a. Foo a => a -> a
440 -- because the typechecker doesn't understand foralls to the
441 -- right of an arrow. The "right" type to give it is
442 -- op :: forall a. Foo a => R -> a -> a
443 -- But then we must generate the right unfolding too:
444 -- op = /\a -> \dfoo -> \ r ->
447 -- Note that this is exactly the type we'd infer from a user defn
451 selector_ty = mkForAllTys tyvars $ mkForAllTys field_tyvars $
452 mkFunTys dict_tys $ mkFunTys field_dict_tys $
453 mkFunTy data_ty field_tau
455 arity = 1 + n_dict_tys + n_field_dict_tys
457 (strict_sig, rhs_w_str) = dmdAnalTopRhs sel_rhs
458 -- Use the demand analyser to work out strictness.
459 -- With all this unpackery it's not easy!
462 `setCafInfo` caf_info
464 `setUnfoldingInfo` mkTopUnfolding rhs_w_str
465 `setAllStrictnessInfo` Just strict_sig
467 -- Allocate Ids. We do it a funny way round because field_dict_tys is
468 -- almost always empty. Also note that we use length_tycon_theta
469 -- rather than n_dict_tys, because the latter gives an infinite loop:
470 -- n_dict tys depends on the_alts, which depens on arg_ids, which depends
471 -- on arity, which depends on n_dict tys. Sigh! Mega sigh!
472 field_dict_base = length tycon_theta + 1
473 dict_id_base = field_dict_base + n_field_dict_tys
474 field_base = dict_id_base + 1
475 dict_ids = mkTemplateLocalsNum 1 dict_tys
476 field_dict_ids = mkTemplateLocalsNum field_dict_base field_dict_tys
477 data_id = mkTemplateLocal dict_id_base data_ty
479 alts = map mk_maybe_alt data_cons
480 the_alts = catMaybes alts
482 no_default = all isJust alts -- No default needed
483 default_alt | no_default = []
484 | otherwise = [(DEFAULT, [], error_expr)]
486 -- the default branch may have CAF refs, because it calls recSelError etc.
487 caf_info | no_default = NoCafRefs
488 | otherwise = MayHaveCafRefs
490 sel_rhs = mkLams tyvars $ mkLams field_tyvars $
491 mkLams dict_ids $ mkLams field_dict_ids $
492 Lam data_id $ sel_body
494 sel_body | isNewTyCon tycon = mkNewTypeBody tycon field_tau (mk_result data_id)
495 | otherwise = Case (Var data_id) data_id (default_alt ++ the_alts)
497 mk_result result_id = mkVarApps (mkVarApps (Var result_id) field_tyvars) field_dict_ids
498 -- We pull the field lambdas to the top, so we need to
499 -- apply them in the body. For example:
500 -- data T = MkT { foo :: forall a. a->a }
502 -- foo :: forall a. T -> a -> a
503 -- foo = /\a. \t:T. case t of { MkT f -> f a }
505 mk_maybe_alt data_con
506 = case maybe_the_arg_id of
508 Just the_arg_id -> Just (mkReboxingAlt uniqs data_con arg_ids body)
510 body = mk_result the_arg_id
512 arg_ids = mkTemplateLocalsNum field_base (dataConOrigArgTys data_con)
513 -- No need to instantiate; same tyvars in datacon as tycon
515 unpack_base = field_base + length arg_ids
516 uniqs = map mkBuiltinUnique [unpack_base..]
518 -- arity+1 avoids all shadowing
519 maybe_the_arg_id = assocMaybe (field_lbls `zip` arg_ids) field_label
520 field_lbls = dataConFieldLabels data_con
522 error_expr = mkRuntimeErrorApp rEC_SEL_ERROR_ID field_tau full_msg
523 full_msg = showSDoc (sep [text "No match in record selector", ppr sel_id])
526 -- (mkReboxingAlt us con xs rhs) basically constructs the case
527 -- alternative (con, xs, rhs)
528 -- but it does the reboxing necessary to construct the *source*
529 -- arguments, xs, from the representation arguments ys.
531 -- data T = MkT !(Int,Int) Bool
533 -- mkReboxingAlt MkT [x,b] r
534 -- = (DataAlt MkT, [y::Int,z::Int,b], let x = (y,z) in r)
536 -- mkDataAlt should really be in DataCon, but it can't because
537 -- it manipulates CoreSyn.
540 :: [Unique] -- Uniques for the new Ids
542 -> [Var] -- Source-level args
546 mkReboxingAlt us con args rhs
547 | not (any isMarkedUnboxed stricts)
548 = (DataAlt con, args, rhs)
552 (binds, args') = go args stricts us
554 (DataAlt con, args', mkLets binds rhs)
557 stricts = dataConStrictMarks con
559 go [] stricts us = ([], [])
561 -- Type variable case
562 go (arg:args) stricts us
564 = let (binds, args') = go args stricts us
565 in (binds, arg:args')
567 -- Term variable case
568 go (arg:args) (str:stricts) us
569 | isMarkedUnboxed str
571 (_, tycon_args, pack_con, con_arg_tys)
572 = splitProductType "mkReboxingAlt" (idType arg)
574 unpacked_args = zipWith (mkSysLocal FSLIT("rb")) us con_arg_tys
575 (binds, args') = go args stricts (dropList con_arg_tys us)
576 con_app = mkConApp pack_con (map Type tycon_args ++ map Var unpacked_args)
578 (NonRec arg con_app : binds, unpacked_args ++ args')
581 = let (binds, args') = go args stricts us
582 in (binds, arg:args')
586 %************************************************************************
588 \subsection{Dictionary selectors}
590 %************************************************************************
592 Selecting a field for a dictionary. If there is just one field, then
593 there's nothing to do.
595 ToDo: unify with mkRecordSelId.
598 mkDictSelId :: Name -> Class -> Id
599 mkDictSelId name clas
600 = mkGlobalId (RecordSelId field_lbl) name sel_ty info
602 sel_ty = mkForAllTys tyvars (mkFunTy (idType dict_id) (idType the_arg_id))
603 -- We can't just say (exprType rhs), because that would give a type
605 -- for a single-op class (after all, the selector is the identity)
606 -- But it's type must expose the representation of the dictionary
607 -- to gat (say) C a -> (a -> a)
609 field_lbl = mkFieldLabel name tycon sel_ty tag
610 tag = assoc "MkId.mkDictSelId" (map idName (classSelIds clas) `zip` allFieldLabelTags) name
614 `setUnfoldingInfo` mkTopUnfolding rhs
615 `setAllStrictnessInfo` Just strict_sig
617 -- We no longer use 'must-inline' on record selectors. They'll
618 -- inline like crazy if they scrutinise a constructor
620 -- The strictness signature is of the form U(AAAVAAAA) -> T
621 -- where the V depends on which item we are selecting
622 -- It's worth giving one, so that absence info etc is generated
623 -- even if the selector isn't inlined
624 strict_sig = mkStrictSig (mkTopDmdType [arg_dmd] TopRes)
625 arg_dmd | isNewTyCon tycon = evalDmd
626 | otherwise = Eval (Prod [ if the_arg_id == id then evalDmd else Abs
629 tyvars = classTyVars clas
631 tycon = classTyCon clas
632 [data_con] = tyConDataCons tycon
633 tyvar_tys = mkTyVarTys tyvars
634 arg_tys = dataConArgTys data_con tyvar_tys
635 the_arg_id = arg_ids !! (tag - firstFieldLabelTag)
637 pred = mkClassPred clas tyvar_tys
638 (dict_id:arg_ids) = mkTemplateLocals (mkPredTy pred : arg_tys)
640 rhs | isNewTyCon tycon = mkLams tyvars $ Lam dict_id $
641 mkNewTypeBody tycon (head arg_tys) (Var dict_id)
642 | otherwise = mkLams tyvars $ Lam dict_id $
643 Case (Var dict_id) dict_id
644 [(DataAlt data_con, arg_ids, Var the_arg_id)]
646 mkNewTypeBody tycon result_ty result_expr
647 -- Adds a coerce where necessary
648 -- Used for both wrapping and unwrapping
649 | isRecursiveTyCon tycon -- Recursive case; use a coerce
650 = Note (Coerce result_ty (exprType result_expr)) result_expr
651 | otherwise -- Normal case
656 %************************************************************************
658 \subsection{Primitive operations
660 %************************************************************************
663 mkPrimOpId :: PrimOp -> Id
667 (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
668 ty = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
669 name = mkPrimOpIdName prim_op
670 id = mkGlobalId (PrimOpId prim_op) name ty info
675 `setAllStrictnessInfo` Just strict_sig
677 rules = foldl (addRule id) emptyCoreRules (primOpRules prim_op)
680 -- For each ccall we manufacture a separate CCallOpId, giving it
681 -- a fresh unique, a type that is correct for this particular ccall,
682 -- and a CCall structure that gives the correct details about calling
685 -- The *name* of this Id is a local name whose OccName gives the full
686 -- details of the ccall, type and all. This means that the interface
687 -- file reader can reconstruct a suitable Id
689 mkFCallId :: Unique -> ForeignCall -> Type -> Id
690 mkFCallId uniq fcall ty
691 = ASSERT( isEmptyVarSet (tyVarsOfType ty) )
692 -- A CCallOpId should have no free type variables;
693 -- when doing substitutions won't substitute over it
694 mkGlobalId (FCallId fcall) name ty info
696 occ_str = showSDoc (braces (ppr fcall <+> ppr ty))
697 -- The "occurrence name" of a ccall is the full info about the
698 -- ccall; it is encoded, but may have embedded spaces etc!
700 name = mkFCallName uniq occ_str
704 `setAllStrictnessInfo` Just strict_sig
706 (_, tau) = tcSplitForAllTys ty
707 (arg_tys, _) = tcSplitFunTys tau
708 arity = length arg_tys
709 strict_sig = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
713 %************************************************************************
715 \subsection{DictFuns and default methods}
717 %************************************************************************
719 Important notes about dict funs and default methods
720 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
721 Dict funs and default methods are *not* ImplicitIds. Their definition
722 involves user-written code, so we can't figure out their strictness etc
723 based on fixed info, as we can for constructors and record selectors (say).
725 We build them as GlobalIds, but when in the module where they are
726 bound, we turn the Id at the *binding site* into an exported LocalId.
727 This ensures that they are taken to account by free-variable finding
728 and dependency analysis (e.g. CoreFVs.exprFreeVars). The simplifier
729 will propagate the LocalId to all occurrence sites.
731 Why shouldn't they be bound as GlobalIds? Because, in particular, if
732 they are globals, the specialiser floats dict uses above their defns,
733 which prevents good simplifications happening. Also the strictness
734 analyser treats a occurrence of a GlobalId as imported and assumes it
735 contains strictness in its IdInfo, which isn't true if the thing is
736 bound in the same module as the occurrence.
738 It's OK for dfuns to be LocalIds, because we form the instance-env to
739 pass on to the next module (md_insts) in CoreTidy, afer tidying
740 and globalising the top-level Ids.
742 BUT make sure they are *exported* LocalIds (setIdLocalExported) so
743 that they aren't discarded by the occurrence analyser.
746 mkDefaultMethodId dm_name ty = mkVanillaGlobal dm_name ty noCafIdInfo
748 mkDictFunId :: Name -- Name to use for the dict fun;
755 mkDictFunId dfun_name clas inst_tyvars inst_tys dfun_theta
756 = mkVanillaGlobal dfun_name dfun_ty noCafIdInfo
758 dfun_ty = mkSigmaTy inst_tyvars dfun_theta (mkDictTy clas inst_tys)
760 {- 1 dec 99: disable the Mark Jones optimisation for the sake
761 of compatibility with Hugs.
762 See `types/InstEnv' for a discussion related to this.
764 (class_tyvars, sc_theta, _, _) = classBigSig clas
765 not_const (clas, tys) = not (isEmptyVarSet (tyVarsOfTypes tys))
766 sc_theta' = substClasses (mkTopTyVarSubst class_tyvars inst_tys) sc_theta
767 dfun_theta = case inst_decl_theta of
768 [] -> [] -- If inst_decl_theta is empty, then we don't
769 -- want to have any dict arguments, so that we can
770 -- expose the constant methods.
772 other -> nub (inst_decl_theta ++ filter not_const sc_theta')
773 -- Otherwise we pass the superclass dictionaries to
774 -- the dictionary function; the Mark Jones optimisation.
776 -- NOTE the "nub". I got caught by this one:
777 -- class Monad m => MonadT t m where ...
778 -- instance Monad m => MonadT (EnvT env) m where ...
779 -- Here, the inst_decl_theta has (Monad m); but so
780 -- does the sc_theta'!
782 -- NOTE the "not_const". I got caught by this one too:
783 -- class Foo a => Baz a b where ...
784 -- instance Wob b => Baz T b where..
785 -- Now sc_theta' has Foo T
790 %************************************************************************
792 \subsection{Un-definable}
794 %************************************************************************
796 These Ids can't be defined in Haskell. They could be defined in
797 unfoldings in the wired-in GHC.Prim interface file, but we'd have to
798 ensure that they were definitely, definitely inlined, because there is
799 no curried identifier for them. That's what mkCompulsoryUnfolding
800 does. If we had a way to get a compulsory unfolding from an interface
801 file, we could do that, but we don't right now.
803 unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
804 just gets expanded into a type coercion wherever it occurs. Hence we
805 add it as a built-in Id with an unfolding here.
807 The type variables we use here are "open" type variables: this means
808 they can unify with both unlifted and lifted types. Hence we provide
809 another gun with which to shoot yourself in the foot.
812 -- unsafeCoerce# :: forall a b. a -> b
814 = pcMiscPrelId unsafeCoerceIdKey gHC_PRIM FSLIT("unsafeCoerce#") ty info
816 info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
819 ty = mkForAllTys [openAlphaTyVar,openBetaTyVar]
820 (mkFunTy openAlphaTy openBetaTy)
821 [x] = mkTemplateLocals [openAlphaTy]
822 rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
823 Note (Coerce openBetaTy openAlphaTy) (Var x)
825 -- nullAddr# :: Addr#
826 -- The reason is is here is because we don't provide
827 -- a way to write this literal in Haskell.
829 = pcMiscPrelId nullAddrIdKey gHC_PRIM FSLIT("nullAddr#") addrPrimTy info
831 info = noCafIdInfo `setUnfoldingInfo`
832 mkCompulsoryUnfolding (Lit nullAddrLit)
835 = pcMiscPrelId seqIdKey gHC_PRIM FSLIT("seq") ty info
837 info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
840 ty = mkForAllTys [alphaTyVar,betaTyVar]
841 (mkFunTy alphaTy (mkFunTy betaTy betaTy))
842 [x,y] = mkTemplateLocals [alphaTy, betaTy]
843 rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x [(DEFAULT, [], Var y)])
845 -- lazy :: forall a?. a? -> a? (i.e. works for unboxed types too)
846 -- Used to lazify pseq: pseq a b = a `seq` lazy b
847 -- No unfolding: it gets "inlined" by the worker/wrapper pass
848 -- Also, no strictness: by being a built-in Id, it overrides all
849 -- the info in PrelBase.hi. This is important, because the strictness
850 -- analyser will spot it as strict!
852 = pcMiscPrelId lazyIdKey pREL_BASE FSLIT("lazy") ty info
855 ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
857 lazyIdUnfolding :: CoreExpr -- Used to expand LazyOp after strictness anal
858 lazyIdUnfolding = mkLams [openAlphaTyVar,x] (Var x)
860 [x] = mkTemplateLocals [openAlphaTy]
863 @getTag#@ is another function which can't be defined in Haskell. It needs to
864 evaluate its argument and call the dataToTag# primitive.
868 = pcMiscPrelId getTagIdKey gHC_PRIM FSLIT("getTag#") ty info
870 info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
871 -- We don't provide a defn for this; you must inline it
873 ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy intPrimTy)
874 [x,y] = mkTemplateLocals [alphaTy,alphaTy]
875 rhs = mkLams [alphaTyVar,x] $
876 Case (Var x) y [ (DEFAULT, [], mkApps (Var dataToTagId) [Type alphaTy, Var y]) ]
878 dataToTagId = mkPrimOpId DataToTagOp
881 @realWorld#@ used to be a magic literal, \tr{void#}. If things get
882 nasty as-is, change it back to a literal (@Literal@).
884 voidArgId is a Local Id used simply as an argument in functions
885 where we just want an arg to avoid having a thunk of unlifted type.
887 x = \ void :: State# RealWorld -> (# p, q #)
889 This comes up in strictness analysis
892 realWorldPrimId -- :: State# RealWorld
893 = pcMiscPrelId realWorldPrimIdKey gHC_PRIM FSLIT("realWorld#")
895 (noCafIdInfo `setUnfoldingInfo` mkOtherCon [])
896 -- The mkOtherCon makes it look that realWorld# is evaluated
897 -- which in turn makes Simplify.interestingArg return True,
898 -- which in turn makes INLINE things applied to realWorld# likely
901 voidArgId -- :: State# RealWorld
902 = mkSysLocal FSLIT("void") voidArgIdKey realWorldStatePrimTy
906 %************************************************************************
908 \subsection[PrelVals-error-related]{@error@ and friends; @trace@}
910 %************************************************************************
912 GHC randomly injects these into the code.
914 @patError@ is just a version of @error@ for pattern-matching
915 failures. It knows various ``codes'' which expand to longer
916 strings---this saves space!
918 @absentErr@ is a thing we put in for ``absent'' arguments. They jolly
919 well shouldn't be yanked on, but if one is, then you will get a
920 friendly message from @absentErr@ (rather than a totally random
923 @parError@ is a special version of @error@ which the compiler does
924 not know to be a bottoming Id. It is used in the @_par_@ and @_seq_@
925 templates, but we don't ever expect to generate code for it.
929 :: Id -- Should be of type (forall a. Addr# -> a)
930 -- where Addr# points to a UTF8 encoded string
931 -> Type -- The type to instantiate 'a'
932 -> String -- The string to print
935 mkRuntimeErrorApp err_id res_ty err_msg
936 = mkApps (Var err_id) [Type res_ty, err_string]
938 err_string = Lit (MachStr (mkFastString (stringToUtf8 err_msg)))
940 rEC_SEL_ERROR_ID = mkRuntimeErrorId recSelErrIdKey FSLIT("recSelError")
941 rUNTIME_ERROR_ID = mkRuntimeErrorId runtimeErrorIdKey FSLIT("runtimeError")
943 iRREFUT_PAT_ERROR_ID = mkRuntimeErrorId irrefutPatErrorIdKey FSLIT("irrefutPatError")
944 rEC_CON_ERROR_ID = mkRuntimeErrorId recConErrorIdKey FSLIT("recConError")
945 nON_EXHAUSTIVE_GUARDS_ERROR_ID = mkRuntimeErrorId nonExhaustiveGuardsErrorIdKey FSLIT("nonExhaustiveGuardsError")
946 pAT_ERROR_ID = mkRuntimeErrorId patErrorIdKey FSLIT("patError")
947 nO_METHOD_BINDING_ERROR_ID = mkRuntimeErrorId noMethodBindingErrorIdKey FSLIT("noMethodBindingError")
949 -- The runtime error Ids take a UTF8-encoded string as argument
950 mkRuntimeErrorId key name = pc_bottoming_Id key pREL_ERR name runtimeErrorTy
951 runtimeErrorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTy addrPrimTy openAlphaTy)
955 eRROR_ID = pc_bottoming_Id errorIdKey pREL_ERR FSLIT("error") 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 :: Unique{-IdKey-} -> Module -> FastString -> Type -> IdInfo -> Id
973 pcMiscPrelId key mod str ty info
975 name = mkWiredInName mod (mkVarOcc str) key
976 imp = mkVanillaGlobal name ty info -- the usual case...
979 -- We lie and say the thing is imported; otherwise, we get into
980 -- a mess with dependency analysis; e.g., core2stg may heave in
981 -- random calls to GHCbase.unpackPS__. If GHCbase is the module
982 -- being compiled, then it's just a matter of luck if the definition
983 -- will be in "the right place" to be in scope.
985 pc_bottoming_Id key mod name ty
986 = pcMiscPrelId key mod name ty bottoming_info
988 strict_sig = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
989 bottoming_info = noCafIdInfo `setAllStrictnessInfo` Just strict_sig
990 -- these "bottom" out, no matter what their arguments
992 (openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars
993 openAlphaTy = mkTyVarTy openAlphaTyVar
994 openBetaTy = mkTyVarTy openBetaTyVar