MkId.lhs 40.7 KB
Newer Older
Thomas Schilling's avatar
Thomas Schilling committed
1
%
Simon Marlow's avatar
Simon Marlow committed
2
% (c) The University of Glasgow 2006
3
% (c) The AQUA Project, Glasgow University, 1998
4
5
6
7
8
%

This module contains definitions for the IdInfo for things that
have a standard form, namely:

Thomas Schilling's avatar
Thomas Schilling committed
9
10
11
12
- data constructors
- record selectors
- method and superclass selectors
- primitive operations
13
14
15

\begin{code}
module MkId (
16
        mkDictFunId, mkDictFunTy, mkDictSelId,
17

Ian Lynagh's avatar
Ian Lynagh committed
18
19
        mkDataConIds,
        mkPrimOpId, mkFCallId, mkTickBoxOpId, mkBreakPointOpId,
20

Ian Lynagh's avatar
Ian Lynagh committed
21
        mkReboxingAlt, wrapNewTypeBody, unwrapNewTypeBody,
22
        wrapFamInstBody, unwrapFamInstScrut,
23
        mkUnpackCase, mkProductBox,
24

Ian Lynagh's avatar
Ian Lynagh committed
25
26
        -- And some particular Ids; see below for why they are wired in
        wiredInIds, ghcPrimIds,
27
        unsafeCoerceName, unsafeCoerceId, realWorldPrimId, 
28
29
30
31
32
        voidArgId, nullAddrId, seqId, lazyId, lazyIdKey,
        coercionTokenId,

	-- Re-export error Ids
	module PrelRules
33
34
35
36
    ) where

#include "HsVersions.h"

Simon Marlow's avatar
Simon Marlow committed
37
38
import Rules
import TysPrim
39
import TysWiredIn	( unitTy )
Simon Marlow's avatar
Simon Marlow committed
40
41
42
43
import PrelRules
import Type
import Coercion
import TcType
44
import MkCore
45
import CoreUtils	( exprType, mkCoerce )
Simon Marlow's avatar
Simon Marlow committed
46
47
48
49
50
51
52
53
54
55
import CoreUnfold
import Literal
import TyCon
import Class
import VarSet
import Name
import PrimOp
import ForeignCall
import DataCon
import Id
56
import Var              ( mkExportedLocalVar )
Simon Marlow's avatar
Simon Marlow committed
57
import IdInfo
58
import Demand
59
import CoreSyn
Simon Marlow's avatar
Simon Marlow committed
60
import Unique
61
import PrelNames
Simon Marlow's avatar
Simon Marlow committed
62
63
import BasicTypes       hiding ( SuccessFlag(..) )
import Util
64
import Pair
65
import Outputable
66
import FastString
Simon Marlow's avatar
Simon Marlow committed
67
import ListSetOps
68
import Module
69
\end{code}
70

71
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
72
%*                                                                      *
73
\subsection{Wired in Ids}
Ian Lynagh's avatar
Ian Lynagh committed
74
%*                                                                      *
75
76
%************************************************************************

77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
Note [Wired-in Ids]
~~~~~~~~~~~~~~~~~~~
There are several reasons why an Id might appear in the wiredInIds:

(1) The ghcPrimIds are wired in because they can't be defined in
    Haskell at all, although the can be defined in Core.  They have
    compulsory unfoldings, so they are always inlined and they  have
    no definition site.  Their home module is GHC.Prim, so they
    also have a description in primops.txt.pp, where they are called
    'pseudoops'.

(2) The 'error' function, eRROR_ID, is wired in because we don't yet have
    a way to express in an interface file that the result type variable
    is 'open'; that is can be unified with an unboxed type

    [The interface file format now carry such information, but there's
    no way yet of expressing at the definition site for these 
    error-reporting functions that they have an 'open' 
    result type. -- sof 1/99]

(3) Other error functions (rUNTIME_ERROR_ID) are wired in (a) because
    the desugarer generates code that mentiones them directly, and
    (b) for the same reason as eRROR_ID

(4) lazyId is wired in because the wired-in version overrides the
    strictness of the version defined in GHC.Base

In cases (2-4), the function has a definition in a library module, and
can be called; but the wired-in version means that the details are 
never read from that module's interface file; instead, the full definition
is right here.

109
\begin{code}
110
wiredInIds :: [Id]
111
wiredInIds
112
113
114
  =  [lazyId]
  ++ errorIds		-- Defined in MkCore
  ++ ghcPrimIds
115
116

-- These Ids are exported from GHC.Prim
117
ghcPrimIds :: [Id]
118
ghcPrimIds
Ian Lynagh's avatar
Ian Lynagh committed
119
120
  = [   -- These can't be defined in Haskell, but they have
        -- perfectly reasonable unfoldings in Core
121
122
123
124
    realWorldPrimId,
    unsafeCoerceId,
    nullAddrId,
    seqId
125
126
127
    ]
\end{code}

128
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
129
%*                                                                      *
130
\subsection{Data constructors}
Ian Lynagh's avatar
Ian Lynagh committed
131
%*                                                                      *
132
133
%************************************************************************

134
135
136
137
The wrapper for a constructor is an ordinary top-level binding that evaluates
any strict args, unboxes any args that are going to be flattened, and calls
the worker.

138
139
We're going to build a constructor that looks like:

Ian Lynagh's avatar
Ian Lynagh committed
140
        data (Data a, C b) =>  T a b = T1 !a !Int b
141

Ian Lynagh's avatar
Ian Lynagh committed
142
143
144
145
146
        T1 = /\ a b -> 
             \d1::Data a, d2::C b ->
             \p q r -> case p of { p ->
                       case q of { q ->
                       Con T1 [a,b] [p,q,r]}}
147
148
149
150
151
152
153
154
155
156

Notice that

* d2 is thrown away --- a context in a data decl is used to make sure
  one *could* construct dictionaries at the site the constructor
  is used, but the dictionary isn't actually used.

* We have to check that we can construct Data dictionaries for
  the types a and Int.  Once we've done that we can throw d1 away too.

157
* We use (case p of q -> ...) to evaluate p, rather than "seq" because
158
159
160
161
  all that matters is that the arguments are evaluated.  "seq" is 
  very careful to preserve evaluation order, which we don't need
  to be here.

