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