DataCon.lhs 34.9 KB
Newer Older
1
%
Simon Marlow's avatar
Simon Marlow committed
2
% (c) The University of Glasgow 2006
3 4
% (c) The GRASP/AQUA Project, Glasgow University, 1998
%
5
\section[DataCon]{@DataCon@: Data Constructors}
6 7

\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
8 9 10 11 12 13 14
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details

15
module DataCon (
batterseapower's avatar
batterseapower committed
16
        -- * Main data types
17
	DataCon, DataConIds(..),
batterseapower's avatar
batterseapower committed
18 19 20 21 22 23
	ConTag,
	
	-- ** Type construction
	mkDataCon, fIRST_TAG,
	
	-- ** Type deconstruction
24
	dataConRepType, dataConSig, dataConFullSig,
25 26
	dataConName, dataConIdentity, dataConTag, dataConTyCon, 
        dataConOrigTyCon, dataConUserType,
27
	dataConUnivTyVars, dataConExTyVars, dataConAllTyVars, 
28
	dataConEqSpec, eqSpecPreds, dataConTheta,
29
	dataConStupidTheta,  
30
	dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
31
	dataConInstOrigArgTys, dataConRepArgTys, 
32 33
	dataConFieldLabels, dataConFieldType,
	dataConStrictMarks, dataConExStricts,
34
	dataConSourceArity, dataConRepArity,
35
	dataConIsInfix,
36
	dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds,
37
	dataConRepStrictness,
batterseapower's avatar
batterseapower committed
38 39
	
	-- ** Predicates on DataCons
40
	isNullarySrcDataCon, isNullaryRepDataCon, isTupleCon, isUnboxedTupleCon,
41
	isVanillaDataCon, classDataCon, dataConCannotMatch,
42

batterseapower's avatar
batterseapower committed
43
        -- * Splitting product types
44 45
	splitProductType_maybe, splitProductType, deepSplitProductType,
        deepSplitProductType_maybe
46 47 48 49
    ) where

#include "HsVersions.h"

Simon Marlow's avatar
Simon Marlow committed
50
import Type
51
import Unify
Simon Marlow's avatar
Simon Marlow committed
52 53 54 55 56
import Coercion
import TyCon
import Class
import Name
import Var
57
import Outputable
Simon Marlow's avatar
Simon Marlow committed
58 59 60
import Unique
import ListSetOps
import Util
batterseapower's avatar
batterseapower committed
61
import BasicTypes
62
import FastString
63 64
import Module

65
import qualified Data.Data as Data
66
import qualified Data.Typeable
67 68
import Data.Char
import Data.Word
69 70 71
\end{code}


72 73 74
Data constructor representation
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider the following Haskell data type declaration
75

76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106
	data T = T !Int ![Int]

Using the strictness annotations, GHC will represent this as

	data T = T Int# [Int]

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

	T e1 e2

is translated to

	case e1 of { I# x -> 
	case e2 of { r ->
	T x r }}

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

	case e of { T a b -> ... }

becomes

	case e of { T a' b -> let a = I# a' in ... }

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


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

109 110 111 112 113 114
		   OccName   Name space	  Name of   Notes
 ---------------------------------------------------------------------------
 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
 The "newtype coercion"  :CoT  TcClsName  TyCon
115 116 117 118 119 120
 
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
121 122 123 124 125 126
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:

127 128
The "worker Id", is the actual data constructor.
* Every data constructor (newtype or data type) has a worker
129

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

132 133
* For a *data* type, the worker *is* the data constructor;
  it has no unfolding
134

135 136 137 138
* For a *newtype*, the worker has a compulsory unfolding which 
  does a cast, e.g.
	newtype T = MkT Int
	The worker for MkT has unfolding
batterseapower's avatar
batterseapower committed
139
		\\(x:Int). x `cast` sym CoT
140 141
  Here CoT is the type constructor, witnessing the FC axiom
	axiom CoT : T = Int
142

batterseapower's avatar
batterseapower committed
143
The "wrapper Id", \$WC, goes as follows
144 145 146 147 148 149 150 151

* Its type is exactly what it looks like in the source program. 

* It is an ordinary function, and it gets a top-level binding 
  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
batterseapower's avatar
batterseapower committed
152
	\$wC = C
153

154 155
Note [The need for a wrapper]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
156 157 158 159
Why might the wrapper have anything to do?  Two reasons:

* Unboxing strict fields (with -funbox-strict-fields)
	data T = MkT !(Int,Int)
batterseapower's avatar
batterseapower committed
160 161
	\$wMkT :: (Int,Int) -> T
	\$wMkT (x,y) = MkT x y
162 163 164 165 166 167 168 169 170 171 172 173
  Notice that the worker has two fields where the wapper has 
  just one.  That is, the worker has type
		MkT :: Int -> Int -> T

* Equality constraints for GADTs
	data T a where { MkT :: a -> T [a] }

  The worker gets a type with explicit equality
  constraints, thus:
	MkT :: forall a b. (a=[b]) => b -> T a

  The wrapper has the programmer-specified type:
