A bunch of typofixes
[ghc.git] / compiler / basicTypes / MkId.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The AQUA Project, Glasgow University, 1998
4
5
6 This module contains definitions for the IdInfo for things that
7 have a standard form, namely:
8
9 - data constructors
10 - record selectors
11 - method and superclass selectors
12 - primitive operations
13 -}
14
15 {-# LANGUAGE CPP #-}
16
17 module MkId (
18 mkDictFunId, mkDictFunTy, mkDictSelId, mkDictSelRhs,
19
20 mkPrimOpId, mkFCallId,
21
22 wrapNewTypeBody, unwrapNewTypeBody,
23 wrapFamInstBody, unwrapFamInstScrut,
24 wrapTypeUnbranchedFamInstBody, unwrapTypeUnbranchedFamInstScrut,
25
26 DataConBoxer(..), mkDataConRep, mkDataConWorkId,
27
28 -- And some particular Ids; see below for why they are wired in
29 wiredInIds, ghcPrimIds,
30 unsafeCoerceName, unsafeCoerceId, realWorldPrimId,
31 voidPrimId, voidArgId,
32 nullAddrId, seqId, lazyId, lazyIdKey, runRWId,
33 coercionTokenId, magicDictId, coerceId,
34 proxyHashId, noinlineId, noinlineIdName,
35
36 -- Re-export error Ids
37 module PrelRules
38 ) where
39
40 #include "HsVersions.h"
41
42 import GhcPrelude
43
44 import Rules
45 import TysPrim
46 import TysWiredIn
47 import PrelRules
48 import Type
49 import FamInstEnv
50 import Coercion
51 import TcType
52 import MkCore
53 import CoreUtils ( exprType, mkCast )
54 import CoreUnfold
55 import Literal
56 import TyCon
57 import CoAxiom
58 import Class
59 import NameSet
60 import Name
61 import PrimOp
62 import ForeignCall
63 import DataCon
64 import Id
65 import IdInfo
66 import Demand
67 import CoreSyn
68 import Unique
69 import UniqSupply
70 import PrelNames
71 import BasicTypes hiding ( SuccessFlag(..) )
72 import Util
73 import Pair
74 import DynFlags
75 import Outputable
76 import FastString
77 import ListSetOps
78 import qualified GHC.LanguageExtensions as LangExt
79
80 import Data.Maybe ( maybeToList )
81
82 {-
83 ************************************************************************
84 * *
85 \subsection{Wired in Ids}
86 * *
87 ************************************************************************
88
89 Note [Wired-in Ids]
90 ~~~~~~~~~~~~~~~~~~~
91 There are several reasons why an Id might appear in the wiredInIds:
92
93 (1) The ghcPrimIds are wired in because they can't be defined in
94 Haskell at all, although the can be defined in Core. They have
95 compulsory unfoldings, so they are always inlined and they have
96 no definition site. Their home module is GHC.Prim, so they
97 also have a description in primops.txt.pp, where they are called
98 'pseudoops'.
99
100 (2) The 'error' function, eRROR_ID, is wired in because we don't yet have
101 a way to express in an interface file that the result type variable
102 is 'open'; that is can be unified with an unboxed type
103
104 [The interface file format now carry such information, but there's
105 no way yet of expressing at the definition site for these
106 error-reporting functions that they have an 'open'
107 result type. -- sof 1/99]
108
109 (3) Other error functions (rUNTIME_ERROR_ID) are wired in (a) because
110 the desugarer generates code that mentions them directly, and
111 (b) for the same reason as eRROR_ID
112
113 (4) lazyId is wired in because the wired-in version overrides the
114 strictness of the version defined in GHC.Base
115
116 (5) noinlineId is wired in because when we serialize to interfaces
117 we may insert noinline statements.
118
119 In cases (2-4), the function has a definition in a library module, and
120 can be called; but the wired-in version means that the details are
121 never read from that module's interface file; instead, the full definition
122 is right here.
123 -}
124
125 wiredInIds :: [Id]
126 wiredInIds
127 = [lazyId, dollarId, oneShotId, runRWId, noinlineId]
128 ++ errorIds -- Defined in MkCore
129 ++ ghcPrimIds
130
131 -- These Ids are exported from GHC.Prim
132 ghcPrimIds :: [Id]
133 ghcPrimIds
134 = [ -- These can't be defined in Haskell, but they have
135 -- perfectly reasonable unfoldings in Core
136 realWorldPrimId,
137 voidPrimId,
138 unsafeCoerceId,
139 nullAddrId,
140 seqId,
141 magicDictId,
142 coerceId,
143 proxyHashId
144 ]
145
146 {-
147 ************************************************************************
148 * *
149 \subsection{Data constructors}
150 * *
151 ************************************************************************
152
153 The wrapper for a constructor is an ordinary top-level binding that evaluates
154 any strict args, unboxes any args that are going to be flattened, and calls
155 the worker.
156
157 We're going to build a constructor that looks like:
158
159 data (Data a, C b) => T a b = T1 !a !Int b
160
161 T1 = /\ a b ->
162 \d1::Data a, d2::C b ->
163 \p q r -> case p of { p ->
164 case q of { q ->
165 Con T1 [a,b] [p,q,r]}}
166
167 Notice that
168
169 * d2 is thrown away --- a context in a data decl is used to make sure
170 one *could* construct dictionaries at the site the constructor
171 is used, but the dictionary isn't actually used.
172
173 * We have to check that we can construct Data dictionaries for
174 the types a and Int. Once we've done that we can throw d1 away too.
175
176 * We use (case p of q -> ...) to evaluate p, rather than "seq" because
177 all that matters is that the arguments are evaluated. "seq" is
178 very careful to preserve evaluation order, which we don't need
179 to be here.
180
181 You might think that we could simply give constructors some strictness
182 info, like PrimOps, and let CoreToStg do the let-to-case transformation.
183 But we don't do that because in the case of primops and functions strictness
184 is a *property* not a *requirement*. In the case of constructors we need to
185 do something active to evaluate the argument.
186
187 Making an explicit case expression allows the simplifier to eliminate
188 it in the (common) case where the constructor arg is already evaluated.
189
190 Note [Wrappers for data instance tycons]
191 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
192 In the case of data instances, the wrapper also applies the coercion turning
193 the representation type into the family instance type to cast the result of
194 the wrapper. For example, consider the declarations
195
196 data family Map k :: * -> *
197 data instance Map (a, b) v = MapPair (Map a (Pair b v))
198
199 The tycon to which the datacon MapPair belongs gets a unique internal
200 name of the form :R123Map, and we call it the representation tycon.
201 In contrast, Map is the family tycon (accessible via
202 tyConFamInst_maybe). A coercion allows you to move between
203 representation and family type. It is accessible from :R123Map via
204 tyConFamilyCoercion_maybe and has kind
205
206 Co123Map a b v :: {Map (a, b) v ~ :R123Map a b v}
207
208 The wrapper and worker of MapPair get the types
209
210 -- Wrapper
211 $WMapPair :: forall a b v. Map a (Map a b v) -> Map (a, b) v
212 $WMapPair a b v = MapPair a b v `cast` sym (Co123Map a b v)
213
214 -- Worker
215 MapPair :: forall a b v. Map a (Map a b v) -> :R123Map a b v
216
217 This coercion is conditionally applied by wrapFamInstBody.
218
219 It's a bit more complicated if the data instance is a GADT as well!
220
221 data instance T [a] where
222 T1 :: forall b. b -> T [Maybe b]
223
224 Hence we translate to
225
226 -- Wrapper
227 $WT1 :: forall b. b -> T [Maybe b]
228 $WT1 b v = T1 (Maybe b) b (Maybe b) v
229 `cast` sym (Co7T (Maybe b))
230
231 -- Worker
232 T1 :: forall c b. (c ~ Maybe b) => b -> :R7T c
233
234 -- Coercion from family type to representation type
235 Co7T a :: T [a] ~ :R7T a
236
237 Note [Newtype datacons]
238 ~~~~~~~~~~~~~~~~~~~~~~~
239 The "data constructor" for a newtype should always be vanilla. At one
240 point this wasn't true, because the newtype arising from
241 class C a => D a
242 looked like
243 newtype T:D a = D:D (C a)
244 so the data constructor for T:C had a single argument, namely the
245 predicate (C a). But now we treat that as an ordinary argument, not
246 part of the theta-type, so all is well.
247
248
249 ************************************************************************
250 * *
251 \subsection{Dictionary selectors}
252 * *
253 ************************************************************************
254
255 Selecting a field for a dictionary. If there is just one field, then
256 there's nothing to do.
257
258 Dictionary selectors may get nested forall-types. Thus:
259
260 class Foo a where
261 op :: forall b. Ord b => a -> b -> b
262
263 Then the top-level type for op is
264
265 op :: forall a. Foo a =>
266 forall b. Ord b =>
267 a -> b -> b
268
269 -}
270
271 mkDictSelId :: Name -- Name of one of the *value* selectors
272 -- (dictionary superclass or method)
273 -> Class -> Id
274 mkDictSelId name clas
275 = mkGlobalId (ClassOpId clas) name sel_ty info
276 where
277 tycon = classTyCon clas
278 sel_names = map idName (classAllSelIds clas)
279 new_tycon = isNewTyCon tycon
280 [data_con] = tyConDataCons tycon
281 tyvars = dataConUnivTyVarBinders data_con
282 n_ty_args = length tyvars
283 arg_tys = dataConRepArgTys data_con -- Includes the dictionary superclasses
284 val_index = assoc "MkId.mkDictSelId" (sel_names `zip` [0..]) name
285
286 sel_ty = mkForAllTys tyvars $
287 mkFunTy (mkClassPred clas (mkTyVarTys (binderVars tyvars))) $
288 getNth arg_tys val_index
289
290 base_info = noCafIdInfo
291 `setArityInfo` 1
292 `setStrictnessInfo` strict_sig
293 `setLevityInfoWithType` sel_ty
294
295 info | new_tycon
296 = base_info `setInlinePragInfo` alwaysInlinePragma
297 `setUnfoldingInfo` mkInlineUnfoldingWithArity 1
298 (mkDictSelRhs clas val_index)
299 -- See Note [Single-method classes] in TcInstDcls
300 -- for why alwaysInlinePragma
301
302 | otherwise
303 = base_info `setRuleInfo` mkRuleInfo [rule]
304 -- Add a magic BuiltinRule, but no unfolding
305 -- so that the rule is always available to fire.
306 -- See Note [ClassOp/DFun selection] in TcInstDcls
307
308 -- This is the built-in rule that goes
309 -- op (dfT d1 d2) ---> opT d1 d2
310 rule = BuiltinRule { ru_name = fsLit "Class op " `appendFS`
311 occNameFS (getOccName name)
312 , ru_fn = name
313 , ru_nargs = n_ty_args + 1
314 , ru_try = dictSelRule val_index n_ty_args }
315
316 -- The strictness signature is of the form U(AAAVAAAA) -> T
317 -- where the V depends on which item we are selecting
318 -- It's worth giving one, so that absence info etc is generated
319 -- even if the selector isn't inlined
320
321 strict_sig = mkClosedStrictSig [arg_dmd] topRes
322 arg_dmd | new_tycon = evalDmd
323 | otherwise = mkManyUsedDmd $
324 mkProdDmd [ if name == sel_name then evalDmd else absDmd
325 | sel_name <- sel_names ]
326
327 mkDictSelRhs :: Class
328 -> Int -- 0-indexed selector among (superclasses ++ methods)
329 -> CoreExpr
330 mkDictSelRhs clas val_index
331 = mkLams tyvars (Lam dict_id rhs_body)
332 where
333 tycon = classTyCon clas
334 new_tycon = isNewTyCon tycon
335 [data_con] = tyConDataCons tycon
336 tyvars = dataConUnivTyVars data_con
337 arg_tys = dataConRepArgTys data_con -- Includes the dictionary superclasses
338
339 the_arg_id = getNth arg_ids val_index
340 pred = mkClassPred clas (mkTyVarTys tyvars)
341 dict_id = mkTemplateLocal 1 pred
342 arg_ids = mkTemplateLocalsNum 2 arg_tys
343
344 rhs_body | new_tycon = unwrapNewTypeBody tycon (mkTyVarTys tyvars) (Var dict_id)
345 | otherwise = Case (Var dict_id) dict_id (idType the_arg_id)
346 [(DataAlt data_con, arg_ids, varToCoreExpr the_arg_id)]
347 -- varToCoreExpr needed for equality superclass selectors
348 -- sel a b d = case x of { MkC _ (g:a~b) _ -> CO g }
349
350 dictSelRule :: Int -> Arity -> RuleFun
351 -- Tries to persuade the argument to look like a constructor
352 -- application, using exprIsConApp_maybe, and then selects
353 -- from it
354 -- sel_i t1..tk (D t1..tk op1 ... opm) = opi
355 --
356 dictSelRule val_index n_ty_args _ id_unf _ args
357 | (dict_arg : _) <- drop n_ty_args args
358 , Just (_, _, con_args) <- exprIsConApp_maybe id_unf dict_arg
359 = Just (getNth con_args val_index)
360 | otherwise
361 = Nothing
362
363 {-
364 ************************************************************************
365 * *
366 Data constructors
367 * *
368 ************************************************************************
369 -}
370
371 mkDataConWorkId :: Name -> DataCon -> Id
372 mkDataConWorkId wkr_name data_con
373 | isNewTyCon tycon
374 = mkGlobalId (DataConWrapId data_con) wkr_name nt_wrap_ty nt_work_info
375 | otherwise
376 = mkGlobalId (DataConWorkId data_con) wkr_name alg_wkr_ty wkr_info
377
378 where
379 tycon = dataConTyCon data_con
380
381 ----------- Workers for data types --------------
382 alg_wkr_ty = dataConRepType data_con
383 wkr_arity = dataConRepArity data_con
384 wkr_info = noCafIdInfo
385 `setArityInfo` wkr_arity
386 `setStrictnessInfo` wkr_sig
387 `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated,
388 -- even if arity = 0
389 `setLevityInfoWithType` alg_wkr_ty
390 -- NB: unboxed tuples have workers, so we can't use
391 -- setNeverLevPoly
392
393 wkr_sig = mkClosedStrictSig (replicate wkr_arity topDmd) (dataConCPR data_con)
394 -- Note [Data-con worker strictness]
395 -- Notice that we do *not* say the worker is strict
396 -- even if the data constructor is declared strict
397 -- e.g. data T = MkT !(Int,Int)
398 -- Why? Because the *wrapper* is strict (and its unfolding has case
399 -- expressions that do the evals) but the *worker* itself is not.
400 -- If we pretend it is strict then when we see
401 -- case x of y -> $wMkT y
402 -- the simplifier thinks that y is "sure to be evaluated" (because
403 -- $wMkT is strict) and drops the case. No, $wMkT is not strict.
404 --
405 -- When the simplifier sees a pattern
406 -- case e of MkT x -> ...
407 -- it uses the dataConRepStrictness of MkT to mark x as evaluated;
408 -- but that's fine... dataConRepStrictness comes from the data con
409 -- not from the worker Id.
410
411 ----------- Workers for newtypes --------------
412 (nt_tvs, _, nt_arg_tys, _) = dataConSig data_con
413 res_ty_args = mkTyVarTys nt_tvs
414 nt_wrap_ty = dataConUserType data_con
415 nt_work_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo
416 `setArityInfo` 1 -- Arity 1
417 `setInlinePragInfo` alwaysInlinePragma
418 `setUnfoldingInfo` newtype_unf
419 `setLevityInfoWithType` nt_wrap_ty
420 id_arg1 = mkTemplateLocal 1 (head nt_arg_tys)
421 newtype_unf = ASSERT2( isVanillaDataCon data_con &&
422 isSingleton nt_arg_tys, ppr data_con )
423 -- Note [Newtype datacons]
424 mkCompulsoryUnfolding $
425 mkLams nt_tvs $ Lam id_arg1 $
426 wrapNewTypeBody tycon res_ty_args (Var id_arg1)
427
428 dataConCPR :: DataCon -> DmdResult
429 dataConCPR con
430 | isDataTyCon tycon -- Real data types only; that is,
431 -- not unboxed tuples or newtypes
432 , null (dataConExTyVars con) -- No existentials
433 , wkr_arity > 0
434 , wkr_arity <= mAX_CPR_SIZE
435 = if is_prod then vanillaCprProdRes (dataConRepArity con)
436 else cprSumRes (dataConTag con)
437 | otherwise
438 = topRes
439 where
440 is_prod = isProductTyCon tycon
441 tycon = dataConTyCon con
442 wkr_arity = dataConRepArity con
443
444 mAX_CPR_SIZE :: Arity
445 mAX_CPR_SIZE = 10
446 -- We do not treat very big tuples as CPR-ish:
447 -- a) for a start we get into trouble because there aren't
448 -- "enough" unboxed tuple types (a tiresome restriction,
449 -- but hard to fix),
450 -- b) more importantly, big unboxed tuples get returned mainly
451 -- on the stack, and are often then allocated in the heap
452 -- by the caller. So doing CPR for them may in fact make
453 -- things worse.
454
455 {-
456 -------------------------------------------------
457 -- Data constructor representation
458 --
459 -- This is where we decide how to wrap/unwrap the
460 -- constructor fields
461 --
462 --------------------------------------------------
463 -}
464
465 type Unboxer = Var -> UniqSM ([Var], CoreExpr -> CoreExpr)
466 -- Unbox: bind rep vars by decomposing src var
467
468 data Boxer = UnitBox | Boxer (TCvSubst -> UniqSM ([Var], CoreExpr))
469 -- Box: build src arg using these rep vars
470
471 -- | Data Constructor Boxer
472 newtype DataConBoxer = DCB ([Type] -> [Var] -> UniqSM ([Var], [CoreBind]))
473 -- Bind these src-level vars, returning the
474 -- rep-level vars to bind in the pattern
475
476 {-
477 Note [Inline partially-applied constructor wrappers]
478 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
479
480 We allow the wrapper to inline when partially applied to avoid
481 boxing values unnecessarily. For example, consider
482
483 data Foo a = Foo !Int a
484
485 instance Traversable Foo where
486 traverse f (Foo i a) = Foo i <$> f a
487
488 This desugars to
489
490 traverse f foo = case foo of
491 Foo i# a -> let i = I# i#
492 in map ($WFoo i) (f a)
493
494 If the wrapper `$WFoo` is not inlined, we get a fruitless reboxing of `i`.
495 But if we inline the wrapper, we get
496
497 map (\a. case i of I# i# a -> Foo i# a) (f a)
498
499 and now case-of-known-constructor eliminates the redundant allocation.
500 -}
501
502 mkDataConRep :: DynFlags
503 -> FamInstEnvs
504 -> Name
505 -> Maybe [HsImplBang]
506 -- See Note [Bangs on imported data constructors]
507 -> DataCon
508 -> UniqSM DataConRep
509 mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
510 | not wrapper_reqd
511 = return NoDataConRep
512
513 | otherwise
514 = do { wrap_args <- mapM newLocal wrap_arg_tys
515 ; wrap_body <- mk_rep_app (wrap_args `zip` dropList eq_spec unboxers)
516 initial_wrap_app
517
518 ; let wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty wrap_info
519 wrap_info = noCafIdInfo
520 `setArityInfo` wrap_arity
521 -- It's important to specify the arity, so that partial
522 -- applications are treated as values
523 `setInlinePragInfo` wrap_prag
524 `setUnfoldingInfo` wrap_unf
525 `setStrictnessInfo` wrap_sig
526 -- We need to get the CAF info right here because TidyPgm
527 -- does not tidy the IdInfo of implicit bindings (like the wrapper)
528 -- so it not make sure that the CAF info is sane
529 `setNeverLevPoly` wrap_ty
530
531 wrap_sig = mkClosedStrictSig wrap_arg_dmds (dataConCPR data_con)
532
533 wrap_arg_dmds = map mk_dmd arg_ibangs
534 mk_dmd str | isBanged str = evalDmd
535 | otherwise = topDmd
536
537 wrap_prag = alwaysInlinePragma `setInlinePragmaActivation`
538 ActiveAfter NoSourceText 2
539 -- See Note [Activation for data constructor wrappers]
540
541 -- The wrapper will usually be inlined (see wrap_unf), so its
542 -- strictness and CPR info is usually irrelevant. But this is
543 -- not always the case; GHC may choose not to inline it. In
544 -- particular, the wrapper constructor is not inlined inside
545 -- an INLINE rhs or when it is not applied to any arguments.
546 -- See Note [Inline partially-applied constructor wrappers]
547 -- Passing Nothing here allows the wrapper to inline when
548 -- unsaturated.
549 wrap_unf = mkInlineUnfolding wrap_rhs
550 wrap_tvs = (univ_tvs `minusList` map eqSpecTyVar eq_spec) ++ ex_tvs
551 wrap_rhs = mkLams wrap_tvs $
552 mkLams wrap_args $
553 wrapFamInstBody tycon res_ty_args $
554 wrap_body
555
556 ; return (DCR { dcr_wrap_id = wrap_id
557 , dcr_boxer = mk_boxer boxers
558 , dcr_arg_tys = rep_tys
559 , dcr_stricts = rep_strs
560 , dcr_bangs = arg_ibangs }) }
561
562 where
563 (univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys, _orig_res_ty)
564 = dataConFullSig data_con
565 res_ty_args = substTyVars (mkTvSubstPrs (map eqSpecPair eq_spec)) univ_tvs
566
567 tycon = dataConTyCon data_con -- The representation TyCon (not family)
568 wrap_ty = dataConUserType data_con
569 ev_tys = eqSpecPreds eq_spec ++ theta
570 all_arg_tys = ev_tys ++ orig_arg_tys
571 ev_ibangs = map (const HsLazy) ev_tys
572 orig_bangs = dataConSrcBangs data_con
573
574 wrap_arg_tys = theta ++ orig_arg_tys
575 wrap_arity = length wrap_arg_tys
576 -- The wrap_args are the arguments *other than* the eq_spec
577 -- Because we are going to apply the eq_spec args manually in the
578 -- wrapper
579
580 arg_ibangs =
581 case mb_bangs of
582 Nothing -> zipWith (dataConSrcToImplBang dflags fam_envs)
583 orig_arg_tys orig_bangs
584 Just bangs -> bangs
585
586 (rep_tys_w_strs, wrappers)
587 = unzip (zipWith dataConArgRep all_arg_tys (ev_ibangs ++ arg_ibangs))
588
589 (unboxers, boxers) = unzip wrappers
590 (rep_tys, rep_strs) = unzip (concat rep_tys_w_strs)
591
592 wrapper_reqd = not (isNewTyCon tycon) -- Newtypes have only a worker
593 && (any isBanged (ev_ibangs ++ arg_ibangs)
594 -- Some forcing/unboxing (includes eq_spec)
595 || isFamInstTyCon tycon -- Cast result
596 || (not $ null eq_spec)) -- GADT
597
598 initial_wrap_app = Var (dataConWorkId data_con)
599 `mkTyApps` res_ty_args
600 `mkVarApps` ex_tvs
601 `mkCoApps` map (mkReflCo Nominal . eqSpecType) eq_spec
602
603 mk_boxer :: [Boxer] -> DataConBoxer
604 mk_boxer boxers = DCB (\ ty_args src_vars ->
605 do { let (ex_vars, term_vars) = splitAtList ex_tvs src_vars
606 subst1 = zipTvSubst univ_tvs ty_args
607 subst2 = extendTvSubstList subst1 ex_tvs
608 (mkTyVarTys ex_vars)
609 ; (rep_ids, binds) <- go subst2 boxers term_vars
610 ; return (ex_vars ++ rep_ids, binds) } )
611
612 go _ [] src_vars = ASSERT2( null src_vars, ppr data_con ) return ([], [])
613 go subst (UnitBox : boxers) (src_var : src_vars)
614 = do { (rep_ids2, binds) <- go subst boxers src_vars
615 ; return (src_var : rep_ids2, binds) }
616 go subst (Boxer boxer : boxers) (src_var : src_vars)
617 = do { (rep_ids1, arg) <- boxer subst
618 ; (rep_ids2, binds) <- go subst boxers src_vars
619 ; return (rep_ids1 ++ rep_ids2, NonRec src_var arg : binds) }
620 go _ (_:_) [] = pprPanic "mk_boxer" (ppr data_con)
621
622 mk_rep_app :: [(Id,Unboxer)] -> CoreExpr -> UniqSM CoreExpr
623 mk_rep_app [] con_app
624 = return con_app
625 mk_rep_app ((wrap_arg, unboxer) : prs) con_app
626 = do { (rep_ids, unbox_fn) <- unboxer wrap_arg
627 ; expr <- mk_rep_app prs (mkVarApps con_app rep_ids)
628 ; return (unbox_fn expr) }
629
630 {- Note [Activation for data constructor wrappers]
631 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
632 The Activation on a data constructor wrapper allows it to inline in
633 Phase 2 and later (1, 0). But not in the InitialPhase. That gives
634 rewrite rules a chance to fire (in the InitialPhase) if they mention
635 a data constructor on the left
636 RULE "foo" f (K a b) = ...
637 Since the LHS of rules are simplified with InitialPhase, we won't
638 inline the wrapper on the LHS either.
639
640 People have asked for this before, but now that even the InitialPhase
641 does some inlining, it has become important.
642
643
644 Note [Bangs on imported data constructors]
645 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
646
647 We pass Maybe [HsImplBang] to mkDataConRep to make use of HsImplBangs
648 from imported modules.
649
650 - Nothing <=> use HsSrcBangs
651 - Just bangs <=> use HsImplBangs
652
653 For imported types we can't work it all out from the HsSrcBangs,
654 because we want to be very sure to follow what the original module
655 (where the data type was declared) decided, and that depends on what
656 flags were enabled when it was compiled. So we record the decisions in
657 the interface file.
658
659 The HsImplBangs passed are in 1-1 correspondence with the
660 dataConOrigArgTys of the DataCon.
661
662 Note [Data con wrappers and unlifted types]
663 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
664 Consider
665 data T = MkT !Int#
666
667 We certainly do not want to make a wrapper
668 $WMkT x = case x of y { DEFAULT -> MkT y }
669
670 For a start, it's still to generate a no-op. But worse, since wrappers
671 are currently injected at TidyCore, we don't even optimise it away!
672 So the stupid case expression stays there. This actually happened for
673 the Integer data type (see Trac #1600 comment:66)!
674 -}
675
676 -------------------------
677 newLocal :: Type -> UniqSM Var
678 newLocal ty = do { uniq <- getUniqueM
679 ; return (mkSysLocalOrCoVar (fsLit "dt") uniq ty) }
680
681 -- | Unpack/Strictness decisions from source module
682 dataConSrcToImplBang
683 :: DynFlags
684 -> FamInstEnvs
685 -> Type
686 -> HsSrcBang
687 -> HsImplBang
688
689 dataConSrcToImplBang dflags fam_envs arg_ty
690 (HsSrcBang ann unpk NoSrcStrict)
691 | xopt LangExt.StrictData dflags -- StrictData => strict field
692 = dataConSrcToImplBang dflags fam_envs arg_ty
693 (HsSrcBang ann unpk SrcStrict)
694 | otherwise -- no StrictData => lazy field
695 = HsLazy
696
697 dataConSrcToImplBang _ _ _ (HsSrcBang _ _ SrcLazy)
698 = HsLazy
699
700 dataConSrcToImplBang dflags fam_envs arg_ty
701 (HsSrcBang _ unpk_prag SrcStrict)
702 | isUnliftedType arg_ty
703 = HsLazy -- For !Int#, say, use HsLazy
704 -- See Note [Data con wrappers and unlifted types]
705
706 | not (gopt Opt_OmitInterfacePragmas dflags) -- Don't unpack if -fomit-iface-pragmas
707 -- Don't unpack if we aren't optimising; rather arbitrarily,
708 -- we use -fomit-iface-pragmas as the indication
709 , let mb_co = topNormaliseType_maybe fam_envs arg_ty
710 -- Unwrap type families and newtypes
711 arg_ty' = case mb_co of { Just (_,ty) -> ty; Nothing -> arg_ty }
712 , isUnpackableType dflags fam_envs arg_ty'
713 , (rep_tys, _) <- dataConArgUnpack arg_ty'
714 , case unpk_prag of
715 NoSrcUnpack ->
716 gopt Opt_UnboxStrictFields dflags
717 || (gopt Opt_UnboxSmallStrictFields dflags
718 && rep_tys `lengthAtMost` 1) -- See Note [Unpack one-wide fields]
719 srcUnpack -> isSrcUnpacked srcUnpack
720 = case mb_co of
721 Nothing -> HsUnpack Nothing
722 Just (co,_) -> HsUnpack (Just co)
723
724 | otherwise -- Record the strict-but-no-unpack decision
725 = HsStrict
726
727
728 -- | Wrappers/Workers and representation following Unpack/Strictness
729 -- decisions
730 dataConArgRep
731 :: Type
732 -> HsImplBang
733 -> ([(Type,StrictnessMark)] -- Rep types
734 ,(Unboxer,Boxer))
735
736 dataConArgRep arg_ty HsLazy
737 = ([(arg_ty, NotMarkedStrict)], (unitUnboxer, unitBoxer))
738
739 dataConArgRep arg_ty HsStrict
740 = ([(arg_ty, MarkedStrict)], (seqUnboxer, unitBoxer))
741
742 dataConArgRep arg_ty (HsUnpack Nothing)
743 | (rep_tys, wrappers) <- dataConArgUnpack arg_ty
744 = (rep_tys, wrappers)
745
746 dataConArgRep _ (HsUnpack (Just co))
747 | let co_rep_ty = pSnd (coercionKind co)
748 , (rep_tys, wrappers) <- dataConArgUnpack co_rep_ty
749 = (rep_tys, wrapCo co co_rep_ty wrappers)
750
751
752 -------------------------
753 wrapCo :: Coercion -> Type -> (Unboxer, Boxer) -> (Unboxer, Boxer)
754 wrapCo co rep_ty (unbox_rep, box_rep) -- co :: arg_ty ~ rep_ty
755 = (unboxer, boxer)
756 where
757 unboxer arg_id = do { rep_id <- newLocal rep_ty
758 ; (rep_ids, rep_fn) <- unbox_rep rep_id
759 ; let co_bind = NonRec rep_id (Var arg_id `Cast` co)
760 ; return (rep_ids, Let co_bind . rep_fn) }
761 boxer = Boxer $ \ subst ->
762 do { (rep_ids, rep_expr)
763 <- case box_rep of
764 UnitBox -> do { rep_id <- newLocal (TcType.substTy subst rep_ty)
765 ; return ([rep_id], Var rep_id) }
766 Boxer boxer -> boxer subst
767 ; let sco = substCoUnchecked subst co
768 ; return (rep_ids, rep_expr `Cast` mkSymCo sco) }
769
770 ------------------------
771 seqUnboxer :: Unboxer
772 seqUnboxer v = return ([v], \e -> Case (Var v) v (exprType e) [(DEFAULT, [], e)])
773
774 unitUnboxer :: Unboxer
775 unitUnboxer v = return ([v], \e -> e)
776
777 unitBoxer :: Boxer
778 unitBoxer = UnitBox
779
780 -------------------------
781 dataConArgUnpack
782 :: Type
783 -> ( [(Type, StrictnessMark)] -- Rep types
784 , (Unboxer, Boxer) )
785
786 dataConArgUnpack arg_ty
787 | Just (tc, tc_args) <- splitTyConApp_maybe arg_ty
788 , Just con <- tyConSingleAlgDataCon_maybe tc
789 -- NB: check for an *algebraic* data type
790 -- A recursive newtype might mean that
791 -- 'arg_ty' is a newtype
792 , let rep_tys = dataConInstArgTys con tc_args
793 = ASSERT( isVanillaDataCon con )
794 ( rep_tys `zip` dataConRepStrictness con
795 ,( \ arg_id ->
796 do { rep_ids <- mapM newLocal rep_tys
797 ; let unbox_fn body
798 = Case (Var arg_id) arg_id (exprType body)
799 [(DataAlt con, rep_ids, body)]
800 ; return (rep_ids, unbox_fn) }
801 , Boxer $ \ subst ->
802 do { rep_ids <- mapM (newLocal . TcType.substTyUnchecked subst) rep_tys
803 ; return (rep_ids, Var (dataConWorkId con)
804 `mkTyApps` (substTysUnchecked subst tc_args)
805 `mkVarApps` rep_ids ) } ) )
806 | otherwise
807 = pprPanic "dataConArgUnpack" (ppr arg_ty)
808 -- An interface file specified Unpacked, but we couldn't unpack it
809
810 isUnpackableType :: DynFlags -> FamInstEnvs -> Type -> Bool
811 -- True if we can unpack the UNPACK the argument type
812 -- See Note [Recursive unboxing]
813 -- We look "deeply" inside rather than relying on the DataCons
814 -- we encounter on the way, because otherwise we might well
815 -- end up relying on ourselves!
816 isUnpackableType dflags fam_envs ty
817 | Just (tc, _) <- splitTyConApp_maybe ty
818 , Just con <- tyConSingleAlgDataCon_maybe tc
819 , isVanillaDataCon con
820 = ok_con_args (unitNameSet (getName tc)) con
821 | otherwise
822 = False
823 where
824 ok_arg tcs (ty, bang) = not (attempt_unpack bang) || ok_ty tcs norm_ty
825 where
826 norm_ty = topNormaliseType fam_envs ty
827 ok_ty tcs ty
828 | Just (tc, _) <- splitTyConApp_maybe ty
829 , let tc_name = getName tc
830 = not (tc_name `elemNameSet` tcs)
831 && case tyConSingleAlgDataCon_maybe tc of
832 Just con | isVanillaDataCon con
833 -> ok_con_args (tcs `extendNameSet` getName tc) con
834 _ -> True
835 | otherwise
836 = True
837
838 ok_con_args tcs con
839 = all (ok_arg tcs) (dataConOrigArgTys con `zip` dataConSrcBangs con)
840 -- NB: dataConSrcBangs gives the *user* request;
841 -- We'd get a black hole if we used dataConImplBangs
842
843 attempt_unpack (HsSrcBang _ SrcUnpack NoSrcStrict)
844 = xopt LangExt.StrictData dflags
845 attempt_unpack (HsSrcBang _ SrcUnpack SrcStrict)
846 = True
847 attempt_unpack (HsSrcBang _ NoSrcUnpack SrcStrict)
848 = True -- Be conservative
849 attempt_unpack (HsSrcBang _ NoSrcUnpack NoSrcStrict)
850 = xopt LangExt.StrictData dflags -- Be conservative
851 attempt_unpack _ = False
852
853 {-
854 Note [Unpack one-wide fields]
855 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
856 The flag UnboxSmallStrictFields ensures that any field that can
857 (safely) be unboxed to a word-sized unboxed field, should be so unboxed.
858 For example:
859
860 data A = A Int#
861 newtype B = B A
862 data C = C !B
863 data D = D !C
864 data E = E !()
865 data F = F !D
866 data G = G !F !F
867
868 All of these should have an Int# as their representation, except
869 G which should have two Int#s.
870
871 However
872
873 data T = T !(S Int)
874 data S = S !a
875
876 Here we can represent T with an Int#.
877
878 Note [Recursive unboxing]
879 ~~~~~~~~~~~~~~~~~~~~~~~~~
880 Consider
881 data R = MkR {-# UNPACK #-} !S Int
882 data S = MkS {-# UNPACK #-} !Int
883 The representation arguments of MkR are the *representation* arguments
884 of S (plus Int); the rep args of MkS are Int#. This is all fine.
885
886 But be careful not to try to unbox this!
887 data T = MkT {-# UNPACK #-} !T Int
888 Because then we'd get an infinite number of arguments.
889
890 Here is a more complicated case:
891 data S = MkS {-# UNPACK #-} !T Int
892 data T = MkT {-# UNPACK #-} !S Int
893 Each of S and T must decide independently whether to unpack
894 and they had better not both say yes. So they must both say no.
895
896 Also behave conservatively when there is no UNPACK pragma
897 data T = MkS !T Int
898 with -funbox-strict-fields or -funbox-small-strict-fields
899 we need to behave as if there was an UNPACK pragma there.
900
901 But it's the *argument* type that matters. This is fine:
902 data S = MkS S !Int
903 because Int is non-recursive.
904
905 ************************************************************************
906 * *
907 Wrapping and unwrapping newtypes and type families
908 * *
909 ************************************************************************
910 -}
911
912 wrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
913 -- The wrapper for the data constructor for a newtype looks like this:
914 -- newtype T a = MkT (a,Int)
915 -- MkT :: forall a. (a,Int) -> T a
916 -- MkT = /\a. \(x:(a,Int)). x `cast` sym (CoT a)
917 -- where CoT is the coercion TyCon associated with the newtype
918 --
919 -- The call (wrapNewTypeBody T [a] e) returns the
920 -- body of the wrapper, namely
921 -- e `cast` (CoT [a])
922 --
923 -- If a coercion constructor is provided in the newtype, then we use
924 -- it, otherwise the wrap/unwrap are both no-ops
925 --
926 -- If the we are dealing with a newtype *instance*, we have a second coercion
927 -- identifying the family instance with the constructor of the newtype
928 -- instance. This coercion is applied in any case (ie, composed with the
929 -- coercion constructor of the newtype or applied by itself).
930
931 wrapNewTypeBody tycon args result_expr
932 = ASSERT( isNewTyCon tycon )
933 wrapFamInstBody tycon args $
934 mkCast result_expr (mkSymCo co)
935 where
936 co = mkUnbranchedAxInstCo Representational (newTyConCo tycon) args []
937
938 -- When unwrapping, we do *not* apply any family coercion, because this will
939 -- be done via a CoPat by the type checker. We have to do it this way as
940 -- computing the right type arguments for the coercion requires more than just
941 -- a spliting operation (cf, TcPat.tcConPat).
942
943 unwrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
944 unwrapNewTypeBody tycon args result_expr
945 = ASSERT( isNewTyCon tycon )
946 mkCast result_expr (mkUnbranchedAxInstCo Representational (newTyConCo tycon) args [])
947
948 -- If the type constructor is a representation type of a data instance, wrap
949 -- the expression into a cast adjusting the expression type, which is an
950 -- instance of the representation type, to the corresponding instance of the
951 -- family instance type.
952 -- See Note [Wrappers for data instance tycons]
953 wrapFamInstBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
954 wrapFamInstBody tycon args body
955 | Just co_con <- tyConFamilyCoercion_maybe tycon
956 = mkCast body (mkSymCo (mkUnbranchedAxInstCo Representational co_con args []))
957 | otherwise
958 = body
959
960 -- Same as `wrapFamInstBody`, but for type family instances, which are
961 -- represented by a `CoAxiom`, and not a `TyCon`
962 wrapTypeFamInstBody :: CoAxiom br -> Int -> [Type] -> [Coercion]
963 -> CoreExpr -> CoreExpr
964 wrapTypeFamInstBody axiom ind args cos body
965 = mkCast body (mkSymCo (mkAxInstCo Representational axiom ind args cos))
966
967 wrapTypeUnbranchedFamInstBody :: CoAxiom Unbranched -> [Type] -> [Coercion]
968 -> CoreExpr -> CoreExpr
969 wrapTypeUnbranchedFamInstBody axiom
970 = wrapTypeFamInstBody axiom 0
971
972 unwrapFamInstScrut :: TyCon -> [Type] -> CoreExpr -> CoreExpr
973 unwrapFamInstScrut tycon args scrut
974 | Just co_con <- tyConFamilyCoercion_maybe tycon
975 = mkCast scrut (mkUnbranchedAxInstCo Representational co_con args []) -- data instances only
976 | otherwise
977 = scrut
978
979 unwrapTypeFamInstScrut :: CoAxiom br -> Int -> [Type] -> [Coercion]
980 -> CoreExpr -> CoreExpr
981 unwrapTypeFamInstScrut axiom ind args cos scrut
982 = mkCast scrut (mkAxInstCo Representational axiom ind args cos)
983
984 unwrapTypeUnbranchedFamInstScrut :: CoAxiom Unbranched -> [Type] -> [Coercion]
985 -> CoreExpr -> CoreExpr
986 unwrapTypeUnbranchedFamInstScrut axiom
987 = unwrapTypeFamInstScrut axiom 0
988
989 {-
990 ************************************************************************
991 * *
992 \subsection{Primitive operations}
993 * *
994 ************************************************************************
995 -}
996
997 mkPrimOpId :: PrimOp -> Id
998 mkPrimOpId prim_op
999 = id
1000 where
1001 (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
1002 ty = mkSpecForAllTys tyvars (mkFunTys arg_tys res_ty)
1003 name = mkWiredInName gHC_PRIM (primOpOcc prim_op)
1004 (mkPrimOpIdUnique (primOpTag prim_op))
1005 (AnId id) UserSyntax
1006 id = mkGlobalId (PrimOpId prim_op) name ty info
1007
1008 info = noCafIdInfo
1009 `setRuleInfo` mkRuleInfo (maybeToList $ primOpRules name prim_op)
1010 `setArityInfo` arity
1011 `setStrictnessInfo` strict_sig
1012 `setInlinePragInfo` neverInlinePragma
1013 `setLevityInfoWithType` res_ty
1014 -- We give PrimOps a NOINLINE pragma so that we don't
1015 -- get silly warnings from Desugar.dsRule (the inline_shadows_rule
1016 -- test) about a RULE conflicting with a possible inlining
1017 -- cf Trac #7287
1018
1019 -- For each ccall we manufacture a separate CCallOpId, giving it
1020 -- a fresh unique, a type that is correct for this particular ccall,
1021 -- and a CCall structure that gives the correct details about calling
1022 -- convention etc.
1023 --
1024 -- The *name* of this Id is a local name whose OccName gives the full
1025 -- details of the ccall, type and all. This means that the interface
1026 -- file reader can reconstruct a suitable Id
1027
1028 mkFCallId :: DynFlags -> Unique -> ForeignCall -> Type -> Id
1029 mkFCallId dflags uniq fcall ty
1030 = ASSERT( noFreeVarsOfType ty )
1031 -- A CCallOpId should have no free type variables;
1032 -- when doing substitutions won't substitute over it
1033 mkGlobalId (FCallId fcall) name ty info
1034 where
1035 occ_str = showSDoc dflags (braces (ppr fcall <+> ppr ty))
1036 -- The "occurrence name" of a ccall is the full info about the
1037 -- ccall; it is encoded, but may have embedded spaces etc!
1038
1039 name = mkFCallName uniq occ_str
1040
1041 info = noCafIdInfo
1042 `setArityInfo` arity
1043 `setStrictnessInfo` strict_sig
1044 `setLevityInfoWithType` ty
1045
1046 (bndrs, _) = tcSplitPiTys ty
1047 arity = count isAnonTyBinder bndrs
1048 strict_sig = mkClosedStrictSig (replicate arity topDmd) topRes
1049 -- the call does not claim to be strict in its arguments, since they
1050 -- may be lifted (foreign import prim) and the called code doesn't
1051 -- necessarily force them. See Trac #11076.
1052 {-
1053 ************************************************************************
1054 * *
1055 \subsection{DictFuns and default methods}
1056 * *
1057 ************************************************************************
1058
1059 Note [Dict funs and default methods]
1060 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1061 Dict funs and default methods are *not* ImplicitIds. Their definition
1062 involves user-written code, so we can't figure out their strictness etc
1063 based on fixed info, as we can for constructors and record selectors (say).
1064
1065 NB: See also Note [Exported LocalIds] in Id
1066 -}
1067
1068 mkDictFunId :: Name -- Name to use for the dict fun;
1069 -> [TyVar]
1070 -> ThetaType
1071 -> Class
1072 -> [Type]
1073 -> Id
1074 -- Implements the DFun Superclass Invariant (see TcInstDcls)
1075 -- See Note [Dict funs and default methods]
1076
1077 mkDictFunId dfun_name tvs theta clas tys
1078 = mkExportedLocalId (DFunId is_nt)
1079 dfun_name
1080 dfun_ty
1081 where
1082 is_nt = isNewTyCon (classTyCon clas)
1083 dfun_ty = mkDictFunTy tvs theta clas tys
1084
1085 mkDictFunTy :: [TyVar] -> ThetaType -> Class -> [Type] -> Type
1086 mkDictFunTy tvs theta clas tys
1087 = mkSpecSigmaTy tvs theta (mkClassPred clas tys)
1088
1089 {-
1090 ************************************************************************
1091 * *
1092 \subsection{Un-definable}
1093 * *
1094 ************************************************************************
1095
1096 These Ids can't be defined in Haskell. They could be defined in
1097 unfoldings in the wired-in GHC.Prim interface file, but we'd have to
1098 ensure that they were definitely, definitely inlined, because there is
1099 no curried identifier for them. That's what mkCompulsoryUnfolding
1100 does. If we had a way to get a compulsory unfolding from an interface
1101 file, we could do that, but we don't right now.
1102
1103 unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
1104 just gets expanded into a type coercion wherever it occurs. Hence we
1105 add it as a built-in Id with an unfolding here.
1106
1107 The type variables we use here are "open" type variables: this means
1108 they can unify with both unlifted and lifted types. Hence we provide
1109 another gun with which to shoot yourself in the foot.
1110 -}
1111
1112 lazyIdName, unsafeCoerceName, nullAddrName, seqName,
1113 realWorldName, voidPrimIdName, coercionTokenName,
1114 magicDictName, coerceName, proxyName, dollarName, oneShotName,
1115 runRWName, noinlineIdName :: Name
1116 unsafeCoerceName = mkWiredInIdName gHC_PRIM (fsLit "unsafeCoerce#") unsafeCoerceIdKey unsafeCoerceId
1117 nullAddrName = mkWiredInIdName gHC_PRIM (fsLit "nullAddr#") nullAddrIdKey nullAddrId
1118 seqName = mkWiredInIdName gHC_PRIM (fsLit "seq") seqIdKey seqId
1119 realWorldName = mkWiredInIdName gHC_PRIM (fsLit "realWorld#") realWorldPrimIdKey realWorldPrimId
1120 voidPrimIdName = mkWiredInIdName gHC_PRIM (fsLit "void#") voidPrimIdKey voidPrimId
1121 lazyIdName = mkWiredInIdName gHC_MAGIC (fsLit "lazy") lazyIdKey lazyId
1122 coercionTokenName = mkWiredInIdName gHC_PRIM (fsLit "coercionToken#") coercionTokenIdKey coercionTokenId
1123 magicDictName = mkWiredInIdName gHC_PRIM (fsLit "magicDict") magicDictKey magicDictId
1124 coerceName = mkWiredInIdName gHC_PRIM (fsLit "coerce") coerceKey coerceId
1125 proxyName = mkWiredInIdName gHC_PRIM (fsLit "proxy#") proxyHashKey proxyHashId
1126 dollarName = mkWiredInIdName gHC_BASE (fsLit "$") dollarIdKey dollarId
1127 oneShotName = mkWiredInIdName gHC_MAGIC (fsLit "oneShot") oneShotKey oneShotId
1128 runRWName = mkWiredInIdName gHC_MAGIC (fsLit "runRW#") runRWKey runRWId
1129 noinlineIdName = mkWiredInIdName gHC_MAGIC (fsLit "noinline") noinlineIdKey noinlineId
1130
1131 dollarId :: Id -- Note [dollarId magic]
1132 dollarId = pcMiscPrelId dollarName ty
1133 (noCafIdInfo `setUnfoldingInfo` unf)
1134 where
1135 fun_ty = mkFunTy alphaTy openBetaTy
1136 ty = mkSpecForAllTys [runtimeRep2TyVar, alphaTyVar, openBetaTyVar] $
1137 mkFunTy fun_ty fun_ty
1138 unf = mkInlineUnfoldingWithArity 2 rhs
1139 [f,x] = mkTemplateLocals [fun_ty, alphaTy]
1140 rhs = mkLams [runtimeRep2TyVar, alphaTyVar, openBetaTyVar, f, x] $
1141 App (Var f) (Var x)
1142
1143 ------------------------------------------------
1144 proxyHashId :: Id
1145 proxyHashId
1146 = pcMiscPrelId proxyName ty
1147 (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings]
1148 `setNeverLevPoly` ty )
1149 where
1150 -- proxy# :: forall k (a:k). Proxy# k a
1151 bndrs = mkTemplateKiTyVars [liftedTypeKind] (\ks -> ks)
1152 [k,t] = mkTyVarTys bndrs
1153 ty = mkSpecForAllTys bndrs (mkProxyPrimTy k t)
1154
1155 ------------------------------------------------
1156 unsafeCoerceId :: Id
1157 unsafeCoerceId
1158 = pcMiscPrelId unsafeCoerceName ty info
1159 where
1160 info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
1161 `setUnfoldingInfo` mkCompulsoryUnfolding rhs
1162
1163 -- unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
1164 -- (a :: TYPE r1) (b :: TYPE r2).
1165 -- a -> b
1166 bndrs = mkTemplateKiTyVars [runtimeRepTy, runtimeRepTy]
1167 (\ks -> map tYPE ks)
1168
1169 [_, _, a, b] = mkTyVarTys bndrs
1170
1171 ty = mkSpecForAllTys bndrs (mkFunTy a b)
1172
1173 [x] = mkTemplateLocals [a]
1174 rhs = mkLams (bndrs ++ [x]) $
1175 Cast (Var x) (mkUnsafeCo Representational a b)
1176
1177 ------------------------------------------------
1178 nullAddrId :: Id
1179 -- nullAddr# :: Addr#
1180 -- The reason it is here is because we don't provide
1181 -- a way to write this literal in Haskell.
1182 nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info
1183 where
1184 info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
1185 `setUnfoldingInfo` mkCompulsoryUnfolding (Lit nullAddrLit)
1186 `setNeverLevPoly` addrPrimTy
1187
1188 ------------------------------------------------
1189 seqId :: Id -- See Note [seqId magic]
1190 seqId = pcMiscPrelId seqName ty info
1191 where
1192 info = noCafIdInfo `setInlinePragInfo` inline_prag
1193 `setUnfoldingInfo` mkCompulsoryUnfolding rhs
1194 `setNeverLevPoly` ty
1195
1196 inline_prag
1197 = alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter
1198 NoSourceText 0
1199 -- Make 'seq' not inline-always, so that simpleOptExpr
1200 -- (see CoreSubst.simple_app) won't inline 'seq' on the
1201 -- LHS of rules. That way we can have rules for 'seq';
1202 -- see Note [seqId magic]
1203
1204 ty = mkSpecForAllTys [alphaTyVar,betaTyVar]
1205 (mkFunTy alphaTy (mkFunTy betaTy betaTy))
1206
1207 [x,y] = mkTemplateLocals [alphaTy, betaTy]
1208 rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x betaTy [(DEFAULT, [], Var y)])
1209
1210 ------------------------------------------------
1211 lazyId :: Id -- See Note [lazyId magic]
1212 lazyId = pcMiscPrelId lazyIdName ty info
1213 where
1214 info = noCafIdInfo `setNeverLevPoly` ty
1215 ty = mkSpecForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
1216
1217 noinlineId :: Id -- See Note [noinlineId magic]
1218 noinlineId = pcMiscPrelId noinlineIdName ty info
1219 where
1220 info = noCafIdInfo `setNeverLevPoly` ty
1221 ty = mkSpecForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
1222
1223 oneShotId :: Id -- See Note [The oneShot function]
1224 oneShotId = pcMiscPrelId oneShotName ty info
1225 where
1226 info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
1227 `setUnfoldingInfo` mkCompulsoryUnfolding rhs
1228 ty = mkSpecForAllTys [ runtimeRep1TyVar, runtimeRep2TyVar
1229 , openAlphaTyVar, openBetaTyVar ]
1230 (mkFunTy fun_ty fun_ty)
1231 fun_ty = mkFunTy openAlphaTy openBetaTy
1232 [body, x] = mkTemplateLocals [fun_ty, openAlphaTy]
1233 x' = setOneShotLambda x
1234 rhs = mkLams [ runtimeRep1TyVar, runtimeRep2TyVar
1235 , openAlphaTyVar, openBetaTyVar
1236 , body, x'] $
1237 Var body `App` Var x
1238
1239 runRWId :: Id -- See Note [runRW magic] in this module
1240 runRWId = pcMiscPrelId runRWName ty info
1241 where
1242 info = noCafIdInfo `setInlinePragInfo` neverInlinePragma
1243 `setStrictnessInfo` strict_sig
1244 `setArityInfo` 1
1245 strict_sig = mkClosedStrictSig [strictApply1Dmd] topRes
1246 -- Important to express its strictness,
1247 -- since it is not inlined until CorePrep
1248 -- Also see Note [runRW arg] in CorePrep
1249
1250 -- State# RealWorld
1251 stateRW = mkTyConApp statePrimTyCon [realWorldTy]
1252 -- o
1253 ret_ty = openAlphaTy
1254 -- State# RealWorld -> o
1255 arg_ty = stateRW `mkFunTy` ret_ty
1256 -- (State# RealWorld -> o) -> o
1257 ty = mkSpecForAllTys [runtimeRep1TyVar, openAlphaTyVar] $
1258 arg_ty `mkFunTy` ret_ty
1259
1260 --------------------------------------------------------------------------------
1261 magicDictId :: Id -- See Note [magicDictId magic]
1262 magicDictId = pcMiscPrelId magicDictName ty info
1263 where
1264 info = noCafIdInfo `setInlinePragInfo` neverInlinePragma
1265 `setNeverLevPoly` ty
1266 ty = mkSpecForAllTys [alphaTyVar] alphaTy
1267
1268 --------------------------------------------------------------------------------
1269
1270 coerceId :: Id
1271 coerceId = pcMiscPrelId coerceName ty info
1272 where
1273 info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
1274 `setUnfoldingInfo` mkCompulsoryUnfolding rhs
1275 `setNeverLevPoly` ty
1276 eqRTy = mkTyConApp coercibleTyCon [ liftedTypeKind
1277 , alphaTy, betaTy ]
1278 eqRPrimTy = mkTyConApp eqReprPrimTyCon [ liftedTypeKind
1279 , liftedTypeKind
1280 , alphaTy, betaTy ]
1281 ty = mkSpecForAllTys [alphaTyVar, betaTyVar] $
1282 mkFunTys [eqRTy, alphaTy] betaTy
1283
1284 [eqR,x,eq] = mkTemplateLocals [eqRTy, alphaTy, eqRPrimTy]
1285 rhs = mkLams [alphaTyVar, betaTyVar, eqR, x] $
1286 mkWildCase (Var eqR) eqRTy betaTy $
1287 [(DataAlt coercibleDataCon, [eq], Cast (Var x) (mkCoVarCo eq))]
1288
1289 {-
1290 Note [dollarId magic]
1291 ~~~~~~~~~~~~~~~~~~~~~
1292 The only reason that ($) is wired in is so that its type can be
1293 forall (a:*, b:Open). (a->b) -> a -> b
1294 That is, the return type can be unboxed. E.g. this is OK
1295 foo $ True where foo :: Bool -> Int#
1296 because ($) doesn't inspect or move the result of the call to foo.
1297 See Trac #8739.
1298
1299 There is a special typing rule for ($) in TcExpr, so the type of ($)
1300 isn't looked at there, BUT Lint subsequently (and rightly) complains
1301 if sees ($) applied to Int# (say), unless we give it a wired-in type
1302 as we do here.
1303
1304 Note [Unsafe coerce magic]
1305 ~~~~~~~~~~~~~~~~~~~~~~~~~~
1306 We define a *primitive*
1307 GHC.Prim.unsafeCoerce#
1308 and then in the base library we define the ordinary function
1309 Unsafe.Coerce.unsafeCoerce :: forall (a:*) (b:*). a -> b
1310 unsafeCoerce x = unsafeCoerce# x
1311
1312 Notice that unsafeCoerce has a civilized (albeit still dangerous)
1313 polymorphic type, whose type args have kind *. So you can't use it on
1314 unboxed values (unsafeCoerce 3#).
1315
1316 In contrast unsafeCoerce# is even more dangerous because you *can* use
1317 it on unboxed things, (unsafeCoerce# 3#) :: Int. Its type is
1318 forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) (a: TYPE r1) (b: TYPE r2). a -> b
1319
1320 Note [seqId magic]
1321 ~~~~~~~~~~~~~~~~~~
1322 'GHC.Prim.seq' is special in several ways.
1323
1324 a) In source Haskell its second arg can have an unboxed type
1325 x `seq` (v +# w)
1326 But see Note [Typing rule for seq] in TcExpr, which
1327 explains why we give seq itself an ordinary type
1328 seq :: forall a b. a -> b -> b
1329 and treat it as a language construct from a typing point of view.
1330
1331 b) Its fixity is set in LoadIface.ghcPrimIface
1332
1333 c) It has quite a bit of desugaring magic.
1334 See DsUtils.hs Note [Desugaring seq (1)] and (2) and (3)
1335
1336 d) There is some special rule handing: Note [User-defined RULES for seq]
1337
1338 Note [User-defined RULES for seq]
1339 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1340 Roman found situations where he had
1341 case (f n) of _ -> e
1342 where he knew that f (which was strict in n) would terminate if n did.
1343 Notice that the result of (f n) is discarded. So it makes sense to
1344 transform to
1345 case n of _ -> e
1346
1347 Rather than attempt some general analysis to support this, I've added
1348 enough support that you can do this using a rewrite rule:
1349
1350 RULE "f/seq" forall n. seq (f n) = seq n
1351
1352 You write that rule. When GHC sees a case expression that discards
1353 its result, it mentally transforms it to a call to 'seq' and looks for
1354 a RULE. (This is done in Simplify.trySeqRules.) As usual, the
1355 correctness of the rule is up to you.
1356
1357 VERY IMPORTANT: to make this work, we give the RULE an arity of 1, not 2.
1358 If we wrote
1359 RULE "f/seq" forall n e. seq (f n) e = seq n e
1360 with rule arity 2, then two bad things would happen:
1361
1362 - The magical desugaring done in Note [seqId magic] item (c)
1363 for saturated application of 'seq' would turn the LHS into
1364 a case expression!
1365
1366 - The code in Simplify.rebuildCase would need to actually supply
1367 the value argument, which turns out to be awkward.
1368
1369 Note [lazyId magic]
1370 ~~~~~~~~~~~~~~~~~~~
1371 lazy :: forall a?. a? -> a? (i.e. works for unboxed types too)
1372
1373 'lazy' is used to make sure that a sub-expression, and its free variables,
1374 are truly used call-by-need, with no code motion. Key examples:
1375
1376 * pseq: pseq a b = a `seq` lazy b
1377 We want to make sure that the free vars of 'b' are not evaluated
1378 before 'a', even though the expression is plainly strict in 'b'.
1379
1380 * catch: catch a b = catch# (lazy a) b
1381 Again, it's clear that 'a' will be evaluated strictly (and indeed
1382 applied to a state token) but we want to make sure that any exceptions
1383 arising from the evaluation of 'a' are caught by the catch (see
1384 Trac #11555).
1385
1386 Implementing 'lazy' is a bit tricky:
1387
1388 * It must not have a strictness signature: by being a built-in Id,
1389 all the info about lazyId comes from here, not from GHC.Base.hi.
1390 This is important, because the strictness analyser will spot it as
1391 strict!
1392
1393 * It must not have an unfolding: it gets "inlined" by a HACK in
1394 CorePrep. It's very important to do this inlining *after* unfoldings
1395 are exposed in the interface file. Otherwise, the unfolding for
1396 (say) pseq in the interface file will not mention 'lazy', so if we
1397 inline 'pseq' we'll totally miss the very thing that 'lazy' was
1398 there for in the first place. See Trac #3259 for a real world
1399 example.
1400
1401 * Suppose CorePrep sees (catch# (lazy e) b). At all costs we must
1402 avoid using call by value here:
1403 case e of r -> catch# r b
1404 Avoiding that is the whole point of 'lazy'. So in CorePrep (which
1405 generate the 'case' expression for a call-by-value call) we must
1406 spot the 'lazy' on the arg (in CorePrep.cpeApp), and build a 'let'
1407 instead.
1408
1409 * lazyId is defined in GHC.Base, so we don't *have* to inline it. If it
1410 appears un-applied, we'll end up just calling it.
1411
1412 Note [noinlineId magic]
1413 ~~~~~~~~~~~~~~~~~~~~~~~
1414 noinline :: forall a. a -> a
1415
1416 'noinline' is used to make sure that a function f is never inlined,
1417 e.g., as in 'noinline f x'. Ordinarily, the identity function with NOINLINE
1418 could be used to achieve this effect; however, this has the unfortunate
1419 result of leaving a (useless) call to noinline at runtime. So we have
1420 a little bit of magic to optimize away 'noinline' after we are done
1421 running the simplifier.
1422
1423 'noinline' needs to be wired-in because it gets inserted automatically
1424 when we serialize an expression to the interface format, and we DON'T
1425 want use its fingerprints.
1426
1427
1428 Note [runRW magic]
1429 ~~~~~~~~~~~~~~~~~~
1430 Some definitions, for instance @runST@, must have careful control over float out
1431 of the bindings in their body. Consider this use of @runST@,
1432
1433 f x = runST ( \ s -> let (a, s') = newArray# 100 [] s
1434 (_, s'') = fill_in_array_or_something a x s'
1435 in freezeArray# a s'' )
1436
1437 If we inline @runST@, we'll get:
1438
1439 f x = let (a, s') = newArray# 100 [] realWorld#{-NB-}
1440 (_, s'') = fill_in_array_or_something a x s'
1441 in freezeArray# a s''
1442
1443 And now if we allow the @newArray#@ binding to float out to become a CAF,
1444 we end up with a result that is totally and utterly wrong:
1445
1446 f = let (a, s') = newArray# 100 [] realWorld#{-NB-} -- YIKES!!!
1447 in \ x ->
1448 let (_, s'') = fill_in_array_or_something a x s'
1449 in freezeArray# a s''
1450
1451 All calls to @f@ will share a {\em single} array! Clearly this is nonsense and
1452 must be prevented.
1453
1454 This is what @runRW#@ gives us: by being inlined extremely late in the
1455 optimization (right before lowering to STG, in CorePrep), we can ensure that
1456 no further floating will occur. This allows us to safely inline things like
1457 @runST@, which are otherwise needlessly expensive (see #10678 and #5916).
1458
1459 While the definition of @GHC.Magic.runRW#@, we override its type in @MkId@
1460 to be open-kinded,
1461
1462 runRW# :: forall (r1 :: RuntimeRep). (o :: TYPE r)
1463 => (State# RealWorld -> (# State# RealWorld, o #))
1464 -> (# State# RealWorld, o #)
1465
1466
1467 Note [The oneShot function]
1468 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
1469 In the context of making left-folds fuse somewhat okish (see ticket #7994
1470 and Note [Left folds via right fold]) it was determined that it would be useful
1471 if library authors could explicitly tell the compiler that a certain lambda is
1472 called at most once. The oneShot function allows that.
1473
1474 'oneShot' is open kinded, i.e. the type variables can refer to unlifted
1475 types as well (Trac #10744); e.g.
1476 oneShot (\x:Int# -> x +# 1#)
1477
1478 Like most magic functions it has a compulsary unfolding, so there is no need
1479 for a real definition somewhere. We have one in GHC.Magic for the convenience
1480 of putting the documentation there.
1481
1482 It uses `setOneShotLambda` on the lambda's binder. That is the whole magic:
1483
1484 A typical call looks like
1485 oneShot (\y. e)
1486 after unfolding the definition `oneShot = \f \x[oneshot]. f x` we get
1487 (\f \x[oneshot]. f x) (\y. e)
1488 --> \x[oneshot]. ((\y.e) x)
1489 --> \x[oneshot] e[x/y]
1490 which is what we want.
1491
1492 It is only effective if the one-shot info survives as long as possible; in
1493 particular it must make it into the interface in unfoldings. See Note [Preserve
1494 OneShotInfo] in CoreTidy.
1495
1496 Also see https://ghc.haskell.org/trac/ghc/wiki/OneShot.
1497
1498
1499 Note [magicDictId magic]
1500 ~~~~~~~~~~~~~~~~~~~~~~~~~
1501 The identifier `magicDict` is just a place-holder, which is used to
1502 implement a primitive that we cannot define in Haskell but we can write
1503 in Core. It is declared with a place-holder type:
1504
1505 magicDict :: forall a. a
1506
1507 The intention is that the identifier will be used in a very specific way,
1508 to create dictionaries for classes with a single method. Consider a class
1509 like this:
1510
1511 class C a where
1512 f :: T a
1513
1514 We are going to use `magicDict`, in conjunction with a built-in Prelude
1515 rule, to cast values of type `T a` into dictionaries for `C a`. To do
1516 this, we define a function like this in the library:
1517
1518 data WrapC a b = WrapC (C a => Proxy a -> b)
1519
1520 withT :: (C a => Proxy a -> b)
1521 -> T a -> Proxy a -> b
1522 withT f x y = magicDict (WrapC f) x y
1523
1524 The purpose of `WrapC` is to avoid having `f` instantiated.
1525 Also, it avoids impredicativity, because `magicDict`'s type
1526 cannot be instantiated with a forall. The field of `WrapC` contains
1527 a `Proxy` parameter which is used to link the type of the constraint,
1528 `C a`, with the type of the `Wrap` value being made.
1529
1530 Next, we add a built-in Prelude rule (see prelude/PrelRules.hs),
1531 which will replace the RHS of this definition with the appropriate
1532 definition in Core. The rewrite rule works as follows:
1533
1534 magicDict @t (wrap @a @b f) x y
1535 ---->
1536 f (x `cast` co a) y
1537
1538 The `co` coercion is the newtype-coercion extracted from the type-class.
1539 The type class is obtain by looking at the type of wrap.
1540
1541
1542 -------------------------------------------------------------
1543 @realWorld#@ used to be a magic literal, \tr{void#}. If things get
1544 nasty as-is, change it back to a literal (@Literal@).
1545
1546 voidArgId is a Local Id used simply as an argument in functions
1547 where we just want an arg to avoid having a thunk of unlifted type.
1548 E.g.
1549 x = \ void :: Void# -> (# p, q #)
1550
1551 This comes up in strictness analysis
1552
1553 Note [evaldUnfoldings]
1554 ~~~~~~~~~~~~~~~~~~~~~~
1555 The evaldUnfolding makes it look that some primitive value is
1556 evaluated, which in turn makes Simplify.interestingArg return True,
1557 which in turn makes INLINE things applied to said value likely to be
1558 inlined.
1559 -}
1560
1561 realWorldPrimId :: Id -- :: State# RealWorld
1562 realWorldPrimId = pcMiscPrelId realWorldName realWorldStatePrimTy
1563 (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings]
1564 `setOneShotInfo` stateHackOneShot
1565 `setNeverLevPoly` realWorldStatePrimTy)
1566
1567 voidPrimId :: Id -- Global constant :: Void#
1568 voidPrimId = pcMiscPrelId voidPrimIdName voidPrimTy
1569 (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings]
1570 `setNeverLevPoly` voidPrimTy)
1571
1572 voidArgId :: Id -- Local lambda-bound :: Void#
1573 voidArgId = mkSysLocal (fsLit "void") voidArgIdKey voidPrimTy
1574
1575 coercionTokenId :: Id -- :: () ~ ()
1576 coercionTokenId -- Used to replace Coercion terms when we go to STG
1577 = pcMiscPrelId coercionTokenName
1578 (mkTyConApp eqPrimTyCon [liftedTypeKind, liftedTypeKind, unitTy, unitTy])
1579 noCafIdInfo
1580
1581 pcMiscPrelId :: Name -> Type -> IdInfo -> Id
1582 pcMiscPrelId name ty info
1583 = mkVanillaGlobalWithInfo name ty info
1584 -- We lie and say the thing is imported; otherwise, we get into
1585 -- a mess with dependency analysis; e.g., core2stg may heave in
1586 -- random calls to GHCbase.unpackPS__. If GHCbase is the module
1587 -- being compiled, then it's just a matter of luck if the definition
1588 -- will be in "the right place" to be in scope.