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