batterseapower's avatar
batterseapower committed
174 175
	\$wMkT :: a -> T [a]
	\$wMkT a x = MkT [a] a [a] x
176
  The third argument is a coerion
177
	[a] :: [a]~[a]
178

179 180
INVARIANT: the dictionary constructor for a class
	   never has a wrapper.
181 182


183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206
A note about the stupid context
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Data types can have a context:
	
	data (Eq a, Ord b) => T a b = T1 a b | T2 a

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

	T1 :: (Eq a, Ord b) => a -> b -> T a b
	T2 :: (Eq a) => a -> T a b

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):

	f (T2 x) = x
gets inferred type
	f :: Eq a => T a b -> a

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.

207 208 209 210 211 212 213 214 215
	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).

	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.
216

217 218 219 220 221 222
	[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.]
223

224 225 226 227
[July 04] With the advent of generalised data types, it's less obvious
what the "stupid context" is.  Consider
	C :: forall a. Ord a => a -> a -> T (Foo a)
Does the C constructor in Core contain the Ord dictionary?  Yes, it must:
228

229 230 231 232
	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
233

234
Note that (Foo a) might not be an instance of Ord.
235

236 237 238 239 240 241 242
%************************************************************************
%*									*
\subsection{Data constructors}
%*									*
%************************************************************************

\begin{code}
batterseapower's avatar
batterseapower committed
243
-- | A data constructor
244
data DataCon
245
  = MkData {
246 247
	dcName    :: Name,	-- This is the name of the *source data con*
				-- (see "Note [Data Constructor Naming]" above)
248
	dcUnique :: Unique, 	-- Cached from Name
batterseapower's avatar
batterseapower committed
249
	dcTag    :: ConTag,     -- ^ Tag, used for ordering 'DataCon's
250 251 252

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

257 258
	-- 	*** As represented internally
	--  data T a where
259
	--    MkT :: forall a. forall x y. (a~(x,y),x~y,Ord x) => x -> y -> T a
260
	-- 
261 262 263
	-- The next six fields express the type of the constructor, in pieces
	-- e.g.
	--
264 265
	--	dcUnivTyVars  = [a]
	--	dcExTyVars    = [x,y]
266
	--	dcEqSpec      = [a~(x,y)]
267
	--	dcOtherTheta  = [x~y, Ord x]	
268
	--	dcOrigArgTys  = [a,List b]
269
	--	dcRepTyCon       = T
270 271 272 273

	dcVanilla :: Bool,	-- True <=> This is a vanilla Haskell 98 data constructor
				--	    Its type is of form
				--	        forall a1..an . t1 -> ... tm -> T a1..an
274
				-- 	    No existentials, no coercions, nothing.
275
				-- That is: dcExTyVars = dcEqSpec = dcOtherTheta = []
276 277 278 279 280
		-- 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)

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
281
	dcUnivTyVars :: [TyVar],	-- Universally-quantified type vars [a,b,c]
282
					-- INVARIANT: length matches arity of the dcRepTyCon
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
283
					---           result type of (rep) data con is exactly (T a b c)
284

285 286
	dcExTyVars   :: [TyVar],	-- Existentially-quantified type vars 
		-- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
287 288 289 290
		-- FOR THE PARENT TyCon. With GADTs the data con might not even have 
		-- the same number of type variables.
		-- [This is a change (Oct05): previously, vanilla datacons guaranteed to
		--  have the same type variables as their parent TyCon, but that seems ugly.]
291

292 293 294
	-- INVARIANT: the UnivTyVars and ExTyVars all have distinct OccNames
	-- Reason: less confusing, and easier to generate IfaceSyn

295
	dcEqSpec :: [(TyVar,Type)],	-- Equalities derived from the result type, 
Ian Lynagh's avatar
Ian Lynagh committed
296
					-- _as written by the programmer_
297 298
		-- This field allows us to move conveniently between the two ways
		-- of representing a GADT constructor's type:
299
		--	MkT :: forall a b. (a ~ [b]) => b -> T a
300
		--	MkT :: forall b. b -> T [b]
301
		-- Each equality is of the form (a ~ ty), where 'a' is one of 
302 303
		-- the universally quantified type variables
					
304 305 306
		-- The next two fields give the type context of the data constructor
		-- 	(aside from the GADT constraints, 
		--	 which are given by the dcExpSpec)
307 308
		-- In GADT form, this is *exactly* what the programmer writes, even if
		-- the context constrains only universally quantified variables
309
		--	MkT :: forall a b. (a ~ b, Ord b) => a -> T a b
310
	dcOtherTheta :: ThetaType,  -- The other constraints in the data con's type
311
		                    -- other than those in the dcEqSpec
312 313 314 315

	dcStupidTheta :: ThetaType,	-- The context of the data type declaration 
					--	data Eq a => T a = ...
					-- or, rather, a "thinned" version thereof
316 317 318 319
		-- "Thinned", because the Report says
		-- to eliminate any constraints that don't mention
		-- tyvars free in the arg types for this constructor
		--
