DataCon.hs 49.8 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, 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,
33 34 35
        dataConUnivTyVars, dataConUnivTyBinders,
        dataConExTyVars, dataConExTyBinders,
        dataConAllTyVars,
36
        dataConEqSpec, dataConTheta,
Edward Z. Yang's avatar
Edward Z. Yang committed
37 38 39 40
        dataConStupidTheta,
        dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
        dataConInstOrigArgTys, dataConRepArgTys,
        dataConFieldLabels, dataConFieldType,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
41
        dataConSrcBangs,
Edward Z. Yang's avatar
Edward Z. Yang committed
42 43
        dataConSourceArity, dataConRepArity, dataConRepRepArity,
        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 52
        -- ** Predicates on DataCons
        isNullarySrcDataCon, isNullaryRepDataCon, isTupleDataCon, isUnboxedTupleCon,
        isVanillaDataCon, classDataCon, dataConCannotMatch,
53
        isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked,
54
        specialPromotedDc, isLegacyPromotableDataCon, isLegacyPromotableTyCon,
55

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

#include "HsVersions.h"

62
import {-# SOURCE #-} MkId( DataConBoxer )
Simon Marlow's avatar
Simon Marlow committed
63
import Type
64
import ForeignCall ( CType )
65
import Coercion
66
import Unify
Simon Marlow's avatar
Simon Marlow committed
67
import TyCon
Adam Gundry's avatar
Adam Gundry committed
68
import FieldLabel
Simon Marlow's avatar
Simon Marlow committed
69 70
import Class
import Name
71 72
import PrelNames
import NameEnv
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

82
import qualified Data.Data as Data
83
import qualified Data.Typeable
84 85
import Data.Char
import Data.Word
Adam Gundry's avatar
Adam Gundry committed
86
import Data.List( mapAccumL, find )
87

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

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

Using the strictness annotations, GHC will represent this as

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

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

Edward Z. Yang's avatar
Edward Z. Yang committed
101
        T e1 e2
102 103 104

is translated to

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

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
112
        case e of { T a b -> ... }
113 114 115

becomes

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

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


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

Edward Z. Yang's avatar
Edward Z. Yang committed
126
                   OccName   Name space   Name of   Notes
127
 ---------------------------------------------------------------------------
Edward Z. Yang's avatar
Edward Z. Yang committed
128 129 130
 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
131
 The "newtype coercion"  :CoT  TcClsName  TyCon
Edward Z. Yang's avatar
Edward Z. Yang committed
132

133 134 135 136 137
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
138 139 140 141 142 143
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:

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

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

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

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

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

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

Edward Z. Yang's avatar
Edward Z. Yang committed
164
* It is an ordinary function, and it gets a top-level binding
165 166 167 168
  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
169
        \$wC = C
170

171 172
Note [The need for a wrapper]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
173 174 175
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
176 177 178 179
        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
180
  just one.  That is, the worker has type
Edward Z. Yang's avatar
Edward Z. Yang committed
181
                MkT :: Int -> Int -> T
182 183

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

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

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

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


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

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

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
209 210
        T1 :: (Eq a, Ord b) => a -> b -> T a b
        T2 :: (Eq a) => a -> T a b
211 212 213 214 215

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
216
        f (T2 x) = x
217
gets inferred type
Edward Z. Yang's avatar
Edward Z. Yang committed
218
        f :: Eq a => T a b -> a
219 220 221 222 223

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
224 225 226 227 228
        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).
229

Edward Z. Yang's avatar
Edward Z. Yang committed
230 231 232
        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.
233

Edward Z. Yang's avatar
Edward Z. Yang committed
234 235 236 237 238 239
        [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.]
240

241 242
[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
243
        C :: forall a. Ord a => a -> a -> T (Foo a)
244
Does the C constructor in Core contain the Ord dictionary?  Yes, it must:
245

Edward Z. Yang's avatar
Edward Z. Yang committed
246 247 248 249
        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
250

251
Note that (Foo a) might not be an instance of Ord.
252

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

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

-- For details on above see note [Api annotations] in ApiAnnotation
266
data DataCon
267
  = MkData {
Edward Z. Yang's avatar
Edward Z. Yang committed
268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292
        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

293
        -- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
Simon Peyton Jones's avatar
Simon Peyton Jones committed
294 295 296
        -- 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.)
297

Edward Z. Yang's avatar
Edward Z. Yang committed
298 299 300 301 302 303 304 305 306 307
        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)

