TysWiredIn.hs 42.4 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1
2
3
{-
(c) The GRASP Project, Glasgow University, 1994-1998

4
\section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types}
Austin Seipp's avatar
Austin Seipp committed
5
-}
6

7
8
{-# LANGUAGE CPP #-}

9
-- | This module is about types that can be defined in Haskell, but which
10
--   must be wired into the compiler nonetheless.  C.f module TysPrim
11
module TysWiredIn (
12
        -- * All wired in things
13
        wiredInTyCons, isBuiltInOcc_maybe,
14

15
        -- * Bool
16
17
18
        boolTy, boolTyCon, boolTyCon_RDR, boolTyConName,
        trueDataCon,  trueDataConId,  true_RDR,
        falseDataCon, falseDataConId, false_RDR,
19
        promotedFalseDataCon, promotedTrueDataCon,
20

21
        -- * Ordering
22
        orderingTyCon,
23
24
25
        ltDataCon, ltDataConId,
        eqDataCon, eqDataConId,
        gtDataCon, gtDataConId,
26
        promotedLTDataCon, promotedEQDataCon, promotedGTDataCon,
27

28
        -- * Char
29
30
        charTyCon, charDataCon, charTyCon_RDR,
        charTy, stringTy, charTyConName,
sof's avatar
sof committed
31

32
33
34
35
36
        -- * Double
        doubleTyCon, doubleDataCon, doubleTy, doubleTyConName,

        -- * Float
        floatTyCon, floatDataCon, floatTy, floatTyConName,
sof's avatar
sof committed
37

38
        -- * Int
39
40
        intTyCon, intDataCon, intTyCon_RDR, intDataCon_RDR, intTyConName,
        intTy,
41

42
        -- * Word
43
        wordTyCon, wordDataCon, wordTyConName, wordTy,
Ian Lynagh's avatar
Ian Lynagh committed
44

45
46
47
        -- * Word8
        word8TyCon, word8DataCon, word8TyConName, word8Ty,

48
        -- * List
49
50
51
        listTyCon, listTyCon_RDR, listTyConName, listTyConKey,
        nilDataCon, nilDataConName, nilDataConKey,
        consDataCon_RDR, consDataCon, consDataConName,
Ben Gamari's avatar
Ben Gamari committed
52
        promotedNilDataCon, promotedConsDataCon,
53

54
        mkListTy,
55

Jan Stolarek's avatar
Jan Stolarek committed
56
57
        -- * Maybe
        maybeTyCon, maybeTyConName,
58
59
        nothingDataCon, nothingDataConName, promotedNothingDataCon,
        justDataCon, justDataConName, promotedJustDataCon,
Jan Stolarek's avatar
Jan Stolarek committed
60

61
62
        -- * Tuples
        mkTupleTy, mkBoxedTupleTy,
63
        tupleTyCon, tupleDataCon, tupleTyConName,
64
        promotedTupleDataCon,
65
66
        unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey,
        pairTyCon,
67
        unboxedUnitTyCon, unboxedUnitDataCon,
68
        cTupleTyConName, cTupleTyConNames, isCTupleTyConName,
chak's avatar
chak committed
69

70
        -- * Kinds
71
        typeNatKindCon, typeNatKind, typeSymbolKindCon, typeSymbolKind,
72
        isLiftedTypeKindTyConName, liftedTypeKind, constraintKind,
73
74
        starKindTyCon, starKindTyConName,
        unicodeStarKindTyCon, unicodeStarKindTyConName,
75
        liftedTypeKindTyCon, constraintKindTyCon,
76

77
        -- * Parallel arrays
78
79
80
        mkPArrTy,
        parrTyCon, parrFakeCon, isPArrTyCon, isPArrFakeCon,
        parrTyCon_RDR, parrTyConName,
batterseapower's avatar
batterseapower committed
81
82

        -- * Equality predicates
83
        heqTyCon, heqClass, heqDataCon,
84
        coercibleTyCon, coercibleDataCon, coercibleClass,
batterseapower's avatar
batterseapower committed
85

86
87
88
89
90
91
92
93
94
        mkWiredInTyConName, -- This is used in TcTypeNats to define the
                            -- built-in functions for evaluation.

        mkWiredInIdName,    -- used in MkId

        -- * Levity
        levityTy, levityTyCon, liftedDataCon, unliftedDataCon,
        liftedPromDataCon, unliftedPromDataCon,
        liftedDataConTy, unliftedDataConTy,
Ben Gamari's avatar
Ben Gamari committed
95
96
97
98
        liftedDataConName, unliftedDataConName,

        -- * Helpers for building type representations
        tyConRepModOcc
99
100
    ) where

101
102
#include "HsVersions.h"

103
import {-# SOURCE #-} MkId( mkDataConWorkId, mkDictSelId )
104

105
-- friends:
106
import PrelNames
107
108
import TysPrim

109
-- others:
110
import CoAxiom
111
import Id
112
import Constants        ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE )
113
import Module           ( Module )
114
import Type
115
import DataCon
Matthew Pickering's avatar
Matthew Pickering committed
116
import {-# SOURCE #-} ConLike
117
import TyCon
118
import Class            ( Class, mkClass )
Ian Lynagh's avatar
Ian Lynagh committed
119
import RdrName
120
import Name
121
122
123
import NameSet          ( NameSet, mkNameSet, elemNameSet )
import BasicTypes       ( Arity, RecFlag(..), Boxity(..),
                           TupleSort(..) )
124
import ForeignCall
125
import SrcLoc           ( noSrcSpan )
Ben Gamari's avatar
Ben Gamari committed
126
import Unique
Ian Lynagh's avatar
Ian Lynagh committed
127
import Data.Array
128
import FastString
129
import Outputable
130
import Util
131
import BooleanFormula   ( mkAnd )
sof's avatar
sof committed
132

Ian Lynagh's avatar
Ian Lynagh committed
133
alpha_tyvar :: [TyVar]
134
alpha_tyvar = [alphaTyVar]
Ian Lynagh's avatar
Ian Lynagh committed
135
136
137

alpha_ty :: [Type]
alpha_ty = [alphaTy]
138

Ben Gamari's avatar
Ben Gamari committed
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
-- * Some helpers for generating type representations

-- | Make a 'Name' for the 'Typeable' representation of the given wired-in type
mkPrelTyConRepName :: Name -> Name
-- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.
-- This doesn't really belong here but a refactoring of this code eliminating
-- these manually-defined representations is imminent
mkPrelTyConRepName tc_name  -- Prelude tc_name is always External,
                            -- so nameModule will work
  = mkExternalName rep_uniq rep_mod rep_occ (nameSrcSpan tc_name)
  where
    name_occ  = nameOccName tc_name
    name_mod  = nameModule  tc_name
    name_uniq = nameUnique  tc_name
    rep_uniq | isTcOcc name_occ = tyConRepNameUnique   name_uniq
             | otherwise        = dataConRepNameUnique name_uniq
    (rep_mod, rep_occ) = tyConRepModOcc name_mod name_occ

-- | The name (and defining module) for the Typeable representation (TyCon) of a
-- type constructor.
--
-- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.
tyConRepModOcc :: Module -> OccName -> (Module, OccName)
tyConRepModOcc tc_module tc_occ
  -- The list type is defined in GHC.Types and therefore must have its
  -- representations defined manually in Data.Typeable.Internal.
  -- However, $tc': isn't a valid Haskell identifier, so we override the derived
  -- name here.
  | is_wired_in promotedConsDataCon
  = (tYPEABLE_INTERNAL, mkOccName varName "tc'Cons")
  | is_wired_in promotedNilDataCon
  = (tYPEABLE_INTERNAL, mkOccName varName "tc'Nil")

  | tc_module == gHC_TYPES
  = (tYPEABLE_INTERNAL, mkTyConRepUserOcc tc_occ)
  | otherwise
  = (tc_module,         mkTyConRepSysOcc tc_occ)
  where
    is_wired_in :: TyCon -> Bool
    is_wired_in tc =
      tc_module == gHC_TYPES && tc_occ == nameOccName (tyConName tc)

Austin Seipp's avatar
Austin Seipp committed
181
182
183
{-
************************************************************************
*                                                                      *
184
\subsection{Wired in type constructors}
Austin Seipp's avatar
Austin Seipp committed
185
186
*                                                                      *
************************************************************************
187

188
189
If you change which things are wired in, make sure you change their
names in PrelNames, so they use wTcQual, wDataQual, etc
Austin Seipp's avatar
Austin Seipp committed
190
-}
191

batterseapower's avatar
batterseapower committed
192
193
194
195
196
197
198
199
200
-- This list is used only to define PrelInfo.wiredInThings. That in turn
-- is used to initialise the name environment carried around by the renamer.
-- This means that if we look up the name of a TyCon (or its implicit binders)
-- that occurs in this list that name will be assigned the wired-in key we
-- define here.
--
-- Because of their infinite nature, this list excludes tuples, Any and implicit
-- parameter TyCons. Instead, we have a hack in lookupOrigNameCache to deal with
-- these names.
201
202
--
-- See also Note [Known-key names]
batterseapower's avatar
batterseapower committed
203
wiredInTyCons :: [TyCon]
204

205
206
207
208
209
210
211
212
213
214
215
wiredInTyCons = [ unitTyCon     -- Not treated like other tuples, because
                                -- it's defined in GHC.Base, and there's only
                                -- one of it.  We put it in wiredInTyCons so
                                -- that it'll pre-populate the name cache, so
                                -- the special case in lookupOrigNameCache
                                -- doesn't need to look out for it
              , boolTyCon
              , charTyCon
              , doubleTyCon
              , floatTyCon
              , intTyCon
216
              , wordTyCon
217
              , word8TyCon
218
              , listTyCon
Jan Stolarek's avatar
Jan Stolarek committed
219
              , maybeTyCon
220
              , parrTyCon
221
              , heqTyCon
222
              , coercibleTyCon
223
              , typeNatKindCon
224
              , typeSymbolKindCon
225
226
227
228
229
              , levityTyCon
              , constraintKindTyCon
              , liftedTypeKindTyCon
              , starKindTyCon
              , unicodeStarKindTyCon
230
              ]
231

232
mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
Ian Lynagh's avatar
Ian Lynagh committed
233
mkWiredInTyConName built_in modu fs unique tycon
234
  = mkWiredInName modu (mkTcOccFS fs) unique
235
236
                  (ATyCon tycon)        -- Relevant TyCon
                  built_in
237

238
mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
Ian Lynagh's avatar
Ian Lynagh committed
239
mkWiredInDataConName built_in modu fs unique datacon
240
  = mkWiredInName modu (mkDataOccFS fs) unique
Gergő Érdi's avatar
Gergő Érdi committed
241
                  (AConLike (RealDataCon datacon))    -- Relevant DataCon
242
                  built_in
243

244
245
246
mkWiredInIdName :: Module -> FastString -> Unique -> Id -> Name
mkWiredInIdName mod fs uniq id
 = mkWiredInName mod (mkOccNameFS Name.varName fs) uniq (AnId id) UserSyntax
batterseapower's avatar
batterseapower committed
247

248
-- See Note [Kind-changing of (~) and Coercible]
249
250
251
252
253
254
255
256
-- in libraries/ghc-prim/GHC/Types.hs
heqTyConName, heqDataConName, heqSCSelIdName :: Name
heqTyConName   = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "~~")   heqTyConKey      heqTyCon
heqDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Eq#")  heqDataConKey heqDataCon
heqSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "HEq_sc") heqSCSelIdKey heqSCSelId