320 321
		-- INVARIANT: the free tyvars of dcStupidTheta are a subset of dcUnivTyVars
		-- Reason: dcStupidTeta is gotten by thinning the stupid theta from the tycon
322
		-- 
323 324 325 326
		-- "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.
327

328
	dcOrigArgTys :: [Type],		-- Original argument types
329
					-- (before unboxing and flattening of strict fields)
330
	dcOrigResTy :: Type,		-- Original result type, as seen by the user
331 332 333 334
		-- 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
335

336
	-- Now the strictness annotations and field labels of the constructor
337
	dcStrictMarks :: [HsBang],
338 339 340
		-- Strictness annotations as decided by the compiler.  
		-- Does *not* include the existential dictionaries
		-- length = dataConSourceArity dataCon
341 342 343

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

347
	-- Constructor representation
348 349 350
	dcRepArgTys :: [Type],	-- Final, representation argument types, 
				-- after unboxing and flattening,
				-- and *including* all existential evidence args
351

352
	dcRepStrictness :: [StrictnessMark],
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
353
                -- One for each *representation* *value* argument
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
354
		-- See also Note [Data-con worker strictness] in MkId.lhs
355

356 357 358
	-- Result type of constructor is T t1..tn
	dcRepTyCon  :: TyCon,		-- Result tycon, T

359
	dcRepType   :: Type,	-- Type of the constructor
360
				-- 	forall a x y. (a~(x,y), x~y, Ord x) =>
361
                                --        x -> y -> T a
362
				-- (this is *not* of the constructor wrapper Id:
363
				--  see Note [Data con representation] below)
364 365
	-- Notice that the existential type parameters come *second*.  
	-- Reason: in a case expression we may find:
366 367
	--	case (e :: T t) of
        --        MkT x y co1 co2 (d:Ord x) (v:r) (w:F s) -> ...
368
	-- It's convenient to apply the rep-type of MkT to 't', to get
369
	--	forall x y. (t~(x,y), x~y, Ord x) => x -> y -> T t
370
	-- and use that to check the pattern.  Mind you, this is really only
371
	-- used in CoreLint.
372 373


374
	-- The curried worker function that corresponds to the constructor:
375 376 377 378
	-- It doesn't have an unfolding; the code generator saturates these Ids
	-- and allocates a real constructor when it finds one.
	--
	-- An entirely separate wrapper function is built in TcTyDecls
379 380
	dcIds :: DataConIds,

381
	dcInfix :: Bool		-- True <=> declared infix
382 383
				-- Used for Template Haskell and 'deriving' only
				-- The actual fixity is stored elsewhere
384
  }
385
  deriving Data.Typeable.Typeable
386

batterseapower's avatar
batterseapower committed
387
-- | Contains the Ids of the data constructor functions
388
data DataConIds
389
  = DCIds (Maybe Id) Id 	-- Algebraic data types always have a worker, and
390
				-- may or may not have a wrapper, depending on whether
391
				-- the wrapper does anything.  Newtypes just have a worker
392

393
	-- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments
394 395 396 397 398

	-- The wrapper takes dcOrigArgTys as its arguments
	-- The worker takes dcRepArgTys as its arguments
	-- If the worker is absent, dcRepArgTys is the same as dcOrigArgTys

399
	-- The 'Nothing' case of DCIds is important
400 401
	-- Not only is this efficient,
	-- but it also ensures that the wrapper is replaced
402
	-- by the worker (because it *is* the worker)
403 404 405 406 407 408 409 410
	-- even when there are no args. E.g. in
	-- 		f (:) x
	-- 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.)

batterseapower's avatar
batterseapower committed
411
-- | Type of the tags associated with each constructor possibility
412 413 414
type ConTag = Int

fIRST_TAG :: ConTag
batterseapower's avatar
batterseapower committed
415 416
-- ^ Tags are allocated from here for real constructors
fIRST_TAG =  1
417 418
\end{code}

419 420
Note [Data con representation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
421
The dcRepType field contains the type of the representation of a contructor
422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437
This may differ from the type of the contructor *Id* (built
by MkId.mkDataConId) for two reasons:
	a) the constructor Id may be overloaded, but the dictionary isn't stored
	   e.g.    data Eq a => T a = MkT a a

	b) the constructor may store an unboxed version of a strict field.

Here's an example illustrating both:
	data Ord a => T a = MkT Int! a
Here
	T :: Ord a => Int -> a -> T a
but the rep type is
	Trep :: Int# -> a -> T a
Actually, the unboxed part isn't implemented yet!


438 439 440 441 442 443
%************************************************************************
%*									*
\subsection{Instances}
%*									*
%************************************************************************

444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466
\begin{code}
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
    a <	 b = getUnique a <  getUnique b
    a >= b = getUnique a >= getUnique b
    a >	 b = getUnique a > getUnique b
    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)

instance Show DataCon where
    showsPrec p con = showsPrecSDoc p (ppr con)
467 468 469 470 471 472