308
        -- Universally-quantified type vars [a,b,c]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
309 310
        -- INVARIANT: length matches arity of the dcRepTyCon
        -- INVARIANT: result type of data con worker is exactly (T a b c)
311 312 313 314 315 316 317 318
        dcUnivTyVars    :: [TyVar],     -- Two linked fields
        dcUnivTyBinders :: [TyBinder],  -- see Note [TyBinders in DataCons]


        -- Existentially-quantified type vars [x,y]
        dcExTyVars     :: [TyVar],     -- Two linked fields
        dcExTyBinders  :: [TyBinder],  -- see Note [TyBinders in DataCons]

319

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

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

Edward Z. Yang's avatar
Edward Z. Yang committed
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 364 365
                -- 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
366
        dcSrcBangs :: [HsSrcBang],
Simon Peyton Jones's avatar
Simon Peyton Jones committed
367
                -- See Note [Bangs on data constructor arguments]
368 369
                --
                -- The [HsSrcBang] as written by the programmer.
370
                --
Edward Z. Yang's avatar
Edward Z. Yang committed
371 372 373 374 375 376 377 378 379 380 381 382 383 384
                -- 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
385
        dcRep      :: DataConRep,
386

387
        -- Cached
388 389 390 391
          -- dcRepArity == length dataConRepArgTys
        dcRepArity    :: Arity,
          -- dcSourceArity == length dcOrigArgTys
        dcSourceArity :: Arity,
392

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

Edward Z. Yang's avatar
Edward Z. Yang committed
396 397
        dcRepType   :: Type,    -- Type of the constructor
                                --      forall a x y. (a~(x,y), x~y, Ord x) =>
398
                                --        x -> y -> T a
Edward Z. Yang's avatar
Edward Z. Yang committed
399 400 401 402 403
                                -- (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
404
        --        MkT x y co1 co2 (d:Ord x) (v:r) (w:F s) -> ...
Edward Z. Yang's avatar
Edward Z. Yang committed
405 406 407 408
        -- 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.
409 410


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

415 416
        dcPromoted :: TyCon    -- The promoted TyCon
                               -- See Note [Promoted data constructors] in TyCon
417
  }
418
  deriving Data.Typeable.Typeable
419

420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441

{- Note [TyBinders in DataCons]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DataCons and PatSyns store their universal and existential type
variables in a pair of fields, e.g.
        dcUnivTyVars    :: [TyVar],
        dcUnivTyBinders :: [TyBinder],
and similarly dcExTyVars/dcExTyVarBinders

Of these, the former is always redundant:
  dcUnivTyVars = [ tv | Named tv _ <- dcUnivTyBinders ]

Specifically:

 * The two fields correspond 1-1

 * Each TyBinder a Named (no Anons)

 * The TyVar in each TyBinder is the same as the TyVar in
   the corresponding tyvar in the TyVars list.

 * Each Visibilty flag (va, vb, etc) is Invisible or Specified.
Simon Peyton Jones's avatar
Simon Peyton Jones committed
442 443
   None are Visible. (A DataCon is a term-level function; see
   Note [No Visible TyBinder in terms] in TyCoRep.)
444 445 446 447 448 449 450 451 452 453 454

Why store these fields redundantly?  Purely convenience.  In most
places in GHC, it's just the TyVars that are needed, so that's what's
returned from, say, dataConFullSig.

Why do we need the TyBinders?  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.
-}

Edward Z. Yang's avatar
Edward Z. Yang committed
455
data DataConRep
456 457
  = NoDataConRep              -- No wrapper

Edward Z. Yang's avatar
Edward Z. Yang committed
458
  | DCR { dcr_wrap_id :: Id   -- Takes src args, unboxes/flattens,
459 460 461 462
                              -- and constructs the representation

        , dcr_boxer   :: DataConBoxer

Edward Z. Yang's avatar
Edward Z. Yang committed
463
        , dcr_arg_tys :: [Type]  -- Final, representation argument types,
464 465 466 467
                                 -- after unboxing and flattening,
                                 -- and *including* all evidence args

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

Simon Peyton Jones's avatar
Simon Peyton Jones committed
470 471 472
        , 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]
473

474 475 476
    }
-- 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
477
-- the wrapper does anything.
478 479 480 481 482 483 484 485 486 487 488 489 490 491 492
--
-- 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
493
--              f (:) x
494 495 496 497 498 499
-- 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.)