-- See Note [Kind-changing of (~) and Coercible] in libraries/ghc-prim/GHC/Types.hs
coercibleTyConName, coercibleDataConName, coercibleSCSelIdName :: Name
257
258
coercibleTyConName   = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Coercible")  coercibleTyConKey   coercibleTyCon
coercibleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "MkCoercible") coercibleDataConKey coercibleDataCon
259
coercibleSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "Coercible_sc") coercibleSCSelIdKey coercibleSCSelId
260

Ian Lynagh's avatar
Ian Lynagh committed
261
charTyConName, charDataConName, intTyConName, intDataConName :: Name
262
charTyConName     = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Char") charTyConKey charTyCon
263
charDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "C#") charDataConKey charDataCon
264
265
intTyConName      = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Int") intTyConKey   intTyCon
intDataConName    = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "I#") intDataConKey  intDataCon
Ian Lynagh's avatar
Ian Lynagh committed
266
267

boolTyConName, falseDataConName, trueDataConName :: Name
268
boolTyConName     = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Bool") boolTyConKey boolTyCon
Ian Lynagh's avatar
Ian Lynagh committed
269
falseDataConName  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "False") falseDataConKey falseDataCon
270
trueDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "True")  trueDataConKey  trueDataCon
Ian Lynagh's avatar
Ian Lynagh committed
271

