0ef6ee10f596640cfb660a6918ea4dfcc2e5eb16
[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 {-# OPTIONS -fno-warn-tabs #-}
16 -- The above warning supression flag is a temporary kludge.
17 -- While working on this module you are encouraged to remove it and
18 -- detab the module (please do the detabbing in a separate patch). See
19 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
20 -- for details
21
22 module MkId (
23         mkDictFunId, mkDictFunTy, mkDictSelId,
24
25         mkDataConIds, mkPrimOpId, mkFCallId,
26
27         mkReboxingAlt, wrapNewTypeBody, unwrapNewTypeBody,
28         wrapFamInstBody, unwrapFamInstScrut,
29         wrapTypeFamInstBody, unwrapTypeFamInstScrut,
30         mkUnpackCase, mkProductBox,
31
32         -- And some particular Ids; see below for why they are wired in
33         wiredInIds, ghcPrimIds,
34         unsafeCoerceName, unsafeCoerceId, realWorldPrimId, 
35         voidArgId, nullAddrId, seqId, lazyId, lazyIdKey, noupdateIdKey,
36         coercionTokenId,
37
38         -- Re-export error Ids
39         module PrelRules
40     ) where
41
42 #include "HsVersions.h"
43
44 import Rules
45 import TysPrim
46 import TysWiredIn
47 import PrelRules
48 import Type
49 import Coercion
50 import TcType
51 import MkCore
52 import CoreUtils        ( exprType, mkCast )
53 import CoreUnfold
54 import Literal
55 import TyCon
56 import Class
57 import VarSet
58 import Name
59 import PrimOp
60 import ForeignCall
61 import DataCon
62 import Id
63 import Var              ( mkExportedLocalVar )
64 import IdInfo
65 import Demand
66 import CoreSyn
67 import Unique
68 import PrelNames
69 import BasicTypes       hiding ( SuccessFlag(..) )
70 import Util
71 import Pair
72 import DynFlags
73 import Outputable
74 import FastString
75 import ListSetOps
76
77 import Data.Maybe       ( maybeToList )
78 \end{code}
79
80 %************************************************************************
81 %*                                                                      *
82 \subsection{Wired in Ids}
83 %*                                                                      *
84 %************************************************************************
85
86 Note [Wired-in Ids]
87 ~~~~~~~~~~~~~~~~~~~
88 There are several reasons why an Id might appear in the wiredInIds:
89
90 (1) The ghcPrimIds are wired in because they can't be defined in
91     Haskell at all, although the can be defined in Core.  They have
92     compulsory unfoldings, so they are always inlined and they  have
93     no definition site.  Their home module is GHC.Prim, so they
94     also have a description in primops.txt.pp, where they are called
95     'pseudoops'.
96
97 (2) The 'error' function, eRROR_ID, is wired in because we don't yet have
98     a way to express in an interface file that the result type variable
99     is 'open'; that is can be unified with an unboxed type
100
101     [The interface file format now carry such information, but there's
102     no way yet of expressing at the definition site for these 
103     error-reporting functions that they have an 'open' 
104     result type. -- sof 1/99]
105
106 (3) Other error functions (rUNTIME_ERROR_ID) are wired in (a) because
107     the desugarer generates code that mentiones them directly, and
108     (b) for the same reason as eRROR_ID
109
110 (4) lazyId is wired in because the wired-in version overrides the
111     strictness of the version defined in GHC.Base
112
113 In cases (2-4), the function has a definition in a library module, and
114 can be called; but the wired-in version means that the details are 
115 never read from that module's interface file; instead, the full definition
116 is right here.
117
118 \begin{code}
119 wiredInIds :: [Id]
120 wiredInIds
121   =  [lazyId]
122   ++ errorIds           -- Defined in MkCore
123   ++ ghcPrimIds
124
125 -- These Ids are exported from GHC.Prim
126 ghcPrimIds :: [Id]
127 ghcPrimIds
128   = [   -- These can't be defined in Haskell, but they have
129         -- perfectly reasonable unfoldings in Core
130     realWorldPrimId,
131     unsafeCoerceId,
132     nullAddrId,
133     seqId,
134     noupdateId -- Here for now to avoid changing base
135     ]
136 \end{code}
137
138 %************************************************************************
139 %*                                                                      *
140 \subsection{Data constructors}
141 %*                                                                      *
142 %************************************************************************
143
144 The wrapper for a constructor is an ordinary top-level binding that evaluates
145 any strict args, unboxes any args that are going to be flattened, and calls
146 the worker.
147
148 We're going to build a constructor that looks like:
149
150         data (Data a, C b) =>  T a b = T1 !a !Int b
151
152         T1 = /\ a b -> 
153              \d1::Data a, d2::C b ->
154              \p q r -> case p of { p ->
155                        case q of { q ->
156                        Con T1 [a,b] [p,q,r]}}
157
158 Notice that
159
160 * d2 is thrown away --- a context in a data decl is used to make sure
161   one *could* construct dictionaries at the site the constructor
162   is used, but the dictionary isn't actually used.
163
164 * We have to check that we can construct Data dictionaries for
165   the types a and Int.  Once we've done that we can throw d1 away too.
166
167 * We use (case p of q -> ...) to evaluate p, rather than "seq" because
168   all that matters is that the arguments are evaluated.  "seq" is 
169   very careful to preserve evaluation order, which we don't need
170   to be here.
171
172   You might think that we could simply give constructors some strictness
173   info, like PrimOps, and let CoreToStg do the let-to-case transformation.
174   But we don't do that because in the case of primops and functions strictness
175   is a *property* not a *requirement*.  In the case of constructors we need to
176   do something active to evaluate the argument.
177
178   Making an explicit case expression allows the simplifier to eliminate
179   it in the (common) case where the constructor arg is already evaluated.
180
181 Note [Wrappers for data instance tycons]
182 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
183 In the case of data instances, the wrapper also applies the coercion turning
184 the representation type into the family instance type to cast the result of
185 the wrapper.  For example, consider the declarations
186
187   data family Map k :: * -> *
188   data instance Map (a, b) v = MapPair (Map a (Pair b v))
189
190 The tycon to which the datacon MapPair belongs gets a unique internal
191 name of the form :R123Map, and we call it the representation tycon.
192 In contrast, Map is the family tycon (accessible via
193 tyConFamInst_maybe). A coercion allows you to move between
194 representation and family type.  It is accessible from :R123Map via
195 tyConFamilyCoercion_maybe and has kind
196
197   Co123Map a b v :: {Map (a, b) v ~ :R123Map a b v}
198
199 The wrapper and worker of MapPair get the types
200
201         -- Wrapper
202   $WMapPair :: forall a b v. Map a (Map a b v) -> Map (a, b) v
203   $WMapPair a b v = MapPair a b v `cast` sym (Co123Map a b v)
204
205         -- Worker
206   MapPair :: forall a b v. Map a (Map a b v) -> :R123Map a b v
207
208 This coercion is conditionally applied by wrapFamInstBody.
209
210 It's a bit more complicated if the data instance is a GADT as well!
211
212    data instance T [a] where
213         T1 :: forall b. b -> T [Maybe b]
214
215 Hence we translate to
216
217         -- Wrapper
218   $WT1 :: forall b. b -> T [Maybe b]
219   $WT1 b v = T1 (Maybe b) b (Maybe b) v
220                         `cast` sym (Co7T (Maybe b))
221
222         -- Worker
223   T1 :: forall c b. (c ~ Maybe b) => b -> :R7T c
224
225         -- Coercion from family type to representation type
226   Co7T a :: T [a] ~ :R7T a
227
228 \begin{code}
229 mkDataConIds :: Name -> Name -> DataCon -> DataConIds
230 mkDataConIds wrap_name wkr_name data_con
231   | isNewTyCon tycon                    -- Newtype, only has a worker
232   = DCIds Nothing nt_work_id                 
233
234   | any isBanged all_strict_marks      -- Algebraic, needs wrapper
235     || not (null eq_spec)              -- NB: LoadIface.ifaceDeclImplicitBndrs
236     || isFamInstTyCon tycon            --     depends on this test
237   = DCIds (Just alg_wrap_id) wrk_id
238
239   | otherwise                                -- Algebraic, no wrapper
240   = DCIds Nothing wrk_id
241   where
242     (univ_tvs, ex_tvs, eq_spec, 
243      other_theta, orig_arg_tys, res_ty) = dataConFullSig data_con
244     tycon = dataConTyCon data_con       -- The representation TyCon (not family)
245
246         ----------- Worker (algebraic data types only) --------------
247         -- The *worker* for the data constructor is the function that
248         -- takes the representation arguments and builds the constructor.
249     wrk_id = mkGlobalId (DataConWorkId data_con) wkr_name
250                         (dataConRepType data_con) wkr_info
251
252     wkr_arity = dataConRepArity data_con
253     wkr_info  = noCafIdInfo
254                 `setArityInfo`       wkr_arity
255                 `setStrictnessInfo`  Just wkr_sig
256                 `setUnfoldingInfo`   evaldUnfolding  -- Record that it's evaluated,
257                                                         -- even if arity = 0
258
259     wkr_sig = mkStrictSig (mkTopDmdType (replicate wkr_arity topDmd) cpr_info)
260         --      Note [Data-con worker strictness]
261         -- Notice that we do *not* say the worker is strict
262         -- even if the data constructor is declared strict
263         --      e.g.    data T = MkT !(Int,Int)
264         -- Why?  Because the *wrapper* is strict (and its unfolding has case
265         -- expresssions that do the evals) but the *worker* itself is not.
266         -- If we pretend it is strict then when we see
267         --      case x of y -> $wMkT y
268         -- the simplifier thinks that y is "sure to be evaluated" (because
269         --  $wMkT is strict) and drops the case.  No, $wMkT is not strict.
270         --
271         -- When the simplifer sees a pattern 
272         --      case e of MkT x -> ...
273         -- it uses the dataConRepStrictness of MkT to mark x as evaluated;
274         -- but that's fine... dataConRepStrictness comes from the data con
275         -- not from the worker Id.
276
277     cpr_info | isProductTyCon tycon && 
278                isDataTyCon tycon    &&
279                wkr_arity > 0        &&
280                wkr_arity <= mAX_CPR_SIZE        = retCPR
281              | otherwise                        = TopRes
282         -- RetCPR is only true for products that are real data types;
283         -- that is, not unboxed tuples or [non-recursive] newtypes
284
285         ----------- Workers for newtypes --------------
286     nt_work_id   = mkGlobalId (DataConWrapId data_con) wkr_name wrap_ty nt_work_info
287     nt_work_info = noCafIdInfo          -- The NoCaf-ness is set by noCafIdInfo
288                   `setArityInfo` 1      -- Arity 1
289                   `setInlinePragInfo`    alwaysInlinePragma
290                   `setUnfoldingInfo`     newtype_unf
291     id_arg1      = mkTemplateLocal 1 (head orig_arg_tys)
292     newtype_unf  = ASSERT2( isVanillaDataCon data_con &&
293                             isSingleton orig_arg_tys, ppr data_con  )
294                               -- Note [Newtype datacons]
295                    mkCompulsoryUnfolding $ 
296                    mkLams wrap_tvs $ Lam id_arg1 $ 
297                    wrapNewTypeBody tycon res_ty_args (Var id_arg1)
298
299
300         ----------- Wrapper --------------
301         -- We used to include the stupid theta in the wrapper's args
302         -- but now we don't.  Instead the type checker just injects these
303         -- extra constraints where necessary.
304     wrap_tvs    = (univ_tvs `minusList` map fst eq_spec) ++ ex_tvs
305     res_ty_args = substTyVars (mkTopTvSubst eq_spec) univ_tvs
306     ev_tys      = other_theta
307     wrap_ty     = mkForAllTys wrap_tvs $ 
308                   mkFunTys ev_tys $
309                   mkFunTys orig_arg_tys $ res_ty
310
311         ----------- Wrappers for algebraic data types -------------- 
312     alg_wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty alg_wrap_info
313     alg_wrap_info = noCafIdInfo
314                     `setArityInfo`         wrap_arity
315                         -- It's important to specify the arity, so that partial
316                         -- applications are treated as values
317                     `setInlinePragInfo`    alwaysInlinePragma
318                     `setUnfoldingInfo`     wrap_unf
319                     `setStrictnessInfo` Just wrap_sig
320                         -- We need to get the CAF info right here because TidyPgm
321                         -- does not tidy the IdInfo of implicit bindings (like the wrapper)
322                         -- so it not make sure that the CAF info is sane
323
324     all_strict_marks = dataConExStricts data_con ++ dataConStrictMarks data_con
325     wrap_sig = mkStrictSig (mkTopDmdType wrap_arg_dmds cpr_info)
326     wrap_stricts = dropList eq_spec all_strict_marks
327     wrap_arg_dmds = map mk_dmd wrap_stricts
328     mk_dmd str | isBanged str = evalDmd
329                | otherwise    = lazyDmd
330         -- The Cpr info can be important inside INLINE rhss, where the
331         -- wrapper constructor isn't inlined.
332         -- And the argument strictness can be important too; we
333         -- may not inline a contructor when it is partially applied.
334         -- For example:
335         --      data W = C !Int !Int !Int
336         --      ...(let w = C x in ...(w p q)...)...
337         -- we want to see that w is strict in its two arguments
338
339     wrap_unf = mkInlineUnfolding (Just (length ev_args + length id_args)) wrap_rhs
340     wrap_rhs = mkLams wrap_tvs $ 
341                mkLams ev_args $
342                mkLams id_args $
343                foldr mk_case con_app 
344                      (zip (ev_args ++ id_args) wrap_stricts)
345                      i3 []
346              -- The ev_args is the evidence arguments *other than* the eq_spec
347              -- Because we are going to apply the eq_spec args manually in the
348              -- wrapper
349
350     con_app _ rep_ids = wrapFamInstBody tycon res_ty_args $
351                           Var wrk_id `mkTyApps`  res_ty_args
352                                      `mkVarApps` ex_tvs                 
353                                      `mkCoApps`  map (mkReflCo . snd) eq_spec
354                                      `mkVarApps` reverse rep_ids
355                             -- Dont box the eq_spec coercions since they are
356                             -- marked as HsUnpack by mk_dict_strict_mark
357
358     (ev_args,i2) = mkLocals 1  ev_tys
359     (id_args,i3) = mkLocals i2 orig_arg_tys
360     wrap_arity   = i3-1
361
362     mk_case 
363            :: (Id, HsBang)      -- Arg, strictness
364            -> (Int -> [Id] -> CoreExpr) -- Body
365            -> Int                       -- Next rep arg id
366            -> [Id]                      -- Rep args so far, reversed
367            -> CoreExpr
368     mk_case (arg,strict) body i rep_args
369           = case strict of
370                 HsNoBang -> body i (arg:rep_args)
371                 HsUnpack -> unboxProduct i (Var arg) (idType arg) the_body 
372                       where
373                         the_body i con_args = body i (reverse con_args ++ rep_args)
374                 _other  -- HsUnpackFailed and HsStrict
375                    | isUnLiftedType (idType arg) -> body i (arg:rep_args)
376                    | otherwise -> Case (Var arg) arg res_ty 
377                                        [(DEFAULT,[], body i (arg:rep_args))]
378
379 mAX_CPR_SIZE :: Arity
380 mAX_CPR_SIZE = 10
381 -- We do not treat very big tuples as CPR-ish:
382 --      a) for a start we get into trouble because there aren't 
383 --         "enough" unboxed tuple types (a tiresome restriction, 
384 --         but hard to fix), 
385 --      b) more importantly, big unboxed tuples get returned mainly
386 --         on the stack, and are often then allocated in the heap
387 --         by the caller.  So doing CPR for them may in fact make
388 --         things worse.
389
390 mkLocals :: Int -> [Type] -> ([Id], Int)
391 mkLocals i tys = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
392                where
393                  n = length tys
394 \end{code}
395
396 Note [Newtype datacons]
397 ~~~~~~~~~~~~~~~~~~~~~~~
398 The "data constructor" for a newtype should always be vanilla.  At one
399 point this wasn't true, because the newtype arising from
400      class C a => D a
401 looked like
402        newtype T:D a = D:D (C a)
403 so the data constructor for T:C had a single argument, namely the
404 predicate (C a).  But now we treat that as an ordinary argument, not
405 part of the theta-type, so all is well.
406
407
408 %************************************************************************
409 %*                                                                      *
410 \subsection{Dictionary selectors}
411 %*                                                                      *
412 %************************************************************************
413
414 Selecting a field for a dictionary.  If there is just one field, then
415 there's nothing to do.  
416
417 Dictionary selectors may get nested forall-types.  Thus:
418
419         class Foo a where
420           op :: forall b. Ord b => a -> b -> b
421
422 Then the top-level type for op is
423
424         op :: forall a. Foo a => 
425               forall b. Ord b => 
426               a -> b -> b
427
428 This is unlike ordinary record selectors, which have all the for-alls
429 at the outside.  When dealing with classes it's very convenient to
430 recover the original type signature from the class op selector.
431
432 \begin{code}
433 mkDictSelId :: Bool          -- True <=> don't include the unfolding
434                              -- Little point on imports without -O, because the
435                              -- dictionary itself won't be visible
436             -> Name          -- Name of one of the *value* selectors 
437                              -- (dictionary superclass or method)
438             -> Class -> Id
439 mkDictSelId no_unf name clas
440   = mkGlobalId (ClassOpId clas) name sel_ty info
441   where
442     sel_ty = mkForAllTys tyvars (mkFunTy (idType dict_id) (idType the_arg_id))
443         -- We can't just say (exprType rhs), because that would give a type
444         --      C a -> C a
445         -- for a single-op class (after all, the selector is the identity)
446         -- But it's type must expose the representation of the dictionary
447         -- to get (say)         C a -> (a -> a)
448
449     base_info = noCafIdInfo
450                 `setArityInfo`      1
451                 `setStrictnessInfo` Just strict_sig
452                 `setUnfoldingInfo`  (if no_unf then noUnfolding
453                                      else mkImplicitUnfolding rhs)
454                    -- In module where class op is defined, we must add
455                    -- the unfolding, even though it'll never be inlined
456                    -- becuase we use that to generate a top-level binding
457                    -- for the ClassOp
458
459     info | new_tycon = base_info `setInlinePragInfo` alwaysInlinePragma
460                    -- See Note [Single-method classes] in TcInstDcls
461                    -- for why alwaysInlinePragma
462          | otherwise = base_info  `setSpecInfo`       mkSpecInfo [rule]
463                                   `setInlinePragInfo` neverInlinePragma
464                    -- Add a magic BuiltinRule, and never inline it
465                    -- so that the rule is always available to fire.
466                    -- See Note [ClassOp/DFun selection] in TcInstDcls
467
468     n_ty_args = length tyvars
469
470     -- This is the built-in rule that goes
471     --      op (dfT d1 d2) --->  opT d1 d2
472     rule = BuiltinRule { ru_name = fsLit "Class op " `appendFS` 
473                                      occNameFS (getOccName name)
474                        , ru_fn    = name
475                        , ru_nargs = n_ty_args + 1
476                        , ru_try   = dictSelRule val_index n_ty_args }
477
478         -- The strictness signature is of the form U(AAAVAAAA) -> T
479         -- where the V depends on which item we are selecting
480         -- It's worth giving one, so that absence info etc is generated
481         -- even if the selector isn't inlined
482     strict_sig = mkStrictSig (mkTopDmdType [arg_dmd] TopRes)
483     arg_dmd | new_tycon = evalDmd
484             | otherwise = Eval (Prod [ if the_arg_id == id then evalDmd else Abs
485                                      | id <- arg_ids ])
486
487     tycon          = classTyCon clas
488     new_tycon      = isNewTyCon tycon
489     [data_con]     = tyConDataCons tycon
490     tyvars         = dataConUnivTyVars data_con
491     arg_tys        = dataConRepArgTys data_con  -- Includes the dictionary superclasses
492
493     -- 'index' is a 0-index into the *value* arguments of the dictionary
494     val_index      = assoc "MkId.mkDictSelId" sel_index_prs name
495     sel_index_prs  = map idName (classAllSelIds clas) `zip` [0..]
496
497     the_arg_id     = arg_ids !! val_index
498     pred           = mkClassPred clas (mkTyVarTys tyvars)
499     dict_id        = mkTemplateLocal 1 pred
500     arg_ids        = mkTemplateLocalsNum 2 arg_tys
501
502     rhs = mkLams tyvars  (Lam dict_id   rhs_body)
503     rhs_body | new_tycon = unwrapNewTypeBody tycon (map mkTyVarTy tyvars) (Var dict_id)
504              | otherwise = Case (Var dict_id) dict_id (idType the_arg_id)
505                                 [(DataAlt data_con, arg_ids, varToCoreExpr the_arg_id)]
506                                 -- varToCoreExpr needed for equality superclass selectors
507                                 --   sel a b d = case x of { MkC _ (g:a~b) _ -> CO g }
508
509 dictSelRule :: Int -> Arity 
510             -> Id -> IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
511 -- Tries to persuade the argument to look like a constructor
512 -- application, using exprIsConApp_maybe, and then selects
513 -- from it
514 --       sel_i t1..tk (D t1..tk op1 ... opm) = opi
515 --
516 dictSelRule val_index n_ty_args _ id_unf args
517   | (dict_arg : _) <- drop n_ty_args args
518   , Just (_, _, con_args) <- exprIsConApp_maybe id_unf dict_arg
519   = Just (con_args !! val_index)
520   | otherwise
521   = Nothing
522 \end{code}
523
524
525 %************************************************************************
526 %*                                                                      *
527         Boxing and unboxing
528 %*                                                                      *
529 %************************************************************************
530
531 \begin{code}
532 -- unbox a product type...
533 -- we will recurse into newtypes, casting along the way, and unbox at the
534 -- first product data constructor we find. e.g.
535 --  
536 --   data PairInt = PairInt Int Int
537 --   newtype S = MkS PairInt
538 --   newtype T = MkT S
539 --
540 -- If we have e = MkT (MkS (PairInt 0 1)) and some body expecting a list of
541 -- ids, we get (modulo int passing)
542 --
543 --   case (e `cast` CoT) `cast` CoS of
544 --     PairInt a b -> body [a,b]
545 --
546 -- The Ints passed around are just for creating fresh locals
547 unboxProduct :: Int -> CoreExpr -> Type -> (Int -> [Id] -> CoreExpr) -> CoreExpr
548 unboxProduct i arg arg_ty body
549   = result
550   where 
551     result = mkUnpackCase the_id arg con_args boxing_con rhs
552     (_tycon, _tycon_args, boxing_con, tys) = deepSplitProductType "unboxProduct" arg_ty
553     ([the_id], i') = mkLocals i [arg_ty]
554     (con_args, i'') = mkLocals i' tys
555     rhs = body i'' con_args
556
557 mkUnpackCase ::  Id -> CoreExpr -> [Id] -> DataCon -> CoreExpr -> CoreExpr
558 -- (mkUnpackCase x e args Con body)
559 --      returns
560 -- case (e `cast` ...) of bndr { Con args -> body }
561 -- 
562 -- the type of the bndr passed in is irrelevent
563 mkUnpackCase bndr arg unpk_args boxing_con body
564   = Case cast_arg (setIdType bndr bndr_ty) (exprType body) [(DataAlt boxing_con, unpk_args, body)]
565   where
566   (cast_arg, bndr_ty) = go (idType bndr) arg
567   go ty arg 
568     | (tycon, tycon_args, _, _)  <- splitProductType "mkUnpackCase" ty
569     , isNewTyCon tycon && not (isRecursiveTyCon tycon)
570     = go (newTyConInstRhs tycon tycon_args) 
571          (unwrapNewTypeBody tycon tycon_args arg)
572     | otherwise = (arg, ty)
573
574 -- ...and the dual
575 reboxProduct :: [Unique]     -- uniques to create new local binders
576              -> Type         -- type of product to box
577              -> ([Unique],   -- remaining uniques
578                  CoreExpr,   -- boxed product
579                  [Id])       -- Ids being boxed into product
580 reboxProduct us ty
581   = let 
582         (_tycon, _tycon_args, _pack_con, con_arg_tys) = deepSplitProductType "reboxProduct" ty
583  
584         us' = dropList con_arg_tys us
585
586         arg_ids  = zipWith (mkSysLocal (fsLit "rb")) us con_arg_tys
587
588         bind_rhs = mkProductBox arg_ids ty
589
590     in
591       (us', bind_rhs, arg_ids)
592
593 mkProductBox :: [Id] -> Type -> CoreExpr
594 mkProductBox arg_ids ty 
595   = result_expr
596   where 
597     (tycon, tycon_args, pack_con, _con_arg_tys) = splitProductType "mkProductBox" ty
598
599     result_expr
600       | isNewTyCon tycon && not (isRecursiveTyCon tycon) 
601       = wrap (mkProductBox arg_ids (newTyConInstRhs tycon tycon_args))
602       | otherwise = mkConApp pack_con (map Type tycon_args ++ varsToCoreExprs arg_ids)
603
604     wrap expr = wrapNewTypeBody tycon tycon_args expr
605
606
607 -- (mkReboxingAlt us con xs rhs) basically constructs the case
608 -- alternative (con, xs, rhs)
609 -- but it does the reboxing necessary to construct the *source* 
610 -- arguments, xs, from the representation arguments ys.
611 -- For example:
612 --      data T = MkT !(Int,Int) Bool
613 --
614 -- mkReboxingAlt MkT [x,b] r 
615 --      = (DataAlt MkT, [y::Int,z::Int,b], let x = (y,z) in r)
616 --
617 -- mkDataAlt should really be in DataCon, but it can't because
618 -- it manipulates CoreSyn.
619
620 mkReboxingAlt
621   :: [Unique] -- Uniques for the new Ids
622   -> DataCon
623   -> [Var]    -- Source-level args, *including* all evidence vars 
624   -> CoreExpr -- RHS
625   -> CoreAlt
626
627 mkReboxingAlt us con args rhs
628   | not (any isMarkedUnboxed stricts)
629   = (DataAlt con, args, rhs)
630
631   | otherwise
632   = let
633         (binds, args') = go args stricts us
634     in
635     (DataAlt con, args', mkLets binds rhs)
636
637   where
638     stricts = dataConExStricts con ++ dataConStrictMarks con
639
640     go [] _stricts _us = ([], [])
641
642     -- Type variable case
643     go (arg:args) stricts us 
644       | isTyVar arg
645       = let (binds, args') = go args stricts us
646         in  (binds, arg:args')
647
648         -- Term variable case
649     go (arg:args) (str:stricts) us
650       | isMarkedUnboxed str
651       = let (binds, unpacked_args')        = go args stricts us'
652             (us', bind_rhs, unpacked_args) = reboxProduct us (idType arg)
653         in
654             (NonRec arg bind_rhs : binds, unpacked_args ++ unpacked_args')
655       | otherwise
656       = let (binds, args') = go args stricts us
657         in  (binds, arg:args')
658     go (_ : _) [] _ = panic "mkReboxingAlt"
659 \end{code}
660
661
662 %************************************************************************
663 %*                                                                      *
664         Wrapping and unwrapping newtypes and type families
665 %*                                                                      *
666 %************************************************************************
667
668 \begin{code}
669 wrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
670 -- The wrapper for the data constructor for a newtype looks like this:
671 --      newtype T a = MkT (a,Int)
672 --      MkT :: forall a. (a,Int) -> T a
673 --      MkT = /\a. \(x:(a,Int)). x `cast` sym (CoT a)
674 -- where CoT is the coercion TyCon assoicated with the newtype
675 --
676 -- The call (wrapNewTypeBody T [a] e) returns the
677 -- body of the wrapper, namely
678 --      e `cast` (CoT [a])
679 --
680 -- If a coercion constructor is provided in the newtype, then we use
681 -- it, otherwise the wrap/unwrap are both no-ops 
682 --
683 -- If the we are dealing with a newtype *instance*, we have a second coercion
684 -- identifying the family instance with the constructor of the newtype
685 -- instance.  This coercion is applied in any case (ie, composed with the
686 -- coercion constructor of the newtype or applied by itself).
687
688 wrapNewTypeBody tycon args result_expr
689   = ASSERT( isNewTyCon tycon )
690     wrapFamInstBody tycon args $
691     mkCast result_expr (mkSymCo co)
692   where
693     co = mkAxInstCo (newTyConCo tycon) args
694
695 -- When unwrapping, we do *not* apply any family coercion, because this will
696 -- be done via a CoPat by the type checker.  We have to do it this way as
697 -- computing the right type arguments for the coercion requires more than just
698 -- a spliting operation (cf, TcPat.tcConPat).
699
700 unwrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
701 unwrapNewTypeBody tycon args result_expr
702   = ASSERT( isNewTyCon tycon )
703     mkCast result_expr (mkAxInstCo (newTyConCo tycon) args)
704
705 -- If the type constructor is a representation type of a data instance, wrap
706 -- the expression into a cast adjusting the expression type, which is an
707 -- instance of the representation type, to the corresponding instance of the
708 -- family instance type.
709 -- See Note [Wrappers for data instance tycons]
710 wrapFamInstBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
711 wrapFamInstBody tycon args body
712   | Just co_con <- tyConFamilyCoercion_maybe tycon
713   = mkCast body (mkSymCo (mkAxInstCo co_con args))
714   | otherwise
715   = body
716
717 -- Same as `wrapFamInstBody`, but for type family instances, which are
718 -- represented by a `CoAxiom`, and not a `TyCon`
719 wrapTypeFamInstBody :: CoAxiom -> [Type] -> CoreExpr -> CoreExpr
720 wrapTypeFamInstBody axiom args body
721   = mkCast body (mkSymCo (mkAxInstCo axiom args))
722
723 unwrapFamInstScrut :: TyCon -> [Type] -> CoreExpr -> CoreExpr
724 unwrapFamInstScrut tycon args scrut
725   | Just co_con <- tyConFamilyCoercion_maybe tycon
726   = mkCast scrut (mkAxInstCo co_con args)
727   | otherwise
728   = scrut
729
730 unwrapTypeFamInstScrut :: CoAxiom -> [Type] -> CoreExpr -> CoreExpr
731 unwrapTypeFamInstScrut axiom args scrut
732   = mkCast scrut (mkAxInstCo axiom args)
733 \end{code}
734
735
736 %************************************************************************
737 %*                                                                      *
738 \subsection{Primitive operations}
739 %*                                                                      *
740 %************************************************************************
741
742 \begin{code}
743 mkPrimOpId :: PrimOp -> Id
744 mkPrimOpId prim_op 
745   = id
746   where
747     (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
748     ty   = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
749     name = mkWiredInName gHC_PRIM (primOpOcc prim_op) 
750                          (mkPrimOpIdUnique (primOpTag prim_op))
751                          (AnId id) UserSyntax
752     id   = mkGlobalId (PrimOpId prim_op) name ty info
753                 
754     info = noCafIdInfo
755            `setSpecInfo`          mkSpecInfo (maybeToList $ primOpRules name prim_op)
756            `setArityInfo`         arity
757            `setStrictnessInfo` Just strict_sig
758
759 -- For each ccall we manufacture a separate CCallOpId, giving it
760 -- a fresh unique, a type that is correct for this particular ccall,
761 -- and a CCall structure that gives the correct details about calling
762 -- convention etc.  
763 --
764 -- The *name* of this Id is a local name whose OccName gives the full
765 -- details of the ccall, type and all.  This means that the interface 
766 -- file reader can reconstruct a suitable Id
767
768 mkFCallId :: DynFlags -> Unique -> ForeignCall -> Type -> Id
769 mkFCallId dflags uniq fcall ty
770   = ASSERT( isEmptyVarSet (tyVarsOfType ty) )
771     -- A CCallOpId should have no free type variables; 
772     -- when doing substitutions won't substitute over it
773     mkGlobalId (FCallId fcall) name ty info
774   where
775     occ_str = showSDoc dflags (braces (ppr fcall <+> ppr ty))
776     -- The "occurrence name" of a ccall is the full info about the
777     -- ccall; it is encoded, but may have embedded spaces etc!
778
779     name = mkFCallName uniq occ_str
780
781     info = noCafIdInfo
782            `setArityInfo`         arity
783            `setStrictnessInfo` Just strict_sig
784
785     (_, tau)     = tcSplitForAllTys ty
786     (arg_tys, _) = tcSplitFunTys tau
787     arity        = length arg_tys
788     strict_sig   = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
789 \end{code}
790
791
792 %************************************************************************
793 %*                                                                      *
794 \subsection{DictFuns and default methods}
795 %*                                                                      *
796 %************************************************************************
797
798 Important notes about dict funs and default methods
799 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
800 Dict funs and default methods are *not* ImplicitIds.  Their definition
801 involves user-written code, so we can't figure out their strictness etc
802 based on fixed info, as we can for constructors and record selectors (say).
803
804 We build them as LocalIds, but with External Names.  This ensures that
805 they are taken to account by free-variable finding and dependency
806 analysis (e.g. CoreFVs.exprFreeVars).
807
808 Why shouldn't they be bound as GlobalIds?  Because, in particular, if
809 they are globals, the specialiser floats dict uses above their defns,
810 which prevents good simplifications happening.  Also the strictness
811 analyser treats a occurrence of a GlobalId as imported and assumes it
812 contains strictness in its IdInfo, which isn't true if the thing is
813 bound in the same module as the occurrence.
814
815 It's OK for dfuns to be LocalIds, because we form the instance-env to
816 pass on to the next module (md_insts) in CoreTidy, afer tidying
817 and globalising the top-level Ids.
818
819 BUT make sure they are *exported* LocalIds (mkExportedLocalId) so 
820 that they aren't discarded by the occurrence analyser.
821
822 \begin{code}
823 mkDictFunId :: Name      -- Name to use for the dict fun;
824             -> [TyVar]
825             -> ThetaType
826             -> Class 
827             -> [Type]
828             -> Id
829 -- Implements the DFun Superclass Invariant (see TcInstDcls)
830
831 mkDictFunId dfun_name tvs theta clas tys
832   = mkExportedLocalVar (DFunId n_silent is_nt)
833                        dfun_name
834                        dfun_ty
835                        vanillaIdInfo
836   where
837     is_nt = isNewTyCon (classTyCon clas)
838     (n_silent, dfun_ty) = mkDictFunTy tvs theta clas tys
839
840 mkDictFunTy :: [TyVar] -> ThetaType -> Class -> [Type] -> (Int, Type)
841 mkDictFunTy tvs theta clas tys
842   = (length silent_theta, dfun_ty)
843   where
844     dfun_ty = mkSigmaTy tvs (silent_theta ++ theta) (mkClassPred clas tys)
845     silent_theta 
846       | null tvs, null theta 
847       = []
848       | otherwise
849       = filterOut discard $
850         substTheta (zipTopTvSubst (classTyVars clas) tys)
851                    (classSCTheta clas)
852                    -- See Note [Silent Superclass Arguments]
853     discard pred = any (`eqPred` pred) theta
854                  -- See the DFun Superclass Invariant in TcInstDcls
855 \end{code}
856
857
858 %************************************************************************
859 %*                                                                      *
860 \subsection{Un-definable}
861 %*                                                                      *
862 %************************************************************************
863
864 These Ids can't be defined in Haskell.  They could be defined in
865 unfoldings in the wired-in GHC.Prim interface file, but we'd have to
866 ensure that they were definitely, definitely inlined, because there is
867 no curried identifier for them.  That's what mkCompulsoryUnfolding
868 does.  If we had a way to get a compulsory unfolding from an interface
869 file, we could do that, but we don't right now.
870
871 unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
872 just gets expanded into a type coercion wherever it occurs.  Hence we
873 add it as a built-in Id with an unfolding here.
874
875 The type variables we use here are "open" type variables: this means
876 they can unify with both unlifted and lifted types.  Hence we provide
877 another gun with which to shoot yourself in the foot.
878
879 \begin{code}
880 lazyIdName, unsafeCoerceName, nullAddrName, seqName, realWorldName, coercionTokenName, noupdateName :: Name
881 unsafeCoerceName  = mkWiredInIdName gHC_PRIM (fsLit "unsafeCoerce#") unsafeCoerceIdKey  unsafeCoerceId
882 nullAddrName      = mkWiredInIdName gHC_PRIM (fsLit "nullAddr#")     nullAddrIdKey      nullAddrId
883 seqName           = mkWiredInIdName gHC_PRIM (fsLit "seq")           seqIdKey           seqId
884 realWorldName     = mkWiredInIdName gHC_PRIM (fsLit "realWorld#")    realWorldPrimIdKey realWorldPrimId
885 lazyIdName        = mkWiredInIdName gHC_BASE (fsLit "lazy")         lazyIdKey           lazyId
886 coercionTokenName = mkWiredInIdName gHC_PRIM (fsLit "coercionToken#") coercionTokenIdKey coercionTokenId
887 noupdateName      = mkWiredInIdName gHC_PRIM (fsLit "noupdate")      noupdateIdKey noupdateId
888 \end{code}
889
890 \begin{code}
891 ------------------------------------------------
892 -- unsafeCoerce# :: forall a b. a -> b
893 unsafeCoerceId :: Id
894 unsafeCoerceId
895   = pcMiscPrelId unsafeCoerceName ty info
896   where
897     info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
898                        `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
899            
900
901     ty  = mkForAllTys [openAlphaTyVar,openBetaTyVar]
902                       (mkFunTy openAlphaTy openBetaTy)
903     [x] = mkTemplateLocals [openAlphaTy]
904     rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
905           Cast (Var x) (mkUnsafeCo openAlphaTy openBetaTy)
906
907 ------------------------------------------------
908 nullAddrId :: Id
909 -- nullAddr# :: Addr#
910 -- The reason is is here is because we don't provide 
911 -- a way to write this literal in Haskell.
912 nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info
913   where
914     info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
915                        `setUnfoldingInfo`  mkCompulsoryUnfolding (Lit nullAddrLit)
916
917 ------------------------------------------------
918 seqId :: Id     -- See Note [seqId magic]
919 seqId = pcMiscPrelId seqName ty info
920   where
921     info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
922                        `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
923                        `setSpecInfo`       mkSpecInfo [seq_cast_rule]
924            
925
926     ty  = mkForAllTys [alphaTyVar,betaTyVar]
927                       (mkFunTy alphaTy (mkFunTy betaTy betaTy))
928               -- NB argBetaTyVar; see Note [seqId magic]
929
930     [x,y] = mkTemplateLocals [alphaTy, betaTy]
931     rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x betaTy [(DEFAULT, [], Var y)])
932
933     -- See Note [Built-in RULES for seq]
934     seq_cast_rule = BuiltinRule { ru_name  = fsLit "seq of cast"
935                                 , ru_fn    = seqName
936                                 , ru_nargs = 4
937                                 , ru_try   = match_seq_of_cast
938                                 }
939
940 match_seq_of_cast :: Id -> IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
941     -- See Note [Built-in RULES for seq]
942 match_seq_of_cast _ _ [Type _, Type res_ty, Cast scrut co, expr]
943   = Just (Var seqId `mkApps` [Type (pFst (coercionKind co)), Type res_ty,
944                               scrut, expr])
945 match_seq_of_cast _ _ _ = Nothing
946
947 ------------------------------------------------
948 lazyId :: Id    -- See Note [lazyId magic]
949 lazyId = pcMiscPrelId lazyIdName ty info
950   where
951     info = noCafIdInfo
952     ty  = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
953
954 noupdateId :: Id
955 noupdateId = pcMiscPrelId noupdateName ty info
956   where
957     info = noCafIdInfo
958     ty  = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
959 \end{code}
960
961 Note [Unsafe coerce magic]
962 ~~~~~~~~~~~~~~~~~~~~~~~~~~
963 We define a *primitive*
964    GHC.Prim.unsafeCoerce#
965 and then in the base library we define the ordinary function
966    Unsafe.Coerce.unsafeCoerce :: forall (a:*) (b:*). a -> b
967    unsafeCoerce x = unsafeCoerce# x
968
969 Notice that unsafeCoerce has a civilized (albeit still dangerous)
970 polymorphic type, whose type args have kind *.  So you can't use it on
971 unboxed values (unsafeCoerce 3#).
972
973 In contrast unsafeCoerce# is even more dangerous because you *can* use
974 it on unboxed things, (unsafeCoerce# 3#) :: Int. Its type is
975    forall (a:OpenKind) (b:OpenKind). a -> b
976
977 Note [seqId magic]
978 ~~~~~~~~~~~~~~~~~~
979 'GHC.Prim.seq' is special in several ways. 
980
981 a) Its second arg can have an unboxed type
982       x `seq` (v +# w)
983    Hence its second type variable has ArgKind
984
985 b) Its fixity is set in LoadIface.ghcPrimIface
986
987 c) It has quite a bit of desugaring magic. 
988    See DsUtils.lhs Note [Desugaring seq (1)] and (2) and (3)
989
990 d) There is some special rule handing: Note [User-defined RULES for seq]
991
992 e) See Note [Typing rule for seq] in TcExpr.
993
994 Note [User-defined RULES for seq]
995 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
996 Roman found situations where he had
997       case (f n) of _ -> e
998 where he knew that f (which was strict in n) would terminate if n did.
999 Notice that the result of (f n) is discarded. So it makes sense to
1000 transform to
1001       case n of _ -> e
1002
1003 Rather than attempt some general analysis to support this, I've added
1004 enough support that you can do this using a rewrite rule:
1005
1006   RULE "f/seq" forall n.  seq (f n) e = seq n e
1007
1008 You write that rule.  When GHC sees a case expression that discards
1009 its result, it mentally transforms it to a call to 'seq' and looks for
1010 a RULE.  (This is done in Simplify.rebuildCase.)  As usual, the
1011 correctness of the rule is up to you.
1012
1013 To make this work, we need to be careful that the magical desugaring
1014 done in Note [seqId magic] item (c) is *not* done on the LHS of a rule.
1015 Or rather, we arrange to un-do it, in DsBinds.decomposeRuleLhs.
1016
1017 Note [Built-in RULES for seq]
1018 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1019 We also have the following built-in rule for seq
1020
1021   seq (x `cast` co) y = seq x y
1022
1023 This eliminates unnecessary casts and also allows other seq rules to
1024 match more often.  Notably,     
1025
1026    seq (f x `cast` co) y  -->  seq (f x) y
1027   
1028 and now a user-defined rule for seq (see Note [User-defined RULES for seq])
1029 may fire.
1030
1031
1032 Note [lazyId magic]
1033 ~~~~~~~~~~~~~~~~~~~
1034     lazy :: forall a?. a? -> a?   (i.e. works for unboxed types too)
1035
1036 Used to lazify pseq:   pseq a b = a `seq` lazy b
1037
1038 Also, no strictness: by being a built-in Id, all the info about lazyId comes from here,
1039 not from GHC.Base.hi.   This is important, because the strictness
1040 analyser will spot it as strict!
1041
1042 Also no unfolding in lazyId: it gets "inlined" by a HACK in CorePrep.
1043 It's very important to do this inlining *after* unfoldings are exposed 
1044 in the interface file.  Otherwise, the unfolding for (say) pseq in the
1045 interface file will not mention 'lazy', so if we inline 'pseq' we'll totally
1046 miss the very thing that 'lazy' was there for in the first place.
1047 See Trac #3259 for a real world example.
1048
1049 lazyId is defined in GHC.Base, so we don't *have* to inline it.  If it
1050 appears un-applied, we'll end up just calling it.
1051
1052 -------------------------------------------------------------
1053 @realWorld#@ used to be a magic literal, \tr{void#}.  If things get
1054 nasty as-is, change it back to a literal (@Literal@).
1055
1056 voidArgId is a Local Id used simply as an argument in functions
1057 where we just want an arg to avoid having a thunk of unlifted type.
1058 E.g.
1059         x = \ void :: State# RealWorld -> (# p, q #)
1060
1061 This comes up in strictness analysis
1062
1063 \begin{code}
1064 realWorldPrimId :: Id
1065 realWorldPrimId -- :: State# RealWorld
1066   = pcMiscPrelId realWorldName realWorldStatePrimTy
1067                  (noCafIdInfo `setUnfoldingInfo` evaldUnfolding)
1068         -- The evaldUnfolding makes it look that realWorld# is evaluated
1069         -- which in turn makes Simplify.interestingArg return True,
1070         -- which in turn makes INLINE things applied to realWorld# likely
1071         -- to be inlined
1072
1073 voidArgId :: Id
1074 voidArgId       -- :: State# RealWorld
1075   = mkSysLocal (fsLit "void") voidArgIdKey realWorldStatePrimTy
1076
1077 coercionTokenId :: Id         -- :: () ~ ()
1078 coercionTokenId -- Used to replace Coercion terms when we go to STG
1079   = pcMiscPrelId coercionTokenName 
1080                  (mkTyConApp eqPrimTyCon [liftedTypeKind, unitTy, unitTy])
1081                  noCafIdInfo
1082 \end{code}
1083
1084
1085 \begin{code}
1086 pcMiscPrelId :: Name -> Type -> IdInfo -> Id
1087 pcMiscPrelId name ty info
1088   = mkVanillaGlobalWithInfo name ty info
1089     -- We lie and say the thing is imported; otherwise, we get into
1090     -- a mess with dependency analysis; e.g., core2stg may heave in
1091     -- random calls to GHCbase.unpackPS__.  If GHCbase is the module
1092     -- being compiled, then it's just a matter of luck if the definition
1093     -- will be in "the right place" to be in scope.
1094 \end{code}