500 501
-------------------------

502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522
-- | Bangs on data constructor arguments as the user wrote them in the
-- source code.
--
-- (HsSrcBang _ SrcUnpack SrcLazy) and
-- (HsSrcBang _ SrcUnpack NoSrcStrict) (without StrictData) makes no sense, we
-- emit a warning (in checkValidDataCon) and treat it like
-- (HsSrcBang _ NoSrcUnpack SrcLazy)
data HsSrcBang =
  HsSrcBang (Maybe SourceText) -- Note [Pragma source text] in BasicTypes
            SrcUnpackedness
            SrcStrictness
  deriving (Data.Data, Data.Typeable)

-- | Bangs of data constructor arguments as generated by the compiler
-- 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
523 524
  deriving (Data.Data, Data.Typeable)

525 526 527
-- | What strictness annotation the user wrote
data SrcStrictness = SrcLazy -- ^ Lazy, ie '~'
                   | SrcStrict -- ^ Strict, ie '!'
528
                   | NoSrcStrict -- ^ no strictness annotation
529 530 531 532 533 534 535 536 537
     deriving (Eq, Data.Data, Data.Typeable)

-- | What unpackedness the user requested
data SrcUnpackedness = SrcUnpack -- ^ {-# UNPACK #-} specified
                     | SrcNoUnpack -- ^ {-# NOUNPACK #-} specified
                     | NoSrcUnpack -- ^ no unpack pragma
     deriving (Eq, Data.Data, Data.Typeable)


Simon Peyton Jones's avatar
Simon Peyton Jones committed
538

539
-------------------------
Edward Z. Yang's avatar
Edward Z. Yang committed
540
-- StrictnessMark is internal only, used to indicate strictness
541
-- of the DataCon *worker* fields
Edward Z. Yang's avatar
Edward Z. Yang committed
542
data StrictnessMark = MarkedStrict | NotMarkedStrict
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 569 570 571 572 573 574
-- | 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)

575 576 577 578 579 580 581 582
-- | Filter out any TyBinders mentioned in an EqSpec
filterEqSpec :: [EqSpec] -> [TyBinder] -> [TyBinder]
filterEqSpec eq_spec
  = filter not_in_eq_spec
  where
    not_in_eq_spec bndr = let var = binderVar "filterEqSpec" bndr in
                          all (not . (== var) . eqSpecTyVar) eq_spec

583 584 585
instance Outputable EqSpec where
  ppr (EqSpec tv ty) = ppr (tv, ty)

Simon Peyton Jones's avatar
Simon Peyton Jones committed
586 587 588 589 590 591 592
{- 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
593
flags like -funbox-small-strict-fields.
Simon Peyton Jones's avatar
Simon Peyton Jones committed
594 595 596

Terminology:
  * HsSrcBang:  What the user wrote
597
                Constructors: HsSrcBang
Simon Peyton Jones's avatar
Simon Peyton Jones committed
598 599

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

602
* If T was defined in this module, MkT's dcSrcBangs field
Simon Peyton Jones's avatar
Simon Peyton Jones committed
603
  records the [HsSrcBang] of what the user wrote; in the example
604 605 606
    [ HsSrcBang _ NoSrcUnpack SrcStrict
    , HsSrcBang _ SrcUnpack SrcStrict
    , HsSrcBang _ NoSrcUnpack NoSrcStrictness]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
607

608 609 610 611
* 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
612 613 614

* 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
615
    [HsStrict, HsStrict, HsLazy]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
616
  With -O it might be
617
    [HsStrict, HsUnpack _, HsLazy]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
618
  With -funbox-small-strict-fields it might be
619 620 621
    [HsUnpack, HsUnpack _, HsLazy]
  With -XStrictData it might be
    [HsStrict, HsUnpack _, HsStrict]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
622

623 624
Note [Data con representation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
625
The dcRepType field contains the type of the representation of a contructor
626
This may differ from the type of the constructor *Id* (built
627
by MkId.mkDataConId) for two reasons:
Edward Z. Yang's avatar
Edward Z. Yang committed
628 629
        a) the constructor Id may be overloaded, but the dictionary isn't stored
           e.g.    data Eq a => T a = MkT a a
630

Edward Z. Yang's avatar
Edward Z. Yang committed
631
        b) the constructor may store an unboxed version of a strict field.
632 633

Here's an example illustrating both:
Edward Z. Yang's avatar
Edward Z. Yang committed
634
        data Ord a => T a = MkT Int! a
635
Here
Edward Z. Yang's avatar
Edward Z. Yang committed
636
        T :: Ord a => Int -> a -> T a
637
but the rep type is
Edward Z. Yang's avatar
Edward Z. Yang committed
638
        Trep :: Int# -> a -> T a
639 640
Actually, the unboxed part isn't implemented yet!

641

642

Austin Seipp's avatar
Austin Seipp committed
643 644
************************************************************************
*                                                                      *
645
\subsection{Instances}
Austin Seipp's avatar
Austin Seipp committed
646 647 648
*                                                                      *
************************************************************************
-}
649

