0678f7837f0017437d2839ad86f579964fd80f97
[ghc.git] / compiler / basicTypes / MkId.lhs
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 \begin{code}
15 {-# LANGUAGE CPP #-}
16 {-# OPTIONS_GHC -fno-warn-tabs #-}
17 -- The above warning supression flag is a temporary kludge.
18 -- While working on this module you are encouraged to remove it and
19 -- detab the module (please do the detabbing in a separate patch). See
20 --     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
21 -- for details
22
23 module MkId (
24         mkDictFunId, mkDictFunTy, mkDictSelId, mkDictSelRhs,
25
26         mkPrimOpId, mkFCallId,
27
28         wrapNewTypeBody, unwrapNewTypeBody,
29         wrapFamInstBody, unwrapFamInstScrut,
30         wrapTypeFamInstBody, wrapTypeUnbranchedFamInstBody, unwrapTypeFamInstScrut,
31         unwrapTypeUnbranchedFamInstScrut,
32
33         DataConBoxer(..), mkDataConRep, mkDataConWorkId,
34
35         -- And some particular Ids; see below for why they are wired in
36         wiredInIds, ghcPrimIds,
37         unsafeCoerceName, unsafeCoerceId, realWorldPrimId,
38         voidPrimId, voidArgId,
39         nullAddrId, seqId, lazyId, lazyIdKey,
40         coercionTokenId, magicDictId, coerceId,
41
42         -- Re-export error Ids
43         module PrelRules
44     ) where
45
46 #include "HsVersions.h"
47
48 import Rules
49 import TysPrim
50 import TysWiredIn
51 import PrelRules
52 import Type
53 import FamInstEnv
54 import Coercion
55 import TcType
56 import MkCore
57 import CoreUtils        ( exprType, mkCast )
58 import CoreUnfold
59 import Literal
60 import TyCon
61 import CoAxiom
62 import Class
63 import NameSet
64 import VarSet
65 import Name
66 import PrimOp
67 import ForeignCall
68 import DataCon
69 import Id
70 import Var              ( mkExportedLocalVar )
71 import IdInfo
72 import Demand
73 import CoreSyn
74 import Unique
75 import UniqSupply
76 import PrelNames
77 import BasicTypes       hiding ( SuccessFlag(..) )
78 import Util
79 import Pair
80 import DynFlags
81 import Outputable
82 import FastString
83 import ListSetOps
84
85 import Data.Maybe       ( maybeToList )
86 \end{code}
87
88 %************************************************************************
89 %*                                                                      *
90 \subsection{Wired in Ids}
91 %*                                                                      *
92 %************************************************************************
93
94 Note [Wired-in Ids]
95 ~~~~~~~~~~~~~~~~~~~
96 There are several reasons why an Id might appear in the wiredInIds:
97
98 (1) The ghcPrimIds are wired in because they can't be defined in
99     Haskell at all, although the can be defined in Core.  They have
100     compulsory unfoldings, so they are always inlined and they  have
101     no definition site.  Their home module is GHC.Prim, so they
102     also have a description in primops.txt.pp, where they are called
103     'pseudoops'.
104
105 (2) The 'error' function, eRROR_ID, is wired in because we don't yet have
106     a way to express in an interface file that the result type variable
107     is 'open'; that is can be unified with an unboxed type
108
109     [The interface file format now carry such information, but there's
110     no way yet of expressing at the definition site for these 
111     error-reporting functions that they have an 'open' 
112     result type. -- sof 1/99]
113
114 (3) Other error functions (rUNTIME_ERROR_ID) are wired in (a) because
115     the desugarer generates code that mentiones them directly, and
116     (b) for the same reason as eRROR_ID
117
118 (4) lazyId is wired in because the wired-in version overrides the
119     strictness of the version defined in GHC.Base
120
121 In cases (2-4), the function has a definition in a library module, and
122 can be called; but the wired-in version means that the details are 
123 never read from that module's interface file; instead, the full definition
124 is right here.
125
126 \begin{code}
127 wiredInIds :: [Id]
128 wiredInIds
129   =  [lazyId, dollarId]
130   ++ errorIds           -- Defined in MkCore
131   ++ ghcPrimIds
132
133 -- These Ids are exported from GHC.Prim
134 ghcPrimIds :: [Id]
135 ghcPrimIds
136   = [   -- These can't be defined in Haskell, but they have
137         -- perfectly reasonable unfoldings in Core
138     realWorldPrimId,
139     voidPrimId,
140     unsafeCoerceId,
141     nullAddrId,
142     seqId,
143     magicDictId,
144     coerceId,
145     proxyHashId
146     ]
147 \end{code}
148
149 %************************************************************************
150 %*                                                                      *
151 \subsection{Data constructors}
152 %*                                                                      *
153 %************************************************************************
154
155 The wrapper for a constructor is an ordinary top-level binding that evaluates
156 any strict args, unboxes any args that are going to be flattened, and calls
157 the worker.
158
159 We're going to build a constructor that looks like:
160
161         data (Data a, C b) =>  T a b = T1 !a !Int b
162
163         T1 = /\ a b -> 
164              \d1::Data a, d2::C b ->
165              \p q r -> case p of { p ->
166                        case q of { q ->
167                        Con T1 [a,b] [p,q,r]}}
168
169 Notice that
170
171 * d2 is thrown away --- a context in a data decl is used to make sure
172   one *could* construct dictionaries at the site the constructor
173   is used, but the dictionary isn't actually used.
174
175 * We have to check that we can construct Data dictionaries for
176   the types a and Int.  Once we've done that we can throw d1 away too.
177
178 * We use (case p of q -> ...) to evaluate p, rather than "seq" because
179   all that matters is that the arguments are evaluated.  "seq" is 
180   very careful to preserve evaluation order, which we don't need
181   to be here.
182
183   You might think that we could simply give constructors some strictness
184   info, like PrimOps, and let CoreToStg do the let-to-case transformation.
185   But we don't do that because in the case of primops and functions strictness
186   is a *property* not a *requirement*.  In the case of constructors we need to
187   do something active to evaluate the argument.
188
189   Making an explicit case expression allows the simplifier to eliminate
190   it in the (common) case where the constructor arg is already evaluated.
191
192 Note [Wrappers for data instance tycons]
193 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
194 In the case of data instances, the wrapper also applies the coercion turning
195 the representation type into the family instance type to cast the result of
196 the wrapper.  For example, consider the declarations
197
198   data family Map k :: * -> *
199   data instance Map (a, b) v = MapPair (Map a (Pair b v))
200
201 The tycon to which the datacon MapPair belongs gets a unique internal
202 name of the form :R123Map, and we call it the representation tycon.
203 In contrast, Map is the family tycon (accessible via
204 tyConFamInst_maybe). A coercion allows you to move between
205 representation and family type.  It is accessible from :R123Map via
206 tyConFamilyCoercion_maybe and has kind
207
208   Co123Map a b v :: {Map (a, b) v ~ :R123Map a b v}
209
210 The wrapper and worker of MapPair get the types
211
212         -- Wrapper
213   $WMapPair :: forall a b v. Map a (Map a b v) -> Map (a, b) v
214   $WMapPair a b v = MapPair a b v `cast` sym (Co123Map a b v)
215
216         -- Worker
217   MapPair :: forall a b v. Map a (Map a b v) -> :R123Map a b v
218
219 This coercion is conditionally applied by wrapFamInstBody.
220
221 It's a bit more complicated if the data instance is a GADT as well!
222
223    data instance T [a] where
224         T1 :: forall b. b -> T [Maybe b]
225
226 Hence we translate to
227
228         -- Wrapper
229   $WT1 :: forall b. b -> T [Maybe b]
230   $WT1 b v = T1 (Maybe b) b (Maybe b) v
231                         `cast` sym (Co7T (Maybe b))
232
233         -- Worker
234   T1 :: forall c b. (c ~ Maybe b) => b -> :R7T c
235
236         -- Coercion from family type to representation type
237   Co7T a :: T [a] ~ :R7T a
238
239 Note [Newtype datacons]
240 ~~~~~~~~~~~~~~~~~~~~~~~
241 The "data constructor" for a newtype should always be vanilla.  At one
242 point this wasn't true, because the newtype arising from
243      class C a => D a
244 looked like
245        newtype T:D a = D:D (C a)
246 so the data constructor for T:C had a single argument, namely the
247 predicate (C a).  But now we treat that as an ordinary argument, not
248 part of the theta-type, so all is well.
249
250
251 %************************************************************************
252 %*                                                                      *
253 \subsection{Dictionary selectors}
254 %*                                                                      *
255 %************************************************************************
256
257 Selecting a field for a dictionary.  If there is just one field, then
258 there's nothing to do.  
259
260 Dictionary selectors may get nested forall-types.  Thus:
261
262         class Foo a where
263           op :: forall b. Ord b => a -> b -> b
264
265 Then the top-level type for op is
266
267         op :: forall a. Foo a => 
268               forall b. Ord b => 
269               a -> b -> b
270
271 This is unlike ordinary record selectors, which have all the for-alls
272 at the outside.  When dealing with classes it's very convenient to
273 recover the original type signature from the class op selector.
274
275 \begin{code}
276 mkDictSelId :: Name          -- Name of one of the *value* selectors 
277                              -- (dictionary superclass or method)
278             -> Class -> Id
279 mkDictSelId name clas
280   = mkGlobalId (ClassOpId clas) name sel_ty info
281   where
282     tycon          = classTyCon clas
283     sel_names      = map idName (classAllSelIds clas)
284     new_tycon      = isNewTyCon tycon
285     [data_con]     = tyConDataCons tycon
286     tyvars         = dataConUnivTyVars data_con
287     arg_tys        = dataConRepArgTys data_con  -- Includes the dictionary superclasses
288     val_index      = assoc "MkId.mkDictSelId" (sel_names `zip` [0..]) name
289
290     sel_ty = mkForAllTys tyvars (mkFunTy (mkClassPred clas (mkTyVarTys tyvars))
291                                          (getNth arg_tys val_index))
292
293     base_info = noCafIdInfo
294                 `setArityInfo`         1
295                 `setStrictnessInfo`    strict_sig
296
297     info | new_tycon
298          = base_info `setInlinePragInfo` alwaysInlinePragma
299                      `setUnfoldingInfo`  mkInlineUnfolding (Just 1) (mkDictSelRhs clas val_index)
300                    -- See Note [Single-method classes] in TcInstDcls
301                    -- for why alwaysInlinePragma
302
303          | otherwise
304          = base_info `setSpecInfo` mkSpecInfo [rule]
305                    -- Add a magic BuiltinRule, but no unfolding
306                    -- so that the rule is always available to fire.
307                    -- See Note [ClassOp/DFun selection] in TcInstDcls
308
309     n_ty_args = length tyvars
310
311     -- This is the built-in rule that goes
312     --      op (dfT d1 d2) --->  opT d1 d2
313     rule = BuiltinRule { ru_name = fsLit "Class op " `appendFS` 
314                                      occNameFS (getOccName name)
315                        , ru_fn    = name
316                        , ru_nargs = n_ty_args + 1
317                        , ru_try   = dictSelRule val_index n_ty_args }
318
319         -- The strictness signature is of the form U(AAAVAAAA) -> T
320         -- where the V depends on which item we are selecting
321         -- It's worth giving one, so that absence info etc is generated
322         -- even if the selector isn't inlined
323
324     strict_sig = mkClosedStrictSig [arg_dmd] topRes
325     arg_dmd | new_tycon = evalDmd
326             | otherwise = mkManyUsedDmd $
327                           mkProdDmd [ if name == sel_name then evalDmd else absDmd
328                                     | sel_name <- sel_names ]
329
330 mkDictSelRhs :: Class
331              -> Int         -- 0-indexed selector among (superclasses ++ methods)
332              -> CoreExpr
333 mkDictSelRhs clas val_index
334   = mkLams tyvars (Lam dict_id rhs_body)
335   where
336     tycon          = classTyCon clas
337     new_tycon      = isNewTyCon tycon
338     [data_con]     = tyConDataCons tycon
339     tyvars         = dataConUnivTyVars data_con
340     arg_tys        = dataConRepArgTys data_con  -- Includes the dictionary superclasses
341
342     the_arg_id     = getNth arg_ids val_index
343     pred           = mkClassPred clas (mkTyVarTys tyvars)
344     dict_id        = mkTemplateLocal 1 pred
345     arg_ids        = mkTemplateLocalsNum 2 arg_tys
346
347     rhs_body | new_tycon = unwrapNewTypeBody tycon (map mkTyVarTy tyvars) (Var dict_id)
348              | otherwise = Case (Var dict_id) dict_id (idType the_arg_id)
349                                 [(DataAlt data_con, arg_ids, varToCoreExpr the_arg_id)]
350                                 -- varToCoreExpr needed for equality superclass selectors
351                                 --   sel a b d = case x of { MkC _ (g:a~b) _ -> CO g }
352
353 dictSelRule :: Int -> Arity -> RuleFun
354 -- Tries to persuade the argument to look like a constructor
355 -- application, using exprIsConApp_maybe, and then selects
356 -- from it
357 --       sel_i t1..tk (D t1..tk op1 ... opm) = opi
358 --
359 dictSelRule val_index n_ty_args _ id_unf _ args
360   | (dict_arg : _) <- drop n_ty_args args
361   , Just (_, _, con_args) <- exprIsConApp_maybe id_unf dict_arg
362   = Just (getNth con_args val_index)
363   | otherwise
364   = Nothing
365 \end{code}
366
367
368 %************************************************************************
369 %*                                                                      *
370         Boxing and unboxing
371 %*                                                                      *
372 %************************************************************************
373
374
375 \begin{code}
376 mkDataConWorkId :: Name -> DataCon -> Id
377 mkDataConWorkId wkr_name data_con
378   | isNewTyCon tycon
379   = mkGlobalId (DataConWrapId data_con) wkr_name nt_wrap_ty nt_work_info
380   | otherwise
381   = mkGlobalId (DataConWorkId data_con) wkr_name alg_wkr_ty wkr_info
382
383   where
384     tycon = dataConTyCon data_con
385
386         ----------- Workers for data types --------------
387     alg_wkr_ty = dataConRepType data_con
388     wkr_arity = dataConRepArity data_con
389     wkr_info  = noCafIdInfo
390                 `setArityInfo`       wkr_arity
391                 `setStrictnessInfo`  wkr_sig
392                 `setUnfoldingInfo`   evaldUnfolding  -- Record that it's evaluated,
393                                                      -- even if arity = 0
394
395     wkr_sig = mkClosedStrictSig (replicate wkr_arity topDmd) (dataConCPR data_con)
396         --      Note [Data-con worker strictness]
397         -- Notice that we do *not* say the worker is strict
398         -- even if the data constructor is declared strict
399         --      e.g.    data T = MkT !(Int,Int)
400         -- Why?  Because the *wrapper* is strict (and its unfolding has case
401         -- expresssions that do the evals) but the *worker* itself is not.
402         -- If we pretend it is strict then when we see
403         --      case x of y -> $wMkT y
404         -- the simplifier thinks that y is "sure to be evaluated" (because
405         --  $wMkT is strict) and drops the case.  No, $wMkT is not strict.
406         --
407         -- When the simplifer sees a pattern 
408         --      case e of MkT x -> ...
409         -- it uses the dataConRepStrictness of MkT to mark x as evaluated;
410         -- but that's fine... dataConRepStrictness comes from the data con
411         -- not from the worker Id.
412
413         ----------- Workers for newtypes --------------
414     (nt_tvs, _, nt_arg_tys, _) = dataConSig data_con
415     res_ty_args  = mkTyVarTys nt_tvs
416     nt_wrap_ty   = dataConUserType data_con
417     nt_work_info = noCafIdInfo          -- The NoCaf-ness is set by noCafIdInfo
418                   `setArityInfo` 1      -- Arity 1
419                   `setInlinePragInfo`    alwaysInlinePragma
420                   `setUnfoldingInfo`     newtype_unf
421     id_arg1      = mkTemplateLocal 1 (head nt_arg_tys)
422     newtype_unf  = ASSERT2( isVanillaDataCon data_con &&
423                             isSingleton nt_arg_tys, ppr data_con  )
424                               -- Note [Newtype datacons]
425                    mkCompulsoryUnfolding $ 
426                    mkLams nt_tvs $ Lam id_arg1 $ 
427                    wrapNewTypeBody tycon res_ty_args (Var id_arg1)
428
429 dataConCPR :: DataCon -> DmdResult
430 dataConCPR con
431   | isDataTyCon tycon     -- Real data types only; that is, 
432                           -- not unboxed tuples or newtypes
433   , isVanillaDataCon con  -- No existentials 
434   , wkr_arity > 0
435   , wkr_arity <= mAX_CPR_SIZE
436   = if is_prod then vanillaCprProdRes (dataConRepArity con)
437                else cprSumRes (dataConTag con)
438   | otherwise
439   = topRes
440   where
441     is_prod = isProductTyCon tycon
442     tycon = dataConTyCon con
443     wkr_arity = dataConRepArity con
444
445     mAX_CPR_SIZE :: Arity
446     mAX_CPR_SIZE = 10
447     -- We do not treat very big tuples as CPR-ish:
448     --      a) for a start we get into trouble because there aren't 
449     --         "enough" unboxed tuple types (a tiresome restriction, 
450     --         but hard to fix), 
451     --      b) more importantly, big unboxed tuples get returned mainly
452     --         on the stack, and are often then allocated in the heap
453     --         by the caller.  So doing CPR for them may in fact make
454     --         things worse.
455 \end{code}
456
457 -------------------------------------------------
458 --         Data constructor representation
459 -- 
460 -- This is where we decide how to wrap/unwrap the 
461 -- constructor fields
462 --
463 --------------------------------------------------
464
465
466 \begin{code}
467 type Unboxer = Var -> UniqSM ([Var], CoreExpr -> CoreExpr)
468   -- Unbox: bind rep vars by decomposing src var
469
470 data Boxer = UnitBox | Boxer (TvSubst -> UniqSM ([Var], CoreExpr))
471   -- Box:   build src arg using these rep vars
472
473 newtype DataConBoxer = DCB ([Type] -> [Var] -> UniqSM ([Var], [CoreBind]))
474                        -- Bind these src-level vars, returning the
475                        -- rep-level vars to bind in the pattern
476
477 mkDataConRep :: DynFlags -> FamInstEnvs -> Name -> DataCon -> UniqSM DataConRep
478 mkDataConRep dflags fam_envs wrap_name data_con
479   | not wrapper_reqd
480   = return NoDataConRep
481
482   | otherwise
483   = do { wrap_args <- mapM newLocal wrap_arg_tys
484        ; wrap_body <- mk_rep_app (wrap_args `zip` dropList eq_spec unboxers) 
485                                  initial_wrap_app
486
487        ; let wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty wrap_info
488              wrap_info = noCafIdInfo
489                          `setArityInfo`         wrap_arity
490                              -- It's important to specify the arity, so that partial
491                              -- applications are treated as values
492                          `setInlinePragInfo`    alwaysInlinePragma
493                          `setUnfoldingInfo`     wrap_unf
494                          `setStrictnessInfo`    wrap_sig
495                              -- We need to get the CAF info right here because TidyPgm
496                              -- does not tidy the IdInfo of implicit bindings (like the wrapper)
497                              -- so it not make sure that the CAF info is sane
498
499              wrap_sig = mkClosedStrictSig wrap_arg_dmds (dataConCPR data_con)
500              wrap_arg_dmds = map mk_dmd (dropList eq_spec wrap_bangs)
501              mk_dmd str | isBanged str = evalDmd
502                         | otherwise    = topDmd
503                  -- The Cpr info can be important inside INLINE rhss, where the
504                  -- wrapper constructor isn't inlined.
505                  -- And the argument strictness can be important too; we
506                  -- may not inline a contructor when it is partially applied.
507                  -- For example:
508                  --      data W = C !Int !Int !Int
509                  --      ...(let w = C x in ...(w p q)...)...
510                  -- we want to see that w is strict in its two arguments
511
512              wrap_unf = mkInlineUnfolding (Just wrap_arity) wrap_rhs
513              wrap_tvs = (univ_tvs `minusList` map fst eq_spec) ++ ex_tvs
514              wrap_rhs = mkLams wrap_tvs $ 
515                         mkLams wrap_args $
516                         wrapFamInstBody tycon res_ty_args $
517                         wrap_body
518
519        ; return (DCR { dcr_wrap_id = wrap_id
520                      , dcr_boxer   = mk_boxer boxers
521                      , dcr_arg_tys = rep_tys
522                      , dcr_stricts = rep_strs
523                      , dcr_bangs   = dropList ev_tys wrap_bangs }) }
524
525   where
526     (univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys, _) = dataConFullSig data_con
527     res_ty_args  = substTyVars (mkTopTvSubst eq_spec) univ_tvs
528     tycon        = dataConTyCon data_con       -- The representation TyCon (not family)
529     wrap_ty      = dataConUserType data_con
530     ev_tys       = eqSpecPreds eq_spec ++ theta
531     all_arg_tys  = ev_tys                         ++ orig_arg_tys
532     orig_bangs   = map mk_pred_strict_mark ev_tys ++ dataConStrictMarks data_con
533
534     wrap_arg_tys = theta ++ orig_arg_tys
535     wrap_arity   = length wrap_arg_tys
536              -- The wrap_args are the arguments *other than* the eq_spec
537              -- Because we are going to apply the eq_spec args manually in the
538              -- wrapper
539
540     (wrap_bangs, rep_tys_w_strs, wrappers)
541        = unzip3 (zipWith (dataConArgRep dflags fam_envs) all_arg_tys orig_bangs)
542     (unboxers, boxers) = unzip wrappers
543     (rep_tys, rep_strs) = unzip (concat rep_tys_w_strs)
544
545     wrapper_reqd = not (isNewTyCon tycon)  -- Newtypes have only a worker
546                 && (any isBanged orig_bangs   -- Some forcing/unboxing
547                                               -- (includes eq_spec)
548                     || isFamInstTyCon tycon)  -- Cast result
549
550     initial_wrap_app = Var (dataConWorkId data_con)
551                       `mkTyApps`  res_ty_args
552                       `mkVarApps` ex_tvs                 
553                       `mkCoApps`  map (mkReflCo Nominal . snd) eq_spec
554                         -- Dont box the eq_spec coercions since they are
555                         -- marked as HsUnpack by mk_dict_strict_mark
556
557     mk_boxer :: [Boxer] -> DataConBoxer
558     mk_boxer boxers = DCB (\ ty_args src_vars -> 
559                       do { let ex_vars = takeList ex_tvs src_vars
560                                subst1 = mkTopTvSubst (univ_tvs `zip` ty_args)
561                                subst2 = extendTvSubstList subst1 ex_tvs 
562                                                           (mkTyVarTys ex_vars)
563                          ; (rep_ids, binds) <- go subst2 boxers (dropList ex_tvs src_vars)
564                          ; return (ex_vars ++ rep_ids, binds) } )
565
566     go _ [] src_vars = ASSERT2( null src_vars, ppr data_con ) return ([], [])
567     go subst (UnitBox : boxers) (src_var : src_vars)
568       = do { (rep_ids2, binds) <- go subst boxers src_vars
569            ; return (src_var : rep_ids2, binds) }
570     go subst (Boxer boxer : boxers) (src_var : src_vars)
571       = do { (rep_ids1, arg)  <- boxer subst
572            ; (rep_ids2, binds) <- go subst boxers src_vars
573            ; return (rep_ids1 ++ rep_ids2, NonRec src_var arg : binds) }
574     go _ (_:_) [] = pprPanic "mk_boxer" (ppr data_con)
575
576     mk_rep_app :: [(Id,Unboxer)] -> CoreExpr -> UniqSM CoreExpr
577     mk_rep_app [] con_app 
578       = return con_app
579     mk_rep_app ((wrap_arg, unboxer) : prs) con_app 
580       = do { (rep_ids, unbox_fn) <- unboxer wrap_arg
581            ; expr <- mk_rep_app prs (mkVarApps con_app rep_ids)
582            ; return (unbox_fn expr) }
583
584 -------------------------
585 newLocal :: Type -> UniqSM Var
586 newLocal ty = do { uniq <- getUniqueUs 
587                  ; return (mkSysLocal (fsLit "dt") uniq ty) }
588
589 -------------------------
590 dataConArgRep
591    :: DynFlags 
592    -> FamInstEnvs
593    -> Type -> HsBang
594    -> ( HsBang   -- Like input but with HsUnpackFailed if necy
595       , [(Type, StrictnessMark)]   -- Rep types
596       , (Unboxer, Boxer) )
597
598 dataConArgRep _ _ arg_ty HsNoBang
599   = (HsNoBang, [(arg_ty, NotMarkedStrict)], (unitUnboxer, unitBoxer))
600
601 dataConArgRep _ _ arg_ty (HsUserBang _ False)  -- No '!'
602   = (HsNoBang, [(arg_ty, NotMarkedStrict)], (unitUnboxer, unitBoxer))
603
604 dataConArgRep dflags fam_envs arg_ty 
605     (HsUserBang unpk_prag True)  -- {-# UNPACK #-} !
606   | not (gopt Opt_OmitInterfacePragmas dflags) -- Don't unpack if -fomit-iface-pragmas
607           -- Don't unpack if we aren't optimising; rather arbitrarily, 
608           -- we use -fomit-iface-pragmas as the indication
609   , let mb_co   = topNormaliseType_maybe fam_envs arg_ty
610                      -- Unwrap type families and newtypes
611         arg_ty' = case mb_co of { Just (_,ty) -> ty; Nothing -> arg_ty }
612   , isUnpackableType fam_envs arg_ty'
613   , (rep_tys, wrappers) <- dataConArgUnpack arg_ty'
614   , case unpk_prag of
615       Nothing -> gopt Opt_UnboxStrictFields dflags
616               || (gopt Opt_UnboxSmallStrictFields dflags 
617                    && length rep_tys <= 1)  -- See Note [Unpack one-wide fields]
618       Just unpack_me -> unpack_me
619   = case mb_co of
620       Nothing          -> (HsUnpack Nothing,   rep_tys, wrappers)
621       Just (co,rep_ty) -> (HsUnpack (Just co), rep_tys, wrapCo co rep_ty wrappers)
622
623   | otherwise  -- Record the strict-but-no-unpack decision
624   = strict_but_not_unpacked arg_ty
625
626 dataConArgRep _ _ arg_ty HsStrict
627   = strict_but_not_unpacked arg_ty
628
629 dataConArgRep _ _ arg_ty (HsUnpack Nothing)
630   | (rep_tys, wrappers) <- dataConArgUnpack arg_ty
631   = (HsUnpack Nothing, rep_tys, wrappers)
632
633 dataConArgRep _ _ _ (HsUnpack (Just co))
634   | let co_rep_ty = pSnd (coercionKind co)
635   , (rep_tys, wrappers) <- dataConArgUnpack co_rep_ty
636   = (HsUnpack (Just co), rep_tys, wrapCo co co_rep_ty wrappers)
637
638 strict_but_not_unpacked :: Type -> (HsBang, [(Type,StrictnessMark)], (Unboxer, Boxer))
639 strict_but_not_unpacked arg_ty
640   = (HsStrict, [(arg_ty, MarkedStrict)], (seqUnboxer, unitBoxer))
641
642 -------------------------
643 wrapCo :: Coercion -> Type -> (Unboxer, Boxer) -> (Unboxer, Boxer)
644 wrapCo co rep_ty (unbox_rep, box_rep)  -- co :: arg_ty ~ rep_ty
645   = (unboxer, boxer)
646   where
647     unboxer arg_id = do { rep_id <- newLocal rep_ty
648                         ; (rep_ids, rep_fn) <- unbox_rep rep_id
649                         ; let co_bind = NonRec rep_id (Var arg_id `Cast` co)
650                         ; return (rep_ids, Let co_bind . rep_fn) }
651     boxer = Boxer $ \ subst -> 
652             do { (rep_ids, rep_expr) 
653                     <- case box_rep of
654                          UnitBox -> do { rep_id <- newLocal (TcType.substTy subst rep_ty)
655                                        ; return ([rep_id], Var rep_id) }
656                          Boxer boxer -> boxer subst
657                ; let sco = substCo (tvCvSubst subst) co
658                ; return (rep_ids, rep_expr `Cast` mkSymCo sco) }
659
660 ------------------------
661 seqUnboxer :: Unboxer
662 seqUnboxer v = return ([v], \e -> Case (Var v) v (exprType e) [(DEFAULT, [], e)])
663
664 unitUnboxer :: Unboxer
665 unitUnboxer v = return ([v], \e -> e)
666
667 unitBoxer :: Boxer
668 unitBoxer = UnitBox
669
670 -------------------------
671 dataConArgUnpack
672    :: Type
673    ->  ( [(Type, StrictnessMark)]   -- Rep types
674        , (Unboxer, Boxer) )
675
676 dataConArgUnpack arg_ty
677   | Just (tc, tc_args) <- splitTyConApp_maybe arg_ty
678   , Just con <- tyConSingleAlgDataCon_maybe tc
679       -- NB: check for an *algebraic* data type
680       -- A recursive newtype might mean that 
681       -- 'arg_ty' is a newtype
682   , let rep_tys = dataConInstArgTys con tc_args
683   = ASSERT( isVanillaDataCon con )
684     ( rep_tys `zip` dataConRepStrictness con
685     ,( \ arg_id ->
686        do { rep_ids <- mapM newLocal rep_tys
687           ; let unbox_fn body
688                   = Case (Var arg_id) arg_id (exprType body)
689                          [(DataAlt con, rep_ids, body)]
690           ; return (rep_ids, unbox_fn) }
691      , Boxer $ \ subst ->
692        do { rep_ids <- mapM (newLocal . TcType.substTy subst) rep_tys
693           ; return (rep_ids, Var (dataConWorkId con)
694                              `mkTyApps` (substTys subst tc_args)
695                              `mkVarApps` rep_ids ) } ) )
696   | otherwise
697   = pprPanic "dataConArgUnpack" (ppr arg_ty)
698     -- An interface file specified Unpacked, but we couldn't unpack it
699
700 isUnpackableType :: FamInstEnvs -> Type -> Bool
701 -- True if we can unpack the UNPACK the argument type 
702 -- See Note [Recursive unboxing]
703 -- We look "deeply" inside rather than relying on the DataCons
704 -- we encounter on the way, because otherwise we might well
705 -- end up relying on ourselves!
706 isUnpackableType fam_envs ty
707   | Just (tc, _) <- splitTyConApp_maybe ty
708   , Just con <- tyConSingleAlgDataCon_maybe tc
709   , isVanillaDataCon con
710   = ok_con_args (unitNameSet (getName tc)) con
711   | otherwise
712   = False
713   where
714     ok_arg tcs (ty, bang) = not (attempt_unpack bang) || ok_ty tcs norm_ty
715         where
716           norm_ty = topNormaliseType fam_envs ty
717     ok_ty tcs ty
718       | Just (tc, _) <- splitTyConApp_maybe ty
719       , let tc_name = getName tc
720       =  not (tc_name `elemNameSet` tcs)
721       && case tyConSingleAlgDataCon_maybe tc of
722             Just con | isVanillaDataCon con
723                     -> ok_con_args (tcs `addOneToNameSet` getName tc) con
724             _ -> True
725       | otherwise 
726       = True
727
728     ok_con_args tcs con
729        = all (ok_arg tcs) (dataConOrigArgTys con `zip` dataConStrictMarks con)
730          -- NB: dataConStrictMarks gives the *user* request; 
731          -- We'd get a black hole if we used dataConRepBangs
732
733     attempt_unpack (HsUnpack {})                 = True
734     attempt_unpack (HsUserBang (Just unpk) bang) = bang && unpk
735     attempt_unpack (HsUserBang Nothing bang)     = bang  -- Be conservative
736     attempt_unpack HsStrict                      = False
737     attempt_unpack HsNoBang                      = False
738 \end{code}
739
740 Note [Unpack one-wide fields]
741 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
742 The flag UnboxSmallStrictFields ensures that any field that can
743 (safely) be unboxed to a word-sized unboxed field, should be so unboxed.
744 For example:
745
746     data A = A Int#
747     newtype B = B A
748     data C = C !B
749     data D = D !C
750     data E = E !()
751     data F = F !D
752     data G = G !F !F
753
754 All of these should have an Int# as their representation, except
755 G which should have two Int#s.  
756
757 However 
758
759     data T = T !(S Int)
760     data S = S !a
761
762 Here we can represent T with an Int#.
763
764 Note [Recursive unboxing]
765 ~~~~~~~~~~~~~~~~~~~~~~~~~
766 Consider
767   data R = MkR {-# UNPACK #-} !S Int
768   data S = MkS {-# UNPACK #-} !Int
769 The representation arguments of MkR are the *representation* arguments
770 of S (plus Int); the rep args of MkS are Int#.  This is all fine.
771
772 But be careful not to try to unbox this!
773         data T = MkT {-# UNPACK #-} !T Int
774 Because then we'd get an infinite number of arguments.
775
776 Here is a more complicated case:
777         data S = MkS {-# UNPACK #-} !T Int
778         data T = MkT {-# UNPACK #-} !S Int
779 Each of S and T must decide independendently whether to unpack
780 and they had better not both say yes. So they must both say no.
781
782 Also behave conservatively when there is no UNPACK pragma
783         data T = MkS !T Int
784 with -funbox-strict-fields or -funbox-small-strict-fields
785 we need to behave as if there was an UNPACK pragma there.
786
787 But it's the *argument* type that matters. This is fine:
788         data S = MkS S !Int
789 because Int is non-recursive.
790
791
792 Note [Unpack equality predicates]
793 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
794 If we have a GADT with a contructor C :: (a~[b]) => b -> T a
795 we definitely want that equality predicate *unboxed* so that it
796 takes no space at all.  This is easily done: just give it
797 an UNPACK pragma. The rest of the unpack/repack code does the
798 heavy lifting.  This one line makes every GADT take a word less
799 space for each equality predicate, so it's pretty important!
800
801
802 \begin{code}
803 mk_pred_strict_mark :: PredType -> HsBang
804 mk_pred_strict_mark pred 
805   | isEqPred pred = HsUnpack Nothing    -- Note [Unpack equality predicates]
806   | otherwise     = HsNoBang
807 \end{code}
808
809 %************************************************************************
810 %*                                                                      *
811         Wrapping and unwrapping newtypes and type families
812 %*                                                                      *
813 %************************************************************************
814
815 \begin{code}
816 wrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
817 -- The wrapper for the data constructor for a newtype looks like this:
818 --      newtype T a = MkT (a,Int)
819 --      MkT :: forall a. (a,Int) -> T a
820 --      MkT = /\a. \(x:(a,Int)). x `cast` sym (CoT a)
821 -- where CoT is the coercion TyCon assoicated with the newtype
822 --
823 -- The call (wrapNewTypeBody T [a] e) returns the
824 -- body of the wrapper, namely
825 --      e `cast` (CoT [a])
826 --
827 -- If a coercion constructor is provided in the newtype, then we use
828 -- it, otherwise the wrap/unwrap are both no-ops 
829 --
830 -- If the we are dealing with a newtype *instance*, we have a second coercion
831 -- identifying the family instance with the constructor of the newtype
832 -- instance.  This coercion is applied in any case (ie, composed with the
833 -- coercion constructor of the newtype or applied by itself).
834
835 wrapNewTypeBody tycon args result_expr
836   = ASSERT( isNewTyCon tycon )
837     wrapFamInstBody tycon args $
838     mkCast result_expr (mkSymCo co)
839   where
840     co = mkUnbranchedAxInstCo Representational (newTyConCo tycon) args
841
842 -- When unwrapping, we do *not* apply any family coercion, because this will
843 -- be done via a CoPat by the type checker.  We have to do it this way as
844 -- computing the right type arguments for the coercion requires more than just
845 -- a spliting operation (cf, TcPat.tcConPat).
846
847 unwrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
848 unwrapNewTypeBody tycon args result_expr
849   = ASSERT( isNewTyCon tycon )
850     mkCast result_expr (mkUnbranchedAxInstCo Representational (newTyConCo tycon) args)
851
852 -- If the type constructor is a representation type of a data instance, wrap
853 -- the expression into a cast adjusting the expression type, which is an
854 -- instance of the representation type, to the corresponding instance of the
855 -- family instance type.
856 -- See Note [Wrappers for data instance tycons]
857 wrapFamInstBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
858 wrapFamInstBody tycon args body
859   | Just co_con <- tyConFamilyCoercion_maybe tycon
860   = mkCast body (mkSymCo (mkUnbranchedAxInstCo Representational co_con args))
861   | otherwise
862   = body
863
864 -- Same as `wrapFamInstBody`, but for type family instances, which are
865 -- represented by a `CoAxiom`, and not a `TyCon`
866 wrapTypeFamInstBody :: CoAxiom br -> Int -> [Type] -> CoreExpr -> CoreExpr
867 wrapTypeFamInstBody axiom ind args body
868   = mkCast body (mkSymCo (mkAxInstCo Representational axiom ind args))
869
870 wrapTypeUnbranchedFamInstBody :: CoAxiom Unbranched -> [Type] -> CoreExpr -> CoreExpr
871 wrapTypeUnbranchedFamInstBody axiom
872   = wrapTypeFamInstBody axiom 0
873
874 unwrapFamInstScrut :: TyCon -> [Type] -> CoreExpr -> CoreExpr
875 unwrapFamInstScrut tycon args scrut
876   | Just co_con <- tyConFamilyCoercion_maybe tycon
877   = mkCast scrut (mkUnbranchedAxInstCo Representational co_con args) -- data instances only
878   | otherwise
879   = scrut
880
881 unwrapTypeFamInstScrut :: CoAxiom br -> Int -> [Type] -> CoreExpr -> CoreExpr
882 unwrapTypeFamInstScrut axiom ind args scrut
883   = mkCast scrut (mkAxInstCo Representational axiom ind args)
884
885 unwrapTypeUnbranchedFamInstScrut :: CoAxiom Unbranched -> [Type] -> CoreExpr -> CoreExpr
886 unwrapTypeUnbranchedFamInstScrut axiom
887   = unwrapTypeFamInstScrut axiom 0
888 \end{code}
889
890
891 %************************************************************************
892 %*                                                                      *
893 \subsection{Primitive operations}
894 %*                                                                      *
895 %************************************************************************
896
897 \begin{code}
898 mkPrimOpId :: PrimOp -> Id
899 mkPrimOpId prim_op 
900   = id
901   where
902     (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
903     ty   = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
904     name = mkWiredInName gHC_PRIM (primOpOcc prim_op) 
905                          (mkPrimOpIdUnique (primOpTag prim_op))
906                          (AnId id) UserSyntax
907     id   = mkGlobalId (PrimOpId prim_op) name ty info
908                 
909     info = noCafIdInfo
910            `setSpecInfo`          mkSpecInfo (maybeToList $ primOpRules name prim_op)
911            `setArityInfo`         arity
912            `setStrictnessInfo`    strict_sig
913            `setInlinePragInfo`    neverInlinePragma
914                -- We give PrimOps a NOINLINE pragma so that we don't
915                -- get silly warnings from Desugar.dsRule (the inline_shadows_rule 
916                -- test) about a RULE conflicting with a possible inlining
917                -- cf Trac #7287
918
919 -- For each ccall we manufacture a separate CCallOpId, giving it
920 -- a fresh unique, a type that is correct for this particular ccall,
921 -- and a CCall structure that gives the correct details about calling
922 -- convention etc.  
923 --
924 -- The *name* of this Id is a local name whose OccName gives the full
925 -- details of the ccall, type and all.  This means that the interface 
926 -- file reader can reconstruct a suitable Id
927
928 mkFCallId :: DynFlags -> Unique -> ForeignCall -> Type -> Id
929 mkFCallId dflags uniq fcall ty
930   = ASSERT( isEmptyVarSet (tyVarsOfType ty) )
931     -- A CCallOpId should have no free type variables; 
932     -- when doing substitutions won't substitute over it
933     mkGlobalId (FCallId fcall) name ty info
934   where
935     occ_str = showSDoc dflags (braces (ppr fcall <+> ppr ty))
936     -- The "occurrence name" of a ccall is the full info about the
937     -- ccall; it is encoded, but may have embedded spaces etc!
938
939     name = mkFCallName uniq occ_str
940
941     info = noCafIdInfo
942            `setArityInfo`         arity
943            `setStrictnessInfo`    strict_sig
944
945     (_, tau)        = tcSplitForAllTys ty
946     (arg_tys, _)    = tcSplitFunTys tau
947     arity           = length arg_tys
948     strict_sig      = mkClosedStrictSig (replicate arity evalDmd) topRes
949 \end{code}
950
951
952 %************************************************************************
953 %*                                                                      *
954 \subsection{DictFuns and default methods}
955 %*                                                                      *
956 %************************************************************************
957
958 Important notes about dict funs and default methods
959 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
960 Dict funs and default methods are *not* ImplicitIds.  Their definition
961 involves user-written code, so we can't figure out their strictness etc
962 based on fixed info, as we can for constructors and record selectors (say).
963
964 We build them as LocalIds, but with External Names.  This ensures that
965 they are taken to account by free-variable finding and dependency
966 analysis (e.g. CoreFVs.exprFreeVars).
967
968 Why shouldn't they be bound as GlobalIds?  Because, in particular, if
969 they are globals, the specialiser floats dict uses above their defns,
970 which prevents good simplifications happening.  Also the strictness
971 analyser treats a occurrence of a GlobalId as imported and assumes it
972 contains strictness in its IdInfo, which isn't true if the thing is
973 bound in the same module as the occurrence.
974
975 It's OK for dfuns to be LocalIds, because we form the instance-env to
976 pass on to the next module (md_insts) in CoreTidy, afer tidying
977 and globalising the top-level Ids.
978
979 BUT make sure they are *exported* LocalIds (mkExportedLocalId) so 
980 that they aren't discarded by the occurrence analyser.
981
982 \begin{code}
983 mkDictFunId :: Name      -- Name to use for the dict fun;
984             -> [TyVar]
985             -> ThetaType
986             -> Class 
987             -> [Type]
988             -> Id
989 -- Implements the DFun Superclass Invariant (see TcInstDcls)
990
991 mkDictFunId dfun_name tvs theta clas tys
992   = mkExportedLocalVar (DFunId n_silent is_nt)
993                        dfun_name
994                        dfun_ty
995                        vanillaIdInfo
996   where
997     is_nt = isNewTyCon (classTyCon clas)
998     (n_silent, dfun_ty) = mkDictFunTy tvs theta clas tys
999
1000 mkDictFunTy :: [TyVar] -> ThetaType -> Class -> [Type] -> (Int, Type)
1001 mkDictFunTy tvs theta clas tys
1002   = (length silent_theta, dfun_ty)
1003   where
1004     dfun_ty = mkSigmaTy tvs (silent_theta ++ theta) (mkClassPred clas tys)
1005     silent_theta 
1006       | null tvs, null theta 
1007       = []
1008       | otherwise
1009       = filterOut discard $
1010         substTheta (zipTopTvSubst (classTyVars clas) tys)
1011                    (classSCTheta clas)
1012                    -- See Note [Silent Superclass Arguments]
1013     discard pred = any (`eqPred` pred) theta
1014                  -- See the DFun Superclass Invariant in TcInstDcls
1015 \end{code}
1016
1017
1018 %************************************************************************
1019 %*                                                                      *
1020 \subsection{Un-definable}
1021 %*                                                                      *
1022 %************************************************************************
1023
1024 These Ids can't be defined in Haskell.  They could be defined in
1025 unfoldings in the wired-in GHC.Prim interface file, but we'd have to
1026 ensure that they were definitely, definitely inlined, because there is
1027 no curried identifier for them.  That's what mkCompulsoryUnfolding
1028 does.  If we had a way to get a compulsory unfolding from an interface
1029 file, we could do that, but we don't right now.
1030
1031 unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
1032 just gets expanded into a type coercion wherever it occurs.  Hence we
1033 add it as a built-in Id with an unfolding here.
1034
1035 The type variables we use here are "open" type variables: this means
1036 they can unify with both unlifted and lifted types.  Hence we provide
1037 another gun with which to shoot yourself in the foot.
1038
1039 \begin{code}
1040 lazyIdName, unsafeCoerceName, nullAddrName, seqName,
1041    realWorldName, voidPrimIdName, coercionTokenName,
1042    magicDictName, coerceName, proxyName, dollarName :: Name
1043 unsafeCoerceName  = mkWiredInIdName gHC_PRIM  (fsLit "unsafeCoerce#")  unsafeCoerceIdKey  unsafeCoerceId
1044 nullAddrName      = mkWiredInIdName gHC_PRIM  (fsLit "nullAddr#")      nullAddrIdKey      nullAddrId
1045 seqName           = mkWiredInIdName gHC_PRIM  (fsLit "seq")            seqIdKey           seqId
1046 realWorldName     = mkWiredInIdName gHC_PRIM  (fsLit "realWorld#")     realWorldPrimIdKey realWorldPrimId
1047 voidPrimIdName    = mkWiredInIdName gHC_PRIM  (fsLit "void#")          voidPrimIdKey      voidPrimId
1048 lazyIdName        = mkWiredInIdName gHC_MAGIC (fsLit "lazy")           lazyIdKey          lazyId
1049 coercionTokenName = mkWiredInIdName gHC_PRIM  (fsLit "coercionToken#") coercionTokenIdKey coercionTokenId
1050 magicDictName     = mkWiredInIdName gHC_PRIM  (fsLit "magicDict")      magicDictKey       magicDictId
1051 coerceName        = mkWiredInIdName gHC_PRIM  (fsLit "coerce")         coerceKey          coerceId
1052 proxyName         = mkWiredInIdName gHC_PRIM  (fsLit "proxy#")         proxyHashKey       proxyHashId
1053 dollarName        = mkWiredInIdName gHC_BASE  (fsLit "$")              dollarIdKey        dollarId
1054 \end{code}
1055
1056 \begin{code}
1057 dollarId :: Id  -- Note [dollarId magic]
1058 dollarId = pcMiscPrelId dollarName ty
1059              (noCafIdInfo `setUnfoldingInfo` unf)
1060   where
1061     fun_ty = mkFunTy alphaTy openBetaTy
1062     ty     = mkForAllTys [alphaTyVar, openBetaTyVar] $
1063              mkFunTy fun_ty fun_ty
1064     unf    = mkInlineUnfolding (Just 2) rhs
1065     [f,x]  = mkTemplateLocals [fun_ty, alphaTy]
1066     rhs    = mkLams [alphaTyVar, openBetaTyVar, f, x] $
1067              App (Var f) (Var x)
1068
1069 ------------------------------------------------
1070 -- proxy# :: forall a. Proxy# a
1071 proxyHashId :: Id
1072 proxyHashId
1073   = pcMiscPrelId proxyName ty
1074        (noCafIdInfo `setUnfoldingInfo` evaldUnfolding) -- Note [evaldUnfoldings]
1075   where
1076     ty      = mkForAllTys [kv, tv] (mkProxyPrimTy k t)
1077     kv      = kKiVar
1078     k       = mkTyVarTy kv
1079     tv:_    = tyVarList k
1080     t       = mkTyVarTy tv
1081
1082 ------------------------------------------------
1083 -- unsafeCoerce# :: forall a b. a -> b
1084 unsafeCoerceId :: Id
1085 unsafeCoerceId
1086   = pcMiscPrelId unsafeCoerceName ty info
1087   where
1088     info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
1089                        `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
1090            
1091
1092     ty  = mkForAllTys [openAlphaTyVar,openBetaTyVar]
1093                       (mkFunTy openAlphaTy openBetaTy)
1094     [x] = mkTemplateLocals [openAlphaTy]
1095     rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
1096           Cast (Var x) (mkUnsafeCo openAlphaTy openBetaTy)
1097
1098 ------------------------------------------------
1099 nullAddrId :: Id
1100 -- nullAddr# :: Addr#
1101 -- The reason is is here is because we don't provide 
1102 -- a way to write this literal in Haskell.
1103 nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info
1104   where
1105     info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
1106                        `setUnfoldingInfo`  mkCompulsoryUnfolding (Lit nullAddrLit)
1107
1108 ------------------------------------------------
1109 seqId :: Id     -- See Note [seqId magic]
1110 seqId = pcMiscPrelId seqName ty info
1111   where
1112     info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
1113                        `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
1114                        `setSpecInfo`       mkSpecInfo [seq_cast_rule]
1115            
1116
1117     ty  = mkForAllTys [alphaTyVar,betaTyVar]
1118                       (mkFunTy alphaTy (mkFunTy betaTy betaTy))
1119               -- NB argBetaTyVar; see Note [seqId magic]
1120
1121     [x,y] = mkTemplateLocals [alphaTy, betaTy]
1122     rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x betaTy [(DEFAULT, [], Var y)])
1123
1124     -- See Note [Built-in RULES for seq]
1125     seq_cast_rule = BuiltinRule { ru_name  = fsLit "seq of cast"
1126                                 , ru_fn    = seqName
1127                                 , ru_nargs = 4
1128                                 , ru_try   = match_seq_of_cast
1129                                 }
1130
1131 match_seq_of_cast :: RuleFun
1132     -- See Note [Built-in RULES for seq]
1133 match_seq_of_cast _ _ _ [Type _, Type res_ty, Cast scrut co, expr]
1134   = Just (Var seqId `mkApps` [Type (pFst (coercionKind co)), Type res_ty,
1135                               scrut, expr])
1136 match_seq_of_cast _ _ _ _ = Nothing
1137
1138 ------------------------------------------------
1139 lazyId :: Id    -- See Note [lazyId magic]
1140 lazyId = pcMiscPrelId lazyIdName ty info
1141   where
1142     info = noCafIdInfo
1143     ty  = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
1144
1145
1146 --------------------------------------------------------------------------------
1147 magicDictId :: Id  -- See Note [magicDictId magic]
1148 magicDictId = pcMiscPrelId magicDictName ty info
1149   where
1150   info = noCafIdInfo `setInlinePragInfo` neverInlinePragma
1151   ty   = mkForAllTys [alphaTyVar] alphaTy
1152
1153 --------------------------------------------------------------------------------
1154
1155 coerceId :: Id
1156 coerceId = pcMiscPrelId coerceName ty info
1157   where
1158     info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
1159                        `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
1160     kv = kKiVar
1161     k = mkTyVarTy kv
1162     a:b:_ = tyVarList k
1163     [aTy,bTy] = map mkTyVarTy [a,b]
1164     eqRTy     = mkTyConApp coercibleTyCon  [k, aTy, bTy]
1165     eqRPrimTy = mkTyConApp eqReprPrimTyCon [k, aTy, bTy]
1166     ty   = mkForAllTys [kv, a, b] (mkFunTys [eqRTy, aTy] bTy)
1167
1168     [eqR,x,eq] = mkTemplateLocals [eqRTy, aTy,eqRPrimTy]
1169     rhs = mkLams [kv,a,b,eqR,x] $
1170           mkWildCase (Var eqR) eqRTy bTy $
1171           [(DataAlt coercibleDataCon, [eq], Cast (Var x) (CoVarCo eq))]
1172 \end{code}
1173
1174 Note [dollarId magic]
1175 ~~~~~~~~~~~~~~~~~~~~~
1176 The only reason that ($) is wired in is so that its type can be
1177     forall (a:*, b:Open). (a->b) -> a -> b
1178 That is, the return type can be unboxed.  E.g. this is OK
1179     foo $ True    where  foo :: Bool -> Int#
1180 because ($) doesn't inspect or move the result of the call to foo.
1181 See Trac #8739.
1182
1183 There is a special typing rule for ($) in TcExpr, so the type of ($)
1184 isn't looked at there, BUT Lint subsequently (and rightly) complains
1185 if sees ($) applied to Int# (say), unless we give it a wired-in type
1186 as we do here.
1187
1188 Note [Unsafe coerce magic]
1189 ~~~~~~~~~~~~~~~~~~~~~~~~~~
1190 We define a *primitive*
1191    GHC.Prim.unsafeCoerce#
1192 and then in the base library we define the ordinary function
1193    Unsafe.Coerce.unsafeCoerce :: forall (a:*) (b:*). a -> b
1194    unsafeCoerce x = unsafeCoerce# x
1195
1196 Notice that unsafeCoerce has a civilized (albeit still dangerous)
1197 polymorphic type, whose type args have kind *.  So you can't use it on
1198 unboxed values (unsafeCoerce 3#).
1199
1200 In contrast unsafeCoerce# is even more dangerous because you *can* use
1201 it on unboxed things, (unsafeCoerce# 3#) :: Int. Its type is
1202    forall (a:OpenKind) (b:OpenKind). a -> b
1203
1204 Note [seqId magic]
1205 ~~~~~~~~~~~~~~~~~~
1206 'GHC.Prim.seq' is special in several ways. 
1207
1208 a) Its second arg can have an unboxed type
1209       x `seq` (v +# w)
1210    Hence its second type variable has ArgKind
1211
1212 b) Its fixity is set in LoadIface.ghcPrimIface
1213
1214 c) It has quite a bit of desugaring magic. 
1215    See DsUtils.lhs Note [Desugaring seq (1)] and (2) and (3)
1216
1217 d) There is some special rule handing: Note [User-defined RULES for seq]
1218
1219 e) See Note [Typing rule for seq] in TcExpr.
1220
1221 Note [User-defined RULES for seq]
1222 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1223 Roman found situations where he had
1224       case (f n) of _ -> e
1225 where he knew that f (which was strict in n) would terminate if n did.
1226 Notice that the result of (f n) is discarded. So it makes sense to
1227 transform to
1228       case n of _ -> e
1229
1230 Rather than attempt some general analysis to support this, I've added
1231 enough support that you can do this using a rewrite rule:
1232
1233   RULE "f/seq" forall n.  seq (f n) e = seq n e
1234
1235 You write that rule.  When GHC sees a case expression that discards
1236 its result, it mentally transforms it to a call to 'seq' and looks for
1237 a RULE.  (This is done in Simplify.rebuildCase.)  As usual, the
1238 correctness of the rule is up to you.
1239
1240 To make this work, we need to be careful that the magical desugaring
1241 done in Note [seqId magic] item (c) is *not* done on the LHS of a rule.
1242 Or rather, we arrange to un-do it, in DsBinds.decomposeRuleLhs.
1243
1244 Note [Built-in RULES for seq]
1245 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1246 We also have the following built-in rule for seq
1247
1248   seq (x `cast` co) y = seq x y
1249
1250 This eliminates unnecessary casts and also allows other seq rules to
1251 match more often.  Notably,     
1252
1253    seq (f x `cast` co) y  -->  seq (f x) y
1254   
1255 and now a user-defined rule for seq (see Note [User-defined RULES for seq])
1256 may fire.
1257
1258
1259 Note [lazyId magic]
1260 ~~~~~~~~~~~~~~~~~~~
1261     lazy :: forall a?. a? -> a?   (i.e. works for unboxed types too)
1262
1263 Used to lazify pseq:   pseq a b = a `seq` lazy b
1264
1265 Also, no strictness: by being a built-in Id, all the info about lazyId comes from here,
1266 not from GHC.Base.hi.   This is important, because the strictness
1267 analyser will spot it as strict!
1268
1269 Also no unfolding in lazyId: it gets "inlined" by a HACK in CorePrep.
1270 It's very important to do this inlining *after* unfoldings are exposed 
1271 in the interface file.  Otherwise, the unfolding for (say) pseq in the
1272 interface file will not mention 'lazy', so if we inline 'pseq' we'll totally
1273 miss the very thing that 'lazy' was there for in the first place.
1274 See Trac #3259 for a real world example.
1275
1276 lazyId is defined in GHC.Base, so we don't *have* to inline it.  If it
1277 appears un-applied, we'll end up just calling it.
1278
1279
1280 Note [magicDictId magic]
1281 ~~~~~~~~~~~~~~~~~~~~~~~~~
1282
1283 The identifier `magicDict` is just a place-holder, which is used to
1284 implement a primitve that we cannot define in Haskell but we can write
1285 in Core.  It is declared with a place-holder type:
1286
1287     magicDict :: forall a. a
1288
1289 The intention is that the identifier will be used in a very specific way,
1290 to create dictionaries for classes with a single method.  Consider a class
1291 like this:
1292
1293    class C a where
1294      f :: T a
1295
1296 We are going to use `magicDict`, in conjunction with a built-in Prelude
1297 rule, to cast values of type `T a` into dictionaries for `C a`.  To do
1298 this, we define a function like this in the library:
1299
1300   data WrapC a b = WrapC (C a => Proxy a -> b)
1301
1302   withT :: (C a => Proxy a -> b)
1303         ->  T a -> Proxy a -> b
1304   withT f x y = magicDict (WrapC f) x y
1305
1306 The purpose of `WrapC` is to avoid having `f` instantiated.
1307 Also, it avoids impredicativity, because `magicDict`'s type
1308 cannot be instantiated with a forall.  The field of `WrapC` contains
1309 a `Proxy` parameter which is used to link the type of the constraint,
1310 `C a`, with the type of the `Wrap` value being made.
1311
1312 Next, we add a built-in Prelude rule (see prelude/PrelRules.hs),
1313 which will replace the RHS of this definition with the appropriate
1314 definition in Core.  The rewrite rule works as follows:
1315
1316 magicDict@t (wrap@a@b f) x y
1317 ---->
1318 f (x `cast` co a) y
1319
1320 The `co` coercion is the newtype-coercion extracted from the type-class.
1321 The type class is obtain by looking at the type of wrap.
1322
1323
1324
1325 -------------------------------------------------------------
1326 @realWorld#@ used to be a magic literal, \tr{void#}.  If things get
1327 nasty as-is, change it back to a literal (@Literal@).
1328
1329 voidArgId is a Local Id used simply as an argument in functions
1330 where we just want an arg to avoid having a thunk of unlifted type.
1331 E.g.
1332         x = \ void :: Void# -> (# p, q #)
1333
1334 This comes up in strictness analysis
1335
1336 Note [evaldUnfoldings]
1337 ~~~~~~~~~~~~~~~~~~~~~~
1338 The evaldUnfolding makes it look that some primitive value is
1339 evaluated, which in turn makes Simplify.interestingArg return True,
1340 which in turn makes INLINE things applied to said value likely to be
1341 inlined.
1342
1343
1344 \begin{code}
1345 realWorldPrimId :: Id   -- :: State# RealWorld
1346 realWorldPrimId = pcMiscPrelId realWorldName realWorldStatePrimTy
1347                      (noCafIdInfo `setUnfoldingInfo` evaldUnfolding    -- Note [evaldUnfoldings]
1348                                   `setOneShotInfo` stateHackOneShot)
1349
1350 voidPrimId :: Id     -- Global constant :: Void#
1351 voidPrimId  = pcMiscPrelId voidPrimIdName voidPrimTy
1352                 (noCafIdInfo `setUnfoldingInfo` evaldUnfolding)    -- Note [evaldUnfoldings]
1353
1354 voidArgId :: Id       -- Local lambda-bound :: Void#
1355 voidArgId = mkSysLocal (fsLit "void") voidArgIdKey voidPrimTy
1356
1357 coercionTokenId :: Id         -- :: () ~ ()
1358 coercionTokenId -- Used to replace Coercion terms when we go to STG
1359   = pcMiscPrelId coercionTokenName 
1360                  (mkTyConApp eqPrimTyCon [liftedTypeKind, unitTy, unitTy])
1361                  noCafIdInfo
1362 \end{code}
1363
1364
1365 \begin{code}
1366 pcMiscPrelId :: Name -> Type -> IdInfo -> Id
1367 pcMiscPrelId name ty info
1368   = mkVanillaGlobalWithInfo name ty info
1369     -- We lie and say the thing is imported; otherwise, we get into
1370     -- a mess with dependency analysis; e.g., core2stg may heave in
1371     -- random calls to GHCbase.unpackPS__.  If GHCbase is the module
1372     -- being compiled, then it's just a matter of luck if the definition
1373     -- will be in "the right place" to be in scope.
1374 \end{code}