162
163
164
165
166
167
168
169
170
  You might think that we could simply give constructors some strictness
  info, like PrimOps, and let CoreToStg do the let-to-case transformation.
  But we don't do that because in the case of primops and functions strictness
  is a *property* not a *requirement*.  In the case of constructors we need to
  do something active to evaluate the argument.

  Making an explicit case expression allows the simplifier to eliminate
  it in the (common) case where the constructor arg is already evaluated.

171
172
Note [Wrappers for data instance tycons]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
173
174
In the case of data instances, the wrapper also applies the coercion turning
the representation type into the family instance type to cast the result of
175
176
177
178
179
the wrapper.  For example, consider the declarations

  data family Map k :: * -> *
  data instance Map (a, b) v = MapPair (Map a (Pair b v))

180
181
182
183
184
185
186
The tycon to which the datacon MapPair belongs gets a unique internal
name of the form :R123Map, and we call it the representation tycon.
In contrast, Map is the family tycon (accessible via
tyConFamInst_maybe). A coercion allows you to move between
representation and family type.  It is accessible from :R123Map via
tyConFamilyCoercion_maybe and has kind

187
  Co123Map a b v :: {Map (a, b) v ~ :R123Map a b v}
188
189

The wrapper and worker of MapPair get the types
190

Ian Lynagh's avatar
Ian Lynagh committed
191
        -- Wrapper
192
  $WMapPair :: forall a b v. Map a (Map a b v) -> Map (a, b) v
193
  $WMapPair a b v = MapPair a b v `cast` sym (Co123Map a b v)
194

Ian Lynagh's avatar
Ian Lynagh committed
195
        -- Worker
196
  MapPair :: forall a b v. Map a (Map a b v) -> :R123Map a b v
197

198
This coercion is conditionally applied by wrapFamInstBody.
199

200
It's a bit more complicated if the data instance is a GADT as well!
201

202
   data instance T [a] where
Ian Lynagh's avatar
Ian Lynagh committed
203
        T1 :: forall b. b -> T [Maybe b]
204

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
205
Hence we translate to
206

Ian Lynagh's avatar
Ian Lynagh committed
207
        -- Wrapper
208
  $WT1 :: forall b. b -> T [Maybe b]
209
  $WT1 b v = T1 (Maybe b) b (Maybe b) v
Ian Lynagh's avatar
Ian Lynagh committed
210
                        `cast` sym (Co7T (Maybe b))
211

Ian Lynagh's avatar
Ian Lynagh committed
212
        -- Worker
213
  T1 :: forall c b. (c ~ Maybe b) => b -> :R7T c
214

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
215
216
217
        -- Coercion from family type to representation type
  Co7T a :: T [a] ~ :R7T a

218
\begin{code}
219
220
mkDataConIds :: Name -> Name -> DataCon -> DataConIds
mkDataConIds wrap_name wkr_name data_con
Ian Lynagh's avatar
Ian Lynagh committed
221
  | isNewTyCon tycon                    -- Newtype, only has a worker
222
  = DCIds Nothing nt_work_id                 
223

224
225
226
  | any isBanged all_strict_marks      -- Algebraic, needs wrapper
    || not (null eq_spec)              -- NB: LoadIface.ifaceDeclSubBndrs
    || isFamInstTyCon tycon            --     depends on this test
227
  = DCIds (Just alg_wrap_id) wrk_id
228

Ian Lynagh's avatar
Ian Lynagh committed
229
  | otherwise                                -- Algebraic, no wrapper
230
  = DCIds Nothing wrk_id
231
  where
232
    (univ_tvs, ex_tvs, eq_spec, 
233
     other_theta, orig_arg_tys, res_ty) = dataConFullSig data_con
Ian Lynagh's avatar
Ian Lynagh committed
234
    tycon = dataConTyCon data_con       -- The representation TyCon (not family)
235

Ian Lynagh's avatar
Ian Lynagh committed
236
237
238
        ----------- Worker (algebraic data types only) --------------
        -- The *worker* for the data constructor is the function that
        -- takes the representation arguments and builds the constructor.
239
    wrk_id = mkGlobalId (DataConWorkId data_con) wkr_name
Ian Lynagh's avatar
Ian Lynagh committed
240
                        (dataConRepType data_con) wkr_info
241
242
243

    wkr_arity = dataConRepArity data_con
    wkr_info  = noCafIdInfo
244
                `setArityInfo`       wkr_arity
245
                `setStrictnessInfo`  Just wkr_sig
246
                `setUnfoldingInfo`   evaldUnfolding  -- Record that it's evaluated,
Ian Lynagh's avatar
Ian Lynagh committed
247
                                                        -- even if arity = 0
248
249

    wkr_sig = mkStrictSig (mkTopDmdType (replicate wkr_arity topDmd) cpr_info)
Ian Lynagh's avatar
Ian Lynagh committed
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
        --      Note [Data-con worker strictness]
        -- Notice that we do *not* say the worker is strict
        -- even if the data constructor is declared strict
        --      e.g.    data T = MkT !(Int,Int)
        -- Why?  Because the *wrapper* is strict (and its unfolding has case
        -- expresssions that do the evals) but the *worker* itself is not.
        -- If we pretend it is strict then when we see
        --      case x of y -> $wMkT y
        -- the simplifier thinks that y is "sure to be evaluated" (because
        --  $wMkT is strict) and drops the case.  No, $wMkT is not strict.
        --
        -- When the simplifer sees a pattern 
        --      case e of MkT x -> ...
        -- it uses the dataConRepStrictness of MkT to mark x as evaluated;
        -- but that's fine... dataConRepStrictness comes from the data con
        -- not from the worker Id.
266
267

    cpr_info | isProductTyCon tycon && 
Ian Lynagh's avatar
Ian Lynagh committed
268
269
270
271
272
273
274
275
               isDataTyCon tycon    &&
               wkr_arity > 0        &&
               wkr_arity <= mAX_CPR_SIZE        = retCPR
             | otherwise                        = TopRes
        -- RetCPR is only true for products that are real data types;
        -- that is, not unboxed tuples or [non-recursive] newtypes

        ----------- Workers for newtypes --------------
276
    nt_work_id   = mkGlobalId (DataConWrapId data_con) wkr_name wrap_ty nt_work_info
Ian Lynagh's avatar
Ian Lynagh committed
277
278
    nt_work_info = noCafIdInfo          -- The NoCaf-ness is set by noCafIdInfo
                  `setArityInfo` 1      -- Arity 1