650 651 652 653 654 655
instance Eq DataCon where
    a == b = getUnique a == getUnique b
    a /= b = getUnique a /= getUnique b

instance Ord DataCon where
    a <= b = getUnique a <= getUnique b
Edward Z. Yang's avatar
Edward Z. Yang committed
656
    a <  b = getUnique a <  getUnique b
657
    a >= b = getUnique a >= getUnique b
Edward Z. Yang's avatar
Edward Z. Yang committed
658
    a >  b = getUnique a > getUnique b
659 660 661 662 663 664 665 666 667 668 669
    compare a b = getUnique a `compare` getUnique b

instance Uniquable DataCon where
    getUnique = dcUnique

instance NamedThing DataCon where
    getName = dcName

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

670 671 672 673
instance OutputableBndr DataCon where
    pprInfixOcc con = pprInfixName (dataConName con)
    pprPrefixOcc con = pprPrefixName (dataConName con)

674 675 676 677 678
instance Data.Data DataCon where
    -- don't traverse?
    toConstr _   = abstractConstr "DataCon"
    gunfold _ _  = error "gunfold"
    dataTypeOf _ = mkNoRepType "DataCon"
679

680
instance Outputable HsSrcBang where
681
    ppr (HsSrcBang _ prag mark) = ppr prag <+> ppr mark
682 683

instance Outputable HsImplBang where
684 685 686 687
    ppr HsLazy                  = text "Lazy"
    ppr (HsUnpack Nothing)      = text "Unpacked"
    ppr (HsUnpack (Just co))    = text "Unpacked" <> parens (ppr co)
    ppr HsStrict                = text "StrictNotUnpacked"
688 689

instance Outputable SrcStrictness where
690 691 692
    ppr SrcLazy     = char '~'
    ppr SrcStrict   = char '!'
    ppr NoSrcStrict = empty
693 694

instance Outputable SrcUnpackedness where
695 696
    ppr SrcUnpack   = text "{-# UNPACK #-}"
    ppr SrcNoUnpack = text "{-# NOUNPACK #-}"
697
    ppr NoSrcUnpack = empty
698 699

instance Outputable StrictnessMark where
700
    ppr MarkedStrict    = text "!"
701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725
    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
           1 -> return SrcLazy
           _ -> 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
726

727
-- | Compare strictness annotations
728
eqHsBang :: HsImplBang -> HsImplBang -> Bool
729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747
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
748 749 750 751

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

753
{- *********************************************************************
Austin Seipp's avatar
Austin Seipp committed
754
*                                                                      *
755
\subsection{Construction}
Austin Seipp's avatar
Austin Seipp committed
756
*                                                                      *
757
********************************************************************* -}
758

batterseapower's avatar
batterseapower committed
759
-- | Build a new data constructor
Edward Z. Yang's avatar
Edward Z. Yang committed
760
mkDataCon :: Name
761
          -> Bool           -- ^ Is the constructor declared infix?
762
          -> TyConRepName   -- ^  TyConRepName for the promoted TyCon
763
          -> [HsSrcBang]    -- ^ Strictness/unpack annotations, from user
764 765
          -> [FieldLabel]   -- ^ Field labels for the constructor,
                            -- if it is a record, otherwise empty
766 767 768
          -> [TyVar] -> [TyBinder]  -- ^ Universals. See Note [TyBinders in DataCons]
          -> [TyVar] -> [TyBinder]  -- ^ Existentials.
                            -- (These last two must be Named and Invisible/Specified)
769
          -> [EqSpec]       -- ^ GADT equalities
770 771 772
          -> ThetaType      -- ^ Theta-type occuring before the arguments proper
          -> [Type]         -- ^ Original argument types
          -> Type           -- ^ Original result type
