ghc/compiler/prelude/TysWiredIn.lhs

   1 %
   2 % (c) The GRASP Project, Glasgow University, 1994-1995
   3 %
   4 \section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types}
   5
   6 This module is about types that can be defined in Haskell, but which
   7 must be wired into the compiler nonetheless.
   8
   9 This module tracks the ``state interface'' document, ``GHC prelude:
  10 types and operations.''
  11
  12 \begin{code}
  13 module TysWiredIn (
  14         addrDataCon,
  15         addrTy,
  16         addrTyCon,
  17         boolTy,
  18         boolTyCon,
  19         charDataCon,
  20         charTy,
  21         charTyCon,
  22         consDataCon,
  23         doubleDataCon,
  24         doubleTy,
  25         isDoubleTy,
  26         doubleTyCon,
  27         falseDataCon,
  28         floatDataCon,
  29         floatTy,
  30         isFloatTy,
  31         floatTyCon,
  32         getStatePairingConInfo,
  33
  34         intDataCon,
  35         intTy,
  36         intTyCon,
  37         isIntTy,
  38         inIntRange,
  39
  40         integerTy,
  41         integerTyCon,
  42         integerDataCon,
  43         isIntegerTy,
  44
  45         liftDataCon,
  46         liftTyCon,
  47         listTyCon,
  48         foreignObjTyCon,
  49
  50         mkLiftTy,
  51         mkListTy,
  52         mkTupleTy,
  53         tupleTyCon, tupleCon, unitTyCon, unitDataCon, pairTyCon, pairDataCon,
  54         nilDataCon,
  55         realWorldStateTy,
  56         return2GMPsTyCon,
  57         returnIntAndGMPTyCon,
  58
  59         -- ST and STret types
  60         mkStateTy,
  61         mkStateTransformerTy,
  62         mkSTretTy,
  63         stTyCon,
  64         stDataCon,
  65         stRetDataCon,
  66         stRetTyCon,
  67
  68         -- CCall result types
  69         stateAndAddrPrimTyCon,
  70         stateAndArrayPrimTyCon,
  71         stateAndByteArrayPrimTyCon,
  72         stateAndCharPrimTyCon,
  73         stateAndDoublePrimTyCon,
  74         stateAndFloatPrimTyCon,
  75         stateAndIntPrimTyCon,
  76         stateAndForeignObjPrimTyCon,
  77         stateAndMutableArrayPrimTyCon,
  78         stateAndMutableByteArrayPrimTyCon,
  79         stateAndPtrPrimTyCon,
  80         stateAndStablePtrPrimTyCon,
  81         stateAndSynchVarPrimTyCon,
  82         stateAndWordPrimTyCon,
  83         stateDataCon,
  84         stateTyCon,
  85
  86         stablePtrTyCon,
  87         stringTy,
  88         trueDataCon,
  89         unitTy,
  90         wordDataCon,
  91         wordTy,
  92         wordTyCon
  93     ) where
  94
  95 #include "HsVersions.h"
  96
  97 import {-# SOURCE #-} MkId ( mkDataCon, mkTupleCon )
  98 import {-# SOURCE #-} Id ( Id, StrictnessMark(..) )
  99
 100 -- friends:
 101 import PrelMods
 102 import TysPrim
 103
 104 -- others:
 105 import Kind             ( mkBoxedTypeKind, mkArrowKind )
 106 import Name             ( mkWiredInTyConName, mkWiredInIdName )
 107 import TyCon            ( mkDataTyCon, mkTupleTyCon, mkSynTyCon,
 108                           TyCon, Arity
 109                         )
 110 import BasicTypes       ( Module, NewOrData(..), RecFlag(..) )
 111 import Type             ( Type, mkTyConTy, mkTyConApp, mkSigmaTy, mkTyVarTys,
 112                           mkFunTy, mkFunTys, splitTyConApp_maybe, splitAlgTyConApp_maybe,
 113                           GenType(..), ThetaType, TauType )
 114 import TyVar            ( GenTyVar, TyVar, tyVarKind, alphaTyVars, alphaTyVar, betaTyVar )
 115 import Lex              ( mkTupNameStr )
 116 import Unique
 117 import Util             ( assoc, panic )
 118
 119 alpha_tyvar       = [alphaTyVar]
 120 alpha_ty          = [alphaTy]
 121 alpha_beta_tyvars = [alphaTyVar, betaTyVar]
 122
 123 pcRecDataTyCon, pcNonRecDataTyCon, pcNonRecNewTyCon
 124         :: Unique{-TyConKey-} -> Module -> FAST_STRING
 125         -> [TyVar] -> [Id] -> TyCon
 126
 127 pcRecDataTyCon    = pc_tycon DataType Recursive
 128 pcNonRecDataTyCon = pc_tycon DataType NonRecursive
 129 pcNonRecNewTyCon  = pc_tycon NewType  NonRecursive
 130
 131 pc_tycon new_or_data is_rec key mod str tyvars cons
 132   = tycon
 133   where
 134     tycon = mkDataTyCon name tycon_kind
 135                 tyvars
 136                 []              -- No context
 137                 cons
 138                 []              -- No derivings
 139                 Nothing         -- Not a dictionary
 140                 new_or_data
 141                 is_rec
 142
 143     name = mkWiredInTyConName key mod str tycon
 144     tycon_kind = foldr (mkArrowKind . tyVarKind) mkBoxedTypeKind tyvars
 145
 146 pcSynTyCon key mod str kind arity tyvars expansion
 147   = tycon
 148   where
 149     tycon = mkSynTyCon name kind arity tyvars expansion
 150     name  = mkWiredInTyConName key mod str tycon
 151
 152 pcDataCon :: Unique{-DataConKey-} -> Module -> FAST_STRING
 153           -> [TyVar] -> ThetaType -> [TauType] -> TyCon -> Id
 154 pcDataCon key mod str tyvars context arg_tys tycon
 155   = data_con
 156   where
 157     data_con = mkDataCon name
 158                 [ NotMarkedStrict | a <- arg_tys ]
 159                 [ {- no labelled fields -} ]
 160                 tyvars context [] [] arg_tys tycon
 161     name = mkWiredInIdName key mod str data_con
 162 \end{code}
 163
 164 %************************************************************************
 165 %*                                                                      *
 166 \subsection[TysWiredIn-tuples]{The tuple types}
 167 %*                                                                      *
 168 %************************************************************************
 169
 170 \begin{code}
 171 tupleTyCon :: Arity -> TyCon
 172 tupleTyCon arity
 173   = tycon
 174   where
 175     tycon = mkTupleTyCon uniq name arity
 176     uniq  = mkTupleTyConUnique arity
 177     name  = mkWiredInTyConName uniq mod_name (mkTupNameStr arity) tycon
 178     mod_name | arity == 0 = pREL_BASE
 179              | otherwise  = pREL_TUP
 180
 181 tupleCon :: Arity -> Id
 182 tupleCon arity
 183   = tuple_con
 184   where
 185     tuple_con = mkTupleCon arity name ty
 186     uniq      = mkTupleDataConUnique arity
 187     name      = mkWiredInIdName uniq mod_name (mkTupNameStr arity) tuple_con
 188     mod_name  | arity == 0 = pREL_BASE
 189               | otherwise  = pREL_TUP
 190     ty          = mkSigmaTy tyvars [] (mkFunTys tyvar_tys (mkTyConApp tycon tyvar_tys))
 191     tyvars      = take arity alphaTyVars
 192     tyvar_tys   = mkTyVarTys tyvars
 193     tycon       = tupleTyCon arity
 194
 195 unitTyCon = tupleTyCon 0
 196 pairTyCon = tupleTyCon 2
 197
 198 unitDataCon = tupleCon 0
 199 pairDataCon = tupleCon 2
 200 \end{code}
 201
 202
 203 %************************************************************************
 204 %*                                                                      *
 205 \subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)}
 206 %*                                                                      *
 207 %************************************************************************
 208
 209 \begin{code}
 210 charTy = mkTyConTy charTyCon
 211
 212 charTyCon = pcNonRecDataTyCon charTyConKey  pREL_BASE  SLIT("Char") [] [charDataCon]
 213 charDataCon = pcDataCon charDataConKey pREL_BASE SLIT("C#") [] [] [charPrimTy] charTyCon
 214
 215 stringTy = mkListTy charTy -- convenience only
 216 \end{code}
 217
 218 \begin{code}
 219 intTy = mkTyConTy intTyCon
 220
 221 intTyCon = pcNonRecDataTyCon intTyConKey pREL_BASE SLIT("Int") [] [intDataCon]
 222 intDataCon = pcDataCon intDataConKey pREL_BASE SLIT("I#") [] [] [intPrimTy] intTyCon
 223
 224 isIntTy :: GenType flexi -> Bool
 225 isIntTy ty
 226   = case (splitAlgTyConApp_maybe ty) of
 227         Just (tycon, [], _) -> uniqueOf tycon == intTyConKey
 228         _                   -> False
 229
 230 inIntRange :: Integer -> Bool   -- Tells if an integer lies in the legal range of Ints
 231 inIntRange i = (min_int <= i) && (i <= max_int)
 232
 233 max_int, min_int :: Integer
 234 max_int = toInteger maxInt
 235 min_int = toInteger minInt
 236 \end{code}
 237
 238 \begin{code}
 239 wordTy = mkTyConTy wordTyCon
 240
 241 wordTyCon = pcNonRecDataTyCon wordTyConKey   pREL_FOREIGN SLIT("Word") [] [wordDataCon]
 242 wordDataCon = pcDataCon wordDataConKey pREL_FOREIGN SLIT("W#") [] [] [wordPrimTy] wordTyCon
 243 \end{code}
 244
 245 \begin{code}
 246 addrTy = mkTyConTy addrTyCon
 247
 248 addrTyCon = pcNonRecDataTyCon addrTyConKey   pREL_ADDR SLIT("Addr") [] [addrDataCon]
 249 addrDataCon = pcDataCon addrDataConKey pREL_ADDR SLIT("A#") [] [] [addrPrimTy] addrTyCon
 250 \end{code}
 251
 252 \begin{code}
 253 floatTy = mkTyConTy floatTyCon
 254
 255 floatTyCon = pcNonRecDataTyCon floatTyConKey pREL_BASE SLIT("Float") [] [floatDataCon]
 256 floatDataCon = pcDataCon floatDataConKey pREL_BASE SLIT("F#") [] [] [floatPrimTy] floatTyCon
 257
 258 isFloatTy :: GenType flexi -> Bool
 259 isFloatTy ty
 260   = case (splitAlgTyConApp_maybe ty) of
 261         Just (tycon, [], _) -> uniqueOf tycon == floatTyConKey
 262         _                   -> False
 263
 264 \end{code}
 265
 266 \begin{code}
 267 doubleTy = mkTyConTy doubleTyCon
 268
 269 isDoubleTy :: GenType flexi -> Bool
 270 isDoubleTy ty
 271   = case (splitAlgTyConApp_maybe ty) of
 272         Just (tycon, [], _) -> uniqueOf tycon == doubleTyConKey
 273         _                   -> False
 274
 275 doubleTyCon = pcNonRecDataTyCon doubleTyConKey pREL_BASE SLIT("Double") [] [doubleDataCon]
 276 doubleDataCon = pcDataCon doubleDataConKey pREL_BASE SLIT("D#") [] [] [doublePrimTy] doubleTyCon
 277 \end{code}
 278
 279 \begin{code}
 280 mkStateTy ty     = mkTyConApp stateTyCon [ty]
 281 realWorldStateTy = mkStateTy realWorldTy -- a common use
 282
 283 stateTyCon = pcNonRecDataTyCon stateTyConKey pREL_ST SLIT("State") alpha_tyvar [stateDataCon]
 284 stateDataCon
 285   = pcDataCon stateDataConKey pREL_ST SLIT("S#")
 286         alpha_tyvar [] [mkStatePrimTy alphaTy] stateTyCon
 287 \end{code}
 288
 289 \begin{code}
 290 stablePtrTyCon
 291   = pcNonRecDataTyCon stablePtrTyConKey pREL_FOREIGN SLIT("StablePtr")
 292         alpha_tyvar [stablePtrDataCon]
 293   where
 294     stablePtrDataCon
 295       = pcDataCon stablePtrDataConKey pREL_FOREIGN SLIT("StablePtr")
 296             alpha_tyvar [] [mkStablePtrPrimTy alphaTy] stablePtrTyCon
 297 \end{code}
 298
 299 \begin{code}
 300 foreignObjTyCon
 301   = pcNonRecDataTyCon foreignObjTyConKey pREL_FOREIGN SLIT("ForeignObj")
 302         [] [foreignObjDataCon]
 303   where
 304     foreignObjDataCon
 305       = pcDataCon foreignObjDataConKey pREL_FOREIGN SLIT("ForeignObj")
 306             [] [] [foreignObjPrimTy] foreignObjTyCon
 307 \end{code}
 308
 309 %************************************************************************
 310 %*                                                                      *
 311 \subsection[TysWiredIn-Integer]{@Integer@ and its related ``pairing'' types}
 312 %*                                                                      *
 313 %************************************************************************
 314
 315 @Integer@ and its pals are not really primitive.  @Integer@ itself, first:
 316 \begin{code}
 317 integerTy :: GenType t
 318 integerTy    = mkTyConTy integerTyCon
 319
 320 integerTyCon = pcNonRecDataTyCon integerTyConKey pREL_BASE SLIT("Integer") [] [integerDataCon]
 321
 322 integerDataCon = pcDataCon integerDataConKey pREL_BASE SLIT("J#")
 323                 [] [] [intPrimTy, intPrimTy, byteArrayPrimTy] integerTyCon
 324
 325 isIntegerTy :: GenType flexi -> Bool
 326 isIntegerTy ty
 327   = case (splitAlgTyConApp_maybe ty) of
 328         Just (tycon, [], _) -> uniqueOf tycon == integerTyConKey
 329         _                   -> False
 330 \end{code}
 331
 332 And the other pairing types:
 333 \begin{code}
 334 return2GMPsTyCon = pcNonRecDataTyCon return2GMPsTyConKey
 335         pREL_NUM SLIT("Return2GMPs") [] [return2GMPsDataCon]
 336
 337 return2GMPsDataCon
 338   = pcDataCon return2GMPsDataConKey pREL_NUM SLIT("Return2GMPs") [] []
 339         [intPrimTy, intPrimTy, byteArrayPrimTy,
 340          intPrimTy, intPrimTy, byteArrayPrimTy] return2GMPsTyCon
 341
 342 returnIntAndGMPTyCon = pcNonRecDataTyCon returnIntAndGMPTyConKey
 343         pREL_NUM SLIT("ReturnIntAndGMP") [] [returnIntAndGMPDataCon]
 344
 345 returnIntAndGMPDataCon
 346   = pcDataCon returnIntAndGMPDataConKey pREL_NUM SLIT("ReturnIntAndGMP") [] []
 347         [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy] returnIntAndGMPTyCon
 348 \end{code}
 349
 350 %************************************************************************
 351 %*                                                                      *
 352 \subsection[TysWiredIn-state-pairing]{``State-pairing'' types}
 353 %*                                                                      *
 354 %************************************************************************
 355
 356 These boring types pair a \tr{State#} with another primitive type.
 357 They are not really primitive, so they are given here, not in
 358 \tr{TysPrim.lhs}.
 359
 360 We fish one of these \tr{StateAnd<blah>#} things with
 361 @getStatePairingConInfo@ (given a little way down).
 362
 363 \begin{code}
 364 stateAndPtrPrimTyCon
 365   = pcNonRecDataTyCon stateAndPtrPrimTyConKey pREL_ST SLIT("StateAndPtr#")
 366                 alpha_beta_tyvars [stateAndPtrPrimDataCon]
 367 stateAndPtrPrimDataCon
 368   = pcDataCon stateAndPtrPrimDataConKey pREL_ST SLIT("StateAndPtr#")
 369                 alpha_beta_tyvars [] [mkStatePrimTy alphaTy, betaTy]
 370                 stateAndPtrPrimTyCon
 371
 372 stateAndCharPrimTyCon
 373   = pcNonRecDataTyCon stateAndCharPrimTyConKey pREL_ST SLIT("StateAndChar#")
 374                 alpha_tyvar [stateAndCharPrimDataCon]
 375 stateAndCharPrimDataCon
 376   = pcDataCon stateAndCharPrimDataConKey pREL_ST SLIT("StateAndChar#")
 377                 alpha_tyvar [] [mkStatePrimTy alphaTy, charPrimTy]
 378                 stateAndCharPrimTyCon
 379
 380 stateAndIntPrimTyCon
 381   = pcNonRecDataTyCon stateAndIntPrimTyConKey pREL_ST SLIT("StateAndInt#")
 382                 alpha_tyvar [stateAndIntPrimDataCon]
 383 stateAndIntPrimDataCon
 384   = pcDataCon stateAndIntPrimDataConKey pREL_ST SLIT("StateAndInt#")
 385                 alpha_tyvar [] [mkStatePrimTy alphaTy, intPrimTy]
 386                 stateAndIntPrimTyCon
 387
 388 stateAndWordPrimTyCon
 389   = pcNonRecDataTyCon stateAndWordPrimTyConKey pREL_ST SLIT("StateAndWord#")
 390                 alpha_tyvar [stateAndWordPrimDataCon]
 391 stateAndWordPrimDataCon
 392   = pcDataCon stateAndWordPrimDataConKey pREL_ST SLIT("StateAndWord#")
 393                 alpha_tyvar [] [mkStatePrimTy alphaTy, wordPrimTy]
 394                 stateAndWordPrimTyCon
 395
 396 stateAndAddrPrimTyCon
 397   = pcNonRecDataTyCon stateAndAddrPrimTyConKey pREL_ST SLIT("StateAndAddr#")
 398                 alpha_tyvar [stateAndAddrPrimDataCon]
 399 stateAndAddrPrimDataCon
 400   = pcDataCon stateAndAddrPrimDataConKey pREL_ST SLIT("StateAndAddr#")
 401                 alpha_tyvar [] [mkStatePrimTy alphaTy, addrPrimTy]
 402                 stateAndAddrPrimTyCon
 403
 404 stateAndStablePtrPrimTyCon
 405   = pcNonRecDataTyCon stateAndStablePtrPrimTyConKey pREL_FOREIGN SLIT("StateAndStablePtr#")
 406                 alpha_beta_tyvars [stateAndStablePtrPrimDataCon]
 407 stateAndStablePtrPrimDataCon
 408   = pcDataCon stateAndStablePtrPrimDataConKey pREL_FOREIGN SLIT("StateAndStablePtr#")
 409                 alpha_beta_tyvars []
 410                 [mkStatePrimTy alphaTy, mkTyConApp stablePtrPrimTyCon [betaTy]]
 411                 stateAndStablePtrPrimTyCon
 412
 413 stateAndForeignObjPrimTyCon
 414   = pcNonRecDataTyCon stateAndForeignObjPrimTyConKey pREL_FOREIGN SLIT("StateAndForeignObj#")
 415                 alpha_tyvar [stateAndForeignObjPrimDataCon]
 416 stateAndForeignObjPrimDataCon
 417   = pcDataCon stateAndForeignObjPrimDataConKey pREL_FOREIGN SLIT("StateAndForeignObj#")
 418                 alpha_tyvar []
 419                 [mkStatePrimTy alphaTy, mkTyConTy foreignObjPrimTyCon]
 420                 stateAndForeignObjPrimTyCon
 421
 422 stateAndFloatPrimTyCon
 423   = pcNonRecDataTyCon stateAndFloatPrimTyConKey pREL_ST SLIT("StateAndFloat#")
 424                 alpha_tyvar [stateAndFloatPrimDataCon]
 425 stateAndFloatPrimDataCon
 426   = pcDataCon stateAndFloatPrimDataConKey pREL_ST SLIT("StateAndFloat#")
 427                 alpha_tyvar [] [mkStatePrimTy alphaTy, floatPrimTy]
 428                 stateAndFloatPrimTyCon
 429
 430 stateAndDoublePrimTyCon
 431   = pcNonRecDataTyCon stateAndDoublePrimTyConKey pREL_ST SLIT("StateAndDouble#")
 432                 alpha_tyvar [stateAndDoublePrimDataCon]
 433 stateAndDoublePrimDataCon
 434   = pcDataCon stateAndDoublePrimDataConKey pREL_ST SLIT("StateAndDouble#")
 435                 alpha_tyvar [] [mkStatePrimTy alphaTy, doublePrimTy]
 436                 stateAndDoublePrimTyCon
 437 \end{code}
 438
 439 \begin{code}
 440 stateAndArrayPrimTyCon
 441   = pcNonRecDataTyCon stateAndArrayPrimTyConKey pREL_ARR SLIT("StateAndArray#")
 442                 alpha_beta_tyvars [stateAndArrayPrimDataCon]
 443 stateAndArrayPrimDataCon
 444   = pcDataCon stateAndArrayPrimDataConKey pREL_ARR SLIT("StateAndArray#")
 445                 alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkArrayPrimTy betaTy]
 446                 stateAndArrayPrimTyCon
 447
 448 stateAndMutableArrayPrimTyCon
 449   = pcNonRecDataTyCon stateAndMutableArrayPrimTyConKey pREL_ARR SLIT("StateAndMutableArray#")
 450                 alpha_beta_tyvars [stateAndMutableArrayPrimDataCon]
 451 stateAndMutableArrayPrimDataCon
 452   = pcDataCon stateAndMutableArrayPrimDataConKey pREL_ARR SLIT("StateAndMutableArray#")
 453                 alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkMutableArrayPrimTy alphaTy betaTy]
 454                 stateAndMutableArrayPrimTyCon
 455
 456 stateAndByteArrayPrimTyCon
 457   = pcNonRecDataTyCon stateAndByteArrayPrimTyConKey pREL_ARR SLIT("StateAndByteArray#")
 458                 alpha_tyvar [stateAndByteArrayPrimDataCon]
 459 stateAndByteArrayPrimDataCon
 460   = pcDataCon stateAndByteArrayPrimDataConKey pREL_ARR SLIT("StateAndByteArray#")
 461                 alpha_tyvar [] [mkStatePrimTy alphaTy, byteArrayPrimTy]
 462                 stateAndByteArrayPrimTyCon
 463
 464 stateAndMutableByteArrayPrimTyCon
 465   = pcNonRecDataTyCon stateAndMutableByteArrayPrimTyConKey pREL_ARR SLIT("StateAndMutableByteArray#")
 466                 alpha_tyvar [stateAndMutableByteArrayPrimDataCon]
 467 stateAndMutableByteArrayPrimDataCon
 468   = pcDataCon stateAndMutableByteArrayPrimDataConKey pREL_ARR SLIT("StateAndMutableByteArray#")
 469                 alpha_tyvar [] [mkStatePrimTy alphaTy, mkTyConApp mutableByteArrayPrimTyCon alpha_ty]
 470                 stateAndMutableByteArrayPrimTyCon
 471
 472 stateAndSynchVarPrimTyCon
 473   = pcNonRecDataTyCon stateAndSynchVarPrimTyConKey pREL_CONC SLIT("StateAndSynchVar#")
 474                 alpha_beta_tyvars [stateAndSynchVarPrimDataCon]
 475 stateAndSynchVarPrimDataCon
 476   = pcDataCon stateAndSynchVarPrimDataConKey pREL_CONC SLIT("StateAndSynchVar#")
 477                 alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkSynchVarPrimTy alphaTy betaTy]
 478                 stateAndSynchVarPrimTyCon
 479 \end{code}
 480
 481 The ccall-desugaring mechanism uses this function to figure out how to
 482 rebox the result.  It's really a HACK, especially the part about
 483 how many types to drop from \tr{tys_applied}.
 484
 485 \begin{code}
 486 getStatePairingConInfo
 487         :: Type -- primitive type
 488         -> (Id,         -- state pair constructor for prim type
 489             Type)       -- type of state pair
 490
 491 getStatePairingConInfo prim_ty
 492   = case (splitTyConApp_maybe prim_ty) of
 493       Nothing -> panic "getStatePairingConInfo:1"
 494       Just (prim_tycon, tys_applied) ->
 495         let
 496             (pair_con, pair_tycon, num_tys) = assoc "getStatePairingConInfo" tbl prim_tycon
 497             pair_ty = mkTyConApp pair_tycon (realWorldTy : drop num_tys tys_applied)
 498         in
 499         (pair_con, pair_ty)
 500   where
 501     tbl = [
 502         (charPrimTyCon, (stateAndCharPrimDataCon, stateAndCharPrimTyCon, 0)),
 503         (intPrimTyCon, (stateAndIntPrimDataCon, stateAndIntPrimTyCon, 0)),
 504         (wordPrimTyCon, (stateAndWordPrimDataCon, stateAndWordPrimTyCon, 0)),
 505         (addrPrimTyCon, (stateAndAddrPrimDataCon, stateAndAddrPrimTyCon, 0)),
 506         (stablePtrPrimTyCon, (stateAndStablePtrPrimDataCon, stateAndStablePtrPrimTyCon, 0)),
 507         (foreignObjPrimTyCon, (stateAndForeignObjPrimDataCon, stateAndForeignObjPrimTyCon, 0)),
 508         (floatPrimTyCon, (stateAndFloatPrimDataCon, stateAndFloatPrimTyCon, 0)),
 509         (doublePrimTyCon, (stateAndDoublePrimDataCon, stateAndDoublePrimTyCon, 0)),
 510         (arrayPrimTyCon, (stateAndArrayPrimDataCon, stateAndArrayPrimTyCon, 0)),
 511         (mutableArrayPrimTyCon, (stateAndMutableArrayPrimDataCon, stateAndMutableArrayPrimTyCon, 1)),
 512         (byteArrayPrimTyCon, (stateAndByteArrayPrimDataCon, stateAndByteArrayPrimTyCon, 0)),
 513         (mutableByteArrayPrimTyCon, (stateAndMutableByteArrayPrimDataCon, stateAndMutableByteArrayPrimTyCon, 1)),
 514         (synchVarPrimTyCon, (stateAndSynchVarPrimDataCon, stateAndSynchVarPrimTyCon, 1))
 515         -- (PtrPrimTyCon, (stateAndPtrPrimDataCon, stateAndPtrPrimTyCon, 0)),
 516         ]
 517 \end{code}
 518
 519 %************************************************************************
 520 %*                                                                      *
 521 \subsection[TysWiredIn-ST]{The basic @_ST@ state-transformer type}
 522 %*                                                                      *
 523 %************************************************************************
 524
 525 The only reason this is wired in is because we have to represent the
 526 type of runST.
 527
 528 \begin{code}
 529 mkStateTransformerTy s a = mkTyConApp stTyCon [s, a]
 530
 531 stTyCon = pcNonRecNewTyCon stTyConKey pREL_ST SLIT("ST") alpha_beta_tyvars [stDataCon]
 532
 533 stDataCon = pcDataCon stDataConKey pREL_ST SLIT("ST")
 534                         alpha_beta_tyvars [] [ty] stTyCon
 535   where
 536     ty = mkFunTy (mkStatePrimTy alphaTy) (mkSTretTy alphaTy betaTy)
 537
 538 mkSTretTy alpha beta = mkTyConApp stRetTyCon [alpha,beta]
 539
 540 stRetTyCon
 541   = pcNonRecDataTyCon stRetTyConKey pREL_ST SLIT("STret")
 542         alpha_beta_tyvars [stRetDataCon]
 543 stRetDataCon
 544   = pcDataCon stRetDataConKey pREL_ST SLIT("STret")
 545         alpha_beta_tyvars [] [mkStatePrimTy alphaTy, betaTy]
 546                 stRetTyCon
 547 \end{code}
 548
 549 %************************************************************************
 550 %*                                                                      *
 551 \subsection[TysWiredIn-Bool]{The @Bool@ type}
 552 %*                                                                      *
 553 %************************************************************************
 554
 555 An ordinary enumeration type, but deeply wired in.  There are no
 556 magical operations on @Bool@ (just the regular Prelude code).
 557
 558 {\em BEGIN IDLE SPECULATION BY SIMON}
 559
 560 This is not the only way to encode @Bool@.  A more obvious coding makes
 561 @Bool@ just a boxed up version of @Bool#@, like this:
 562 \begin{verbatim}
 563 type Bool# = Int#
 564 data Bool = MkBool Bool#
 565 \end{verbatim}
 566
 567 Unfortunately, this doesn't correspond to what the Report says @Bool@
 568 looks like!  Furthermore, we get slightly less efficient code (I
 569 think) with this coding. @gtInt@ would look like this:
 570
 571 \begin{verbatim}
 572 gtInt :: Int -> Int -> Bool
 573 gtInt x y = case x of I# x# ->
 574             case y of I# y# ->
 575             case (gtIntPrim x# y#) of
 576                 b# -> MkBool b#
 577 \end{verbatim}
 578
 579 Notice that the result of the @gtIntPrim@ comparison has to be turned
 580 into an integer (here called @b#@), and returned in a @MkBool@ box.
 581
 582 The @if@ expression would compile to this:
 583 \begin{verbatim}
 584 case (gtInt x y) of
 585   MkBool b# -> case b# of { 1# -> e1; 0# -> e2 }
 586 \end{verbatim}
 587
 588 I think this code is a little less efficient than the previous code,
 589 but I'm not certain.  At all events, corresponding with the Report is
 590 important.  The interesting thing is that the language is expressive
 591 enough to describe more than one alternative; and that a type doesn't
 592 necessarily need to be a straightforwardly boxed version of its
 593 primitive counterpart.
 594
 595 {\em END IDLE SPECULATION BY SIMON}
 596
 597 \begin{code}
 598 boolTy = mkTyConTy boolTyCon
 599
 600 boolTyCon = pcNonRecDataTyCon boolTyConKey pREL_BASE SLIT("Bool") [] [falseDataCon, trueDataCon]
 601
 602 falseDataCon = pcDataCon falseDataConKey pREL_BASE SLIT("False") [] [] [] boolTyCon
 603 trueDataCon  = pcDataCon trueDataConKey  pREL_BASE SLIT("True")  [] [] [] boolTyCon
 604 \end{code}
 605
 606 %************************************************************************
 607 %*                                                                      *
 608 \subsection[TysWiredIn-List]{The @List@ type (incl ``build'' magic)}
 609 %*                                                                      *
 610 %************************************************************************
 611
 612 Special syntax, deeply wired in, but otherwise an ordinary algebraic
 613 data types:
 614 \begin{verbatim}
 615 data [] a = [] | a : (List a)
 616 data () = ()
 617 data (,) a b = (,,) a b
 618 ...
 619 \end{verbatim}
 620
 621 \begin{code}
 622 mkListTy :: GenType t -> GenType t
 623 mkListTy ty = mkTyConApp listTyCon [ty]
 624
 625 alphaListTy = mkSigmaTy alpha_tyvar [] (mkTyConApp listTyCon alpha_ty)
 626
 627 listTyCon = pcRecDataTyCon listTyConKey pREL_BASE SLIT("[]")
 628                         alpha_tyvar [nilDataCon, consDataCon]
 629
 630 nilDataCon  = pcDataCon nilDataConKey  pREL_BASE SLIT("[]") alpha_tyvar [] [] listTyCon
 631 consDataCon = pcDataCon consDataConKey pREL_BASE SLIT(":")
 632                 alpha_tyvar [] [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon
 633 -- Interesting: polymorphic recursion would help here.
 634 -- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy
 635 -- gets the over-specific type (Type -> Type)
 636 \end{code}
 637
 638 %************************************************************************
 639 %*                                                                      *
 640 \subsection[TysWiredIn-Tuples]{The @Tuple@ types}
 641 %*                                                                      *
 642 %************************************************************************
 643
 644 The tuple types are definitely magic, because they form an infinite
 645 family.
 646
 647 \begin{itemize}
 648 \item
 649 They have a special family of type constructors, of type @TyCon@
 650 These contain the tycon arity, but don't require a Unique.
 651
 652 \item
 653 They have a special family of constructors, of type
 654 @Id@. Again these contain their arity but don't need a Unique.
 655
 656 \item
 657 There should be a magic way of generating the info tables and
 658 entry code for all tuples.
 659
 660 But at the moment we just compile a Haskell source
 661 file\srcloc{lib/prelude/...} containing declarations like:
 662 \begin{verbatim}
 663 data Tuple0             = Tup0
 664 data Tuple2  a b        = Tup2  a b
 665 data Tuple3  a b c      = Tup3  a b c
 666 data Tuple4  a b c d    = Tup4  a b c d
 667 ...
 668 \end{verbatim}
 669 The print-names associated with the magic @Id@s for tuple constructors
 670 ``just happen'' to be the same as those generated by these
 671 declarations.
 672
 673 \item
 674 The instance environment should have a magic way to know
 675 that each tuple type is an instances of classes @Eq@, @Ix@, @Ord@ and
 676 so on. \ToDo{Not implemented yet.}
 677
 678 \item
 679 There should also be a way to generate the appropriate code for each
 680 of these instances, but (like the info tables and entry code) it is
 681 done by enumeration\srcloc{lib/prelude/InTup?.hs}.
 682 \end{itemize}
 683
 684 \begin{code}
 685 mkTupleTy :: Int -> [GenType t] -> GenType t
 686
 687 mkTupleTy arity tys = mkTyConApp (tupleTyCon arity) tys
 688
 689 unitTy    = mkTupleTy 0 []
 690 \end{code}
 691
 692 %************************************************************************
 693 %*                                                                      *
 694 \subsection[TysWiredIn-_Lift]{@_Lift@ type: to support array indexing}
 695 %*                                                                      *
 696 %************************************************************************
 697
 698 Again, deeply turgid: \tr{data _Lift a = _Lift a}.
 699
 700 \begin{code}
 701 mkLiftTy ty = mkTyConApp liftTyCon [ty]
 702
 703 {-
 704 mkLiftTy ty
 705   = mkSigmaTy tvs theta (mkTyConApp liftTyCon [tau])
 706   where
 707     (tvs, theta, tau) = splitSigmaTy ty
 708
 709 isLiftTy ty
 710   = case (splitAlgTyConApp_maybeExpandingDicts tau) of
 711       Just (tycon, tys, _) -> tycon == liftTyCon
 712       Nothing -> False
 713   where
 714     (tvs, theta, tau) = splitSigmaTy ty
 715 -}
 716
 717
 718 alphaLiftTy = mkSigmaTy alpha_tyvar [] (mkTyConApp liftTyCon alpha_ty)
 719
 720 liftTyCon
 721   = pcNonRecDataTyCon liftTyConKey pREL_BASE SLIT("Lift") alpha_tyvar [liftDataCon]
 722
 723 liftDataCon
 724   = pcDataCon liftDataConKey pREL_BASE SLIT("Lift")
 725                 alpha_tyvar [] alpha_ty liftTyCon
 726   where
 727     bottom = panic "liftDataCon:State# _RealWorld"
 728 \end{code}