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