773
          -> RuntimeRepInfo -- ^ See comments on 'TyCon.RuntimeRepInfo'
774 775 776 777 778
          -> 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
779
          -> DataCon
780 781
  -- Can get the tag from the TyCon

782
mkDataCon name declared_infix prom_info
Edward Z. Yang's avatar
Edward Z. Yang committed
783 784
          arg_stricts   -- Must match orig_arg_tys 1-1
          fields
785
          univ_tvs univ_bndrs ex_tvs ex_bndrs
Edward Z. Yang's avatar
Edward Z. Yang committed
786
          eq_spec theta
787
          orig_arg_tys orig_res_ty rep_info rep_tycon
Edward Z. Yang's avatar
Edward Z. Yang committed
788 789
          stupid_theta work_id rep
-- Warning: mkDataCon is not a good place to check invariants.
790
-- If the programmer writes the wrong result type in the decl, thus:
Edward Z. Yang's avatar
Edward Z. Yang committed
791
--      data T a where { MkT :: S }
792 793 794 795 796
-- 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.

797
  = con
798
  where
799
    is_vanilla = null ex_tvs && null eq_spec && null theta
Edward Z. Yang's avatar
Edward Z. Yang committed
800 801
    con = MkData {dcName = name, dcUnique = nameUnique name,
                  dcVanilla = is_vanilla, dcInfix = declared_infix,
802 803
                  dcUnivTyVars = univ_tvs, dcUnivTyBinders = univ_bndrs,
                  dcExTyVars = ex_tvs, dcExTyBinders = ex_bndrs,
Edward Z. Yang's avatar
Edward Z. Yang committed
804 805 806 807 808
                  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
809
                  dcSrcBangs = arg_stricts,
Edward Z. Yang's avatar
Edward Z. Yang committed
810 811 812
                  dcFields = fields, dcTag = tag, dcRepType = rep_ty,
                  dcWorkId = work_id,
                  dcRep = rep,
813 814
                  dcSourceArity = length orig_arg_tys,
                  dcRepArity = length rep_arg_tys,
815
                  dcPromoted = promoted }
816

Edward Z. Yang's avatar
Edward Z. Yang committed
817 818 819
        -- The 'arg_stricts' passed to mkDataCon are simply those for the
        -- source-language arguments.  We add extra ones for the
        -- dictionary arguments right here.
820

821
    tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con
822
    rep_arg_tys = dataConRepArgTys con
823 824

    rep_ty = mkForAllTys univ_bndrs $ mkForAllTys ex_bndrs $
Edward Z. Yang's avatar
Edward Z. Yang committed
825 826
             mkFunTys rep_arg_tys $
             mkTyConApp rep_tycon (mkTyVarTys univ_tvs)
827

828
      -- See Note [Promoted data constructors] in TyCon
829 830
    prom_binders = filterEqSpec eq_spec univ_bndrs ++
                   ex_bndrs ++
831 832 833 834 835
                   map mkAnonBinder theta ++
                   map mkAnonBinder orig_arg_tys
    prom_res_kind = orig_res_ty
    promoted
      = mkPromotedDataCon con name prom_info prom_binders prom_res_kind roles rep_info
836

837 838
    roles = map (const Nominal) (univ_tvs ++ ex_tvs) ++
            map (const Representational) orig_arg_tys
839

batterseapower's avatar
batterseapower committed
840
-- | The 'Name' of the 'DataCon', giving it a unique, rooted identification
841 842 843
dataConName :: DataCon -> Name
dataConName = dcName

batterseapower's avatar
batterseapower committed
844
-- | The tag used for ordering 'DataCon's
845 846 847
dataConTag :: DataCon -> ConTag
dataConTag  = dcTag

batterseapower's avatar
batterseapower committed
848
-- | The type constructor that we are building via this data constructor
849
dataConTyCon :: DataCon -> TyCon
850
dataConTyCon = dcRepTyCon
851

852 853 854 855
-- | 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
856
dataConOrigTyCon dc
857 858 859
  | Just (tc, _) <- tyConFamInst_maybe (dcRepTyCon dc) = tc
  | otherwise                                          = dcRepTyCon dc

batterseapower's avatar
batterseapower committed
860 861
-- | The representation type of the data constructor, i.e. the sort
-- type that will represent values of this type at runtime
862 863
dataConRepType :: DataCon -> Type
dataConRepType = dcRepType
864

