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