279
                  `setInlinePragInfo`    alwaysInlinePragma
Ian Lynagh's avatar
Ian Lynagh committed
280
                  `setUnfoldingInfo`     newtype_unf
281
282
283
284
    id_arg1      = mkTemplateLocal 1 (head orig_arg_tys)
    newtype_unf  = ASSERT2( isVanillaDataCon data_con &&
                            isSingleton orig_arg_tys, ppr data_con  )
			      -- Note [Newtype datacons]
Ian Lynagh's avatar
Ian Lynagh committed
285
286
                   mkCompulsoryUnfolding $ 
                   mkLams wrap_tvs $ Lam id_arg1 $ 
287
                   wrapNewTypeBody tycon res_ty_args (Var id_arg1)
288

Ian Lynagh's avatar
Ian Lynagh committed
289
290
291
292
293

        ----------- Wrapper --------------
        -- We used to include the stupid theta in the wrapper's args
        -- but now we don't.  Instead the type checker just injects these
        -- extra constraints where necessary.
294
    wrap_tvs    = (univ_tvs `minusList` map fst eq_spec) ++ ex_tvs
Ian Lynagh's avatar
Ian Lynagh committed
295
    res_ty_args = substTyVars (mkTopTvSubst eq_spec) univ_tvs
batterseapower's avatar
batterseapower committed
296
    ev_tys      = other_theta
297
298
299
    wrap_ty     = mkForAllTys wrap_tvs $ 
                  mkFunTys ev_tys $
                  mkFunTys orig_arg_tys $ res_ty
300

Ian Lynagh's avatar
Ian Lynagh committed
301
        ----------- Wrappers for algebraic data types -------------- 
302
    alg_wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty alg_wrap_info
batterseapower's avatar
batterseapower committed
303
    alg_wrap_info = noCafIdInfo
Ian Lynagh's avatar
Ian Lynagh committed
304
305
306
                    `setArityInfo`         wrap_arity
                        -- It's important to specify the arity, so that partial
                        -- applications are treated as values
307
		    `setInlinePragInfo`    alwaysInlinePragma
Ian Lynagh's avatar
Ian Lynagh committed
308
                    `setUnfoldingInfo`     wrap_unf
309
                    `setStrictnessInfo` Just wrap_sig
batterseapower's avatar
batterseapower committed
310
311
312
                        -- We need to get the CAF info right here because TidyPgm
                        -- does not tidy the IdInfo of implicit bindings (like the wrapper)
                        -- so it not make sure that the CAF info is sane
313
314

    all_strict_marks = dataConExStricts data_con ++ dataConStrictMarks data_con
315
316
317
    wrap_sig = mkStrictSig (mkTopDmdType wrap_arg_dmds cpr_info)
    wrap_stricts = dropList eq_spec all_strict_marks
    wrap_arg_dmds = map mk_dmd wrap_stricts
318
319
    mk_dmd str | isBanged str = evalDmd
               | otherwise    = lazyDmd
Ian Lynagh's avatar
Ian Lynagh committed
320
321
322
323
324
325
326
327
        -- The Cpr info can be important inside INLINE rhss, where the
        -- wrapper constructor isn't inlined.
        -- And the argument strictness can be important too; we
        -- may not inline a contructor when it is partially applied.
        -- For example:
        --      data W = C !Int !Int !Int
        --      ...(let w = C x in ...(w p q)...)...
        -- we want to see that w is strict in its two arguments
328

329
    wrap_unf = mkInlineUnfolding (Just (length ev_args + length id_args)) wrap_rhs
330
    wrap_rhs = mkLams wrap_tvs $ 
331
332
               mkLams ev_args $
               mkLams id_args $
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
333
               foldr mk_case con_app 
334
                     (zip (ev_args ++ id_args) wrap_stricts)
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
335
                     i3 []
336
337
338
	     -- The ev_args is the evidence arguments *other than* the eq_spec
	     -- Because we are going to apply the eq_spec args manually in the
	     -- wrapper
339

340
    con_app _ rep_ids = wrapFamInstBody tycon res_ty_args $
Ian Lynagh's avatar
Ian Lynagh committed
341
342
                          Var wrk_id `mkTyApps`  res_ty_args
                                     `mkVarApps` ex_tvs                 
343
                                     `mkCoApps`  map (mkReflCo . snd) eq_spec
Ian Lynagh's avatar
Ian Lynagh committed
344
                                     `mkVarApps` reverse rep_ids
batterseapower's avatar
batterseapower committed
345
346
                            -- Dont box the eq_spec coercions since they are
                            -- marked as HsUnpack by mk_dict_strict_mark
347

348
349
350
    (ev_args,i2) = mkLocals 1  ev_tys
    (id_args,i3) = mkLocals i2 orig_arg_tys
    wrap_arity   = i3-1
351
352

    mk_case 
353
           :: (Id, HsBang)      -- Arg, strictness
Ian Lynagh's avatar
Ian Lynagh committed
354
355
356
357
           -> (Int -> [Id] -> CoreExpr) -- Body
           -> Int                       -- Next rep arg id
           -> [Id]                      -- Rep args so far, reversed
           -> CoreExpr
358
    mk_case (arg,strict) body i rep_args
Ian Lynagh's avatar
Ian Lynagh committed
359
          = case strict of
360
361
                HsNoBang -> body i (arg:rep_args)
                HsUnpack -> unboxProduct i (Var arg) (idType arg) the_body 
362
363
                      where
                        the_body i con_args = body i (reverse con_args ++ rep_args)
364
365
366
367
                _other  -- HsUnpackFailed and HsStrict
                   | isUnLiftedType (idType arg) -> body i (arg:rep_args)
                   | otherwise -> Case (Var arg) arg res_ty 
                                       [(DEFAULT,[], body i (arg:rep_args))]
368
369
370
371

mAX_CPR_SIZE :: Arity
mAX_CPR_SIZE = 10
-- We do not treat very big tuples as CPR-ish:
Ian Lynagh's avatar
Ian Lynagh committed
372
373
374
375
376
377
378
--      a) for a start we get into trouble because there aren't 
--         "enough" unboxed tuple types (a tiresome restriction, 
--         but hard to fix), 
--      b) more importantly, big unboxed tuples get returned mainly
--         on the stack, and are often then allocated in the heap
--         by the caller.  So doing CPR for them may in fact make
--         things worse.
379