batterseapower's avatar
batterseapower committed
865
-- | Should the 'DataCon' be presented infix?
866 867 868
dataConIsInfix :: DataCon -> Bool
dataConIsInfix = dcInfix

batterseapower's avatar
batterseapower committed
869
-- | The universally-quantified type variables of the constructor
870 871 872
dataConUnivTyVars :: DataCon -> [TyVar]
dataConUnivTyVars = dcUnivTyVars

873 874 875 876
-- | 'TyBinder's for the universally-quantified type variables
dataConUnivTyBinders :: DataCon -> [TyBinder]
dataConUnivTyBinders = dcUnivTyBinders

batterseapower's avatar
batterseapower committed
877
-- | The existentially-quantified type variables of the constructor
878 879 880
dataConExTyVars :: DataCon -> [TyVar]
dataConExTyVars = dcExTyVars

881 882 883 884
-- | 'TyBinder's for the existentially-quantified type variables
dataConExTyBinders :: DataCon -> [TyBinder]
dataConExTyBinders = dcExTyBinders

batterseapower's avatar
batterseapower committed
885
-- | Both the universal and existentiatial type variables of the constructor
886 887 888 889
dataConAllTyVars :: DataCon -> [TyVar]
dataConAllTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
  = univ_tvs ++ ex_tvs

batterseapower's avatar
batterseapower committed
890
-- | Equalities derived from the result type of the data constructor, as written
891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914
-- by the programmer in any GADT declaration. This includes *all* GADT-like
-- equalities, including those written in by hand by the programmer.
dataConEqSpec :: DataCon -> [EqSpec]
dataConEqSpec (MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })
  = eq_spec ++
    [ spec   -- heterogeneous equality
    | Just (tc, [_k1, _k2, ty1, ty2]) <- map splitTyConApp_maybe theta
    , tc `hasKey` heqTyConKey
    , spec <- case (getTyVar_maybe ty1, getTyVar_maybe ty2) of
                    (Just tv1, _) -> [mkEqSpec tv1 ty2]
                    (_, Just tv2) -> [mkEqSpec tv2 ty1]
                    _             -> []
    ] ++
    [ spec   -- homogeneous equality
    | Just (tc, [_k, ty1, ty2]) <- map splitTyConApp_maybe theta
    , tc `hasKey` eqTyConKey
    , spec <- case (getTyVar_maybe ty1, getTyVar_maybe ty2) of
                    (Just tv1, _) -> [mkEqSpec tv1 ty2]
                    (_, Just tv2) -> [mkEqSpec tv2 ty1]
                    _             -> []
    ]


-- | The *full* constraints on the constructor type.
915
dataConTheta :: DataCon -> ThetaType
Edward Z. Yang's avatar
Edward Z. Yang committed
916
dataConTheta (MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })
917
  = eqSpecPreds eq_spec ++ theta
918

batterseapower's avatar
batterseapower committed
919 920 921 922
-- | Get the Id of the 'DataCon' worker: a function that is the "actual"
-- constructor and has no top level binding in the program. The type may
-- be different from the obvious one written in the source program. Panics
-- if there is no such 'Id' for this 'DataCon'
923
dataConWorkId :: DataCon -> Id
924
dataConWorkId dc = dcWorkId dc
925

batterseapower's avatar
batterseapower committed
926 927
-- | Get the Id of the 'DataCon' wrapper: a function that wraps the "actual"
-- constructor so it has the type visible in the source program: c.f. 'dataConWorkId'.
Edward Z. Yang's avatar
Edward Z. Yang committed
928
-- Returns Nothing if there is no wrapper, which occurs for an algebraic data constructor
batterseapower's avatar
batterseapower committed
929
-- and also for a newtype (whose constructor is inlined compulsorily)
930
dataConWrapId_maybe :: DataCon -> Maybe Id
931 932 933
dataConWrapId_maybe dc = case dcRep dc of
                           NoDataConRep -> Nothing
                           DCR { dcr_wrap_id = wrap_id } -> Just wrap_id
934

batterseapower's avatar
batterseapower committed
935 936 937
-- | Returns an Id which looks like the Haskell-source constructor by using
-- the wrapper if it exists (see 'dataConWrapId_maybe') and failing over to
-- the worker (see 'dataConWorkId')
938
dataConWrapId :: DataCon -> Id
939 940 941
dataConWrapId dc = case dcRep dc of
                     NoDataConRep-> dcWorkId dc    -- worker=wrapper
                     DCR { dcr_wrap_id = wrap_id } -> wrap_id
