DataCon.hs 50.7 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1998

5
\section[DataCon]{@DataCon@: Data Constructors}
Austin Seipp's avatar
Austin Seipp committed
6
-}
7

8
{-# LANGUAGE CPP, DeriveDataTypeable #-}
Ian Lynagh's avatar
Ian Lynagh committed
9

10
module DataCon (
batterseapower's avatar
batterseapower committed
11
        -- * Main data types
Simon Peyton Jones's avatar
Simon Peyton Jones committed
12
        DataCon, DataConRep(..),
13 14
        SrcStrictness(..), SrcUnpackedness(..),
        HsSrcBang(..), HsImplBang(..),
Simon Peyton Jones's avatar
Simon Peyton Jones committed
15
        StrictnessMark(..),
Edward Z. Yang's avatar
Edward Z. Yang committed
16 17
        ConTag,

18 19 20
        -- ** Equality specs
        EqSpec, mkEqSpec, eqSpecTyVar, eqSpecType,
        eqSpecPair, eqSpecPreds,
21
        substEqSpec, filterEqSpec,
22

Adam Gundry's avatar
Adam Gundry committed
23 24 25
        -- ** Field labels
        FieldLbl(..), FieldLabel, FieldLabelString,

Edward Z. Yang's avatar
Edward Z. Yang committed
26
        -- ** Type construction
27
        mkDataCon, buildAlgTyCon, buildSynTyCon, fIRST_TAG,
Edward Z. Yang's avatar
Edward Z. Yang committed
28 29

        -- ** Type deconstruction
Simon Peyton Jones's avatar
Simon Peyton Jones committed
30
        dataConRepType, dataConSig, dataConInstSig, dataConFullSig,
Edward Z. Yang's avatar
Edward Z. Yang committed
31
        dataConName, dataConIdentity, dataConTag, dataConTyCon,
32
        dataConOrigTyCon, dataConUserType,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
33 34
        dataConUnivTyVars, dataConUnivTyVarBinders,
        dataConExTyVars, dataConExTyVarBinders,
35
        dataConAllTyVars,
36
        dataConEqSpec, dataConTheta,
Edward Z. Yang's avatar
Edward Z. Yang committed
37 38 39
        dataConStupidTheta,
        dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
        dataConInstOrigArgTys, dataConRepArgTys,
40
        dataConFieldLabels, dataConFieldType, dataConFieldType_maybe,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
41
        dataConSrcBangs,
42
        dataConSourceArity, dataConRepArity,
Edward Z. Yang's avatar
Edward Z. Yang committed
43
        dataConIsInfix,
44 45
        dataConWorkId, dataConWrapId, dataConWrapId_maybe,
        dataConImplicitTyThings,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
46
        dataConRepStrictness, dataConImplBangs, dataConBoxer,
Edward Z. Yang's avatar
Edward Z. Yang committed
47 48

        splitDataProductType_maybe,
49

Edward Z. Yang's avatar
Edward Z. Yang committed
50 51
        -- ** Predicates on DataCons
        isNullarySrcDataCon, isNullaryRepDataCon, isTupleDataCon, isUnboxedTupleCon,
52
        isUnboxedSumCon,
Edward Z. Yang's avatar
Edward Z. Yang committed
53
        isVanillaDataCon, classDataCon, dataConCannotMatch,
54
        isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked,
55
        specialPromotedDc, isLegacyPromotableDataCon, isLegacyPromotableTyCon,
56

57
        -- ** Promotion related functions
58
        promoteDataCon
59 60 61 62
    ) where

#include "HsVersions.h"

63
import {-# SOURCE #-} MkId( DataConBoxer )
Simon Marlow's avatar
Simon Marlow committed
64
import Type
65
import ForeignCall ( CType )
66
import Coercion
67
import Unify
Simon Marlow's avatar
Simon Marlow committed
68
import TyCon
Adam Gundry's avatar
Adam Gundry committed
69
import FieldLabel
Simon Marlow's avatar
Simon Marlow committed
70 71
import Class
import Name
72
import PrelNames
Simon Marlow's avatar
Simon Marlow committed
73
import Var
74
import Outputable
Simon Marlow's avatar
Simon Marlow committed
75 76
import ListSetOps
import Util
batterseapower's avatar
batterseapower committed
77
import BasicTypes
78
import FastString
79
import Module
80
import Binary
81
import UniqSet
niteria's avatar
niteria committed
82
import UniqFM
83
import Unique( mkAlphaTyVarUnique )
84

85
import qualified Data.Data as Data
86 87
import Data.Char
import Data.Word
Adam Gundry's avatar
Adam Gundry committed
88
import Data.List( mapAccumL, find )
89

Austin Seipp's avatar
Austin Seipp committed
90
{-
91 92 93
Data constructor representation
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider the following Haskell data type declaration
94

Edward Z. Yang's avatar
Edward Z. Yang committed
95
        data T = T !Int ![Int]
96 97 98

Using the strictness annotations, GHC will represent this as

Edward Z. Yang's avatar
Edward Z. Yang committed
99
        data T = T Int# [Int]
100 101 102

That is, the Int has been unboxed.  Furthermore, the Haskell source construction

Edward Z. Yang's avatar
Edward Z. Yang committed
103
        T e1 e2
104 105 106

is translated to

Edward Z. Yang's avatar
Edward Z. Yang committed
107 108 109
        case e1 of { I# x ->
        case e2 of { r ->
        T x r }}
110 111 112 113

That is, the first argument is unboxed, and the second is evaluated.  Finally,
pattern matching is translated too:

Edward Z. Yang's avatar
Edward Z. Yang committed
114
        case e of { T a b -> ... }
115 116 117

becomes

Edward Z. Yang's avatar
Edward Z. Yang committed
118
        case e of { T a' b -> let a = I# a' in ... }
119 120 121 122 123 124 125

To keep ourselves sane, we name the different versions of the data constructor
differently, as follows.


Note [Data Constructor Naming]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
126
Each data constructor C has two, and possibly up to four, Names associated with it:
127

Edward Z. Yang's avatar
Edward Z. Yang committed
128
                   OccName   Name space   Name of   Notes
129
 ---------------------------------------------------------------------------
Edward Z. Yang's avatar
Edward Z. Yang committed
130 131 132
 The "data con itself"   C     DataName   DataCon   In dom( GlobalRdrEnv )
 The "worker data con"   C     VarName    Id        The worker
 The "wrapper data con"  $WC   VarName    Id        The wrapper
133
 The "newtype coercion"  :CoT  TcClsName  TyCon
Edward Z. Yang's avatar
Edward Z. Yang committed
134

135 136 137 138 139
EVERY data constructor (incl for newtypes) has the former two (the
data con itself, and its worker.  But only some data constructors have a
wrapper (see Note [The need for a wrapper]).

Each of these three has a distinct Unique.  The "data con itself" name
140 141 142 143 144 145
appears in the output of the renamer, and names the Haskell-source
data constructor.  The type checker translates it into either the wrapper Id
(if it exists) or worker Id (otherwise).

The data con has one or two Ids associated with it:

146 147
The "worker Id", is the actual data constructor.
* Every data constructor (newtype or data type) has a worker
148

149
* The worker is very like a primop, in that it has no binding.
150

151 152
* For a *data* type, the worker *is* the data constructor;
  it has no unfolding
153

Edward Z. Yang's avatar
Edward Z. Yang committed
154
* For a *newtype*, the worker has a compulsory unfolding which
155
  does a cast, e.g.
Edward Z. Yang's avatar
Edward Z. Yang committed
156 157 158
        newtype T = MkT Int
        The worker for MkT has unfolding
                \\(x:Int). x `cast` sym CoT
159
  Here CoT is the type constructor, witnessing the FC axiom
Edward Z. Yang's avatar
Edward Z. Yang committed
160
        axiom CoT : T = Int
161

batterseapower's avatar
batterseapower committed
162
The "wrapper Id", \$WC, goes as follows
163

Edward Z. Yang's avatar
Edward Z. Yang committed
164
* Its type is exactly what it looks like in the source program.
165

Edward Z. Yang's avatar
Edward Z. Yang committed
166
* It is an ordinary function, and it gets a top-level binding
167 168 169 170
  like any other function.

* The wrapper Id isn't generated for a data type if there is
  nothing for the wrapper to do.  That is, if its defn would be
Edward Z. Yang's avatar
Edward Z. Yang committed
171
        \$wC = C
172

173 174
Note [The need for a wrapper]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
175 176 177
Why might the wrapper have anything to do?  Two reasons:

* Unboxing strict fields (with -funbox-strict-fields)
Edward Z. Yang's avatar
Edward Z. Yang committed
178 179 180 181
        data T = MkT !(Int,Int)
        \$wMkT :: (Int,Int) -> T
        \$wMkT (x,y) = MkT x y
  Notice that the worker has two fields where the wapper has
182
  just one.  That is, the worker has type
Edward Z. Yang's avatar
Edward Z. Yang committed
183
                MkT :: Int -> Int -> T
184 185

* Equality constraints for GADTs
Edward Z. Yang's avatar
Edward Z. Yang committed
186
        data T a where { MkT :: a -> T [a] }
187 188 189

  The worker gets a type with explicit equality
  constraints, thus:
Edward Z. Yang's avatar
Edward Z. Yang committed
190
        MkT :: forall a b. (a=[b]) => b -> T a
191 192

  The wrapper has the programmer-specified type:
Edward Z. Yang's avatar
Edward Z. Yang committed
193 194
        \$wMkT :: a -> T [a]
        \$wMkT a x = MkT [a] a [a] x
195
  The third argument is a coercion
Edward Z. Yang's avatar
Edward Z. Yang committed
196
        [a] :: [a]~[a]
197

198
INVARIANT: the dictionary constructor for a class
Edward Z. Yang's avatar
Edward Z. Yang committed
199
           never has a wrapper.
200 201


202 203 204
A note about the stupid context
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Data types can have a context:
Edward Z. Yang's avatar
Edward Z. Yang committed
205 206

        data (Eq a, Ord b) => T a b = T1 a b | T2 a
207 208 209 210

and that makes the constructors have a context too
(notice that T2's context is "thinned"):

Edward Z. Yang's avatar
Edward Z. Yang committed
211 212
        T1 :: (Eq a, Ord b) => a -> b -> T a b
        T2 :: (Eq a) => a -> T a b
213 214 215 216 217

Furthermore, this context pops up when pattern matching
(though GHC hasn't implemented this, but it is in H98, and
I've fixed GHC so that it now does):

Edward Z. Yang's avatar
Edward Z. Yang committed
218
        f (T2 x) = x
219
gets inferred type
Edward Z. Yang's avatar
Edward Z. Yang committed
220
        f :: Eq a => T a b -> a
221 222 223 224 225

I say the context is "stupid" because the dictionaries passed
are immediately discarded -- they do nothing and have no benefit.
It's a flaw in the language.

Edward Z. Yang's avatar
Edward Z. Yang committed
226 227 228 229 230
        Up to now [March 2002] I have put this stupid context into the
        type of the "wrapper" constructors functions, T1 and T2, but
        that turned out to be jolly inconvenient for generics, and
        record update, and other functions that build values of type T
        (because they don't have suitable dictionaries available).
231

Edward Z. Yang's avatar
Edward Z. Yang committed
232 233 234
        So now I've taken the stupid context out.  I simply deal with
        it separately in the type checker on occurrences of a
        constructor, either in an expression or in a pattern.
235

Edward Z. Yang's avatar
Edward Z. Yang committed
236 237 238 239 240 241
        [May 2003: actually I think this decision could evasily be
        reversed now, and probably should be.  Generics could be
        disabled for types with a stupid context; record updates now
        (H98) needs the context too; etc.  It's an unforced change, so
        I'm leaving it for now --- but it does seem odd that the
        wrapper doesn't include the stupid context.]
242

243 244
[July 04] With the advent of generalised data types, it's less obvious
what the "stupid context" is.  Consider
Edward Z. Yang's avatar
Edward Z. Yang committed
245
        C :: forall a. Ord a => a -> a -> T (Foo a)
246
Does the C constructor in Core contain the Ord dictionary?  Yes, it must:
247

Edward Z. Yang's avatar
Edward Z. Yang committed
248 249 250 251
        f :: T b -> Ordering
        f = /\b. \x:T b.
            case x of
                C a (d:Ord a) (p:a) (q:a) -> compare d p q
252

253
Note that (Foo a) might not be an instance of Ord.
254

Austin Seipp's avatar
Austin Seipp committed
255 256
************************************************************************
*                                                                      *
257
\subsection{Data constructors}
Austin Seipp's avatar
Austin Seipp committed
258 259 260
*                                                                      *
************************************************************************
-}
261

batterseapower's avatar
batterseapower committed
262
-- | A data constructor
Alan Zimmerman's avatar
Alan Zimmerman committed
263 264 265
--
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
--             'ApiAnnotation.AnnClose','ApiAnnotation.AnnComma'
266 267

-- For details on above see note [Api annotations] in ApiAnnotation
268
data DataCon
269
  = MkData {
Edward Z. Yang's avatar
Edward Z. Yang committed
270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294
        dcName    :: Name,      -- This is the name of the *source data con*
                                -- (see "Note [Data Constructor Naming]" above)
        dcUnique :: Unique,     -- Cached from Name
        dcTag    :: ConTag,     -- ^ Tag, used for ordering 'DataCon's

        -- Running example:
        --
        --      *** As declared by the user
        --  data T a where
        --    MkT :: forall x y. (x~y,Ord x) => x -> y -> T (x,y)

        --      *** As represented internally
        --  data T a where
        --    MkT :: forall a. forall x y. (a~(x,y),x~y,Ord x) => x -> y -> T a
        --
        -- The next six fields express the type of the constructor, in pieces
        -- e.g.
        --
        --      dcUnivTyVars  = [a]
        --      dcExTyVars    = [x,y]
        --      dcEqSpec      = [a~(x,y)]
        --      dcOtherTheta  = [x~y, Ord x]
        --      dcOrigArgTys  = [x,y]
        --      dcRepTyCon       = T

295
        -- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
Simon Peyton Jones's avatar
Simon Peyton Jones committed
296 297 298
        -- FOR THE PARENT TyCon. (This is a change (Oct05): previously, vanilla
        -- datacons guaranteed to have the same type variables as their parent TyCon,
        -- but that seems ugly.)
299

Edward Z. Yang's avatar
Edward Z. Yang committed
300 301 302 303 304 305 306 307 308 309
        dcVanilla :: Bool,      -- True <=> This is a vanilla Haskell 98 data constructor
                                --          Its type is of form
                                --              forall a1..an . t1 -> ... tm -> T a1..an
                                --          No existentials, no coercions, nothing.
                                -- That is: dcExTyVars = dcEqSpec = dcOtherTheta = []
                -- NB 1: newtypes always have a vanilla data con
                -- NB 2: a vanilla constructor can still be declared in GADT-style
                --       syntax, provided its type looks like the above.
                --       The declaration format is held in the TyCon (algTcGadtSyntax)

310
        -- Universally-quantified type vars [a,b,c]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
311 312
        -- INVARIANT: length matches arity of the dcRepTyCon
        -- INVARIANT: result type of data con worker is exactly (T a b c)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
313
        dcUnivTyVars    :: [TyVarBinder],
314 315

        -- Existentially-quantified type vars [x,y]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
316
        dcExTyVars     :: [TyVarBinder],
317

Edward Z. Yang's avatar
Edward Z. Yang committed
318 319 320
        -- INVARIANT: the UnivTyVars and ExTyVars all have distinct OccNames
        -- Reason: less confusing, and easier to generate IfaceSyn

321 322 323
        dcEqSpec :: [EqSpec],   -- Equalities derived from the result type,
                                -- _as written by the programmer_

Edward Z. Yang's avatar
Edward Z. Yang committed
324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363
                -- This field allows us to move conveniently between the two ways
                -- of representing a GADT constructor's type:
                --      MkT :: forall a b. (a ~ [b]) => b -> T a
                --      MkT :: forall b. b -> T [b]
                -- Each equality is of the form (a ~ ty), where 'a' is one of
                -- the universally quantified type variables

                -- The next two fields give the type context of the data constructor
                --      (aside from the GADT constraints,
                --       which are given by the dcExpSpec)
                -- In GADT form, this is *exactly* what the programmer writes, even if
                -- the context constrains only universally quantified variables
                --      MkT :: forall a b. (a ~ b, Ord b) => a -> T a b
        dcOtherTheta :: ThetaType,  -- The other constraints in the data con's type
                                    -- other than those in the dcEqSpec

        dcStupidTheta :: ThetaType,     -- The context of the data type declaration
                                        --      data Eq a => T a = ...
                                        -- or, rather, a "thinned" version thereof
                -- "Thinned", because the Report says
                -- to eliminate any constraints that don't mention
                -- tyvars free in the arg types for this constructor
                --
                -- INVARIANT: the free tyvars of dcStupidTheta are a subset of dcUnivTyVars
                -- Reason: dcStupidTeta is gotten by thinning the stupid theta from the tycon
                --
                -- "Stupid", because the dictionaries aren't used for anything.
                -- Indeed, [as of March 02] they are no longer in the type of
                -- the wrapper Id, because that makes it harder to use the wrap-id
                -- to rebuild values after record selection or in generics.

        dcOrigArgTys :: [Type],         -- Original argument types
                                        -- (before unboxing and flattening of strict fields)
        dcOrigResTy :: Type,            -- Original result type, as seen by the user
                -- NB: for a data instance, the original user result type may
                -- differ from the DataCon's representation TyCon.  Example
                --      data instance T [a] where MkT :: a -> T [a]
                -- The OrigResTy is T [a], but the dcRepTyCon might be :T123

        -- Now the strictness annotations and field labels of the constructor
364
        dcSrcBangs :: [HsSrcBang],
Simon Peyton Jones's avatar
Simon Peyton Jones committed
365
                -- See Note [Bangs on data constructor arguments]
366 367
                --
                -- The [HsSrcBang] as written by the programmer.
368
                --
Edward Z. Yang's avatar
Edward Z. Yang committed
369 370 371 372 373 374 375 376 377 378 379 380 381 382
                -- Matches 1-1 with dcOrigArgTys
                -- Hence length = dataConSourceArity dataCon

        dcFields  :: [FieldLabel],
                -- Field labels for this constructor, in the
                -- same order as the dcOrigArgTys;
                -- length = 0 (if not a record) or dataConSourceArity.

        -- The curried worker function that corresponds to the constructor:
        -- It doesn't have an unfolding; the code generator saturates these Ids
        -- and allocates a real constructor when it finds one.
        dcWorkId :: Id,

        -- Constructor representation
383
        dcRep      :: DataConRep,
384

385 386 387
        -- Cached; see Note [DataCon arities]
        -- INVARIANT: dcRepArity    == length dataConRepArgTys
        -- INVARIANT: dcSourceArity == length dcOrigArgTys
388 389
        dcRepArity    :: Arity,
        dcSourceArity :: Arity,
390

Edward Z. Yang's avatar
Edward Z. Yang committed
391 392
        -- Result type of constructor is T t1..tn
        dcRepTyCon  :: TyCon,           -- Result tycon, T
393

Edward Z. Yang's avatar
Edward Z. Yang committed
394 395
        dcRepType   :: Type,    -- Type of the constructor
                                --      forall a x y. (a~(x,y), x~y, Ord x) =>
396
                                --        x -> y -> T a
Edward Z. Yang's avatar
Edward Z. Yang committed
397 398 399 400 401
                                -- (this is *not* of the constructor wrapper Id:
                                --  see Note [Data con representation] below)
        -- Notice that the existential type parameters come *second*.
        -- Reason: in a case expression we may find:
        --      case (e :: T t) of
402
        --        MkT x y co1 co2 (d:Ord x) (v:r) (w:F s) -> ...
Edward Z. Yang's avatar
Edward Z. Yang committed
403 404 405 406
        -- It's convenient to apply the rep-type of MkT to 't', to get
        --      forall x y. (t~(x,y), x~y, Ord x) => x -> y -> T t
        -- and use that to check the pattern.  Mind you, this is really only
        -- used in CoreLint.
407 408


Edward Z. Yang's avatar
Edward Z. Yang committed
409 410 411
        dcInfix :: Bool,        -- True <=> declared infix
                                -- Used for Template Haskell and 'deriving' only
                                -- The actual fixity is stored elsewhere
412

413 414
        dcPromoted :: TyCon    -- The promoted TyCon
                               -- See Note [Promoted data constructors] in TyCon
415 416
  }

417

Simon Peyton Jones's avatar
Simon Peyton Jones committed
418
{- Note [TyVarBinders in DataCons]
419
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Simon Peyton Jones's avatar
Simon Peyton Jones committed
420
For the TyVarBinders in a DataCon and PatSyn:
421

422 423 424
 * Each argument flag is Inferred or Specified.
   None are Required. (A DataCon is a term-level function; see
   Note [No Required TyBinder in terms] in TyCoRep.)
425

Simon Peyton Jones's avatar
Simon Peyton Jones committed
426 427 428 429
Why do we need the TyVarBinders, rather than just the TyVars?  So that
we can construct the right type for the DataCon with its foralls
attributed the correce visiblity.  That in turn governs whether you
can use visible type application at a call of the data constructor.
430 431 432 433 434 435 436 437

Note [DataCon arities]
~~~~~~~~~~~~~~~~~~~~~~
dcSourceArity does not take constraints into account,
but dcRepArity does.  For example:
   MkT :: Ord a => a -> T a
    dcSourceArity = 1
    dcRepArity    = 2
438 439
-}

440
-- | Data Constructor Representation
Edward Z. Yang's avatar
Edward Z. Yang committed
441
data DataConRep
442 443
  = NoDataConRep              -- No wrapper

Edward Z. Yang's avatar
Edward Z. Yang committed
444
  | DCR { dcr_wrap_id :: Id   -- Takes src args, unboxes/flattens,
445 446 447 448
                              -- and constructs the representation

        , dcr_boxer   :: DataConBoxer

Edward Z. Yang's avatar
Edward Z. Yang committed
449
        , dcr_arg_tys :: [Type]  -- Final, representation argument types,
450 451 452 453
                                 -- after unboxing and flattening,
                                 -- and *including* all evidence args

        , dcr_stricts :: [StrictnessMark]  -- 1-1 with dcr_arg_tys
454
                -- See also Note [Data-con worker strictness] in MkId.hs
455

Simon Peyton Jones's avatar
Simon Peyton Jones committed
456 457 458
        , dcr_bangs :: [HsImplBang]  -- The actual decisions made (including failures)
                                     -- about the original arguments; 1-1 with orig_arg_tys
                                     -- See Note [Bangs on data constructor arguments]
459

460 461 462
    }
-- Algebraic data types always have a worker, and
-- may or may not have a wrapper, depending on whether
Edward Z. Yang's avatar
Edward Z. Yang committed
463
-- the wrapper does anything.
464 465 466 467 468 469 470 471 472 473 474 475 476 477 478
--
-- Data types have a worker with no unfolding
-- Newtypes just have a worker, which has a compulsory unfolding (just a cast)

-- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments

-- The wrapper (if it exists) takes dcOrigArgTys as its arguments
-- The worker takes dataConRepArgTys as its arguments
-- If the worker is absent, dataConRepArgTys is the same as dcOrigArgTys

-- The 'NoDataConRep' case is important
-- Not only is this efficient,
-- but it also ensures that the wrapper is replaced
-- by the worker (because it *is* the worker)
-- even when there are no args. E.g. in
Edward Z. Yang's avatar
Edward Z. Yang committed
479
--              f (:) x
480 481 482 483 484 485
-- the (:) *is* the worker.
-- This is really important in rule matching,
-- (We could match on the wrappers,
-- but that makes it less likely that rules will match
-- when we bring bits of unfoldings together.)

486 487
-------------------------

488 489 490
-- | Haskell Source Bang
--
-- Bangs on data constructor arguments as the user wrote them in the
491 492
-- source code.
--
493 494
-- @(HsSrcBang _ SrcUnpack SrcLazy)@ and
-- @(HsSrcBang _ SrcUnpack NoSrcStrict)@ (without StrictData) makes no sense, we
495
-- emit a warning (in checkValidDataCon) and treat it like
496
-- @(HsSrcBang _ NoSrcUnpack SrcLazy)@
497
data HsSrcBang =
Alan Zimmerman's avatar
Alan Zimmerman committed
498
  HsSrcBang SourceText -- Note [Pragma source text] in BasicTypes
499 500
            SrcUnpackedness
            SrcStrictness
501
  deriving Data.Data
502

503 504 505
-- | Haskell Implementation Bang
--
-- Bangs of data constructor arguments as generated by the compiler
506 507 508 509 510 511 512
-- after consulting HsSrcBang, flags, etc.
data HsImplBang
  = HsLazy  -- ^ Lazy field
  | HsStrict  -- ^ Strict but not unpacked field
  | HsUnpack (Maybe Coercion)
    -- ^ Strict and unpacked field
    -- co :: arg-ty ~ product-ty HsBang
513
  deriving Data.Data
514

515 516 517
-- | Source Strictness
--
-- What strictness annotation the user wrote
518 519
data SrcStrictness = SrcLazy -- ^ Lazy, ie '~'
                   | SrcStrict -- ^ Strict, ie '!'
520
                   | NoSrcStrict -- ^ no strictness annotation
521
     deriving (Eq, Data.Data)
522

523 524 525
-- | Source Unpackedness
--
-- What unpackedness the user requested
526 527 528
data SrcUnpackedness = SrcUnpack -- ^ {-# UNPACK #-} specified
                     | SrcNoUnpack -- ^ {-# NOUNPACK #-} specified
                     | NoSrcUnpack -- ^ no unpack pragma
529
     deriving (Eq, Data.Data)
530 531


Simon Peyton Jones's avatar
Simon Peyton Jones committed
532

533
-------------------------
Edward Z. Yang's avatar
Edward Z. Yang committed
534
-- StrictnessMark is internal only, used to indicate strictness
535
-- of the DataCon *worker* fields
Edward Z. Yang's avatar
Edward Z. Yang committed
536
data StrictnessMark = MarkedStrict | NotMarkedStrict
537

538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568
-- | An 'EqSpec' is a tyvar/type pair representing an equality made in
-- rejigging a GADT constructor
data EqSpec = EqSpec TyVar
                     Type

-- | Make an 'EqSpec'
mkEqSpec :: TyVar -> Type -> EqSpec
mkEqSpec tv ty = EqSpec tv ty

eqSpecTyVar :: EqSpec -> TyVar
eqSpecTyVar (EqSpec tv _) = tv

eqSpecType :: EqSpec -> Type
eqSpecType (EqSpec _ ty) = ty

eqSpecPair :: EqSpec -> (TyVar, Type)
eqSpecPair (EqSpec tv ty) = (tv, ty)

eqSpecPreds :: [EqSpec] -> ThetaType
eqSpecPreds spec = [ mkPrimEqPred (mkTyVarTy tv) ty
                   | EqSpec tv ty <- spec ]

-- | Substitute in an 'EqSpec'. Precondition: if the LHS of the EqSpec
-- is mapped in the substitution, it is mapped to a type variable, not
-- a full type.
substEqSpec :: TCvSubst -> EqSpec -> EqSpec
substEqSpec subst (EqSpec tv ty)
  = EqSpec tv' (substTy subst ty)
  where
    tv' = getTyVar "substEqSpec" (substTyVar subst tv)

569
-- | Filter out any TyBinders mentioned in an EqSpec
Simon Peyton Jones's avatar
Simon Peyton Jones committed
570
filterEqSpec :: [EqSpec] -> [TyVarBinder] -> [TyVarBinder]
571 572 573
filterEqSpec eq_spec
  = filter not_in_eq_spec
  where
Simon Peyton Jones's avatar
Simon Peyton Jones committed
574
    not_in_eq_spec bndr = let var = binderVar bndr in
575 576
                          all (not . (== var) . eqSpecTyVar) eq_spec

577 578 579
instance Outputable EqSpec where
  ppr (EqSpec tv ty) = ppr (tv, ty)

Simon Peyton Jones's avatar
Simon Peyton Jones committed
580 581 582 583 584 585 586
{- Note [Bangs on data constructor arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
  data T = MkT !Int {-# UNPACK #-} !Int Bool

When compiling the module, GHC will decide how to represent
MkT, depending on the optimisation level, and settings of
587
flags like -funbox-small-strict-fields.
Simon Peyton Jones's avatar
Simon Peyton Jones committed
588 589 590

Terminology:
  * HsSrcBang:  What the user wrote
591
                Constructors: HsSrcBang
Simon Peyton Jones's avatar
Simon Peyton Jones committed
592 593

  * HsImplBang: What GHC decided
594
                Constructors: HsLazy, HsStrict, HsUnpack
Simon Peyton Jones's avatar
Simon Peyton Jones committed
595

596
* If T was defined in this module, MkT's dcSrcBangs field
Simon Peyton Jones's avatar
Simon Peyton Jones committed
597
  records the [HsSrcBang] of what the user wrote; in the example
598 599 600
    [ HsSrcBang _ NoSrcUnpack SrcStrict
    , HsSrcBang _ SrcUnpack SrcStrict
    , HsSrcBang _ NoSrcUnpack NoSrcStrictness]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
601

602 603 604 605
* However, if T was defined in an imported module, the importing module
  must follow the decisions made in the original module, regardless of
  the flag settings in the importing module.
  Also see Note [Bangs on imported data constructors] in MkId
Simon Peyton Jones's avatar
Simon Peyton Jones committed
606 607 608

* The dcr_bangs field of the dcRep field records the [HsImplBang]
  If T was defined in this module, Without -O the dcr_bangs might be
609
    [HsStrict, HsStrict, HsLazy]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
610
  With -O it might be
611
    [HsStrict, HsUnpack _, HsLazy]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
612
  With -funbox-small-strict-fields it might be
613 614 615
    [HsUnpack, HsUnpack _, HsLazy]
  With -XStrictData it might be
    [HsStrict, HsUnpack _, HsStrict]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
616

617 618
Note [Data con representation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Gabor Greif's avatar
Gabor Greif committed
619
The dcRepType field contains the type of the representation of a constructor
620
This may differ from the type of the constructor *Id* (built
621
by MkId.mkDataConId) for two reasons:
Edward Z. Yang's avatar
Edward Z. Yang committed
622 623
        a) the constructor Id may be overloaded, but the dictionary isn't stored
           e.g.    data Eq a => T a = MkT a a
624

Edward Z. Yang's avatar
Edward Z. Yang committed
625
        b) the constructor may store an unboxed version of a strict field.
626 627

Here's an example illustrating both:
Edward Z. Yang's avatar
Edward Z. Yang committed
628
        data Ord a => T a = MkT Int! a
629
Here
Edward Z. Yang's avatar
Edward Z. Yang committed
630
        T :: Ord a => Int -> a -> T a
631
but the rep type is
Edward Z. Yang's avatar
Edward Z. Yang committed
632
        Trep :: Int# -> a -> T a
633 634
Actually, the unboxed part isn't implemented yet!

635

636

Austin Seipp's avatar
Austin Seipp committed
637 638
************************************************************************
*                                                                      *
639
\subsection{Instances}
Austin Seipp's avatar
Austin Seipp committed
640 641 642
*                                                                      *
************************************************************************
-}
643

644 645 646 647 648 649 650 651 652 653 654 655 656
instance Eq DataCon where
    a == b = getUnique a == getUnique b
    a /= b = getUnique a /= getUnique b

instance Uniquable DataCon where
    getUnique = dcUnique

instance NamedThing DataCon where
    getName = dcName

instance Outputable DataCon where
    ppr con = ppr (dataConName con)

657 658 659 660
instance OutputableBndr DataCon where
    pprInfixOcc con = pprInfixName (dataConName con)
    pprPrefixOcc con = pprPrefixName (dataConName con)

661 662 663 664 665
instance Data.Data DataCon where
    -- don't traverse?
    toConstr _   = abstractConstr "DataCon"
    gunfold _ _  = error "gunfold"
    dataTypeOf _ = mkNoRepType "DataCon"
666

667
instance Outputable HsSrcBang where
668
    ppr (HsSrcBang _ prag mark) = ppr prag <+> ppr mark
669 670

instance Outputable HsImplBang where
671 672 673 674
    ppr HsLazy                  = text "Lazy"
    ppr (HsUnpack Nothing)      = text "Unpacked"
    ppr (HsUnpack (Just co))    = text "Unpacked" <> parens (ppr co)
    ppr HsStrict                = text "StrictNotUnpacked"
675 676

instance Outputable SrcStrictness where
677 678 679
    ppr SrcLazy     = char '~'
    ppr SrcStrict   = char '!'
    ppr NoSrcStrict = empty
680 681

instance Outputable SrcUnpackedness where
682 683
    ppr SrcUnpack   = text "{-# UNPACK #-}"
    ppr SrcNoUnpack = text "{-# NOUNPACK #-}"
684
    ppr NoSrcUnpack = empty
685 686

instance Outputable StrictnessMark where
687
    ppr MarkedStrict    = text "!"
688 689 690 691 692 693 694 695 696 697 698
    ppr NotMarkedStrict = empty

instance Binary SrcStrictness where
    put_ bh SrcLazy     = putByte bh 0
    put_ bh SrcStrict   = putByte bh 1
    put_ bh NoSrcStrict = putByte bh 2

    get bh =
      do h <- getByte bh
         case h of
           0 -> return SrcLazy
699
           1 -> return SrcStrict
700 701 702 703 704 705 706 707 708 709 710 711 712
           _ -> return NoSrcStrict

instance Binary SrcUnpackedness where
    put_ bh SrcNoUnpack = putByte bh 0
    put_ bh SrcUnpack   = putByte bh 1
    put_ bh NoSrcUnpack = putByte bh 2

    get bh =
      do h <- getByte bh
         case h of
           0 -> return SrcNoUnpack
           1 -> return SrcUnpack
           _ -> return NoSrcUnpack
713

714
-- | Compare strictness annotations
715
eqHsBang :: HsImplBang -> HsImplBang -> Bool
716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734
eqHsBang HsLazy               HsLazy              = True
eqHsBang HsStrict             HsStrict            = True
eqHsBang (HsUnpack Nothing)   (HsUnpack Nothing)  = True
eqHsBang (HsUnpack (Just c1)) (HsUnpack (Just c2))
  = eqType (coercionType c1) (coercionType c2)
eqHsBang _ _                                       = False

isBanged :: HsImplBang -> Bool
isBanged (HsUnpack {}) = True
isBanged (HsStrict {}) = True
isBanged HsLazy        = False

isSrcStrict :: SrcStrictness -> Bool
isSrcStrict SrcStrict = True
isSrcStrict _ = False

isSrcUnpacked :: SrcUnpackedness -> Bool
isSrcUnpacked SrcUnpack = True
isSrcUnpacked _ = False
735 736 737 738

isMarkedStrict :: StrictnessMark -> Bool
isMarkedStrict NotMarkedStrict = False
isMarkedStrict _               = True   -- All others are strict
739

740
{- *********************************************************************
Austin Seipp's avatar
Austin Seipp committed
741
*                                                                      *
742
\subsection{Construction}
Austin Seipp's avatar
Austin Seipp committed
743
*                                                                      *
744
********************************************************************* -}
745

batterseapower's avatar
batterseapower committed
746
-- | Build a new data constructor
Edward Z. Yang's avatar
Edward Z. Yang committed
747
mkDataCon :: Name
748
          -> Bool           -- ^ Is the constructor declared infix?
749
          -> TyConRepName   -- ^  TyConRepName for the promoted TyCon
750
          -> [HsSrcBang]    -- ^ Strictness/unpack annotations, from user
751 752
          -> [FieldLabel]   -- ^ Field labels for the constructor,
                            -- if it is a record, otherwise empty
Simon Peyton Jones's avatar
Simon Peyton Jones committed
753 754
          -> [TyVarBinder]  -- ^ Universals. See Note [TyVarBinders in DataCons]
          -> [TyVarBinder]  -- ^ Existentials.
755
                            -- (These last two must be Named and Inferred/Specified)
756
          -> [EqSpec]       -- ^ GADT equalities
757 758 759
          -> ThetaType      -- ^ Theta-type occuring before the arguments proper
          -> [Type]         -- ^ Original argument types
          -> Type           -- ^ Original result type
760
          -> RuntimeRepInfo -- ^ See comments on 'TyCon.RuntimeRepInfo'
761 762 763 764 765
          -> TyCon          -- ^ Representation type constructor
          -> ThetaType      -- ^ The "stupid theta", context of the data
                            -- declaration e.g. @data Eq a => T a ...@
          -> Id             -- ^ Worker Id
          -> DataConRep     -- ^ Representation
Edward Z. Yang's avatar
Edward Z. Yang committed
766
          -> DataCon
767 768
  -- Can get the tag from the TyCon

769
mkDataCon name declared_infix prom_info
Edward Z. Yang's avatar
Edward Z. Yang committed
770 771
          arg_stricts   -- Must match orig_arg_tys 1-1
          fields
Simon Peyton Jones's avatar
Simon Peyton Jones committed
772
          univ_tvs ex_tvs
Edward Z. Yang's avatar
Edward Z. Yang committed
773
          eq_spec theta
774
          orig_arg_tys orig_res_ty rep_info rep_tycon
Edward Z. Yang's avatar
Edward Z. Yang committed
775 776
          stupid_theta work_id rep
-- Warning: mkDataCon is not a good place to check invariants.
777
-- If the programmer writes the wrong result type in the decl, thus:
Edward Z. Yang's avatar
Edward Z. Yang committed
778
--      data T a where { MkT :: S }
779 780 781 782 783
-- then it's possible that the univ_tvs may hit an assertion failure
-- if you pull on univ_tvs.  This case is checked by checkValidDataCon,
-- so the error is detected properly... it's just that asaertions here
-- are a little dodgy.

784
  = con
785
  where
786
    is_vanilla = null ex_tvs && null eq_spec && null theta
Edward Z. Yang's avatar
Edward Z. Yang committed
787 788
    con = MkData {dcName = name, dcUnique = nameUnique name,
                  dcVanilla = is_vanilla, dcInfix = declared_infix,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
789 790
                  dcUnivTyVars = univ_tvs,
                  dcExTyVars = ex_tvs,
Edward Z. Yang's avatar
Edward Z. Yang committed
791 792 793 794 795
                  dcEqSpec = eq_spec,
                  dcOtherTheta = theta,
                  dcStupidTheta = stupid_theta,
                  dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty,
                  dcRepTyCon = rep_tycon,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
796
                  dcSrcBangs = arg_stricts,
Edward Z. Yang's avatar
Edward Z. Yang committed
797 798 799
                  dcFields = fields, dcTag = tag, dcRepType = rep_ty,
                  dcWorkId = work_id,
                  dcRep = rep,
800 801
                  dcSourceArity = length orig_arg_tys,
                  dcRepArity = length rep_arg_tys,
802
                  dcPromoted = promoted }
803

Edward Z. Yang's avatar
Edward Z. Yang committed
804 805 806
        -- The 'arg_stricts' passed to mkDataCon are simply those for the
        -- source-language arguments.  We add extra ones for the
        -- dictionary arguments right here.
807

808
    tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con
809
    rep_arg_tys = dataConRepArgTys con
810

Simon Peyton Jones's avatar
Simon Peyton Jones committed
811
    rep_ty = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $
Edward Z. Yang's avatar
Edward Z. Yang committed
812
             mkFunTys rep_arg_tys $
813
             mkTyConApp rep_tycon (mkTyVarTys (binderVars univ_tvs))
814

815
      -- See Note [Promoted data constructors] in TyCon
816 817 818 819 820 821 822 823
    prom_tv_bndrs = [ mkNamedTyConBinder vis tv
                    | TvBndr tv vis <- filterEqSpec eq_spec univ_tvs ++ ex_tvs ]

    prom_arg_bndrs = mkCleanAnonTyConBinders prom_tv_bndrs (theta ++ orig_arg_tys)
    prom_res_kind  = orig_res_ty
    promoted       = mkPromotedDataCon con name prom_info
                                       (prom_tv_bndrs ++ prom_arg_bndrs)
                                       prom_res_kind roles rep_info
824

825 826
    roles = map (const Nominal) (univ_tvs ++ ex_tvs) ++
            map (const Representational) orig_arg_tys
827

828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856
mkCleanAnonTyConBinders :: [TyConBinder] -> [Type] -> [TyConBinder]
-- Make sure that the "anonymous" tyvars don't clash in
-- name or unique with the universal/existential ones.
-- Tiresome!  And unnecessary because these tyvars are never looked at
mkCleanAnonTyConBinders tc_bndrs tys
  = [ mkAnonTyConBinder (mkTyVar name ty)
    | (name, ty) <- fresh_names `zip` tys ]
  where
    fresh_names = freshNames (map getName (binderVars tc_bndrs))

freshNames :: [Name] -> [Name]
-- Make names whose Uniques and OccNames differ from
-- those in the 'avoid' list
freshNames avoids
  = [ mkSystemName uniq occ
    | n <- [0..]
    , let uniq = mkAlphaTyVarUnique n
          occ = mkTyVarOccFS (mkFastString ('x' : show n))

    , not (uniq `elementOfUniqSet` avoid_uniqs)
    , not (occ `elemOccSet` avoid_occs) ]

  where
    avoid_uniqs :: UniqSet Unique
    avoid_uniqs = mkUniqSet (map getUnique avoids)

    avoid_occs :: OccSet
    avoid_occs = mkOccSet (map getOccName avoids)

batterseapower's avatar
batterseapower committed
857
-- | The 'Name' of the 'DataCon', giving it a unique, rooted identification
858 859 860
dataConName :: DataCon -> Name
dataConName = dcName

batterseapower's avatar
batterseapower committed
861
-- | The tag used for ordering 'DataCon's
862 863 864
dataConTag :: DataCon -> ConTag
dataConTag  = dcTag

batterseapower's avatar
batterseapower committed
865
-- | The type constructor that we are building via this data constructor
866
dataConTyCon :: DataCon -> TyCon
867
dataConTyCon = dcRepTyCon
868

869 870 871 872
-- | The original type constructor used in the definition of this data
-- constructor.  In case of a data family instance, that will be the family
-- type constructor.
dataConOrigTyCon :: DataCon -> TyCon
Edward Z. Yang's avatar
Edward Z. Yang committed
873
dataConOrigTyCon dc
874 875 876
  | Just (tc, _) <- tyConFamInst_maybe (dcRepTyCon dc) = tc
  | otherwise                                          = dcRepTyCon dc

batterseapower's avatar
batterseapower committed
877 878
-- | The representation type of the data constructor, i.e. the sort
-- type that will represent values of this type at runtime
879 880
dataConRepType :: DataCon -> Type
dataConRepType = dcRepType
881

batterseapower's avatar
batterseapower committed
882
-- | Should the 'DataCon' be presented infix?
883 884 885
dataConIsInfix :: DataCon -> Bool
dataConIsInfix = dcInfix

batterseapower's avatar
batterseapower committed
886
-- | The universally-quantified type variables of the constructor
887
dataConUnivTyVars :: DataCon -> [TyVar]
888
dataConUnivTyVars (MkData { dcUnivTyVars = tvbs }) = binderVars tvbs
889

890
-- | 'TyBinder's for the universally-quantified type variables