instance Data.Data DataCon where
    -- don't traverse?
    toConstr _   = abstractConstr "DataCon"
    gunfold _ _  = error "gunfold"
    dataTypeOf _ = mkNoRepType "DataCon"
473 474
\end{code}

475 476 477

%************************************************************************
%*									*
478
\subsection{Construction}
479 480 481
%*									*
%************************************************************************

482
\begin{code}
batterseapower's avatar
batterseapower committed
483
-- | Build a new data constructor
484
mkDataCon :: Name 
batterseapower's avatar
batterseapower committed
485
	  -> Bool	        -- ^ Is the constructor declared infix?
486
	  -> [HsBang]           -- ^ Strictness annotations written in the source file
487 488
	  -> [FieldLabel]       -- ^ Field labels for the constructor, if it is a record, 
				--   otherwise empty
batterseapower's avatar
batterseapower committed
489 490 491 492
	  -> [TyVar]            -- ^ Universally quantified type variables
	  -> [TyVar]            -- ^ Existentially quantified type variables
	  -> [(TyVar,Type)]     -- ^ GADT equalities
	  -> ThetaType          -- ^ Theta-type occuring before the arguments proper
493 494 495 496 497
	  -> [Type]             -- ^ Original argument types
	  -> Type		-- ^ Original result type
	  -> TyCon              -- ^ Representation type constructor
	  -> ThetaType          -- ^ The "stupid theta", context of the data declaration 
				--   e.g. @data Eq a => T a ...@
batterseapower's avatar
batterseapower committed
498
	  -> DataConIds         -- ^ The Ids of the actual builder functions
499 500 501
	  -> DataCon
  -- Can get the tag from the TyCon

502
mkDataCon name declared_infix
503
	  arg_stricts	-- Must match orig_arg_tys 1-1
504
	  fields
505 506
	  univ_tvs ex_tvs 
	  eq_spec theta
507
	  orig_arg_tys orig_res_ty rep_tycon
508
	  stupid_theta ids
509 510 511 512 513 514 515 516
-- Warning: mkDataCon is not a good place to check invariants. 
-- If the programmer writes the wrong result type in the decl, thus:
--	data T a where { MkT :: S }
-- 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.

517
  = -- ASSERT( not (any isEqPred theta) )
518 519 520
	-- We don't currently allow any equality predicates on
	-- a data constructor (apart from the GADT ones in eq_spec)
    con
521
  where
522
    is_vanilla = null ex_tvs && null eq_spec && null theta
523
    con = MkData {dcName = name, dcUnique = nameUnique name, 
524 525 526
		  dcVanilla = is_vanilla, dcInfix = declared_infix,
	  	  dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, 
		  dcEqSpec = eq_spec, 
527
		  dcOtherTheta = theta,
528
		  dcStupidTheta = stupid_theta, 
529
		  dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty,
530
		  dcRepTyCon = rep_tycon, 
531
		  dcRepArgTys = rep_arg_tys,
532 533
		  dcStrictMarks = arg_stricts, 
		  dcRepStrictness = rep_arg_stricts,
534
		  dcFields = fields, dcTag = tag, dcRepType = ty,
535
		  dcIds = ids }
536

537 538 539
	-- Strictness marks for source-args
	--	*after unboxing choices*, 
	-- but  *including existential dictionaries*
540 541 542 543
	-- 
	-- The 'arg_stricts' passed to mkDataCon are simply those for the
	-- source-language arguments.  We add extra ones for the
	-- dictionary arguments right here.
544
    full_theta   = eqSpecPreds eq_spec ++ theta
batterseapower's avatar
batterseapower committed
545
    real_arg_tys = full_theta                         ++ orig_arg_tys
Simon Peyton Jones's avatar
Simon Peyton Jones committed
546
    real_stricts = map mk_pred_strict_mark full_theta ++ arg_stricts
547 548

	-- Representation arguments and demands
549
	-- To do: eliminate duplication with MkId
550
    (rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
551

552
    tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con
553 554
    ty  = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $ 
	  mkFunTys rep_arg_tys $
555
	  mkTyConApp rep_tycon (mkTyVarTys univ_tvs)
556

557 558
eqSpecPreds :: [(TyVar,Type)] -> ThetaType
eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv, ty) | (tv,ty) <- spec ]
559

Simon Peyton Jones's avatar
Simon Peyton Jones committed
560 561 562 563
mk_pred_strict_mark :: PredType -> HsBang
mk_pred_strict_mark pred 
  | isEqPred pred = HsUnpack	-- Note [Unpack equality predicates]
  | otherwise     = HsNoBang
564 565
\end{code}

Simon Peyton Jones's avatar
Simon Peyton Jones committed
566 567 568 569 570 571 572 573 574
Note [Unpack equality predicates]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If we have a GADT with a contructor C :: (a~[b]) => b -> T a
we definitely want that equality predicate *unboxed* so that it
takes no space at all.  This is easily done: just give it
an UNPACK pragma. The rest of the unpack/repack code does the
heavy lifting.  This one line makes every GADT take a word less
space for each equality predicate, so it's pretty important!

