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