380
mkLocals :: Int -> [Type] -> ([Id], Int)
381
mkLocals i tys = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
Ian Lynagh's avatar
Ian Lynagh committed
382
383
               where
                 n = length tys
384
385
\end{code}

386
387
388
389
390
391
392
393
394
395
396
Note [Newtype datacons]
~~~~~~~~~~~~~~~~~~~~~~~
The "data constructor" for a newtype should always be vanilla.  At one
point this wasn't true, because the newtype arising from
     class C a => D a
looked like
       newtype T:D a = D:D (C a)
so the data constructor for T:C had a single argument, namely the
predicate (C a).  But now we treat that as an ordinary argument, not
part of the theta-type, so all is well.

397
398

%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
399
%*                                                                      *
400
\subsection{Dictionary selectors}
Ian Lynagh's avatar
Ian Lynagh committed
401
%*                                                                      *
402
403
%************************************************************************

404
405
Selecting a field for a dictionary.  If there is just one field, then
there's nothing to do.  
406

407
Dictionary selectors may get nested forall-types.  Thus:
408

409
410
        class Foo a where
          op :: forall b. Ord b => a -> b -> b
411

412
Then the top-level type for op is
413

414
415
416
        op :: forall a. Foo a => 
              forall b. Ord b => 
              a -> b -> b
417

418
419
420
This is unlike ordinary record selectors, which have all the for-alls
at the outside.  When dealing with classes it's very convenient to
recover the original type signature from the class op selector.
421

422
\begin{code}
423
424
425
426
427
428
mkDictSelId :: Bool	     -- True <=> don't include the unfolding
			     -- Little point on imports without -O, because the
			     -- dictionary itself won't be visible
 	    -> Name	     -- Name of one of the *value* selectors 
	       		     -- (dictionary superclass or method)
            -> Class -> Id
429
430
431
432
433
434
435
436
437
mkDictSelId no_unf name clas
  = mkGlobalId (ClassOpId clas) name sel_ty info
  where
    sel_ty = mkForAllTys tyvars (mkFunTy (idType dict_id) (idType the_arg_id))
        -- We can't just say (exprType rhs), because that would give a type
        --      C a -> C a
        -- for a single-op class (after all, the selector is the identity)
        -- But it's type must expose the representation of the dictionary
        -- to get (say)         C a -> (a -> a)
438

439
440
    base_info = noCafIdInfo
                `setArityInfo`      1
441
                `setStrictnessInfo` Just strict_sig
442
                `setUnfoldingInfo`  (if no_unf then noUnfolding
443
	                             else mkImplicitUnfolding rhs)
444
445
446
447
448
		   -- In module where class op is defined, we must add
		   -- the unfolding, even though it'll never be inlined
		   -- becuase we use that to generate a top-level binding
		   -- for the ClassOp

449
    info | new_tycon = base_info `setInlinePragInfo` alwaysInlinePragma
Simon Peyton Jones's avatar
Simon Peyton Jones committed
450
451
    	   	   -- See Note [Single-method classes] in TcInstDcls
		   -- for why alwaysInlinePragma
452
453
454
455
456
         | otherwise = base_info  `setSpecInfo`       mkSpecInfo [rule]
		       		  `setInlinePragInfo` neverInlinePragma
		   -- Add a magic BuiltinRule, and never inline it
		   -- so that the rule is always available to fire.
		   -- See Note [ClassOp/DFun selection] in TcInstDcls
457

458
459
460
461
462
463
464
465
    n_ty_args = length tyvars

    -- This is the built-in rule that goes
    -- 	    op (dfT d1 d2) --->  opT d1 d2
    rule = BuiltinRule { ru_name = fsLit "Class op " `appendFS` 
    	   	       	 	     occNameFS (getOccName name)
                       , ru_fn    = name
    	               , ru_nargs = n_ty_args + 1
466
                       , ru_try   = dictSelRule val_index n_ty_args }
467

468
469
470
471
472
        -- The strictness signature is of the form U(AAAVAAAA) -> T
        -- where the V depends on which item we are selecting
        -- It's worth giving one, so that absence info etc is generated
        -- even if the selector isn't inlined
    strict_sig = mkStrictSig (mkTopDmdType [arg_dmd] TopRes)
473
474
475
    arg_dmd | new_tycon = evalDmd
            | otherwise = Eval (Prod [ if the_arg_id == id then evalDmd else Abs
                                     | id <- arg_ids ])
476

477
478
479
480
481
    tycon      	   = classTyCon clas
    new_tycon  	   = isNewTyCon tycon
    [data_con] 	   = tyConDataCons tycon
    tyvars     	   = dataConUnivTyVars data_con
    arg_tys    	   = dataConRepArgTys data_con	-- Includes the dictionary superclasses
482

483
484
485
    -- 'index' is a 0-index into the *value* arguments of the dictionary
    val_index      = assoc "MkId.mkDictSelId" sel_index_prs name
    sel_index_prs  = map idName (classAllSelIds clas) `zip` [0..]
486

487
488
    the_arg_id     = arg_ids !! val_index
    pred       	   = mkClassPred clas (mkTyVarTys tyvars)
batterseapower's avatar
batterseapower committed
489
    dict_id    	   = mkTemplateLocal 1 pred
490
    arg_ids    	   = mkTemplateLocalsNum 2 arg_tys
491

492
    rhs = mkLams tyvars  (Lam dict_id   rhs_body)
493
494
    rhs_body | new_tycon = unwrapNewTypeBody tycon (map mkTyVarTy tyvars) (Var dict_id)
             | otherwise = Case (Var dict_id) dict_id (idType the_arg_id)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
495
496
497
                                [(DataAlt data_con, arg_ids, varToCoreExpr the_arg_id)]
				-- varToCoreExpr needed for equality superclass selectors
				--   sel a b d = case x of { MkC _ (g:a~b) _ -> CO g }
498

499
dictSelRule :: Int -> Arity 
500
            -> IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
501
502
503
-- Tries to persuade the argument to look like a constructor
-- application, using exprIsConApp_maybe, and then selects
-- from it
504
--       sel_i t1..tk (D t1..tk op1 ... opm) = opi
505
--
506
dictSelRule val_index n_ty_args id_unf args
507
  | (dict_arg : _) <- drop n_ty_args args
508
  , Just (_, _, con_args) <- exprIsConApp_maybe id_unf dict_arg
