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