575
\begin{code}
batterseapower's avatar
batterseapower committed
576
-- | The 'Name' of the 'DataCon', giving it a unique, rooted identification
577 578 579
dataConName :: DataCon -> Name
dataConName = dcName

batterseapower's avatar
batterseapower committed
580
-- | The tag used for ordering 'DataCon's
581 582 583
dataConTag :: DataCon -> ConTag
dataConTag  = dcTag

batterseapower's avatar
batterseapower committed
584
-- | The type constructor that we are building via this data constructor
585
dataConTyCon :: DataCon -> TyCon
586
dataConTyCon = dcRepTyCon
587

588 589 590 591 592 593 594 595
-- | 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
dataConOrigTyCon dc 
  | Just (tc, _) <- tyConFamInst_maybe (dcRepTyCon dc) = tc
  | otherwise                                          = dcRepTyCon dc

batterseapower's avatar
batterseapower committed
596 597
-- | The representation type of the data constructor, i.e. the sort
-- type that will represent values of this type at runtime
598 599
dataConRepType :: DataCon -> Type
dataConRepType = dcRepType
600

batterseapower's avatar
batterseapower committed
601
-- | Should the 'DataCon' be presented infix?
602 603 604
dataConIsInfix :: DataCon -> Bool
dataConIsInfix = dcInfix

batterseapower's avatar
batterseapower committed
605
-- | The universally-quantified type variables of the constructor
606 607 608
dataConUnivTyVars :: DataCon -> [TyVar]
dataConUnivTyVars = dcUnivTyVars

batterseapower's avatar
batterseapower committed
609
-- | The existentially-quantified type variables of the constructor
610 611 612
dataConExTyVars :: DataCon -> [TyVar]
dataConExTyVars = dcExTyVars

batterseapower's avatar
batterseapower committed
613
-- | Both the universal and existentiatial type variables of the constructor
614 615 616 617
dataConAllTyVars :: DataCon -> [TyVar]
dataConAllTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
  = univ_tvs ++ ex_tvs

batterseapower's avatar
batterseapower committed
618 619
-- | Equalities derived from the result type of the data constructor, as written
-- by the programmer in any GADT declaration
620 621 622
dataConEqSpec :: DataCon -> [(TyVar,Type)]
dataConEqSpec = dcEqSpec

623 624 625 626
-- | The *full* constraints on the constructor type
dataConTheta :: DataCon -> ThetaType
dataConTheta (MkData { dcEqSpec = eq_spec, dcOtherTheta = theta }) 
  = eqSpecPreds eq_spec ++ theta
627

batterseapower's avatar
batterseapower committed
628 629 630 631
-- | 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'
632
dataConWorkId :: DataCon -> Id
633
dataConWorkId dc = case dcIds dc of
634
			DCIds _ wrk_id -> wrk_id
635

batterseapower's avatar
batterseapower committed
636 637 638 639
-- | 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'.
-- Returns Nothing if there is no wrapper, which occurs for an algebraic data constructor 
-- and also for a newtype (whose constructor is inlined compulsorily)
640
dataConWrapId_maybe :: DataCon -> Maybe Id
641
dataConWrapId_maybe dc = case dcIds dc of
642
				DCIds mb_wrap _ -> mb_wrap
643

batterseapower's avatar
batterseapower committed
644 645 646
-- | 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')
647
dataConWrapId :: DataCon -> Id
648
dataConWrapId dc = case dcIds dc of
649 650
			DCIds (Just wrap) _   -> wrap
			DCIds Nothing     wrk -> wrk	    -- worker=wrapper
651

batterseapower's avatar
batterseapower committed
652 653
-- | Find all the 'Id's implicitly brought into scope by the data constructor. Currently,
-- the union of the 'dataConWorkId' and the 'dataConWrapId'
654 655
dataConImplicitIds :: DataCon -> [Id]
dataConImplicitIds dc = case dcIds dc of
656 657
			  DCIds (Just wrap) work -> [wrap,work]
			  DCIds Nothing     work -> [work]
658

batterseapower's avatar
batterseapower committed
659
-- | The labels for the fields of this particular 'DataCon'
660 661 662
dataConFieldLabels :: DataCon -> [FieldLabel]
dataConFieldLabels = dcFields

batterseapower's avatar
batterseapower committed
663
-- | Extract the type for any given labelled field of the 'DataCon'
664
dataConFieldType :: DataCon -> FieldLabel -> Type
665 666 667 668
dataConFieldType con label
  = case lookup label (dcFields con `zip` dcOrigArgTys con) of
      Just ty -> ty
      Nothing -> pprPanic "dataConFieldType" (ppr con <+> ppr label)
669

batterseapower's avatar
batterseapower committed
670 671
-- | The strictness markings decided on by the compiler.  Does not include those for
-- existential dictionaries.  The list is in one-to-one correspondence with the arity of the 'DataCon'
672
dataConStrictMarks :: DataCon -> [HsBang]
673
dataConStrictMarks = dcStrictMarks
674

