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