Jan Stolarek's avatar
Jan Stolarek committed
272
273
274
275
276
277
278
279
280
281
282
283
284
listTyConName, nilDataConName, consDataConName :: Name
listTyConName     = mkWiredInTyConName   BuiltInSyntax gHC_TYPES (fsLit "[]") listTyConKey listTyCon
nilDataConName    = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "[]") nilDataConKey nilDataCon
consDataConName   = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit ":") consDataConKey consDataCon

maybeTyConName, nothingDataConName, justDataConName :: Name
maybeTyConName     = mkWiredInTyConName   UserSyntax gHC_BASE (fsLit "Maybe")
                                          maybeTyConKey maybeTyCon
nothingDataConName = mkWiredInDataConName UserSyntax gHC_BASE (fsLit "Nothing")
                                          nothingDataConKey nothingDataCon
justDataConName    = mkWiredInDataConName UserSyntax gHC_BASE (fsLit "Just")
                                          justDataConKey justDataCon

285
wordTyConName, wordDataConName, word8TyConName, word8DataConName :: Name
286
287
wordTyConName      = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Word")   wordTyConKey     wordTyCon
wordDataConName    = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "W#")     wordDataConKey   wordDataCon
288
289
290
291
word8TyConName     = mkWiredInTyConName   UserSyntax gHC_WORD  (fsLit "Word8")  word8TyConKey    word8TyCon
word8DataConName   = mkWiredInDataConName UserSyntax gHC_WORD  (fsLit "W8#")    word8DataConKey  word8DataCon

floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name
292
293
294
295
floatTyConName     = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Float")  floatTyConKey    floatTyCon
floatDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "F#")     floatDataConKey  floatDataCon
doubleTyConName    = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Double") doubleTyConKey   doubleTyCon
doubleDataConName  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#")     doubleDataConKey doubleDataCon
Ian Lynagh's avatar
Ian Lynagh committed
296

297
-- Kinds
298
typeNatKindConName, typeSymbolKindConName :: Name
299
300
typeNatKindConName    = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Nat")    typeNatKindConNameKey    typeNatKindCon
typeSymbolKindConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Symbol") typeSymbolKindConNameKey typeSymbolKindCon
301

302
303
304
305
306
307
308
309
310
311
312
313
314
315
constraintKindTyConName :: Name
constraintKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Constraint") constraintKindTyConKey   constraintKindTyCon

liftedTypeKindTyConName, starKindTyConName, unicodeStarKindTyConName
  :: Name
liftedTypeKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Type") liftedTypeKindTyConKey liftedTypeKindTyCon
starKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "*") starKindTyConKey starKindTyCon
unicodeStarKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "★") unicodeStarKindTyConKey unicodeStarKindTyCon

levityTyConName, liftedDataConName, unliftedDataConName :: Name
levityTyConName     = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Levity") levityTyConKey levityTyCon
liftedDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Lifted") liftedDataConKey liftedDataCon
unliftedDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Unlifted") unliftedDataConKey unliftedDataCon

Ian Lynagh's avatar
Ian Lynagh committed
316
parrTyConName, parrDataConName :: Name
317
318
319
parrTyConName   = mkWiredInTyConName   BuiltInSyntax
                    gHC_PARR' (fsLit "[::]") parrTyConKey parrTyCon
parrDataConName = mkWiredInDataConName UserSyntax
320
                    gHC_PARR' (fsLit "PArr") parrDataConKey parrDataCon
321

Ian Lynagh's avatar
Ian Lynagh committed
322
boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR,
323
    intDataCon_RDR, listTyCon_RDR, consDataCon_RDR, parrTyCon_RDR :: RdrName
324
boolTyCon_RDR   = nameRdrName boolTyConName
325
326
327
328
329
330
false_RDR       = nameRdrName falseDataConName
true_RDR        = nameRdrName trueDataConName
intTyCon_RDR    = nameRdrName intTyConName
charTyCon_RDR   = nameRdrName charTyConName
intDataCon_RDR  = nameRdrName intDataConName
listTyCon_RDR   = nameRdrName listTyConName
331
consDataCon_RDR = nameRdrName consDataConName
332
parrTyCon_RDR   = nameRdrName parrTyConName
333

Austin Seipp's avatar
Austin Seipp committed
334
335
336
{-
************************************************************************
*                                                                      *
337
\subsection{mkWiredInTyCon}
Austin Seipp's avatar
Austin Seipp committed
338
339
340
*                                                                      *
************************************************************************
-}
341

342
pcNonRecDataTyCon :: Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
343
344
-- Not an enumeration
pcNonRecDataTyCon = pcTyCon False NonRecursive
345

346
-- This function assumes that the types it creates have all parameters at
347
348
349
350
351
352
353
354
355
356
357
358
359
-- Representational role, and that there is no kind polymorphism.
pcTyCon :: Bool -> RecFlag -> Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
pcTyCon is_enum is_rec name cType tyvars cons
  = mkAlgTyCon name
                (mkFunTys (map tyVarKind tyvars) liftedTypeKind)
                tyvars
                (map (const Representational) tyvars)
                cType
                []              -- No stupid theta
                (DataTyCon cons is_enum)
                (VanillaAlgTyCon (mkPrelTyConRepName name))
                is_rec
                False           -- Not in GADT syntax
360

361
pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
362
363
364
365
366
367
368
369
370
pcDataCon n univs = pcDataConWithFixity False n univs []  -- no ex_tvs

pcDataConWithFixity :: Bool      -- ^ declared infix?
                    -> Name      -- ^ datacon name
                    -> [TyVar]   -- ^ univ tyvars
                    -> [TyVar]   -- ^ ex tyvars
                    -> [Type]    -- ^ args
                    -> TyCon
                    -> DataCon