675
-- | Strictness of evidence arguments to the wrapper function
676
dataConExStricts :: DataCon -> [HsBang]
677
-- Usually empty, so we don't bother to cache this
Simon Peyton Jones's avatar
Simon Peyton Jones committed
678
dataConExStricts dc = map mk_pred_strict_mark (dataConTheta dc)
679

batterseapower's avatar
batterseapower committed
680
-- | Source-level arity of the data constructor
681
dataConSourceArity :: DataCon -> Arity
682
dataConSourceArity dc = length (dcOrigArgTys dc)
683

batterseapower's avatar
batterseapower committed
684 685 686
-- | Gives the number of actual fields in the /representation/ of the 
-- data constructor. This may be more than appear in the source code;
-- the extra ones are the existentially quantified dictionaries
Simon Marlow's avatar
Simon Marlow committed
687
dataConRepArity :: DataCon -> Int
688 689
dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys

batterseapower's avatar
batterseapower committed
690 691
-- | Return whether there are any argument types for this 'DataCon's original source type
isNullarySrcDataCon :: DataCon -> Bool
692
isNullarySrcDataCon dc = null (dcOrigArgTys dc)
batterseapower's avatar
batterseapower committed
693 694 695

-- | Return whether there are any argument types for this 'DataCon's runtime representation type
isNullaryRepDataCon :: DataCon -> Bool
696
isNullaryRepDataCon dc = null (dcRepArgTys dc)
697

698
dataConRepStrictness :: DataCon -> [StrictnessMark]
batterseapower's avatar
batterseapower committed
699 700
-- ^ Give the demands on the arguments of a
-- Core constructor application (Con dc args)
701
dataConRepStrictness dc = dcRepStrictness dc
702

batterseapower's avatar
batterseapower committed
703 704 705 706 707 708 709 710 711 712
-- | The \"signature\" of the 'DataCon' returns, in order:
--
-- 1) The result of 'dataConAllTyVars',
--
-- 2) All the 'ThetaType's relating to the 'DataCon' (coercion, dictionary, implicit
--    parameter - whatever)
--
-- 3) The type arguments to the constructor
--
-- 4) The /original/ result type of the 'DataCon'
713
dataConSig :: DataCon -> ([TyVar], ThetaType, [Type], Type)
714 715
dataConSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, 
		    dcEqSpec = eq_spec, dcOtherTheta  = theta, 
716
		    dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
717
  = (univ_tvs ++ ex_tvs, eqSpecPreds eq_spec ++ theta, arg_tys, res_ty)
718

batterseapower's avatar
batterseapower committed
719 720 721 722 723 724 725 726 727 728
-- | The \"full signature\" of the 'DataCon' returns, in order:
--
-- 1) The result of 'dataConUnivTyVars'
--
-- 2) The result of 'dataConExTyVars'
--
-- 3) The result of 'dataConEqSpec'
--
-- 4) The result of 'dataConDictTheta'
--
729 730
-- 5) The original argument types to the 'DataCon' (i.e. before 
--    any change of the representation of the type)
batterseapower's avatar
batterseapower committed
731 732
--
-- 6) The original result type of the 'DataCon'
733
dataConFullSig :: DataCon 
734 735 736
	       -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, [Type], Type)
dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, 
			dcEqSpec = eq_spec, dcOtherTheta = theta,
737
			dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
738
  = (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, res_ty)
739 740 741

dataConOrigResTy :: DataCon -> Type
dataConOrigResTy dc = dcOrigResTy dc
742

batterseapower's avatar
batterseapower committed
743 744 745
-- | The \"stupid theta\" of the 'DataCon', such as @data Eq a@ in:
--
-- > data Eq a => T a = ...
746 747 748
dataConStupidTheta :: DataCon -> ThetaType
dataConStupidTheta dc = dcStupidTheta dc

749
dataConUserType :: DataCon -> Type
batterseapower's avatar
batterseapower committed
750 751 752 753 754 755 756
-- ^ The user-declared type of the data constructor
-- in the nice-to-read form:
--
-- > T :: forall a b. a -> b -> T [a]
--
-- rather than:
--
757
-- > T :: forall a c. forall b. (c~[a]) => a -> b -> T c
batterseapower's avatar
batterseapower committed
758
--
759 760
-- NB: If the constructor is part of a data instance, the result type
-- mentions the family tycon, not the internal one.
761 762
dataConUserType  (MkData { dcUnivTyVars = univ_tvs, 
			   dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
763
			   dcOtherTheta = theta, dcOrigArgTys = arg_tys,
764
			   dcOrigResTy = res_ty })
765
  = mkForAllTys ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs) $
batterseapower's avatar
batterseapower committed
766
    mkFunTys theta $
767
    mkFunTys arg_tys $
768
    res_ty
769