509
  = Just (con_args !! val_index)
510
511
  | otherwise
  = Nothing
512
\end{code}
513
514


515
516
517
518
519
%************************************************************************
%*                                                                      *
        Boxing and unboxing
%*                                                                      *
%************************************************************************
520
521

\begin{code}
522
523
524
525
526
527
528
529
530
531
532
-- unbox a product type...
-- we will recurse into newtypes, casting along the way, and unbox at the
-- first product data constructor we find. e.g.
--  
--   data PairInt = PairInt Int Int
--   newtype S = MkS PairInt
--   newtype T = MkT S
--
-- If we have e = MkT (MkS (PairInt 0 1)) and some body expecting a list of
-- ids, we get (modulo int passing)
--
533
--   case (e `cast` CoT) `cast` CoS of
534
535
536
--     PairInt a b -> body [a,b]
--
-- The Ints passed around are just for creating fresh locals
537
538
unboxProduct :: Int -> CoreExpr -> Type -> (Int -> [Id] -> CoreExpr) -> CoreExpr
unboxProduct i arg arg_ty body
539
  = result
540
  where 
541
    result = mkUnpackCase the_id arg con_args boxing_con rhs
542
    (_tycon, _tycon_args, boxing_con, tys) = deepSplitProductType "unboxProduct" arg_ty