batterseapower's avatar
batterseapower committed
371
372
pcDataConWithFixity infx n = pcDataConWithFixity' infx n (incrUnique (nameUnique n))
-- The Name's unique is the first of two free uniques;
373
374
-- the first is used for the datacon itself,
-- the second is used for the "worker name"
batterseapower's avatar
batterseapower committed
375
376
377
378
--
-- To support this the mkPreludeDataConUnique function "allocates"
-- one DataCon unique per pair of Ints.

379
380
pcDataConWithFixity' :: Bool -> Name -> Unique -> [TyVar] -> [TyVar]
                     -> [Type] -> TyCon -> DataCon
batterseapower's avatar
batterseapower committed
381
382
-- The Name should be in the DataName name space; it's the name
-- of the DataCon itself.
383

384
pcDataConWithFixity' declared_infix dc_name wrk_key tyvars ex_tyvars arg_tys tycon
385
386
  = data_con
  where
387
    data_con = mkDataCon dc_name declared_infix prom_info
388
                (map (const no_bang) arg_tys)
389
                []      -- No labelled fields
390
                tyvars
391
                ex_tyvars
392
393
394
395
396
                []      -- No equality spec
                []      -- No theta
                arg_tys (mkTyConApp tycon (mkTyVarTys tyvars))
                tycon
                []      -- No stupid theta
397
                (mkDataConWorkId wrk_name data_con)
398
                NoDataConRep    -- Wired-in types are too simple to need wrappers
399

400
401
    no_bang = HsSrcBang Nothing NoSrcUnpack NoSrcStrict

402
403
    modu     = ASSERT( isExternalName dc_name )
               nameModule dc_name
404
405
    dc_occ   = nameOccName dc_name
    wrk_occ  = mkDataConWorkerOcc dc_occ
Ian Lynagh's avatar
Ian Lynagh committed
406
    wrk_name = mkWiredInName modu wrk_occ wrk_key
407
                             (AnId (dataConWorkId data_con)) UserSyntax
408

409
    prom_info = mkPrelTyConRepName dc_name
410

Austin Seipp's avatar
Austin Seipp committed
411
412
413
{-
************************************************************************
*                                                                      *
414
      Kinds
Austin Seipp's avatar
Austin Seipp committed
415
416
417
*                                                                      *
************************************************************************
-}
418

419
typeNatKindCon, typeSymbolKindCon :: TyCon
420
421
-- data Nat
-- data Symbol
422
423
typeNatKindCon    = pcTyCon False NonRecursive typeNatKindConName    Nothing [] []
typeSymbolKindCon = pcTyCon False NonRecursive typeSymbolKindConName Nothing [] []
424

425
typeNatKind, typeSymbolKind :: Kind
426
427
428
429
430
431
432
433
434
435
436
typeNatKind    = mkTyConTy typeNatKindCon
typeSymbolKind = mkTyConTy typeSymbolKindCon

constraintKindTyCon :: TyCon
constraintKindTyCon = pcTyCon False NonRecursive constraintKindTyConName
                              Nothing [] []

liftedTypeKind, constraintKind :: Kind
liftedTypeKind   = tYPE liftedDataConTy
constraintKind   = mkTyConApp constraintKindTyCon []

437

Austin Seipp's avatar
Austin Seipp committed
438
439
440
{-
************************************************************************
*                                                                      *
441
                Stuff for dealing with tuples
Austin Seipp's avatar
Austin Seipp committed
442
443
*                                                                      *
************************************************************************
444

445
Note [How tuples work]  See also Note [Known-key names] in PrelNames
446
447
~~~~~~~~~~~~~~~~~~~~~~
* There are three families of tuple TyCons and corresponding
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
  DataCons, expressed by the type BasicTypes.TupleSort:
    data TupleSort = BoxedTuple | UnboxedTuple | ConstraintTuple

* All three families are AlgTyCons, whose AlgTyConRhs is TupleTyCon

* BoxedTuples
    - A wired-in type
    - Data type declarations in GHC.Tuple
    - The data constructors really have an info table

* UnboxedTuples
    - A wired-in type
    - Have a pretend DataCon, defined in GHC.Prim,
      but no actual declaration and no info table

* ConstraintTuples
    - Are known-key rather than wired-in. Reason: it's awkward to
      have all the superclass selectors wired-in.
    - Declared as classes in GHC.Classes, e.g.
         class (c1,c2) => (c1,c2)
    - Given constraints: the superclasses automatically become available
    - Wanted constraints: there is a built-in instance
         instance (c1,c2) => (c1,c2)
    - Currently just go up to 16; beyond that
      you have to use manual nesting
    - Their OccNames look like (%,,,%), so they can easily be
      distinguished from term tuples.  But (following Haskell) we
      pretty-print saturated constraint tuples with round parens; see
      BasicTypes.tupleParens.

* In quite a lot of places things are restrcted just to
  BoxedTuple/UnboxedTuple, and then we used BasicTypes.Boxity to distinguish
  E.g. tupleTyCon has a Boxity argument
481
482
483
484
485

* When looking up an OccName in the original-name cache
  (IfaceEnv.lookupOrigNameCache), we spot the tuple OccName to make sure
  we get the right wired-in name.  This guy can't tell the difference
  betweeen BoxedTuple and ConstraintTuple (same OccName!), so tuples
486
  are not serialised into interface files using OccNames at all.
Austin Seipp's avatar
Austin Seipp committed
487
-}
488

489
isBuiltInOcc_maybe :: OccName -> Maybe Name
Austin Seipp's avatar
Austin Seipp committed
490
-- Built in syntax isn't "in scope" so these OccNames
491
492
493
-- map to wired-in Names with BuiltInSyntax
isBuiltInOcc_maybe occ
  = case occNameString occ of
494
        "[]"             -> choose_ns listTyConName nilDataConName
495
496
        ":"              -> Just consDataConName
        "[::]"           -> Just parrTyConName
497
498
499
500
        "()"             -> tup_name Boxed      0
        "(##)"           -> tup_name Unboxed    0
        '(':',':rest     -> parse_tuple Boxed   2 rest
        '(':'#':',':rest -> parse_tuple Unboxed 2 rest
501
502
503
504
505
506
        _other           -> Nothing
  where
    ns = occNameSpace occ

    parse_tuple sort n rest
      | (',' : rest2) <- rest   = parse_tuple sort (n+1) rest2
507
      | tail_matches sort rest  = tup_name sort n
508
509
      | otherwise               = Nothing