batterseapower's avatar
batterseapower committed
770 771 772 773 774
-- | Finds the instantiated types of the arguments required to construct a 'DataCon' representation
-- NB: these INCLUDE any dictionary args
--     but EXCLUDE the data-declaration context, which is discarded
-- It's all post-flattening etc; this is a representation type
dataConInstArgTys :: DataCon	-- ^ A datacon with no existentials or equality constraints
775 776
				-- However, it can have a dcTheta (notably it can be a 
				-- class dictionary, with superclasses)
batterseapower's avatar
batterseapower committed
777 778
	      	  -> [Type] 	-- ^ Instantiated at these types
	      	  -> [Type]
779 780
dataConInstArgTys dc@(MkData {dcRepArgTys = rep_arg_tys, 
			      dcUnivTyVars = univ_tvs, dcEqSpec = eq_spec,
mnislaih's avatar
mnislaih committed
781
			      dcExTyVars = ex_tvs}) inst_tys
782
 = ASSERT2 ( length univ_tvs == length inst_tys 
Ian Lynagh's avatar
Ian Lynagh committed
783
           , ptext (sLit "dataConInstArgTys") <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
784 785 786
   ASSERT2 ( null ex_tvs && null eq_spec, ppr dc )        
   map (substTyWith univ_tvs inst_tys) rep_arg_tys

787 788
-- | Returns just the instantiated /value/ argument types of a 'DataCon',
-- (excluding dictionary args)
789 790 791 792
dataConInstOrigArgTys 
	:: DataCon	-- Works for any DataCon
	-> [Type]	-- Includes existential tyvar args, but NOT
			-- equality constraints or dicts
batterseapower's avatar
batterseapower committed
793
	-> [Type]
794 795
-- For vanilla datacons, it's all quite straightforward
-- But for the call in MatchCon, we really do want just the value args
796
dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
mnislaih's avatar
mnislaih committed
797 798
			          dcUnivTyVars = univ_tvs, 
			          dcExTyVars = ex_tvs}) inst_tys
