2 % (c) The AQUA Project, Glasgow University, 1998
4 \section[StdIdInfo]{Standard unfoldings}
6 This module contains definitions for the IdInfo for things that
7 have a standard form, namely:
11 * method and superclass selectors
12 * primitive operations
16 mkDictFunId, mkDefaultMethodId,
21 mkPrimOpId, mkFCallId,
23 mkReboxingAlt, mkNewTypeBody,
25 -- And some particular Ids; see below for why they are wired in
26 wiredInIds, ghcPrimIds,
27 unsafeCoerceId, realWorldPrimId, voidArgId, nullAddrId, seqId,
28 lazyId, lazyIdUnfolding, lazyIdKey,
31 rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID, rUNTIME_ERROR_ID,
32 nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID,
33 pAT_ERROR_ID, eRROR_ID
36 #include "HsVersions.h"
39 import BasicTypes ( Arity, StrictnessMark(..), isMarkedUnboxed, isMarkedStrict )
40 import TysPrim ( openAlphaTyVars, alphaTyVar, alphaTy,
41 realWorldStatePrimTy, addrPrimTy
43 import TysWiredIn ( charTy, mkListTy )
44 import PrelRules ( primOpRules )
45 import Rules ( addRule )
46 import Type ( TyThing(..) )
47 import TcType ( Type, ThetaType, mkDictTy, mkPredTys, mkPredTy,
48 mkTyConApp, mkTyVarTys, mkClassPred, tcEqPred,
49 mkFunTys, mkFunTy, mkSigmaTy, tcSplitSigmaTy,
50 isUnLiftedType, mkForAllTys, mkTyVarTy, tyVarsOfType,
51 tcSplitFunTys, tcSplitForAllTys
53 import CoreUtils ( exprType )
54 import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding, mkOtherCon )
55 import Literal ( nullAddrLit, mkStringLit )
56 import TyCon ( TyCon, isNewTyCon, tyConTyVars, tyConDataCons,
57 tyConStupidTheta, isProductTyCon, isDataTyCon, isRecursiveTyCon )
58 import Class ( Class, classTyCon, classSelIds )
59 import Var ( Id, TyVar, Var )
60 import VarSet ( isEmptyVarSet )
61 import Name ( mkFCallName, mkWiredInName, Name, BuiltInSyntax(..) )
62 import OccName ( mkOccFS, varName )
63 import PrimOp ( PrimOp, primOpSig, primOpOcc, primOpTag )
64 import ForeignCall ( ForeignCall )
65 import DataCon ( DataCon, DataConIds(..), dataConTyVars,
66 dataConFieldLabels, dataConRepArity,
67 dataConRepArgTys, dataConRepType, dataConStupidTheta,
68 dataConSig, dataConStrictMarks, dataConExStricts,
69 splitProductType, isVanillaDataCon
71 import Id ( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal,
72 mkTemplateLocals, mkTemplateLocalsNum, mkExportedLocalId,
73 mkTemplateLocal, idName
75 import IdInfo ( IdInfo, noCafIdInfo, setUnfoldingInfo,
76 setArityInfo, setSpecInfo, setCafInfo,
77 setAllStrictnessInfo, vanillaIdInfo,
78 GlobalIdDetails(..), CafInfo(..)
80 import NewDemand ( mkStrictSig, DmdResult(..),
81 mkTopDmdType, topDmd, evalDmd, lazyDmd, retCPR,
82 Demand(..), Demands(..) )
83 import DmdAnal ( dmdAnalTopRhs )
85 import Unique ( mkBuiltinUnique, mkPrimOpIdUnique )
88 import Maybe ( isJust )
89 import Util ( dropList, isSingleton )
92 import ListSetOps ( assoc, assocMaybe )
96 %************************************************************************
98 \subsection{Wired in Ids}
100 %************************************************************************
104 = [ -- These error-y things are wired in because we don't yet have
105 -- a way to express in an interface file that the result type variable
106 -- is 'open'; that is can be unified with an unboxed type
108 -- [The interface file format now carry such information, but there's
109 -- no way yet of expressing at the definition site for these
110 -- error-reporting functions that they have an 'open'
111 -- result type. -- sof 1/99]
113 eRROR_ID, -- This one isn't used anywhere else in the compiler
114 -- But we still need it in wiredInIds so that when GHC
115 -- compiles a program that mentions 'error' we don't
116 -- import its type from the interface file; we just get
117 -- the Id defined here. Which has an 'open-tyvar' type.
120 iRREFUT_PAT_ERROR_ID,
121 nON_EXHAUSTIVE_GUARDS_ERROR_ID,
122 nO_METHOD_BINDING_ERROR_ID,
129 -- These Ids are exported from GHC.Prim
131 = [ -- These can't be defined in Haskell, but they have
132 -- perfectly reasonable unfoldings in Core
140 %************************************************************************
142 \subsection{Data constructors}
144 %************************************************************************
146 The wrapper for a constructor is an ordinary top-level binding that evaluates
147 any strict args, unboxes any args that are going to be flattened, and calls
150 We're going to build a constructor that looks like:
152 data (Data a, C b) => T a b = T1 !a !Int b
155 \d1::Data a, d2::C b ->
156 \p q r -> case p of { p ->
158 Con T1 [a,b] [p,q,r]}}
162 * d2 is thrown away --- a context in a data decl is used to make sure
163 one *could* construct dictionaries at the site the constructor
164 is used, but the dictionary isn't actually used.
166 * We have to check that we can construct Data dictionaries for
167 the types a and Int. Once we've done that we can throw d1 away too.
169 * We use (case p of q -> ...) to evaluate p, rather than "seq" because
170 all that matters is that the arguments are evaluated. "seq" is
171 very careful to preserve evaluation order, which we don't need
174 You might think that we could simply give constructors some strictness
175 info, like PrimOps, and let CoreToStg do the let-to-case transformation.
176 But we don't do that because in the case of primops and functions strictness
177 is a *property* not a *requirement*. In the case of constructors we need to
178 do something active to evaluate the argument.
180 Making an explicit case expression allows the simplifier to eliminate
181 it in the (common) case where the constructor arg is already evaluated.
185 mkDataConIds :: Name -> Name -> DataCon -> DataConIds
186 -- Makes the *worker* for the data constructor; that is, the function
187 -- that takes the reprsentation arguments and builds the constructor.
188 mkDataConIds wrap_name wkr_name data_con
192 | any isMarkedStrict all_strict_marks -- Algebraic, needs wrapper
193 = AlgDC (Just alg_wrap_id) wrk_id
195 | otherwise -- Algebraic, no wrapper
196 = AlgDC Nothing wrk_id
198 (tyvars, theta, orig_arg_tys, tycon, res_tys) = dataConSig data_con
200 dict_tys = mkPredTys theta
201 all_arg_tys = dict_tys ++ orig_arg_tys
202 result_ty = mkTyConApp tycon res_tys
204 wrap_ty = mkForAllTys tyvars (mkFunTys all_arg_tys result_ty)
205 -- We used to include the stupid theta in the wrapper's args
206 -- but now we don't. Instead the type checker just injects these
207 -- extra constraints where necessary.
209 ----------- Worker (algebraic data types only) --------------
210 wrk_id = mkGlobalId (DataConWorkId data_con) wkr_name
211 (dataConRepType data_con) wkr_info
213 wkr_arity = dataConRepArity data_con
214 wkr_info = noCafIdInfo
215 `setArityInfo` wkr_arity
216 `setAllStrictnessInfo` Just wkr_sig
218 wkr_sig = mkStrictSig (mkTopDmdType (replicate wkr_arity topDmd) cpr_info)
219 -- Notice that we do *not* say the worker is strict
220 -- even if the data constructor is declared strict
221 -- e.g. data T = MkT !(Int,Int)
222 -- Why? Because the *wrapper* is strict (and its unfolding has case
223 -- expresssions that do the evals) but the *worker* itself is not.
224 -- If we pretend it is strict then when we see
225 -- case x of y -> $wMkT y
226 -- the simplifier thinks that y is "sure to be evaluated" (because
227 -- $wMkT is strict) and drops the case. No, $wMkT is not strict.
229 -- When the simplifer sees a pattern
230 -- case e of MkT x -> ...
231 -- it uses the dataConRepStrictness of MkT to mark x as evaluated;
232 -- but that's fine... dataConRepStrictness comes from the data con
233 -- not from the worker Id.
235 cpr_info | isProductTyCon tycon &&
238 wkr_arity <= mAX_CPR_SIZE = retCPR
240 -- RetCPR is only true for products that are real data types;
241 -- that is, not unboxed tuples or [non-recursive] newtypes
243 ----------- Wrappers for newtypes --------------
244 nt_wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty nt_wrap_info
245 nt_wrap_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo
246 `setArityInfo` 1 -- Arity 1
247 `setUnfoldingInfo` newtype_unf
248 newtype_unf = ASSERT( isVanillaDataCon data_con &&
249 isSingleton orig_arg_tys )
250 -- No existentials on a newtype, but it can have a context
251 -- e.g. newtype Eq a => T a = MkT (...)
252 mkTopUnfolding $ Note InlineMe $
253 mkLams tyvars $ Lam id_arg1 $
254 mkNewTypeBody tycon result_ty (Var id_arg1)
256 id_arg1 = mkTemplateLocal 1 (head orig_arg_tys)
258 ----------- Wrappers for algebraic data types --------------
259 alg_wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty alg_wrap_info
260 alg_wrap_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo
261 `setArityInfo` alg_arity
262 -- It's important to specify the arity, so that partial
263 -- applications are treated as values
264 `setUnfoldingInfo` alg_unf
265 `setAllStrictnessInfo` Just wrap_sig
267 all_strict_marks = dataConExStricts data_con ++ dataConStrictMarks data_con
268 wrap_sig = mkStrictSig (mkTopDmdType arg_dmds cpr_info)
269 arg_dmds = map mk_dmd all_strict_marks
270 mk_dmd str | isMarkedStrict str = evalDmd
271 | otherwise = lazyDmd
272 -- The Cpr info can be important inside INLINE rhss, where the
273 -- wrapper constructor isn't inlined.
274 -- And the argument strictness can be important too; we
275 -- may not inline a contructor when it is partially applied.
277 -- data W = C !Int !Int !Int
278 -- ...(let w = C x in ...(w p q)...)...
279 -- we want to see that w is strict in its two arguments
281 alg_unf = mkTopUnfolding $ Note InlineMe $
283 mkLams dict_args $ mkLams id_args $
284 foldr mk_case con_app
285 (zip (dict_args ++ id_args) all_strict_marks)
288 con_app i rep_ids = mkApps (Var wrk_id)
289 (map varToCoreExpr (tyvars ++ reverse rep_ids))
291 (dict_args,i2) = mkLocals 1 dict_tys
292 (id_args,i3) = mkLocals i2 orig_arg_tys
296 :: (Id, StrictnessMark) -- Arg, strictness
297 -> (Int -> [Id] -> CoreExpr) -- Body
298 -> Int -- Next rep arg id
299 -> [Id] -- Rep args so far, reversed
301 mk_case (arg,strict) body i rep_args
303 NotMarkedStrict -> body i (arg:rep_args)
305 | isUnLiftedType (idType arg) -> body i (arg:rep_args)
307 Case (Var arg) arg result_ty [(DEFAULT,[], body i (arg:rep_args))]
310 -> case splitProductType "do_unbox" (idType arg) of
311 (tycon, tycon_args, con, tys) ->
312 Case (Var arg) arg result_ty
315 body i' (reverse con_args ++ rep_args))]
317 (con_args, i') = mkLocals i tys
319 mAX_CPR_SIZE :: Arity
321 -- We do not treat very big tuples as CPR-ish:
322 -- a) for a start we get into trouble because there aren't
323 -- "enough" unboxed tuple types (a tiresome restriction,
325 -- b) more importantly, big unboxed tuples get returned mainly
326 -- on the stack, and are often then allocated in the heap
327 -- by the caller. So doing CPR for them may in fact make
330 mkLocals i tys = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
336 %************************************************************************
338 \subsection{Record selectors}
340 %************************************************************************
342 We're going to build a record selector unfolding that looks like this:
344 data T a b c = T1 { ..., op :: a, ...}
345 | T2 { ..., op :: a, ...}
348 sel = /\ a b c -> \ d -> case d of
353 Similarly for newtypes
355 newtype N a = MkN { unN :: a->a }
358 unN n = coerce (a->a) n
360 We need to take a little care if the field has a polymorphic type:
362 data R = R { f :: forall a. a->a }
366 f :: forall a. R -> a -> a
367 f = /\ a \ r = case r of
370 (not f :: R -> forall a. a->a, which gives the type inference mechanism
371 problems at call sites)
373 Similarly for (recursive) newtypes
375 newtype N = MkN { unN :: forall a. a->a }
377 unN :: forall b. N -> b -> b
378 unN = /\b -> \n:N -> (coerce (forall a. a->a) n)
381 mkRecordSelId tycon field_label field_ty
382 -- Assumes that all fields with the same field label have the same type
385 sel_id = mkGlobalId (RecordSelId tycon field_label) field_label selector_ty info
386 data_cons = tyConDataCons tycon
387 tyvars = tyConTyVars tycon -- These scope over the types in
388 -- the FieldLabels of constructors of this type
389 data_ty = mkTyConApp tycon tyvar_tys
390 tyvar_tys = mkTyVarTys tyvars
392 -- Very tiresomely, the selectors are (unnecessarily!) overloaded over
393 -- just the dictionaries in the types of the constructors that contain
394 -- the relevant field. [The Report says that pattern matching on a
395 -- constructor gives the same constraints as applying it.] Urgh.
397 -- However, not all data cons have all constraints (because of
398 -- TcTyDecls.thinContext). So we need to find all the data cons
399 -- involved in the pattern match and take the union of their constraints.
401 -- NB: this code relies on the fact that DataCons are quantified over
402 -- the identical type variables as their parent TyCon
403 needed_preds = [pred | (DataAlt dc, _, _) <- the_alts, pred <- dataConStupidTheta dc]
404 dict_tys = mkPredTys (nubBy tcEqPred needed_preds)
405 n_dict_tys = length dict_tys
407 (field_tyvars,field_theta,field_tau) = tcSplitSigmaTy field_ty
408 field_dict_tys = mkPredTys field_theta
409 n_field_dict_tys = length field_dict_tys
410 -- If the field has a universally quantified type we have to
411 -- be a bit careful. Suppose we have
412 -- data R = R { op :: forall a. Foo a => a -> a }
413 -- Then we can't give op the type
414 -- op :: R -> forall a. Foo a => a -> a
415 -- because the typechecker doesn't understand foralls to the
416 -- right of an arrow. The "right" type to give it is
417 -- op :: forall a. Foo a => R -> a -> a
418 -- But then we must generate the right unfolding too:
419 -- op = /\a -> \dfoo -> \ r ->
422 -- Note that this is exactly the type we'd infer from a user defn
426 selector_ty = mkForAllTys tyvars $ mkForAllTys field_tyvars $
427 mkFunTys dict_tys $ mkFunTys field_dict_tys $
428 mkFunTy data_ty field_tau
430 arity = 1 + n_dict_tys + n_field_dict_tys
432 (strict_sig, rhs_w_str) = dmdAnalTopRhs sel_rhs
433 -- Use the demand analyser to work out strictness.
434 -- With all this unpackery it's not easy!
437 `setCafInfo` caf_info
439 `setUnfoldingInfo` mkTopUnfolding rhs_w_str
440 `setAllStrictnessInfo` Just strict_sig
442 -- Allocate Ids. We do it a funny way round because field_dict_tys is
443 -- almost always empty. Also note that we use max_dict_tys
444 -- rather than n_dict_tys, because the latter gives an infinite loop:
445 -- n_dict tys depends on the_alts, which depens on arg_ids, which depends
446 -- on arity, which depends on n_dict tys. Sigh! Mega sigh!
447 dict_ids = mkTemplateLocalsNum 1 dict_tys
448 max_dict_tys = length (tyConStupidTheta tycon)
449 field_dict_base = max_dict_tys + 1
450 field_dict_ids = mkTemplateLocalsNum field_dict_base field_dict_tys
451 dict_id_base = field_dict_base + n_field_dict_tys
452 data_id = mkTemplateLocal dict_id_base data_ty
453 arg_base = dict_id_base + 1
455 alts = map mk_maybe_alt data_cons
456 the_alts = catMaybes alts -- Already sorted by data-con
458 no_default = all isJust alts -- No default needed
459 default_alt | no_default = []
460 | otherwise = [(DEFAULT, [], error_expr)]
462 -- The default branch may have CAF refs, because it calls recSelError etc.
463 caf_info | no_default = NoCafRefs
464 | otherwise = MayHaveCafRefs
466 sel_rhs = mkLams tyvars $ mkLams field_tyvars $
467 mkLams dict_ids $ mkLams field_dict_ids $
468 Lam data_id $ sel_body
470 sel_body | isNewTyCon tycon = mk_result (mkNewTypeBody tycon field_ty (Var data_id))
471 | otherwise = Case (Var data_id) data_id field_tau (default_alt ++ the_alts)
473 mk_result poly_result = mkVarApps (mkVarApps poly_result field_tyvars) field_dict_ids
474 -- We pull the field lambdas to the top, so we need to
475 -- apply them in the body. For example:
476 -- data T = MkT { foo :: forall a. a->a }
478 -- foo :: forall a. T -> a -> a
479 -- foo = /\a. \t:T. case t of { MkT f -> f a }
481 mk_maybe_alt data_con
482 = ASSERT( dc_tyvars == tyvars )
483 -- The only non-vanilla case we allow is when we have an existential
484 -- context that binds no type variables, thus
485 -- data T a = (?v::Int) => MkT a
486 -- In the non-vanilla case, the pattern must bind type variables and
487 -- the context stuff; hence the arg_prefix binding below
489 case maybe_the_arg_id of
491 Just the_arg_id -> Just (mkReboxingAlt uniqs data_con (arg_prefix ++ arg_src_ids) $
492 mk_result (Var the_arg_id))
494 (dc_tyvars, dc_theta, dc_arg_tys, _, _) = dataConSig data_con
495 arg_src_ids = mkTemplateLocalsNum arg_base dc_arg_tys
496 arg_base' = arg_base + length arg_src_ids
497 arg_prefix | isVanillaDataCon data_con = []
498 | otherwise = tyvars ++ mkTemplateLocalsNum arg_base' (mkPredTys dc_theta)
500 unpack_base = arg_base' + length dc_theta
501 uniqs = map mkBuiltinUnique [unpack_base..]
503 maybe_the_arg_id = assocMaybe (field_lbls `zip` arg_src_ids) field_label
504 field_lbls = dataConFieldLabels data_con
506 error_expr = mkRuntimeErrorApp rEC_SEL_ERROR_ID field_tau full_msg
507 full_msg = showSDoc (sep [text "No match in record selector", ppr sel_id])
510 -- (mkReboxingAlt us con xs rhs) basically constructs the case
511 -- alternative (con, xs, rhs)
512 -- but it does the reboxing necessary to construct the *source*
513 -- arguments, xs, from the representation arguments ys.
515 -- data T = MkT !(Int,Int) Bool
517 -- mkReboxingAlt MkT [x,b] r
518 -- = (DataAlt MkT, [y::Int,z::Int,b], let x = (y,z) in r)
520 -- mkDataAlt should really be in DataCon, but it can't because
521 -- it manipulates CoreSyn.
524 :: [Unique] -- Uniques for the new Ids
526 -> [Var] -- Source-level args, including existential dicts
530 mkReboxingAlt us con args rhs
531 | not (any isMarkedUnboxed stricts)
532 = (DataAlt con, args, rhs)
536 (binds, args') = go args stricts us
538 (DataAlt con, args', mkLets binds rhs)
541 stricts = dataConExStricts con ++ dataConStrictMarks con
543 go [] stricts us = ([], [])
545 -- Type variable case
546 go (arg:args) stricts us
548 = let (binds, args') = go args stricts us
549 in (binds, arg:args')
551 -- Term variable case
552 go (arg:args) (str:stricts) us
553 | isMarkedUnboxed str
555 (_, tycon_args, pack_con, con_arg_tys)
556 = splitProductType "mkReboxingAlt" (idType arg)
558 unpacked_args = zipWith (mkSysLocal FSLIT("rb")) us con_arg_tys
559 (binds, args') = go args stricts (dropList con_arg_tys us)
560 con_app = mkConApp pack_con (map Type tycon_args ++ map Var unpacked_args)
562 (NonRec arg con_app : binds, unpacked_args ++ args')
565 = let (binds, args') = go args stricts us
566 in (binds, arg:args')
570 %************************************************************************
572 \subsection{Dictionary selectors}
574 %************************************************************************
576 Selecting a field for a dictionary. If there is just one field, then
577 there's nothing to do.
579 Dictionary selectors may get nested forall-types. Thus:
582 op :: forall b. Ord b => a -> b -> b
584 Then the top-level type for op is
586 op :: forall a. Foo a =>
590 This is unlike ordinary record selectors, which have all the for-alls
591 at the outside. When dealing with classes it's very convenient to
592 recover the original type signature from the class op selector.
595 mkDictSelId :: Name -> Class -> Id
596 mkDictSelId name clas
597 = mkGlobalId (ClassOpId clas) name sel_ty info
599 sel_ty = mkForAllTys tyvars (mkFunTy (idType dict_id) (idType the_arg_id))
600 -- We can't just say (exprType rhs), because that would give a type
602 -- for a single-op class (after all, the selector is the identity)
603 -- But it's type must expose the representation of the dictionary
604 -- to gat (say) C a -> (a -> a)
608 `setUnfoldingInfo` mkTopUnfolding rhs
609 `setAllStrictnessInfo` Just strict_sig
611 -- We no longer use 'must-inline' on record selectors. They'll
612 -- inline like crazy if they scrutinise a constructor
614 -- The strictness signature is of the form U(AAAVAAAA) -> T
615 -- where the V depends on which item we are selecting
616 -- It's worth giving one, so that absence info etc is generated
617 -- even if the selector isn't inlined
618 strict_sig = mkStrictSig (mkTopDmdType [arg_dmd] TopRes)
619 arg_dmd | isNewTyCon tycon = evalDmd
620 | otherwise = Eval (Prod [ if the_arg_id == id then evalDmd else Abs
623 tycon = classTyCon clas
624 [data_con] = tyConDataCons tycon
625 tyvars = dataConTyVars data_con
626 arg_tys = dataConRepArgTys data_con
627 the_arg_id = assoc "MkId.mkDictSelId" (map idName (classSelIds clas) `zip` arg_ids) name
629 pred = mkClassPred clas (mkTyVarTys tyvars)
630 (dict_id:arg_ids) = mkTemplateLocals (mkPredTy pred : arg_tys)
632 rhs | isNewTyCon tycon = mkLams tyvars $ Lam dict_id $
633 mkNewTypeBody tycon (head arg_tys) (Var dict_id)
634 | otherwise = mkLams tyvars $ Lam dict_id $
635 Case (Var dict_id) dict_id (idType the_arg_id)
636 [(DataAlt data_con, arg_ids, Var the_arg_id)]
638 mkNewTypeBody tycon result_ty result_expr
639 -- Adds a coerce where necessary
640 -- Used for both wrapping and unwrapping
641 | isRecursiveTyCon tycon -- Recursive case; use a coerce
642 = Note (Coerce result_ty (exprType result_expr)) result_expr
643 | otherwise -- Normal case
648 %************************************************************************
650 \subsection{Primitive operations
652 %************************************************************************
655 mkPrimOpId :: PrimOp -> Id
659 (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
660 ty = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
661 name = mkWiredInName gHC_PRIM (primOpOcc prim_op)
662 (mkPrimOpIdUnique (primOpTag prim_op))
663 Nothing (AnId id) UserSyntax
664 id = mkGlobalId (PrimOpId prim_op) name ty info
669 `setAllStrictnessInfo` Just strict_sig
671 rules = foldl (addRule id) emptyCoreRules (primOpRules prim_op)
674 -- For each ccall we manufacture a separate CCallOpId, giving it
675 -- a fresh unique, a type that is correct for this particular ccall,
676 -- and a CCall structure that gives the correct details about calling
679 -- The *name* of this Id is a local name whose OccName gives the full
680 -- details of the ccall, type and all. This means that the interface
681 -- file reader can reconstruct a suitable Id
683 mkFCallId :: Unique -> ForeignCall -> Type -> Id
684 mkFCallId uniq fcall ty
685 = ASSERT( isEmptyVarSet (tyVarsOfType ty) )
686 -- A CCallOpId should have no free type variables;
687 -- when doing substitutions won't substitute over it
688 mkGlobalId (FCallId fcall) name ty info
690 occ_str = showSDoc (braces (ppr fcall <+> ppr ty))
691 -- The "occurrence name" of a ccall is the full info about the
692 -- ccall; it is encoded, but may have embedded spaces etc!
694 name = mkFCallName uniq occ_str
698 `setAllStrictnessInfo` Just strict_sig
700 (_, tau) = tcSplitForAllTys ty
701 (arg_tys, _) = tcSplitFunTys tau
702 arity = length arg_tys
703 strict_sig = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
707 %************************************************************************
709 \subsection{DictFuns and default methods}
711 %************************************************************************
713 Important notes about dict funs and default methods
714 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
715 Dict funs and default methods are *not* ImplicitIds. Their definition
716 involves user-written code, so we can't figure out their strictness etc
717 based on fixed info, as we can for constructors and record selectors (say).
719 We build them as GlobalIds, but when in the module where they are
720 bound, we turn the Id at the *binding site* into an exported LocalId.
721 This ensures that they are taken to account by free-variable finding
722 and dependency analysis (e.g. CoreFVs.exprFreeVars). The simplifier
723 will propagate the LocalId to all occurrence sites.
725 Why shouldn't they be bound as GlobalIds? Because, in particular, if
726 they are globals, the specialiser floats dict uses above their defns,
727 which prevents good simplifications happening. Also the strictness
728 analyser treats a occurrence of a GlobalId as imported and assumes it
729 contains strictness in its IdInfo, which isn't true if the thing is
730 bound in the same module as the occurrence.
732 It's OK for dfuns to be LocalIds, because we form the instance-env to
733 pass on to the next module (md_insts) in CoreTidy, afer tidying
734 and globalising the top-level Ids.
736 BUT make sure they are *exported* LocalIds (mkExportedLocalId) so
737 that they aren't discarded by the occurrence analyser.
740 mkDefaultMethodId dm_name ty = mkExportedLocalId dm_name ty
742 mkDictFunId :: Name -- Name to use for the dict fun;
749 mkDictFunId dfun_name inst_tyvars dfun_theta clas inst_tys
750 = mkExportedLocalId dfun_name dfun_ty
752 dfun_ty = mkSigmaTy inst_tyvars dfun_theta (mkDictTy clas inst_tys)
754 {- 1 dec 99: disable the Mark Jones optimisation for the sake
755 of compatibility with Hugs.
756 See `types/InstEnv' for a discussion related to this.
758 (class_tyvars, sc_theta, _, _) = classBigSig clas
759 not_const (clas, tys) = not (isEmptyVarSet (tyVarsOfTypes tys))
760 sc_theta' = substClasses (zipTopTvSubst class_tyvars inst_tys) sc_theta
761 dfun_theta = case inst_decl_theta of
762 [] -> [] -- If inst_decl_theta is empty, then we don't
763 -- want to have any dict arguments, so that we can
764 -- expose the constant methods.
766 other -> nub (inst_decl_theta ++ filter not_const sc_theta')
767 -- Otherwise we pass the superclass dictionaries to
768 -- the dictionary function; the Mark Jones optimisation.
770 -- NOTE the "nub". I got caught by this one:
771 -- class Monad m => MonadT t m where ...
772 -- instance Monad m => MonadT (EnvT env) m where ...
773 -- Here, the inst_decl_theta has (Monad m); but so
774 -- does the sc_theta'!
776 -- NOTE the "not_const". I got caught by this one too:
777 -- class Foo a => Baz a b where ...
778 -- instance Wob b => Baz T b where..
779 -- Now sc_theta' has Foo T
784 %************************************************************************
786 \subsection{Un-definable}
788 %************************************************************************
790 These Ids can't be defined in Haskell. They could be defined in
791 unfoldings in the wired-in GHC.Prim interface file, but we'd have to
792 ensure that they were definitely, definitely inlined, because there is
793 no curried identifier for them. That's what mkCompulsoryUnfolding
794 does. If we had a way to get a compulsory unfolding from an interface
795 file, we could do that, but we don't right now.
797 unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
798 just gets expanded into a type coercion wherever it occurs. Hence we
799 add it as a built-in Id with an unfolding here.
801 The type variables we use here are "open" type variables: this means
802 they can unify with both unlifted and lifted types. Hence we provide
803 another gun with which to shoot yourself in the foot.
806 mkWiredInIdName mod fs uniq id
807 = mkWiredInName mod (mkOccFS varName fs) uniq Nothing (AnId id) UserSyntax
809 unsafeCoerceName = mkWiredInIdName gHC_PRIM FSLIT("unsafeCoerce#") unsafeCoerceIdKey unsafeCoerceId
810 nullAddrName = mkWiredInIdName gHC_PRIM FSLIT("nullAddr#") nullAddrIdKey nullAddrId
811 seqName = mkWiredInIdName gHC_PRIM FSLIT("seq") seqIdKey seqId
812 realWorldName = mkWiredInIdName gHC_PRIM FSLIT("realWorld#") realWorldPrimIdKey realWorldPrimId
813 lazyIdName = mkWiredInIdName pREL_BASE FSLIT("lazy") lazyIdKey lazyId
815 errorName = mkWiredInIdName pREL_ERR FSLIT("error") errorIdKey eRROR_ID
816 recSelErrorName = mkWiredInIdName pREL_ERR FSLIT("recSelError") recSelErrorIdKey rEC_SEL_ERROR_ID
817 runtimeErrorName = mkWiredInIdName pREL_ERR FSLIT("runtimeError") runtimeErrorIdKey rUNTIME_ERROR_ID
818 irrefutPatErrorName = mkWiredInIdName pREL_ERR FSLIT("irrefutPatError") irrefutPatErrorIdKey iRREFUT_PAT_ERROR_ID
819 recConErrorName = mkWiredInIdName pREL_ERR FSLIT("recConError") recConErrorIdKey rEC_CON_ERROR_ID
820 patErrorName = mkWiredInIdName pREL_ERR FSLIT("patError") patErrorIdKey pAT_ERROR_ID
821 noMethodBindingErrorName = mkWiredInIdName pREL_ERR FSLIT("noMethodBindingError")
822 noMethodBindingErrorIdKey nO_METHOD_BINDING_ERROR_ID
823 nonExhaustiveGuardsErrorName
824 = mkWiredInIdName pREL_ERR FSLIT("nonExhaustiveGuardsError")
825 nonExhaustiveGuardsErrorIdKey nON_EXHAUSTIVE_GUARDS_ERROR_ID
829 -- unsafeCoerce# :: forall a b. a -> b
831 = pcMiscPrelId unsafeCoerceName ty info
833 info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
836 ty = mkForAllTys [openAlphaTyVar,openBetaTyVar]
837 (mkFunTy openAlphaTy openBetaTy)
838 [x] = mkTemplateLocals [openAlphaTy]
839 rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
840 Note (Coerce openBetaTy openAlphaTy) (Var x)
842 -- nullAddr# :: Addr#
843 -- The reason is is here is because we don't provide
844 -- a way to write this literal in Haskell.
846 = pcMiscPrelId nullAddrName addrPrimTy info
848 info = noCafIdInfo `setUnfoldingInfo`
849 mkCompulsoryUnfolding (Lit nullAddrLit)
852 = pcMiscPrelId seqName ty info
854 info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
857 ty = mkForAllTys [alphaTyVar,openBetaTyVar]
858 (mkFunTy alphaTy (mkFunTy openBetaTy openBetaTy))
859 [x,y] = mkTemplateLocals [alphaTy, openBetaTy]
861 rhs = mkLams [alphaTyVar,openBetaTyVar,x,y] (Case (Var x) x openBetaTy [(DEFAULT, [], Var y)])
863 -- lazy :: forall a?. a? -> a? (i.e. works for unboxed types too)
864 -- Used to lazify pseq: pseq a b = a `seq` lazy b
865 -- No unfolding: it gets "inlined" by the worker/wrapper pass
866 -- Also, no strictness: by being a built-in Id, it overrides all
867 -- the info in PrelBase.hi. This is important, because the strictness
868 -- analyser will spot it as strict!
870 = pcMiscPrelId lazyIdName ty info
873 ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
875 lazyIdUnfolding :: CoreExpr -- Used to expand LazyOp after strictness anal
876 lazyIdUnfolding = mkLams [openAlphaTyVar,x] (Var x)
878 [x] = mkTemplateLocals [openAlphaTy]
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 realWorldName realWorldStatePrimTy
894 (noCafIdInfo `setUnfoldingInfo` mkOtherCon [])
895 -- The mkOtherCon makes it look that realWorld# is evaluated
896 -- which in turn makes Simplify.interestingArg return True,
897 -- which in turn makes INLINE things applied to realWorld# likely
900 voidArgId -- :: State# RealWorld
901 = mkSysLocal FSLIT("void") voidArgIdKey realWorldStatePrimTy
905 %************************************************************************
907 \subsection[PrelVals-error-related]{@error@ and friends; @trace@}
909 %************************************************************************
911 GHC randomly injects these into the code.
913 @patError@ is just a version of @error@ for pattern-matching
914 failures. It knows various ``codes'' which expand to longer
915 strings---this saves space!
917 @absentErr@ is a thing we put in for ``absent'' arguments. They jolly
918 well shouldn't be yanked on, but if one is, then you will get a
919 friendly message from @absentErr@ (rather than a totally random
922 @parError@ is a special version of @error@ which the compiler does
923 not know to be a bottoming Id. It is used in the @_par_@ and @_seq_@
924 templates, but we don't ever expect to generate code for it.
928 :: Id -- Should be of type (forall a. Addr# -> a)
929 -- where Addr# points to a UTF8 encoded string
930 -> Type -- The type to instantiate 'a'
931 -> String -- The string to print
934 mkRuntimeErrorApp err_id res_ty err_msg
935 = mkApps (Var err_id) [Type res_ty, err_string]
937 err_string = Lit (mkStringLit err_msg)
939 rEC_SEL_ERROR_ID = mkRuntimeErrorId recSelErrorName
940 rUNTIME_ERROR_ID = mkRuntimeErrorId runtimeErrorName
941 iRREFUT_PAT_ERROR_ID = mkRuntimeErrorId irrefutPatErrorName
942 rEC_CON_ERROR_ID = mkRuntimeErrorId recConErrorName
943 pAT_ERROR_ID = mkRuntimeErrorId patErrorName
944 nO_METHOD_BINDING_ERROR_ID = mkRuntimeErrorId noMethodBindingErrorName
945 nON_EXHAUSTIVE_GUARDS_ERROR_ID = mkRuntimeErrorId nonExhaustiveGuardsErrorName
947 -- The runtime error Ids take a UTF8-encoded string as argument
948 mkRuntimeErrorId name = pc_bottoming_Id name runtimeErrorTy
949 runtimeErrorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTy addrPrimTy openAlphaTy)
953 eRROR_ID = pc_bottoming_Id errorName errorTy
956 errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy)
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.
963 %************************************************************************
965 \subsection{Utilities}
967 %************************************************************************
970 pcMiscPrelId :: Name -> Type -> IdInfo -> Id
971 pcMiscPrelId name ty info
972 = mkVanillaGlobal name ty info
973 -- We lie and say the thing is imported; otherwise, we get into
974 -- a mess with dependency analysis; e.g., core2stg may heave in
975 -- random calls to GHCbase.unpackPS__. If GHCbase is the module
976 -- being compiled, then it's just a matter of luck if the definition
977 -- will be in "the right place" to be in scope.
979 pc_bottoming_Id name ty
980 = pcMiscPrelId name ty bottoming_info
982 bottoming_info = vanillaIdInfo `setAllStrictnessInfo` Just strict_sig
983 -- Do *not* mark them as NoCafRefs, because they can indeed have
984 -- CAF refs. For example, pAT_ERROR_ID calls GHC.Err.untangle,
985 -- which has some CAFs
986 -- In due course we may arrange that these error-y things are
987 -- regarded by the GC as permanently live, in which case we
988 -- can give them NoCaf info. As it is, any function that calls
989 -- any pc_bottoming_Id will itself have CafRefs, which bloats
992 strict_sig = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
993 -- These "bottom" out, no matter what their arguments
995 (openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars
996 openAlphaTy = mkTyVarTy openAlphaTyVar
997 openBetaTy = mkTyVarTy openBetaTyVar