510
511
512
513
514
515
516
    tail_matches Boxed   ")" = True
    tail_matches Unboxed "#)" = True
    tail_matches _       _    = False

    tup_name boxity arity
      = choose_ns (getName (tupleTyCon   boxity arity))
                  (getName (tupleDataCon boxity arity))
Austin Seipp's avatar
Austin Seipp committed
517

518
    choose_ns tc dc
519
520
521
      | isTcClsNameSpace ns   = Just tc
      | isDataConNameSpace ns = Just dc
      | otherwise             = pprPanic "tup_name" (ppr occ)
522

523
mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
524
525
526
527
mkTupleOcc ns sort ar = mkOccName ns str
  where
    -- No need to cache these, the caching is done in mk_tuple
    str = case sort of
528
529
530
531
                Unboxed    -> '(' : '#' : commas ++ "#)"
                Boxed      -> '(' : commas ++ ")"

    commas = take (ar-1) (repeat ',')
532

533
534
535
536
mkCTupleOcc :: NameSpace -> Arity -> OccName
mkCTupleOcc ns ar = mkOccName ns str
  where
    str    = "(%" ++ commas ++ "%)"
537
538
    commas = take (ar-1) (repeat ',')

539
540
541
542
543
544
545
546
547
548
549
550
551
cTupleTyConName :: Arity -> Name
cTupleTyConName arity
  = mkExternalName (mkCTupleTyConUnique arity) gHC_CLASSES
                   (mkCTupleOcc tcName arity) noSrcSpan
  -- The corresponding DataCon does not have a known-key name

cTupleTyConNames :: [Name]
cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE])

cTupleTyConNameSet :: NameSet
cTupleTyConNameSet = mkNameSet cTupleTyConNames

isCTupleTyConName :: Name -> Bool
552
-- Use Type.isCTupleClass where possible
553
554
555
556
557
558
isCTupleTyConName n
 = ASSERT2( isExternalName n, ppr n )
   nameModule n == gHC_CLASSES
   && n `elemNameSet` cTupleTyConNameSet

tupleTyCon :: Boxity -> Arity -> TyCon
559
tupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i)  -- Build one specially
560
561
562
563
564
565
566
tupleTyCon Boxed   i = fst (boxedTupleArr   ! i)
tupleTyCon Unboxed i = fst (unboxedTupleArr ! i)

tupleTyConName :: TupleSort -> Arity -> Name
tupleTyConName ConstraintTuple a = cTupleTyConName a
tupleTyConName BoxedTuple      a = tyConName (tupleTyCon Boxed a)
tupleTyConName UnboxedTuple    a = tyConName (tupleTyCon Unboxed a)
batterseapower's avatar
batterseapower committed
567

568
569
promotedTupleDataCon :: Boxity -> Arity -> TyCon
promotedTupleDataCon boxity i = promoteDataCon (tupleDataCon boxity i)
570

571
572
573
574
tupleDataCon :: Boxity -> Arity -> DataCon
tupleDataCon sort i | i > mAX_TUPLE_SIZE = snd (mk_tuple sort i)    -- Build one specially
tupleDataCon Boxed   i = snd (boxedTupleArr   ! i)
tupleDataCon Unboxed i = snd (unboxedTupleArr ! i)
batterseapower's avatar
batterseapower committed
575

576
577
578
boxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon)
boxedTupleArr   = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Boxed   i | i <- [0..mAX_TUPLE_SIZE]]
unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mAX_TUPLE_SIZE]]
batterseapower's avatar
batterseapower committed
579

580
581
mk_tuple :: Boxity -> Int -> (TyCon,DataCon)
mk_tuple boxity arity = (tycon, tuple_con)
582
  where
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
        tycon   = mkTupleTyCon tc_name tc_kind tc_arity tyvars tuple_con
                               tup_sort flavour

        (tup_sort, modu, tc_kind, tc_arity, tyvars, tyvar_tys, flavour)
          = case boxity of
          Boxed ->
            let boxed_tyvars = take arity alphaTyVars in
            ( BoxedTuple
            , gHC_TUPLE
            , mkFunTys (nOfThem arity liftedTypeKind) liftedTypeKind
            , arity
            , boxed_tyvars
            , mkTyVarTys boxed_tyvars
            , VanillaAlgTyCon (mkPrelTyConRepName tc_name)
            )
            -- See Note [Unboxed tuple levity vars] in TyCon
          Unboxed ->
            let all_tvs = mkTemplateTyVars (replicate arity levityTy ++
                                            map (tYPE . mkTyVarTy) (take arity all_tvs))
                   -- NB: This must be one call to mkTemplateTyVars, to make
                   -- sure that all the uniques are different
                (lev_tvs, open_tvs) = splitAt arity all_tvs
            in
            ( UnboxedTuple
            , gHC_PRIM
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
608
            , mkSpecForAllTys lev_tvs $
609
610
611
612
613
614
615
              mkFunTys (map tyVarKind open_tvs) $
              unliftedTypeKind
            , arity * 2
            , all_tvs
            , mkTyVarTys open_tvs
            , UnboxedAlgTyCon
            )
616
617

        tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
618
619
                                (ATyCon tycon) BuiltInSyntax
        tuple_con = pcDataCon dc_name tyvars tyvar_tys tycon
620
        dc_name   = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq
Gergő Érdi's avatar
Gergő Érdi committed
621
                                  (AConLike (RealDataCon tuple_con)) BuiltInSyntax
622
623
        tc_uniq   = mkTupleTyConUnique   boxity arity
        dc_uniq   = mkTupleDataConUnique boxity arity
624

Ian Lynagh's avatar
Ian Lynagh committed
625
unitTyCon :: TyCon
626
627
628
629
630
unitTyCon = tupleTyCon Boxed 0

unitTyConKey :: Unique
unitTyConKey = getUnique unitTyCon

Ian Lynagh's avatar
Ian Lynagh committed
631
unitDataCon :: DataCon
632
unitDataCon   = head (tyConDataCons unitTyCon)
633

Ian Lynagh's avatar
Ian Lynagh committed
634
unitDataConId :: Id
635
unitDataConId = dataConWorkId unitDataCon
636

Ian Lynagh's avatar
Ian Lynagh committed
637
pairTyCon :: TyCon
638
pairTyCon = tupleTyCon Boxed 2
639