799
  = ASSERT2( length tyvars == length inst_tys
Ian Lynagh's avatar
Ian Lynagh committed
800
          , ptext (sLit "dataConInstOrigArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
801 802 803
    map (substTyWith tyvars inst_tys) arg_tys
  where
    tyvars = univ_tvs ++ ex_tvs
804 805
\end{code}

806
\begin{code}
batterseapower's avatar
batterseapower committed
807 808
-- | Returns the argument types of the wrapper, excluding all dictionary arguments
-- and without substituting for any type variables
809 810 811
dataConOrigArgTys :: DataCon -> [Type]
dataConOrigArgTys dc = dcOrigArgTys dc

batterseapower's avatar
batterseapower committed
812 813
-- | Returns the arg types of the worker, including all dictionaries, after any 
-- flattening has been done and without substituting for any type variables
814
dataConRepArgTys :: DataCon -> [Type]
815
dataConRepArgTys dc = dcRepArgTys dc
816 817
\end{code}

818
\begin{code}
batterseapower's avatar
batterseapower committed
819 820
-- | The string @package:module.name@ identifying a constructor, which is attached
-- to its info table and used by the GHCi debugger and the heap profiler
821
dataConIdentity :: DataCon -> [Word8]
batterseapower's avatar
batterseapower committed
822
-- We want this string to be UTF-8, so we get the bytes directly from the FastStrings.
823 824 825 826
dataConIdentity dc = bytesFS (packageIdFS (modulePackageId mod)) ++ 
                  fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++
                  fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
  where name = dataConName dc
827
        mod  = ASSERT( isExternalName name ) nameModule name
828 829
\end{code}

830 831
\begin{code}
isTupleCon :: DataCon -> Bool
832
isTupleCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc
833 834
	
isUnboxedTupleCon :: DataCon -> Bool
835
isUnboxedTupleCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc
836

batterseapower's avatar
batterseapower committed
837
-- | Vanilla 'DataCon's are those that are nice boring Haskell 98 constructors
838 839
isVanillaDataCon :: DataCon -> Bool
isVanillaDataCon dc = dcVanilla dc
840
\end{code}
841

842 843 844 845
\begin{code}
classDataCon :: Class -> DataCon
classDataCon clas = case tyConDataCons (classTyCon clas) of
		      (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr 
846
		      [] -> panic "classDataCon"
847 848
\end{code}

849 850 851 852 853
\begin{code}
dataConCannotMatch :: [Type] -> DataCon -> Bool
-- Returns True iff the data con *definitely cannot* match a 
--		    scrutinee of type (T tys)
--		    where T is the type constructor for the data con
854 855
-- NB: look at *all* equality constraints, not only those
--     in dataConEqSpec; see Trac #5168
856
dataConCannotMatch tys con
857
  | null theta        = False	-- Common
858 859
  | all isTyVarTy tys = False	-- Also common
  | otherwise
860
  = typesCantMatch [(Type.substTy subst ty1, Type.substTy subst ty2)
batterseapower's avatar
batterseapower committed
861
                   | (ty1, ty2) <- concatMap (predEqs . predTypePredTree) theta ]
862 863
  where
    dc_tvs  = dataConUnivTyVars con
864
    theta   = dataConTheta con
865
    subst   = zipTopTvSubst dc_tvs tys
batterseapower's avatar
batterseapower committed
866 867 868 869 870

    -- TODO: could gather equalities from superclasses too
    predEqs (EqPred ty1 ty2) = [(ty1, ty2)]
    predEqs (TuplePred ts)   = concatMap predEqs ts
    predEqs _                = []
871 872
\end{code}

873 874 875 876 877 878
%************************************************************************
%*									*
\subsection{Splitting products}
%*									*
%************************************************************************

879
\begin{code}
batterseapower's avatar
batterseapower committed
880 881 882 883 884 885 886 887 888 889 890 891
-- | Extract the type constructor, type argument, data constructor and it's
-- /representation/ argument types from a type if it is a product type.
--
-- Precisely, we return @Just@ for any type that is all of:
--
--  * Concrete (i.e. constructors visible)
--
--  * Single-constructor
--
--  * Not existentially quantified
--
-- Whether the type is a @data@ type or a @newtype@
892
splitProductType_maybe
batterseapower's avatar
batterseapower committed
893
	:: Type 			-- ^ A product type, perhaps
894 895 896
	-> Maybe (TyCon, 		-- The type constructor
		  [Type],		-- Type args of the tycon
		  DataCon,		-- The data constructor
batterseapower's avatar
batterseapower committed
897
		  [Type])		-- Its /representation/ arg types
898 899 900 901 902 903

	-- Rejecing existentials is conservative.  Maybe some things
	-- could be made to work with them, but I'm not going to sweat
	-- it through till someone finds it's important.

splitProductType_maybe ty
904
  = case splitTyConApp_maybe ty of
905
	Just (tycon,ty_args)
906 907
	   | isProductTyCon tycon  	-- Includes check for non-existential,
					-- and for constructors visible
908
	   -> Just (tycon, ty_args, data_con, dataConInstArgTys data_con ty_args)
909
	   where
910 911
	      data_con = ASSERT( not (null (tyConDataCons tycon)) ) 
			 head (tyConDataCons tycon)
Simon Marlow's avatar
Simon Marlow committed
912
	_other -> Nothing
913

batterseapower's avatar
batterseapower committed
914
-- | As 'splitProductType_maybe', but panics if the 'Type' is not a product type
Simon Marlow's avatar
Simon Marlow committed
915
splitProductType :: String -> Type -> (TyCon, [Type], DataCon, [Type])
916 917 918
splitProductType str ty
  = case splitProductType_maybe ty of
	Just stuff -> stuff
919
	Nothing    -> pprPanic (str ++ ": not a product") (pprType ty)
920 921


batterseapower's avatar
batterseapower committed
922 923
-- | As 'splitProductType_maybe', but in turn instantiates the 'TyCon' returned
-- and hence recursively tries to unpack it as far as it able to
Simon Marlow's avatar
Simon Marlow committed
924
deepSplitProductType_maybe :: Type -> Maybe (TyCon, [Type], DataCon, [Type])
925 926 927
deepSplitProductType_maybe ty
  = do { (res@(tycon, tycon_args, _, _)) <- splitProductType_maybe ty
       ; let {result 
928 929 930
             | Just (ty', _co) <- instNewTyCon_maybe tycon tycon_args
	     , not (isRecursiveTyCon tycon)
             = deepSplitProductType_maybe ty'	-- Ignore the coercion?
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
931 932
             | isNewTyCon tycon = Nothing  -- cannot unbox through recursive
					   -- newtypes nor through families
933 934 935
             | otherwise = Just res}
       ; result
       }
batterseapower's avatar
batterseapower committed
936 937

-- | As 'deepSplitProductType_maybe', but panics if the 'Type' is not a product type
Simon Marlow's avatar
Simon Marlow committed
938
deepSplitProductType :: String -> Type -> (TyCon, [Type], DataCon, [Type])
939 940 941 942 943
deepSplitProductType str ty 
  = case deepSplitProductType_maybe ty of
      Just stuff -> stuff
      Nothing -> pprPanic (str ++ ": not a product") (pprType ty)

batterseapower's avatar
batterseapower committed
944
-- | Compute the representation type strictness and type suitable for a 'DataCon'
945
computeRep :: [HsBang]			-- ^ Original argument strictness
batterseapower's avatar
batterseapower committed
946
	   -> [Type]			-- ^ Original argument types
947 948
	   -> ([StrictnessMark],	-- Representation arg strictness
	       [Type])			-- And type
949

950 951
computeRep stricts tys
  = unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
952
  where
953 954 955 956 957 958 959
    unbox HsNoBang       ty = [(NotMarkedStrict, ty)]
    unbox HsStrict       ty = [(MarkedStrict,    ty)]
    unbox HsUnpackFailed ty = [(MarkedStrict,    ty)]
    unbox HsUnpack ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
                      where
                        (_tycon, _tycon_args, arg_dc, arg_tys) 
                           = deepSplitProductType "unbox_strict_arg_ty" ty
batterseapower's avatar
batterseapower committed
960
\end{code}