543
544
545
546
    ([the_id], i') = mkLocals i [arg_ty]
    (con_args, i'') = mkLocals i' tys
    rhs = body i'' con_args

547
mkUnpackCase ::  Id -> CoreExpr -> [Id] -> DataCon -> CoreExpr -> CoreExpr
chak@cse.unsw.edu.au.'s avatar
Comment    
chak@cse.unsw.edu.au. committed
548
-- (mkUnpackCase x e args Con body)
Ian Lynagh's avatar
Ian Lynagh committed
549
--      returns
chak@cse.unsw.edu.au.'s avatar
Comment    
chak@cse.unsw.edu.au. committed
550
-- case (e `cast` ...) of bndr { Con args -> body }
551
552
-- 
-- the type of the bndr passed in is irrelevent
553
mkUnpackCase bndr arg unpk_args boxing_con body
554
  = Case cast_arg (setIdType bndr bndr_ty) (exprType body) [(DataAlt boxing_con, unpk_args, body)]
555
  where
556
  (cast_arg, bndr_ty) = go (idType bndr) arg
557
  go ty arg 
558
    | (tycon, tycon_args, _, _)  <- splitProductType "mkUnpackCase" ty
559
560
561
    , isNewTyCon tycon && not (isRecursiveTyCon tycon)
    = go (newTyConInstRhs tycon tycon_args) 
         (unwrapNewTypeBody tycon tycon_args arg)
562
    | otherwise = (arg, ty)
563
564
565
566
567
568
569
570
571

-- ...and the dual
reboxProduct :: [Unique]     -- uniques to create new local binders
             -> Type         -- type of product to box
             -> ([Unique],   -- remaining uniques
                 CoreExpr,   -- boxed product
                 [Id])       -- Ids being boxed into product
reboxProduct us ty
  = let 
Ian Lynagh's avatar
Ian Lynagh committed
572
        (_tycon, _tycon_args, _pack_con, con_arg_tys) = deepSplitProductType "reboxProduct" ty
573
574
575
 
        us' = dropList con_arg_tys us

Ian Lynagh's avatar
Ian Lynagh committed
576
        arg_ids  = zipWith (mkSysLocal (fsLit "rb")) us con_arg_tys
577
578
579
580
581
582
583
584
585
586

        bind_rhs = mkProductBox arg_ids ty

    in
      (us', bind_rhs, arg_ids)

mkProductBox :: [Id] -> Type -> CoreExpr
mkProductBox arg_ids ty 
  = result_expr
  where 
587
    (tycon, tycon_args, pack_con, _con_arg_tys) = splitProductType "mkProductBox" ty
588
589

    result_expr
590
      | isNewTyCon tycon && not (isRecursiveTyCon tycon) 
591
      = wrap (mkProductBox arg_ids (newTyConInstRhs tycon tycon_args))
592
      | otherwise = mkConApp pack_con (map Type tycon_args ++ varsToCoreExprs arg_ids)
593
594

    wrap expr = wrapNewTypeBody tycon tycon_args expr
595
596


597
-- (mkReboxingAlt us con xs rhs) basically constructs the case
Ian Lynagh's avatar
Ian Lynagh committed
598
-- alternative (con, xs, rhs)
599
600
601
-- but it does the reboxing necessary to construct the *source* 
-- arguments, xs, from the representation arguments ys.
-- For example:
Ian Lynagh's avatar
Ian Lynagh committed
602
--      data T = MkT !(Int,Int) Bool
603
604
--
-- mkReboxingAlt MkT [x,b] r 
Ian Lynagh's avatar
Ian Lynagh committed
605
--      = (DataAlt MkT, [y::Int,z::Int,b], let x = (y,z) in r)
606
--
607
608
-- mkDataAlt should really be in DataCon, but it can't because
-- it manipulates CoreSyn.
609

610
mkReboxingAlt
Ian Lynagh's avatar
Ian Lynagh committed
611
  :: [Unique] -- Uniques for the new Ids
612
  -> DataCon
613
  -> [Var]    -- Source-level args, *including* all evidence vars 
Ian Lynagh's avatar
Ian Lynagh committed
614
  -> CoreExpr -- RHS
615
  -> CoreAlt
616

617
618
619
mkReboxingAlt us con args rhs
  | not (any isMarkedUnboxed stricts)
  = (DataAlt con, args, rhs)
620

621
  | otherwise
622
  = let
Ian Lynagh's avatar
Ian Lynagh committed
623
        (binds, args') = go args stricts us
624
    in
625
    (DataAlt con, args', mkLets binds rhs)
626

627
  where
628
    stricts = dataConExStricts con ++ dataConStrictMarks con
629

630
    go [] _stricts _us = ([], [])
631

Ian Lynagh's avatar
Ian Lynagh committed
632
    -- Type variable case
633
    go (arg:args) stricts us 
634
      | isTyVar arg
635
      = let (binds, args') = go args stricts us
Ian Lynagh's avatar
Ian Lynagh committed
636
        in  (binds, arg:args')
637

Ian Lynagh's avatar
Ian Lynagh committed
638
        -- Term variable case
639
640
    go (arg:args) (str:stricts) us
      | isMarkedUnboxed str
641
      = let (binds, unpacked_args')        = go args stricts us'
642
643
644
            (us', bind_rhs, unpacked_args) = reboxProduct us (idType arg)
        in
            (NonRec arg bind_rhs : binds, unpacked_args ++ unpacked_args')
645
646
647
      | otherwise
      = let (binds, args') = go args stricts us
        in  (binds, arg:args')
648
    go (_ : _) [] _ = panic "mkReboxingAlt"
649
650
651
\end{code}


652
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
653
654
655
%*                                                                      *
        Wrapping and unwrapping newtypes and type families
%*                                                                      *
656
657
658
%************************************************************************

\begin{code}
659
660
wrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
-- The wrapper for the data constructor for a newtype looks like this:
Ian Lynagh's avatar
Ian Lynagh committed
661
662
663
--      newtype T a = MkT (a,Int)
--      MkT :: forall a. (a,Int) -> T a
--      MkT = /\a. \(x:(a,Int)). x `cast` sym (CoT a)
664
665
666
667
-- where CoT is the coercion TyCon assoicated with the newtype
--
-- The call (wrapNewTypeBody T [a] e) returns the
-- body of the wrapper, namely
Ian Lynagh's avatar
Ian Lynagh committed
668
--      e `cast` (CoT [a])
669
--
670
-- If a coercion constructor is provided in the newtype, then we use
671
-- it, otherwise the wrap/unwrap are both no-ops 
672
--
673
-- If the we are dealing with a newtype *instance*, we have a second coercion
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
674
675
676
-- identifying the family instance with the constructor of the newtype
-- instance.  This coercion is applied in any case (ie, composed with the
-- coercion constructor of the newtype or applied by itself).
677

678
wrapNewTypeBody tycon args result_expr
679
680
681
  = ASSERT( isNewTyCon tycon )
    wrapFamInstBody tycon args $
    mkCoerce (mkSymCo co) result_expr
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
682
  where
683
    co = mkAxInstCo (newTyConCo tycon) args
684

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
685
686
687
688
-- When unwrapping, we do *not* apply any family coercion, because this will
-- be done via a CoPat by the type checker.  We have to do it this way as
-- computing the right type arguments for the coercion requires more than just
-- a spliting operation (cf, TcPat.tcConPat).
689

690
691
unwrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
unwrapNewTypeBody tycon args result_expr
692
693
  = ASSERT( isNewTyCon tycon )
    mkCoerce (mkAxInstCo (newTyConCo tycon) args) result_expr
694

695
696
697
698
699
700
701
702
-- If the type constructor is a representation type of a data instance, wrap
-- the expression into a cast adjusting the expression type, which is an
-- instance of the representation type, to the corresponding instance of the
-- family instance type.
-- See Note [Wrappers for data instance tycons]
wrapFamInstBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
wrapFamInstBody tycon args body
  | Just co_con <- tyConFamilyCoercion_maybe tycon
703
  = mkCoerce (mkSymCo (mkAxInstCo co_con args)) body
704
705
  | otherwise
  = body
706

707
708
709
unwrapFamInstScrut :: TyCon -> [Type] -> CoreExpr -> CoreExpr
unwrapFamInstScrut tycon args scrut
  | Just co_con <- tyConFamilyCoercion_maybe tycon
710
  = mkCoerce (mkAxInstCo co_con args) scrut
711
712
  | otherwise
  = scrut
713
714
715
716
\end{code}


%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
717
%*                                                                      *
718
\subsection{Primitive operations}
Ian Lynagh's avatar
Ian Lynagh committed
719
%*                                                                      *
720
721
722
%************************************************************************

\begin{code}
723
724
mkPrimOpId :: PrimOp -> Id
mkPrimOpId prim_op 
725
  = id
726
  where
727
    (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
728
    ty   = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
729
    name = mkWiredInName gHC_PRIM (primOpOcc prim_op) 
Ian Lynagh's avatar
Ian Lynagh committed
730
731
                         (mkPrimOpIdUnique (primOpTag prim_op))
                         (AnId id) UserSyntax
732
    id   = mkGlobalId (PrimOpId prim_op) name ty info
Ian Lynagh's avatar
Ian Lynagh committed
733
                
734
    info = noCafIdInfo
Ian Lynagh's avatar
Ian Lynagh committed
735
736
           `setSpecInfo`          mkSpecInfo (primOpRules prim_op name)
           `setArityInfo`         arity
737
           `setStrictnessInfo` Just strict_sig
738

739
740
741
742
743
744
745
746
747
-- For each ccall we manufacture a separate CCallOpId, giving it
-- a fresh unique, a type that is correct for this particular ccall,
-- and a CCall structure that gives the correct details about calling
-- convention etc.  
--
-- The *name* of this Id is a local name whose OccName gives the full
-- details of the ccall, type and all.  This means that the interface 
-- file reader can reconstruct a suitable Id

748
749
mkFCallId :: Unique -> ForeignCall -> Type -> Id
mkFCallId uniq fcall ty
750
  = ASSERT( isEmptyVarSet (tyVarsOfType ty) )
Ian Lynagh's avatar
Ian Lynagh committed
751
752
    -- A CCallOpId should have no free type variables; 
    -- when doing substitutions won't substitute over it
753
    mkGlobalId (FCallId fcall) name ty info
754
  where
755
    occ_str = showSDoc (braces (ppr fcall <+> ppr ty))
Ian Lynagh's avatar
Ian Lynagh committed
756
757
    -- The "occurrence name" of a ccall is the full info about the
    -- ccall; it is encoded, but may have embedded spaces etc!
758

759
    name = mkFCallName uniq occ_str
760

761
    info = noCafIdInfo
Ian Lynagh's avatar
Ian Lynagh committed
762
           `setArityInfo`         arity
763
           `setStrictnessInfo` Just strict_sig
764

Ian Lynagh's avatar
Ian Lynagh committed
765
    (_, tau)     = tcSplitForAllTys ty
766
    (arg_tys, _) = tcSplitFunTys tau
Ian Lynagh's avatar
Ian Lynagh committed
767
    arity        = length arg_tys
768
    strict_sig   = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
769

770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
-- Tick boxes and breakpoints are both represented as TickBoxOpIds,
-- except for the type:
--
--    a plain HPC tick box has type (State# RealWorld)
--    a breakpoint Id has type forall a.a
--
-- The breakpoint Id will be applied to a list of arbitrary free variables,
-- which is why it needs a polymorphic type.

mkTickBoxOpId :: Unique -> Module -> TickBoxId -> Id
mkTickBoxOpId uniq mod ix = mkTickBox' uniq mod ix realWorldStatePrimTy

mkBreakPointOpId :: Unique -> Module -> TickBoxId -> Id
mkBreakPointOpId uniq mod ix = mkTickBox' uniq mod ix ty
 where ty = mkSigmaTy [openAlphaTyVar] [] openAlphaTy

786
mkTickBox' :: Unique -> Module -> TickBoxId -> Type -> Id
787
mkTickBox' uniq mod ix ty = mkGlobalId (TickBoxOpId tickbox) name ty info    
788
789
790
791
792
  where
    tickbox = TickBox mod ix
    occ_str = showSDoc (braces (ppr tickbox))
    name    = mkTickBoxOpName uniq occ_str
    info    = noCafIdInfo
793
794
\end{code}

795
796

%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
797
%*                                                                      *
798
\subsection{DictFuns and default methods}
Ian Lynagh's avatar
Ian Lynagh committed
799
%*                                                                      *
800
801
%************************************************************************

802
803
804
805
806
807
Important notes about dict funs and default methods
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dict funs and default methods are *not* ImplicitIds.  Their definition
involves user-written code, so we can't figure out their strictness etc
based on fixed info, as we can for constructors and record selectors (say).

808
809
810
We build them as LocalIds, but with External Names.  This ensures that
they are taken to account by free-variable finding and dependency
analysis (e.g. CoreFVs.exprFreeVars).
811
812
813
814
815
816
817
818
819
820
821
822

Why shouldn't they be bound as GlobalIds?  Because, in particular, if
they are globals, the specialiser floats dict uses above their defns,
which prevents good simplifications happening.  Also the strictness
analyser treats a occurrence of a GlobalId as imported and assumes it
contains strictness in its IdInfo, which isn't true if the thing is
bound in the same module as the occurrence.

It's OK for dfuns to be LocalIds, because we form the instance-env to
pass on to the next module (md_insts) in CoreTidy, afer tidying
and globalising the top-level Ids.

823
BUT make sure they are *exported* LocalIds (mkExportedLocalId) so 
824
825
that they aren't discarded by the occurrence analyser.

826
\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
827
828
829
830
831
832
mkDictFunId :: Name      -- Name to use for the dict fun;
            -> [TyVar]
            -> ThetaType
            -> Class 
            -> [Type]
            -> Id
833
-- Implements the DFun Superclass Invariant (see TcInstDcls)
834

835
mkDictFunId dfun_name tvs theta clas tys
836
  = mkExportedLocalVar (DFunId is_nt)
837
838
839
                       dfun_name
                       dfun_ty
                       vanillaIdInfo
840
  where
841
    is_nt = isNewTyCon (classTyCon clas)
842
    dfun_ty = mkDictFunTy tvs theta clas tys
843

844
mkDictFunTy :: [TyVar] -> ThetaType -> Class -> [Type] -> Type
845
mkDictFunTy tvs theta clas tys
batterseapower's avatar
batterseapower committed
846
  = mkSigmaTy tvs theta (mkClassPred clas tys)
847
\end{code}
848
849
850


%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
851
%*                                                                      *
852
\subsection{Un-definable}
Ian Lynagh's avatar
Ian Lynagh committed
853
%*                                                                      *
854
855
%************************************************************************

856
857
858
859
860
861
These Ids can't be defined in Haskell.  They could be defined in
unfoldings in the wired-in GHC.Prim interface file, but we'd have to
ensure that they were definitely, definitely inlined, because there is
no curried identifier for them.  That's what mkCompulsoryUnfolding
does.  If we had a way to get a compulsory unfolding from an interface
file, we could do that, but we don't right now.
862
863
864
865
866
867
868
869
870

unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
just gets expanded into a type coercion wherever it occurs.  Hence we
add it as a built-in Id with an unfolding here.

The type variables we use here are "open" type variables: this means
they can unify with both unlifted and lifted types.  Hence we provide
another gun with which to shoot yourself in the foot.

871
\begin{code}
872
873
874
875
876
877
878
lazyIdName, unsafeCoerceName, nullAddrName, seqName, realWorldName, coercionTokenName :: Name
unsafeCoerceName  = mkWiredInIdName gHC_PRIM (fsLit "unsafeCoerce#") unsafeCoerceIdKey  unsafeCoerceId
nullAddrName      = mkWiredInIdName gHC_PRIM (fsLit "nullAddr#")     nullAddrIdKey      nullAddrId
seqName           = mkWiredInIdName gHC_PRIM (fsLit "seq")           seqIdKey           seqId
realWorldName     = mkWiredInIdName gHC_PRIM (fsLit "realWorld#")    realWorldPrimIdKey realWorldPrimId
lazyIdName        = mkWiredInIdName gHC_BASE (fsLit "lazy")         lazyIdKey           lazyId
coercionTokenName = mkWiredInIdName gHC_PRIM (fsLit "coercionToken#") coercionTokenIdKey coercionTokenId
879
880
\end{code}

881
\begin{code}
882
------------------------------------------------
883
-- unsafeCoerce# :: forall a b. a -> b
884
unsafeCoerceId :: Id
885
unsafeCoerceId
886
  = pcMiscPrelId unsafeCoerceName ty info
887
  where
888
889
    info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
Ian Lynagh's avatar
Ian Lynagh committed
890
           
891

892
893
894
895
    ty  = mkForAllTys [argAlphaTyVar,openBetaTyVar]
                      (mkFunTy argAlphaTy openBetaTy)
    [x] = mkTemplateLocals [argAlphaTy]
    rhs = mkLams [argAlphaTyVar,openBetaTyVar,x] $
896
          Cast (Var x) (mkUnsafeCo argAlphaTy openBetaTy)
897

898
899
------------------------------------------------
nullAddrId :: Id
900
901
902
-- nullAddr# :: Addr#
-- The reason is is here is because we don't provide 
-- a way to write this literal in Haskell.
903
nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info
904
  where
905
906
    info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
                       `setUnfoldingInfo`  mkCompulsoryUnfolding (Lit nullAddrLit)
907

908
------------------------------------------------
909
seqId :: Id	-- See Note [seqId magic]
910
seqId = pcMiscPrelId seqName ty info
911
  where
912
913
914
    info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
                       `setSpecInfo`       mkSpecInfo [seq_cast_rule]
Ian Lynagh's avatar
Ian Lynagh committed
915
           
916

917
918
919
920
    ty  = mkForAllTys [alphaTyVar,argBetaTyVar]
                      (mkFunTy alphaTy (mkFunTy argBetaTy argBetaTy))
    [x,y] = mkTemplateLocals [alphaTy, argBetaTy]
    rhs = mkLams [alphaTyVar,argBetaTyVar,x,y] (Case (Var x) x argBetaTy [(DEFAULT, [], Var y)])
921

922
    -- See Note [Built-in RULES for seq]
923
924
925
926
927
928
    seq_cast_rule = BuiltinRule { ru_name  = fsLit "seq of cast"
                                , ru_fn    = seqName
                                , ru_nargs = 4
                                , ru_try   = match_seq_of_cast
                                }

929
match_seq_of_cast :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
930
    -- See Note [Built-in RULES for seq]
931
match_seq_of_cast _ [Type _, Type res_ty, Cast scrut co, expr]
932
  = Just (Var seqId `mkApps` [Type (pFst (coercionKind co)), Type res_ty,
933
                              scrut, expr])
934
match_seq_of_cast _ _ = Nothing
935

936
------------------------------------------------
937
lazyId :: Id	-- See Note [lazyId magic]
938
lazyId = pcMiscPrelId lazyIdName ty info
939
940
941
  where
    info = noCafIdInfo
    ty  = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
942
\end{code}
943

944
945
Note [seqId magic]
~~~~~~~~~~~~~~~~~~
946
'GHC.Prim.seq' is special in several ways. 
947
948
949
950
951
952
953
954
955

a) Its second arg can have an unboxed type
      x `seq` (v +# w)

b) Its fixity is set in LoadIface.ghcPrimIface

c) It has quite a bit of desugaring magic. 
   See DsUtils.lhs Note [Desugaring seq (1)] and (2) and (3)

956
d) There is some special rule handing: Note [User-defined RULES for seq]
957

958
959
e) See Note [Typing rule for seq] in TcExpr.

960
961
Note [User-defined RULES for seq]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
Roman found situations where he had
      case (f n) of _ -> e
where he knew that f (which was strict in n) would terminate if n did.
Notice that the result of (f n) is discarded. So it makes sense to
transform to
      case n of _ -> e

Rather than attempt some general analysis to support this, I've added
enough support that you can do this using a rewrite rule:

  RULE "f/seq" forall n.  seq (f n) e = seq n e

You write that rule.  When GHC sees a case expression that discards
its result, it mentally transforms it to a call to 'seq' and looks for
a RULE.  (This is done in Simplify.rebuildCase.)  As usual, the
correctness of the rule is up to you.

To make this work, we need to be careful that the magical desugaring
done in Note [seqId magic] item (c) is *not* done on the LHS of a rule.
Or rather, we arrange to un-do it, in DsBinds.decomposeRuleLhs.

983
984
985
Note [Built-in RULES for seq]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We also have the following built-in rule for seq
986
987
988
989

  seq (x `cast` co) y = seq x y

This eliminates unnecessary casts and also allows other seq rules to
990
991
992
993
994
995
996
match more often.  Notably,     

   seq (f x `cast` co) y  -->  seq (f x) y
  
and now a user-defined rule for seq (see Note [User-defined RULES for seq])
may fire.

997

998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
Note [lazyId magic]
~~~~~~~~~~~~~~~~~~~
    lazy :: forall a?. a? -> a?   (i.e. works for unboxed types too)

Used to lazify pseq:   pseq a b = a `seq` lazy b

Also, no strictness: by being a built-in Id, all the info about lazyId comes from here,
not from GHC.Base.hi.   This is important, because the strictness
analyser will spot it as strict!

Also no unfolding in lazyId: it gets "inlined" by a HACK in CorePrep.
It's very important to do this inlining *after* unfoldings are exposed 
in the interface file.  Otherwise, the unfolding for (say) pseq in the
interface file will not mention 'lazy', so if we inline 'pseq' we'll totally
miss the very thing that 'lazy' was there for in the first place.
See Trac #3259 for a real world example.

lazyId is defined in GHC.Base, so we don't *have* to inline it.  If it
appears un-applied, we'll end up just calling it.

-------------------------------------------------------------
1019
1020
1021
@realWorld#@ used to be a magic literal, \tr{void#}.  If things get
nasty as-is, change it back to a literal (@Literal@).

1022
1023
1024
voidArgId is a Local Id used simply as an argument in functions
where we just want an arg to avoid having a thunk of unlifted type.
E.g.
Ian Lynagh's avatar
Ian Lynagh committed
1025
        x = \ void :: State# RealWorld -> (# p, q #)
1026
1027
1028

This comes up in strictness analysis

1029
\begin{code}
1030
realWorldPrimId :: Id
Ian Lynagh's avatar
Ian Lynagh committed
1031
realWorldPrimId -- :: State# RealWorld
1032
  = pcMiscPrelId realWorldName realWorldStatePrimTy
Ian Lynagh's avatar
Ian Lynagh committed
1033
1034
1035
1036
1037
                 (noCafIdInfo `setUnfoldingInfo` evaldUnfolding)
        -- The evaldUnfolding makes it look that realWorld# is evaluated
        -- which in turn makes Simplify.interestingArg return True,
        -- which in turn makes INLINE things applied to realWorld# likely
        -- to be inlined
1038

1039
voidArgId :: Id
Ian Lynagh's avatar
Ian Lynagh committed
1040
voidArgId       -- :: State# RealWorld
Ian Lynagh's avatar
Ian Lynagh committed
1041
  = mkSysLocal (fsLit "void") voidArgIdKey realWorldStatePrimTy
1042
1043
1044
1045

coercionTokenId :: Id 	      -- :: () ~ ()
coercionTokenId -- Used to replace Coercion terms when we go to STG
  = pcMiscPrelId coercionTokenName 
batterseapower's avatar
batterseapower committed
1046
                 (mkTyConApp eqPrimTyCon [unitTy, unitTy])
1047
                 noCafIdInfo
1048
1049
1050
1051
\end{code}


\begin{code}