640
unboxedUnitTyCon :: TyCon
641
642
unboxedUnitTyCon = tupleTyCon Unboxed 0

643
unboxedUnitDataCon :: DataCon
644
unboxedUnitDataCon = tupleDataCon   Unboxed 0
645

646
647

{- *********************************************************************
Austin Seipp's avatar
Austin Seipp committed
648
*                                                                      *
649
              Equality types and classes
Austin Seipp's avatar
Austin Seipp committed
650
*                                                                      *
651
652
********************************************************************* -}

653
-- See Note [The equality types story] in TysPrim
654
655
656
657
658
659
660
661
662
663
664
665
666
667
heqTyCon, coercibleTyCon :: TyCon
heqClass, coercibleClass :: Class
heqDataCon, coercibleDataCon :: DataCon
heqSCSelId, coercibleSCSelId :: Id

(heqTyCon, heqClass, heqDataCon, heqSCSelId)
  = (tycon, klass, datacon, sc_sel_id)
  where
    tycon     = mkClassTyCon heqTyConName kind tvs roles
                             rhs klass NonRecursive
                             (mkSpecialTyConRepName (fsLit "tcHEq") heqTyConName)
    klass     = mkClass tvs [] [sc_pred] [sc_sel_id] [] [] (mkAnd []) tycon
    datacon   = pcDataCon heqDataConName tvs [sc_pred] tycon

eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
668
    kind      = mkSpecForAllTys [kv1, kv2] $ mkFunTys [k1, k2] constraintKind
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
    kv1:kv2:_ = drop 9 alphaTyVars -- gets "j" and "k"
    k1        = mkTyVarTy kv1
    k2        = mkTyVarTy kv2
    [av,bv]   = mkTemplateTyVars [k1, k2]
    tvs       = [kv1, kv2, av, bv]
    roles     = [Nominal, Nominal, Nominal, Nominal]
    rhs       = DataTyCon { data_cons = [datacon], is_enum = False }

    sc_pred   = mkTyConApp eqPrimTyCon (mkTyVarTys tvs)
    sc_sel_id = mkDictSelId heqSCSelIdName klass

(coercibleTyCon, coercibleClass, coercibleDataCon, coercibleSCSelId)
  = (tycon, klass, datacon, sc_sel_id)
  where
    tycon     = mkClassTyCon coercibleTyConName kind tvs roles
                             rhs klass NonRecursive
                             (mkPrelTyConRepName coercibleTyConName)
    klass     = mkClass tvs [] [sc_pred] [sc_sel_id] [] [] (mkAnd []) tycon
    datacon   = pcDataCon coercibleDataConName tvs [sc_pred] tycon

eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
689
    kind      = mkSpecForAllTys [kKiVar] $ mkFunTys [k, k] constraintKind
690
691
692
693
694
695
696
697
698
    k         = mkTyVarTy kKiVar
    [av,bv]   = mkTemplateTyVars [k, k]
    tvs       = [kKiVar, av, bv]
    roles     = [Nominal, Representational, Representational]
    rhs       = DataTyCon { data_cons = [datacon], is_enum = False }

    sc_pred   = mkTyConApp eqReprPrimTyCon [k, k, mkTyVarTy av, mkTyVarTy bv]
    sc_sel_id = mkDictSelId coercibleSCSelIdName klass

699
700
701
702
703
704
705

{- *********************************************************************
*                                                                      *
                Kinds and levity
*                                                                      *
********************************************************************* -}

706
-- For information about the usage of the following type, see Note [TYPE]
707
-- in module TysPrim
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
levityTy :: Type
levityTy = mkTyConTy levityTyCon

levityTyCon :: TyCon
levityTyCon = pcTyCon True NonRecursive levityTyConName
                      Nothing [] [liftedDataCon, unliftedDataCon]

liftedDataCon, unliftedDataCon :: DataCon
liftedDataCon   = pcDataCon liftedDataConName [] [] levityTyCon
unliftedDataCon = pcDataCon unliftedDataConName [] [] levityTyCon

liftedPromDataCon, unliftedPromDataCon :: TyCon
liftedPromDataCon   = promoteDataCon liftedDataCon
unliftedPromDataCon = promoteDataCon unliftedDataCon

liftedDataConTy, unliftedDataConTy :: Type
liftedDataConTy   = mkTyConTy liftedPromDataCon
unliftedDataConTy = mkTyConTy unliftedPromDataCon

liftedTypeKindTyCon, starKindTyCon, unicodeStarKindTyCon :: TyCon

   -- See Note [TYPE] in TysPrim
liftedTypeKindTyCon   = mkSynonymTyCon liftedTypeKindTyConName
                                       liftedTypeKind
                                       [] []
                                       (tYPE liftedDataConTy)

starKindTyCon         = mkSynonymTyCon starKindTyConName
                                       liftedTypeKind
                                       [] []
                                       (tYPE liftedDataConTy)

unicodeStarKindTyCon  = mkSynonymTyCon unicodeStarKindTyConName
                                       liftedTypeKind
                                       [] []
                                       (tYPE liftedDataConTy)

745
746
747
748
749
750
{- *********************************************************************
*                                                                      *
     The boxed primitive types: Char, Int, etc
*                                                                      *
********************************************************************* -}

Ian Lynagh's avatar
Ian Lynagh committed
751
charTy :: Type
752
charTy = mkTyConTy charTyCon
753

Ian Lynagh's avatar
Ian Lynagh committed
754
charTyCon :: TyCon
755
charTyCon   = pcNonRecDataTyCon charTyConName
756
757
                       (Just (CType "" Nothing ("HsChar",fsLit "HsChar")))
                       [] [charDataCon]
Ian Lynagh's avatar
Ian Lynagh committed
758
charDataCon :: DataCon
759
charDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon
760

Ian Lynagh's avatar
Ian Lynagh committed
761
stringTy :: Type
762
stringTy = mkListTy charTy -- convenience only
763

Ian Lynagh's avatar
Ian Lynagh committed
764
intTy :: Type
765
intTy = mkTyConTy intTyCon
766

Ian Lynagh's avatar
Ian Lynagh committed
767
intTyCon :: TyCon
Alan Zimmerman's avatar
Alan Zimmerman committed
768
intTyCon = pcNonRecDataTyCon intTyConName
769
770
                            (Just (CType "" Nothing ("HsInt",fsLit "HsInt"))) []
                            [intDataCon]