942

batterseapower's avatar
batterseapower committed
943 944
-- | Find all the 'Id's implicitly brought into scope by the data constructor. Currently,
-- the union of the 'dataConWorkId' and the 'dataConWrapId'
945 946 947 948 949 950 951
dataConImplicitTyThings :: DataCon -> [TyThing]
dataConImplicitTyThings (MkData { dcWorkId = work, dcRep = rep })
  = [AnId work] ++ wrap_ids
  where
    wrap_ids = case rep of
                 NoDataConRep               -> []
                 DCR { dcr_wrap_id = wrap } -> [AnId wrap]
952

batterseapower's avatar
batterseapower committed
953
-- | The labels for the fields of this particular 'DataCon'
954 955 956
dataConFieldLabels :: DataCon -> [FieldLabel]
dataConFieldLabels = dcFields

batterseapower's avatar
batterseapower committed
957
-- | Extract the type for any given labelled field of the 'DataCon'
Adam Gundry's avatar
Adam Gundry committed
958
dataConFieldType :: DataCon -> FieldLabelString -> Type
959
dataConFieldType con label
Adam Gundry's avatar
Adam Gundry committed
960 961
  = case find ((== label) . flLabel . fst) (dcFields con `zip` dcOrigArgTys con) of
      Just (_, ty) -> ty
962
      Nothing -> pprPanic "dataConFieldType" (ppr con <+> ppr label)
963

964 965
-- | Strictness/unpack annotations, from user; or, for imported
-- DataCons, from the interface file
Simon Peyton Jones's avatar
Simon Peyton Jones committed
966
-- The list is in one-to-one correspondence with the arity of the 'DataCon'
967

Simon Peyton Jones's avatar
Simon Peyton Jones committed
968 969
dataConSrcBangs :: DataCon -> [HsSrcBang]
dataConSrcBangs = dcSrcBangs
970

batterseapower's avatar
batterseapower committed
971
-- | Source-level arity of the data constructor
972
dataConSourceArity :: DataCon -> Arity
973
dataConSourceArity (MkData { dcSourceArity = arity }) = arity
974

Edward Z. Yang's avatar
Edward Z. Yang committed
975
-- | Gives the number of actual fields in the /representation/ of the
batterseapower's avatar
batterseapower committed
976 977
-- data constructor. This may be more than appear in the source code;
-- the extra ones are the existentially quantified dictionaries
978
dataConRepArity :: DataCon -> Arity
979 980
dataConRepArity (MkData { dcRepArity = arity }) = arity

981

982 983 984 985 986
-- | The number of fields in the /representation/ of the constructor
-- AFTER taking into account the unpacking of any unboxed tuple fields
dataConRepRepArity :: DataCon -> RepArity
dataConRepRepArity dc = typeRepArity (dataConRepArity dc) (dataConRepType dc)

batterseapower's avatar
batterseapower committed
987 988
-- | Return whether there are any argument types for this 'DataCon's original source type
isNullarySrcDataCon :: DataCon -> Bool
989
isNullarySrcDataCon dc = null (dcOrigArgTys dc)
batterseapower's avatar
batterseapower committed
990 991 992

-- | Return whether there are any argument types for this 'DataCon's runtime representation type
isNullaryRepDataCon :: DataCon -> Bool
993
isNullaryRepDataCon dc = dataConRepArity dc == 0
994

995
dataConRepStrictness :: DataCon -> [StrictnessMark]
batterseapower's avatar
batterseapower committed
996 997
-- ^ Give the demands on the arguments of a
-- Core constructor application (Con dc args)
998 999 1000 1001
dataConRepStrictness dc = case dcRep dc of
                            NoDataConRep -> [NotMarkedStrict | _ <- dataConRepArgTys dc]
                            DCR { dcr_stricts = strs } -> strs

Simon Peyton Jones's avatar
Simon Peyton Jones committed
1002 1003 1004
dataConImplBangs :: DataCon -> [HsImplBang]
-- The implementation decisions about the strictness/unpack of each
-- source program argument to the data constructor
1005 1006
dataConImplBangs dc
  = case dcRep dc of
1007
      NoDataConRep              -> replicate (dcSourceArity dc) HsLazy
1008
      DCR { dcr_bangs = bangs } -> bangs