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