Ian Lynagh's avatar
Ian Lynagh committed
771
intDataCon :: DataCon
772
intDataCon = pcDataCon intDataConName [] [intPrimTy] intTyCon
773

Ian Lynagh's avatar
Ian Lynagh committed
774
wordTy :: Type
775
wordTy = mkTyConTy wordTyCon
Ian Lynagh's avatar
Ian Lynagh committed
776
777

wordTyCon :: TyCon
Alan Zimmerman's avatar
Alan Zimmerman committed
778
wordTyCon = pcNonRecDataTyCon wordTyConName
779
780
                      (Just (CType "" Nothing ("HsWord", fsLit "HsWord"))) []
                      [wordDataCon]
Ian Lynagh's avatar
Ian Lynagh committed
781
782
783
wordDataCon :: DataCon
wordDataCon = pcDataCon wordDataConName [] [wordPrimTy] wordTyCon

784
785
786
787
788
789
790
791
792
793
word8Ty :: Type
word8Ty = mkTyConTy word8TyCon

word8TyCon :: TyCon
word8TyCon = pcNonRecDataTyCon word8TyConName
                      (Just (CType "" Nothing ("HsWord8", fsLit "HsWord8"))) []
                      [word8DataCon]
word8DataCon :: DataCon
word8DataCon = pcDataCon word8DataConName [] [wordPrimTy] word8TyCon

Ian Lynagh's avatar
Ian Lynagh committed
794
floatTy :: Type
795
floatTy = mkTyConTy floatTyCon
796

Ian Lynagh's avatar
Ian Lynagh committed
797
floatTyCon :: TyCon
Alan Zimmerman's avatar
Alan Zimmerman committed
798
floatTyCon   = pcNonRecDataTyCon floatTyConName
799
800
                      (Just (CType "" Nothing ("HsFloat", fsLit "HsFloat"))) []
                      [floatDataCon]
Ian Lynagh's avatar
Ian Lynagh committed
801
floatDataCon :: DataCon
802
floatDataCon = pcDataCon         floatDataConName [] [floatPrimTy] floatTyCon
803

Ian Lynagh's avatar
Ian Lynagh committed
804
doubleTy :: Type
805
doubleTy = mkTyConTy doubleTyCon
806

Ian Lynagh's avatar
Ian Lynagh committed
807
doubleTyCon :: TyCon
Alan Zimmerman's avatar
Alan Zimmerman committed
808
doubleTyCon = pcNonRecDataTyCon doubleTyConName
809
810
                      (Just (CType "" Nothing ("HsDouble",fsLit "HsDouble"))) []
                      [doubleDataCon]
Ian Lynagh's avatar
Ian Lynagh committed
811
812
813

doubleDataCon :: DataCon
doubleDataCon = pcDataCon doubleDataConName [] [doublePrimTy] doubleTyCon
814

Austin Seipp's avatar
Austin Seipp committed
815
816
817
{-
************************************************************************
*                                                                      *
Ben Gamari's avatar
Ben Gamari committed
818
              The Bool type
Austin Seipp's avatar
Austin Seipp committed
819
820
*                                                                      *
************************************************************************
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840

An ordinary enumeration type, but deeply wired in.  There are no
magical operations on @Bool@ (just the regular Prelude code).

{\em BEGIN IDLE SPECULATION BY SIMON}

This is not the only way to encode @Bool@.  A more obvious coding makes
@Bool@ just a boxed up version of @Bool#@, like this:
\begin{verbatim}
type Bool# = Int#
data Bool = MkBool Bool#
\end{verbatim}

Unfortunately, this doesn't correspond to what the Report says @Bool@
looks like!  Furthermore, we get slightly less efficient code (I
think) with this coding. @gtInt@ would look like this:

\begin{verbatim}
gtInt :: Int -> Int -> Bool
gtInt x y = case x of I# x# ->
841
842
843
            case y of I# y# ->
            case (gtIntPrim x# y#) of
                b# -> MkBool b#
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
\end{verbatim}

Notice that the result of the @gtIntPrim@ comparison has to be turned
into an integer (here called @b#@), and returned in a @MkBool@ box.

The @if@ expression would compile to this:
\begin{verbatim}
case (gtInt x y) of
  MkBool b# -> case b# of { 1# -> e1; 0# -> e2 }
\end{verbatim}

I think this code is a little less efficient than the previous code,
but I'm not certain.  At all events, corresponding with the Report is
important.  The interesting thing is that the language is expressive
enough to describe more than one alternative; and that a type doesn't
necessarily need to be a straightforwardly boxed version of its
primitive counterpart.

{\em END IDLE SPECULATION BY SIMON}
Austin Seipp's avatar
Austin Seipp committed
863
-}
864

Ian Lynagh's avatar
Ian Lynagh committed
865
boolTy :: Type
866
boolTy = mkTyConTy boolTyCon
867

Ian Lynagh's avatar
Ian Lynagh committed
868
boolTyCon :: TyCon
869
boolTyCon = pcTyCon True NonRecursive boolTyConName
870
                    (Just (CType "" Nothing ("HsBool", fsLit "HsBool")))
871
                    [] [falseDataCon, trueDataCon]
872

Ian Lynagh's avatar
Ian Lynagh committed
873
falseDataCon, trueDataCon :: DataCon
874
875
falseDataCon = pcDataCon falseDataConName [] [] boolTyCon
trueDataCon  = pcDataCon trueDataConName  [] [] boolTyCon
876

Ian Lynagh's avatar
Ian Lynagh committed
877
falseDataConId, trueDataConId :: Id
878
879
falseDataConId = dataConWorkId falseDataCon
trueDataConId  = dataConWorkId trueDataCon
880
881

orderingTyCon :: TyCon
882
orderingTyCon = pcTyCon True NonRecursive orderingTyConName Nothing
883
884
885
886
887
888
889
890
891
892
893
                        [] [ltDataCon, eqDataCon, gtDataCon]

ltDataCon, eqDataCon, gtDataCon :: DataCon
ltDataCon = pcDataCon ltDataConName  [] [] orderingTyCon
eqDataCon = pcDataCon eqDataConName  [] [] orderingTyCon
gtDataCon = pcDataCon gtDataConName  [] [] orderingTyCon

ltDataConId, eqDataConId, gtDataConId :: Id
ltDataConId = dataConWorkId ltDataCon
eqDataConId = dataConWorkId eqDataCon
gtDataConId = dataConWorkId gtDataCon
894

Austin Seipp's avatar
Austin Seipp committed
895
896
897
{-
************************************************************************
*                                                                      *
Ben Gamari's avatar
Ben Gamari committed
898
899
900
            The List type
   Special syntax, deeply wired in,
   but otherwise an ordinary algebraic data type
Austin Seipp's avatar
Austin Seipp committed
901
902
*                                                                      *
************************************************************************
903

Ben Gamari's avatar
Ben Gamari committed
904
       data [] a = [] | a : (List a)
Austin Seipp's avatar
Austin Seipp committed
905
-}
906

907
mkListTy :: Type -> Type
908
mkListTy ty = mkTyConApp listTyCon [ty]
909

Ian Lynagh's avatar
Ian Lynagh committed
910
listTyCon :: TyCon
911
912
913
listTyCon = buildAlgTyCon listTyConName alpha_tyvar [Representational]
                          Nothing []
                          (DataTyCon [nilDataCon, consDataCon] False )
914
                          Recursive False
915
                          (VanillaAlgTyCon (mkSpecialTyConRepName (fsLit "tcList") listTyConName))
916

Ian Lynagh's avatar
Ian Lynagh committed
917
nilDataCon :: DataCon
918
nilDataCon  = pcDataCon nilDataConName alpha_tyvar [] listTyCon
919

Ian Lynagh's avatar
Ian Lynagh committed
920
consDataCon :: DataCon
921
consDataCon = pcDataConWithFixity True {- Declared infix -}
922
               consDataConName
923
               alpha_tyvar [] [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon
924
925
926
-- Interesting: polymorphic recursion would help here.
-- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy
-- gets the over-specific type (Type -> Type)
927

Jan Stolarek's avatar
Jan Stolarek committed
928
929
930
-- Wired-in type Maybe

maybeTyCon :: TyCon
931
maybeTyCon = pcTyCon False NonRecursive maybeTyConName Nothing alpha_tyvar
Jan Stolarek's avatar
Jan Stolarek committed
932
933
934
935
936
937
938
939
940
941
                     [nothingDataCon, justDataCon]

nothingDataCon :: DataCon
nothingDataCon = pcDataCon nothingDataConName alpha_tyvar [] maybeTyCon

justDataCon :: DataCon
justDataCon = pcDataCon justDataConName alpha_tyvar [alphaTy] maybeTyCon

{-
** *********************************************************************
Austin Seipp's avatar
Austin Seipp committed
942
*                                                                      *
Ben Gamari's avatar
Ben Gamari committed
943
            The tuple types
Austin Seipp's avatar
Austin Seipp committed
944
945
*                                                                      *
************************************************************************
946
947
948
949
950
951

The tuple types are definitely magic, because they form an infinite
family.

\begin{itemize}
\item
952
They have a special family of type constructors, of type @TyCon@
953
954
955
956
These contain the tycon arity, but don't require a Unique.

\item
They have a special family of constructors, of type
957
@Id@. Again these contain their arity but don't need a Unique.
958
959
960
961
962
963
964
965

\item
There should be a magic way of generating the info tables and
entry code for all tuples.

But at the moment we just compile a Haskell source
file\srcloc{lib/prelude/...} containing declarations like:
\begin{verbatim}
966
967
968
969
data Tuple0             = Tup0
data Tuple2  a b        = Tup2  a b
data Tuple3  a b c      = Tup3  a b c
data Tuple4  a b c d    = Tup4  a b c d
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
...
\end{verbatim}
The print-names associated with the magic @Id@s for tuple constructors
``just happen'' to be the same as those generated by these
declarations.

\item
The instance environment should have a magic way to know
that each tuple type is an instances of classes @Eq@, @Ix@, @Ord@ and
so on. \ToDo{Not implemented yet.}

\item
There should also be a way to generate the appropriate code for each
of these instances, but (like the info tables and entry code) it is
done by enumeration\srcloc{lib/prelude/InTup?.hs}.
\end{itemize}
Austin Seipp's avatar
Austin Seipp committed
986
-}
987

988
989
-- | Make a tuple type. The list of types should /not/ include any
-- levity specifications.
990
mkTupleTy :: Boxity -> [Type] -> Type
991
-- Special case for *boxed* 1-tuples, which are represented by the type itself
992
993
994
995
mkTupleTy Boxed   [ty] = ty
mkTupleTy Boxed   tys  = mkTyConApp (tupleTyCon Boxed (length tys)) tys
mkTupleTy Unboxed tys  = mkTyConApp (tupleTyCon Unboxed (length tys))
                                        (map (getLevity "mkTupleTy") tys ++ tys)
996

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
997
998
-- | Build the type of a small tuple that holds the specified type of thing
mkBoxedTupleTy :: [Type] -> Type
999
mkBoxedTupleTy tys = mkTupleTy Boxed tys
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
1000

Ian Lynagh's avatar
Ian Lynagh committed
1001
unitTy :: Type
1002
unitTy = mkTupleTy Boxed []
1003

Ben Gamari's avatar
Ben Gamari committed
1004
1005

{- *********************************************************************
Austin Seipp's avatar
Austin Seipp committed
1006
*                                                                      *
Ben Gamari's avatar
Ben Gamari committed
1007
        The parallel-array type,  [::]
Austin Seipp's avatar
Austin Seipp committed
1008
1009
*                                                                      *
************************************************************************
chak's avatar
chak committed
1010
1011

Special syntax for parallel arrays needs some wired in definitions.
Austin Seipp's avatar
Austin Seipp committed
1012
-}
chak's avatar
chak committed
1013

1014
-- | Construct a type representing the application of the parallel array constructor
chak's avatar
chak committed
1015
1016
1017
mkPArrTy    :: Type -> Type
mkPArrTy ty  = mkTyConApp parrTyCon [ty]

1018
-- | Represents the type constructor of parallel arrays
chak's avatar
chak committed
1019
--
1020
--  * This must match the definition in @PrelPArr@
chak's avatar
chak committed
1021
1022
1023
--
-- NB: Although the constructor is given here, it will not be accessible in
--     user code as it is not in the environment of any compiled module except