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         cmpTagTy,
  25         cmpTagTyCon,
  26         consDataCon,
  27         doubleDataCon,
  28         doubleTy,
  29         doubleTyCon,
  30         eqPrimDataCon,
  31         falseDataCon,
  32         floatDataCon,
  33         floatTy,
  34         floatTyCon,
  35         getStatePairingConInfo,
  36         gtPrimDataCon,
  37         intDataCon,
  38         intTy,
  39         intTyCon,
  40         integerTy,
  41         integerTyCon,
  42         integerDataCon,
  43         liftDataCon,
  44         liftTyCon,
  45         listTyCon,
  46         ltPrimDataCon,
  47         mallocPtrTyCon,
  48         mkLiftTy,
  49         mkListTy,
  50         mkPrimIoTy,
  51         mkStateTransformerTy,
  52         mkTupleTy,
  53         nilDataCon,
  54         primIoTyCon,
  55         ratioDataCon,
  56         ratioTyCon,
  57         rationalTy,
  58         rationalTyCon,
  59         realWorldStateTy,
  60         return2GMPsTyCon,
  61         returnIntAndGMPTyCon,
  62         stTyCon,
  63         stablePtrTyCon,
  64         stateAndAddrPrimTyCon,
  65         stateAndArrayPrimTyCon,
  66         stateAndByteArrayPrimTyCon,
  67         stateAndCharPrimTyCon,
  68         stateAndDoublePrimTyCon,
  69         stateAndFloatPrimTyCon,
  70         stateAndIntPrimTyCon,
  71         stateAndMallocPtrPrimTyCon,
  72         stateAndMutableArrayPrimTyCon,
  73         stateAndMutableByteArrayPrimTyCon,
  74         stateAndPtrPrimTyCon,
  75         stateAndStablePtrPrimTyCon,
  76         stateAndSynchVarPrimTyCon,
  77         stateAndWordPrimTyCon,
  78         stateDataCon,
  79         stateTyCon,
  80         stringTy,
  81         stringTyCon,
  82         trueDataCon,
  83         unitTy,
  84         wordDataCon,
  85         wordTy,
  86         wordTyCon
  87     ) where
  88
  89 import Pretty           --ToDo:rm debugging only
  90
  91 import PrelFuns         -- help functions, types and things
  92 import TysPrim
  93
  94 import AbsUniType       ( applyTyCon, mkTupleTyCon, mkSynonymTyCon,
  95                           getUniDataTyCon_maybe, mkSigmaTy, TyCon
  96                           , pprUniType --ToDo: rm debugging only
  97                           IF_ATTACK_PRAGMAS(COMMA cmpTyCon)
  98                         )
  99 import IdInfo
 100 import Maybes           ( Maybe(..) )
 101 import Unique
 102 import Util
 103 \end{code}
 104
 105 %************************************************************************
 106 %*                                                                      *
 107 \subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)}
 108 %*                                                                      *
 109 %************************************************************************
 110
 111 \begin{code}
 112 charTy = UniData charTyCon []
 113
 114 charTyCon = pcDataTyCon charTyConKey pRELUDE_BUILTIN SLIT("Char") [] [charDataCon]
 115 charDataCon = pcDataCon charDataConKey pRELUDE_BUILTIN SLIT("C#") [] [] [charPrimTy] charTyCon nullSpecEnv
 116 \end{code}
 117
 118 \begin{code}
 119 intTy = UniData intTyCon []
 120
 121 intTyCon = pcDataTyCon intTyConKey pRELUDE_BUILTIN SLIT("Int") [] [intDataCon]
 122 intDataCon = pcDataCon intDataConKey pRELUDE_BUILTIN SLIT("I#") [] [] [intPrimTy] intTyCon nullSpecEnv
 123 \end{code}
 124
 125 \begin{code}
 126 wordTy = UniData wordTyCon []
 127
 128 wordTyCon = pcDataTyCon wordTyConKey pRELUDE_BUILTIN SLIT("_Word") [] [wordDataCon]
 129 wordDataCon = pcDataCon wordDataConKey pRELUDE_BUILTIN SLIT("W#") [] [] [wordPrimTy] wordTyCon nullSpecEnv
 130 \end{code}
 131
 132 \begin{code}
 133 addrTy = UniData addrTyCon []
 134
 135 addrTyCon = pcDataTyCon addrTyConKey pRELUDE_BUILTIN SLIT("_Addr") [] [addrDataCon]
 136 addrDataCon = pcDataCon addrDataConKey pRELUDE_BUILTIN SLIT("A#") [] [] [addrPrimTy] addrTyCon nullSpecEnv
 137 \end{code}
 138
 139 \begin{code}
 140 floatTy = UniData floatTyCon []
 141
 142 floatTyCon = pcDataTyCon floatTyConKey pRELUDE_BUILTIN SLIT("Float") [] [floatDataCon]
 143 floatDataCon = pcDataCon floatDataConKey pRELUDE_BUILTIN SLIT("F#") [] [] [floatPrimTy] floatTyCon nullSpecEnv
 144 \end{code}
 145
 146 \begin{code}
 147 doubleTy = UniData doubleTyCon []
 148
 149 doubleTyCon = pcDataTyCon doubleTyConKey pRELUDE_BUILTIN SLIT("Double") [] [doubleDataCon]
 150 doubleDataCon = pcDataCon doubleDataConKey pRELUDE_BUILTIN SLIT("D#") [] [] [doublePrimTy] doubleTyCon nullSpecEnv
 151 \end{code}
 152
 153 \begin{code}
 154 mkStateTy ty     = applyTyCon stateTyCon [ty]
 155 realWorldStateTy = mkStateTy realWorldTy -- a common use
 156
 157 stateTyCon = pcDataTyCon stateTyConKey pRELUDE_BUILTIN SLIT("_State") [alpha_tv] [stateDataCon]
 158 stateDataCon
 159   = pcDataCon stateDataConKey pRELUDE_BUILTIN SLIT("S#")
 160         [alpha_tv] [] [mkStatePrimTy alpha] stateTyCon nullSpecEnv
 161 \end{code}
 162
 163 \begin{code}
 164 {- OLD:
 165 byteArrayTyCon
 166   = pcDataTyCon byteArrayTyConKey pRELUDE_ARRAY SLIT("_ByteArray")
 167         [alpha_tv] [byteArrayDataCon]
 168
 169 byteArrayDataCon
 170   = pcDataCon byteArrayDataConKey pRELUDE_ARRAY SLIT("_ByteArray")
 171         [alpha_tv] []
 172         [mkTupleTy 2 [alpha, alpha], byteArrayPrimTy]
 173         byteArrayTyCon nullSpecEnv
 174 -}
 175 \end{code}
 176
 177 \begin{code}
 178 {- OLD:
 179 mutableArrayTyCon
 180   = pcDataTyCon mutableArrayTyConKey gLASGOW_ST SLIT("_MutableArray")
 181         [alpha_tv, beta_tv, gamma_tv] [mutableArrayDataCon]
 182   where
 183     mutableArrayDataCon
 184       = pcDataCon mutableArrayDataConKey gLASGOW_ST SLIT("_MutableArray")
 185             [alpha_tv, beta_tv, gamma_tv] []
 186             [mkTupleTy 2 [beta, beta], applyTyCon mutableArrayPrimTyCon [alpha, gamma]]
 187             mutableArrayTyCon nullSpecEnv
 188 -}
 189 \end{code}
 190
 191 \begin{code}
 192 {-
 193 mutableByteArrayTyCon
 194   = pcDataTyCon mutableByteArrayTyConKey gLASGOW_ST SLIT("_MutableByteArray")
 195         [alpha_tv, beta_tv] [mutableByteArrayDataCon]
 196
 197 mutableByteArrayDataCon
 198   = pcDataCon mutableByteArrayDataConKey gLASGOW_ST SLIT("_MutableByteArray")
 199         [alpha_tv, beta_tv] []
 200         [mkTupleTy 2 [beta, beta], mkMutableByteArrayPrimTy alpha]
 201         mutableByteArrayTyCon nullSpecEnv
 202 -}
 203 \end{code}
 204
 205 \begin{code}
 206 stablePtrTyCon
 207   = pcDataTyCon stablePtrTyConKey gLASGOW_MISC SLIT("_StablePtr")
 208         [alpha_tv] [stablePtrDataCon]
 209   where
 210     stablePtrDataCon
 211       = pcDataCon stablePtrDataConKey gLASGOW_MISC SLIT("_StablePtr")
 212             [alpha_tv] [] [applyTyCon stablePtrPrimTyCon [alpha]] stablePtrTyCon nullSpecEnv
 213 \end{code}
 214
 215 \begin{code}
 216 mallocPtrTyCon
 217   = pcDataTyCon mallocPtrTyConKey gLASGOW_MISC SLIT("_MallocPtr")
 218         [] [mallocPtrDataCon]
 219   where
 220     mallocPtrDataCon
 221       = pcDataCon mallocPtrDataConKey gLASGOW_MISC SLIT("_MallocPtr")
 222             [] [] [applyTyCon mallocPtrPrimTyCon []] mallocPtrTyCon nullSpecEnv
 223 \end{code}
 224
 225 %************************************************************************
 226 %*                                                                      *
 227 \subsection[TysWiredIn-Integer]{@Integer@ and its related ``pairing'' types}
 228 %*                                                                      *
 229 %************************************************************************
 230
 231 @Integer@ and its pals are not really primitive.  @Integer@ itself, first:
 232 \begin{code}
 233 integerTy :: UniType
 234 integerTy    = UniData integerTyCon []
 235
 236 integerTyCon = pcDataTyCon integerTyConKey pRELUDE_BUILTIN SLIT("Integer") [] [integerDataCon]
 237
 238 #ifndef DPH
 239 integerDataCon = pcDataCon integerDataConKey pRELUDE_BUILTIN SLIT("J#")
 240                 [] [] [intPrimTy, intPrimTy, byteArrayPrimTy] integerTyCon nullSpecEnv
 241 #else
 242 -- DPH: For the time being we implement Integers in the same way as Ints.
 243 integerDataCon = pcDataCon integerDataConKey pRELUDE_BUILTIN SLIT("J#")
 244                 [] [] [intPrimTy] integerTyCon nullSpecEnv
 245 #endif {- Data Parallel Haskell -}
 246 \end{code}
 247
 248 And the other pairing types:
 249 \begin{code}
 250 return2GMPsTyCon = pcDataTyCon return2GMPsTyConKey
 251         pRELUDE_BUILTIN SLIT("_Return2GMPs") [] [return2GMPsDataCon]
 252
 253 return2GMPsDataCon
 254   = pcDataCon return2GMPsDataConKey pRELUDE_BUILTIN SLIT("_Return2GMPs") [] []
 255         [intPrimTy, intPrimTy, byteArrayPrimTy,
 256          intPrimTy, intPrimTy, byteArrayPrimTy] return2GMPsTyCon nullSpecEnv
 257
 258 returnIntAndGMPTyCon = pcDataTyCon returnIntAndGMPTyConKey
 259         pRELUDE_BUILTIN SLIT("_ReturnIntAndGMP") [] [returnIntAndGMPDataCon]
 260
 261 returnIntAndGMPDataCon
 262   = pcDataCon returnIntAndGMPDataConKey pRELUDE_BUILTIN SLIT("_ReturnIntAndGMP") [] []
 263         [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy] returnIntAndGMPTyCon nullSpecEnv
 264 \end{code}
 265
 266 %************************************************************************
 267 %*                                                                      *
 268 \subsection[TysWiredIn-state-pairing]{``State-pairing'' types}
 269 %*                                                                      *
 270 %************************************************************************
 271
 272 These boring types pair a \tr{State#} with another primitive type.
 273 They are not really primitive, so they are given here, not in
 274 \tr{TysPrim.lhs}.
 275
 276 We fish one of these \tr{StateAnd<blah>#} things with
 277 @getStatePairingConInfo@ (given a little way down).
 278
 279 \begin{code}
 280 stateAndPtrPrimTyCon
 281   = pcDataTyCon stateAndPtrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndPtr#")
 282                 [alpha_tv, beta_tv] [stateAndPtrPrimDataCon]
 283 stateAndPtrPrimDataCon
 284   = pcDataCon stateAndPtrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndPtr#")
 285                 [alpha_tv, beta_tv] [] [mkStatePrimTy alpha, beta]
 286                 stateAndPtrPrimTyCon nullSpecEnv
 287
 288 stateAndCharPrimTyCon
 289   = pcDataTyCon stateAndCharPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndChar#")
 290                 [alpha_tv] [stateAndCharPrimDataCon]
 291 stateAndCharPrimDataCon
 292   = pcDataCon stateAndCharPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndChar#")
 293                 [alpha_tv] [] [mkStatePrimTy alpha, charPrimTy]
 294                 stateAndCharPrimTyCon nullSpecEnv
 295
 296 stateAndIntPrimTyCon
 297   = pcDataTyCon stateAndIntPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndInt#")
 298                 [alpha_tv] [stateAndIntPrimDataCon]
 299 stateAndIntPrimDataCon
 300   = pcDataCon stateAndIntPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndInt#")
 301                 [alpha_tv] [] [mkStatePrimTy alpha, intPrimTy]
 302                 stateAndIntPrimTyCon nullSpecEnv
 303
 304 stateAndWordPrimTyCon
 305   = pcDataTyCon stateAndWordPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndWord#")
 306                 [alpha_tv] [stateAndWordPrimDataCon]
 307 stateAndWordPrimDataCon
 308   = pcDataCon stateAndWordPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndWord#")
 309                 [alpha_tv] [] [mkStatePrimTy alpha, wordPrimTy]
 310                 stateAndWordPrimTyCon nullSpecEnv
 311
 312 stateAndAddrPrimTyCon
 313   = pcDataTyCon stateAndAddrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndAddr#")
 314                 [alpha_tv] [stateAndAddrPrimDataCon]
 315 stateAndAddrPrimDataCon
 316   = pcDataCon stateAndAddrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndAddr#")
 317                 [alpha_tv] [] [mkStatePrimTy alpha, addrPrimTy]
 318                 stateAndAddrPrimTyCon nullSpecEnv
 319
 320 stateAndStablePtrPrimTyCon
 321   = pcDataTyCon stateAndStablePtrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndStablePtr#")
 322                 [alpha_tv, beta_tv] [stateAndStablePtrPrimDataCon]
 323 stateAndStablePtrPrimDataCon
 324   = pcDataCon stateAndStablePtrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndStablePtr#")
 325                 [alpha_tv, beta_tv] []
 326                 [mkStatePrimTy alpha, applyTyCon stablePtrPrimTyCon [beta]]
 327                 stateAndStablePtrPrimTyCon nullSpecEnv
 328
 329 stateAndMallocPtrPrimTyCon
 330   = pcDataTyCon stateAndMallocPtrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndMallocPtr#")
 331                 [alpha_tv] [stateAndMallocPtrPrimDataCon]
 332 stateAndMallocPtrPrimDataCon
 333   = pcDataCon stateAndMallocPtrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndMallocPtr#")
 334                 [alpha_tv] []
 335                 [mkStatePrimTy alpha, applyTyCon mallocPtrPrimTyCon []]
 336                 stateAndMallocPtrPrimTyCon nullSpecEnv
 337
 338 stateAndFloatPrimTyCon
 339   = pcDataTyCon stateAndFloatPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndFloat#")
 340                 [alpha_tv] [stateAndFloatPrimDataCon]
 341 stateAndFloatPrimDataCon
 342   = pcDataCon stateAndFloatPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndFloat#")
 343                 [alpha_tv] [] [mkStatePrimTy alpha, floatPrimTy]
 344                 stateAndFloatPrimTyCon nullSpecEnv
 345
 346 stateAndDoublePrimTyCon
 347   = pcDataTyCon stateAndDoublePrimTyConKey pRELUDE_BUILTIN SLIT("StateAndDouble#")
 348                 [alpha_tv] [stateAndDoublePrimDataCon]
 349 stateAndDoublePrimDataCon
 350   = pcDataCon stateAndDoublePrimDataConKey pRELUDE_BUILTIN SLIT("StateAndDouble#")
 351                 [alpha_tv] [] [mkStatePrimTy alpha, doublePrimTy]
 352                 stateAndDoublePrimTyCon nullSpecEnv
 353 \end{code}
 354
 355 \begin{code}
 356 stateAndArrayPrimTyCon
 357   = pcDataTyCon stateAndArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndArray#")
 358                 [alpha_tv, beta_tv] [stateAndArrayPrimDataCon]
 359 stateAndArrayPrimDataCon
 360   = pcDataCon stateAndArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndArray#")
 361                 [alpha_tv, beta_tv] [] [mkStatePrimTy alpha, mkArrayPrimTy beta]
 362                 stateAndArrayPrimTyCon nullSpecEnv
 363
 364 stateAndMutableArrayPrimTyCon
 365   = pcDataTyCon stateAndMutableArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndMutableArray#")
 366                 [alpha_tv, beta_tv] [stateAndMutableArrayPrimDataCon]
 367 stateAndMutableArrayPrimDataCon
 368   = pcDataCon stateAndMutableArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndMutableArray#")
 369                 [alpha_tv, beta_tv] [] [mkStatePrimTy alpha, mkMutableArrayPrimTy alpha beta]
 370                 stateAndMutableArrayPrimTyCon nullSpecEnv
 371
 372 stateAndByteArrayPrimTyCon
 373   = pcDataTyCon stateAndByteArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndByteArray#")
 374                 [alpha_tv] [stateAndByteArrayPrimDataCon]
 375 stateAndByteArrayPrimDataCon
 376   = pcDataCon stateAndByteArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndByteArray#")
 377                 [alpha_tv] [] [mkStatePrimTy alpha, byteArrayPrimTy]
 378                 stateAndByteArrayPrimTyCon nullSpecEnv
 379
 380 stateAndMutableByteArrayPrimTyCon
 381   = pcDataTyCon stateAndMutableByteArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndMutableByteArray#")
 382                 [alpha_tv] [stateAndMutableByteArrayPrimDataCon]
 383 stateAndMutableByteArrayPrimDataCon
 384   = pcDataCon stateAndMutableByteArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndMutableByteArray#")
 385                 [alpha_tv] [] [mkStatePrimTy alpha, applyTyCon mutableByteArrayPrimTyCon [alpha]]
 386                 stateAndMutableByteArrayPrimTyCon nullSpecEnv
 387
 388 stateAndSynchVarPrimTyCon
 389   = pcDataTyCon stateAndSynchVarPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndSynchVar#")
 390                 [alpha_tv, beta_tv] [stateAndSynchVarPrimDataCon]
 391 stateAndSynchVarPrimDataCon
 392   = pcDataCon stateAndSynchVarPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndSynchVar#")
 393                 [alpha_tv, beta_tv] [] [mkStatePrimTy alpha, mkSynchVarPrimTy alpha beta]
 394                 stateAndSynchVarPrimTyCon nullSpecEnv
 395 \end{code}
 396
 397 The ccall-desugaring mechanism uses this function to figure out how to
 398 rebox the result.  It's really a HACK, especially the part about
 399 how many types to drop from \tr{tys_applied}.
 400
 401 \begin{code}
 402 getStatePairingConInfo
 403         :: UniType      -- primitive type
 404         -> (Id,         -- state pair constructor for prim type
 405             UniType)    -- type of state pair
 406
 407 getStatePairingConInfo prim_ty
 408   = case (getUniDataTyCon_maybe prim_ty) of
 409       Nothing -> panic "getStatePairingConInfo:1"
 410       Just (prim_tycon, tys_applied, _) ->
 411         let
 412             (pair_con, pair_tycon, num_tys) = assoc "getStatePairingConInfo" tbl prim_tycon
 413             pair_ty = applyTyCon pair_tycon (realWorldTy : drop num_tys tys_applied)
 414         in
 415         (pair_con, pair_ty)
 416   where
 417     tbl = [
 418         (charPrimTyCon, (stateAndCharPrimDataCon, stateAndCharPrimTyCon, 0)),
 419         (intPrimTyCon, (stateAndIntPrimDataCon, stateAndIntPrimTyCon, 0)),
 420         (wordPrimTyCon, (stateAndWordPrimDataCon, stateAndWordPrimTyCon, 0)),
 421         (addrPrimTyCon, (stateAndAddrPrimDataCon, stateAndAddrPrimTyCon, 0)),
 422         (stablePtrPrimTyCon, (stateAndStablePtrPrimDataCon, stateAndStablePtrPrimTyCon, 0)),
 423         (mallocPtrPrimTyCon, (stateAndMallocPtrPrimDataCon, stateAndMallocPtrPrimTyCon, 0)),
 424         (floatPrimTyCon, (stateAndFloatPrimDataCon, stateAndFloatPrimTyCon, 0)),
 425         (doublePrimTyCon, (stateAndDoublePrimDataCon, stateAndDoublePrimTyCon, 0)),
 426         (arrayPrimTyCon, (stateAndArrayPrimDataCon, stateAndArrayPrimTyCon, 0)),
 427         (mutableArrayPrimTyCon, (stateAndMutableArrayPrimDataCon, stateAndMutableArrayPrimTyCon, 1)),
 428         (byteArrayPrimTyCon, (stateAndByteArrayPrimDataCon, stateAndByteArrayPrimTyCon, 0)),
 429         (mutableByteArrayPrimTyCon, (stateAndMutableByteArrayPrimDataCon, stateAndMutableByteArrayPrimTyCon, 1)),
 430         (synchVarPrimTyCon, (stateAndSynchVarPrimDataCon, stateAndSynchVarPrimTyCon, 1))
 431         -- (PtrPrimTyCon, (stateAndPtrPrimDataCon, stateAndPtrPrimTyCon, 0)),
 432         ]
 433 \end{code}
 434
 435 %************************************************************************
 436 %*                                                                      *
 437 \subsection[TysWiredIn-ST]{The basic @_ST@ state-transformer type}
 438 %*                                                                      *
 439 %************************************************************************
 440
 441 This is really just an ordinary synonym, except it is ABSTRACT.
 442
 443 \begin{code}
 444 mkStateTransformerTy s a = applyTyCon stTyCon [s, a]
 445
 446 stTyCon
 447   = mkSynonymTyCon
 448      stTyConKey
 449      (mkPreludeCoreName gLASGOW_ST SLIT("_ST"))
 450      2
 451      [alpha_tv, beta_tv]
 452      (mkStateTy alpha `UniFun` mkTupleTy 2 [beta, mkStateTy alpha])
 453      True -- ToDo: make... *** ABSTRACT ***
 454 \end{code}
 455
 456 %************************************************************************
 457 %*                                                                      *
 458 \subsection[TysWiredIn-IO]{The @PrimIO@ and @IO@ monadic-I/O types}
 459 %*                                                                      *
 460 %************************************************************************
 461
 462 @PrimIO@ and @IO@ really are just a plain synonyms.
 463
 464 \begin{code}
 465 mkPrimIoTy a = applyTyCon primIoTyCon [a]
 466
 467 primIoTyCon
 468   = mkSynonymTyCon
 469      primIoTyConKey
 470      (mkPreludeCoreName pRELUDE_PRIMIO SLIT("PrimIO"))
 471      1
 472      [alpha_tv]
 473      (mkStateTransformerTy realWorldTy alpha)
 474      True -- need not be abstract
 475 \end{code}
 476
 477 %************************************************************************
 478 %*                                                                      *
 479 \subsection[TysWiredIn-Bool]{The @Bool@ type}
 480 %*                                                                      *
 481 %************************************************************************
 482
 483 An ordinary enumeration type, but deeply wired in.  There are no
 484 magical operations on @Bool@ (just the regular Prelude code).
 485
 486 {\em BEGIN IDLE SPECULATION BY SIMON}
 487
 488 This is not the only way to encode @Bool@.  A more obvious coding makes
 489 @Bool@ just a boxed up version of @Bool#@, like this:
 490 \begin{verbatim}
 491 type Bool# = Int#
 492 data Bool = MkBool Bool#
 493 \end{verbatim}
 494
 495 Unfortunately, this doesn't correspond to what the Report says @Bool@
 496 looks like!  Furthermore, we get slightly less efficient code (I
 497 think) with this coding. @gtInt@ would look like this:
 498
 499 \begin{verbatim}
 500 gtInt :: Int -> Int -> Bool
 501 gtInt x y = case x of I# x# ->
 502             case y of I# y# ->
 503             case (gtIntPrim x# y#) of
 504                 b# -> MkBool b#
 505 \end{verbatim}
 506
 507 Notice that the result of the @gtIntPrim@ comparison has to be turned
 508 into an integer (here called @b#@), and returned in a @MkBool@ box.
 509
 510 The @if@ expression would compile to this:
 511 \begin{verbatim}
 512 case (gtInt x y) of
 513   MkBool b# -> case b# of { 1# -> e1; 0# -> e2 }
 514 \end{verbatim}
 515
 516 I think this code is a little less efficient than the previous code,
 517 but I'm not certain.  At all events, corresponding with the Report is
 518 important.  The interesting thing is that the language is expressive
 519 enough to describe more than one alternative; and that a type doesn't
 520 necessarily need to be a straightforwardly boxed version of its
 521 primitive counterpart.
 522
 523 {\em END IDLE SPECULATION BY SIMON}
 524
 525 \begin{code}
 526 boolTy = UniData boolTyCon []
 527
 528 boolTyCon = pcDataTyCon boolTyConKey pRELUDE_CORE SLIT("Bool") [] [falseDataCon, trueDataCon]
 529
 530 falseDataCon = pcDataCon falseDataConKey pRELUDE_CORE SLIT("False") [] [] [] boolTyCon nullSpecEnv
 531 trueDataCon  = pcDataCon trueDataConKey  pRELUDE_CORE SLIT("True")  [] [] [] boolTyCon nullSpecEnv
 532 \end{code}
 533
 534 %************************************************************************
 535 %*                                                                      *
 536 \subsection[TysWiredIn-CMP-TAG]{The @CMP_TAG#@ type (for fast `derived' comparisons)}
 537 %*                                                                      *
 538 %************************************************************************
 539
 540 \begin{code}
 541 ---------------------------------------------
 542 -- data _CMP_TAG = _LT | _EQ | _GT deriving ()
 543 ---------------------------------------------
 544
 545 cmpTagTy = UniData cmpTagTyCon []
 546
 547 cmpTagTyCon = pcDataTyCon cmpTagTyConKey pRELUDE_BUILTIN SLIT("_CMP_TAG") []
 548                 [ltPrimDataCon, eqPrimDataCon, gtPrimDataCon]
 549
 550 ltPrimDataCon  = pcDataCon ltTagDataConKey pRELUDE_BUILTIN SLIT("_LT") [] [] [] cmpTagTyCon nullSpecEnv
 551 eqPrimDataCon  = pcDataCon eqTagDataConKey pRELUDE_BUILTIN SLIT("_EQ") [] [] [] cmpTagTyCon nullSpecEnv
 552 gtPrimDataCon  = pcDataCon gtTagDataConKey pRELUDE_BUILTIN SLIT("_GT") [] [] [] cmpTagTyCon nullSpecEnv
 553 \end{code}
 554
 555 %************************************************************************
 556 %*                                                                      *
 557 \subsection[TysWiredIn-List]{The @List@ type (incl ``build'' magic)}
 558 %*                                                                      *
 559 %************************************************************************
 560
 561 Special syntax, deeply wired in, but otherwise an ordinary algebraic
 562 data type:
 563 \begin{verbatim}
 564 data List a = Nil | a : (List a)
 565 \end{verbatim}
 566
 567 \begin{code}
 568 mkListTy :: UniType -> UniType
 569 mkListTy ty = UniData listTyCon [ty]
 570
 571 alphaListTy = mkSigmaTy [alpha_tv] [] (mkListTy alpha)
 572
 573 listTyCon = pcDataTyCon listTyConKey pRELUDE_BUILTIN SLIT("List") [alpha_tv] [nilDataCon, consDataCon]
 574
 575 nilDataCon  = pcDataCon nilDataConKey  pRELUDE_BUILTIN SLIT("Nil") [alpha_tv] [] [] listTyCon
 576                 (pcGenerateDataSpecs alphaListTy)
 577 consDataCon = pcDataCon consDataConKey pRELUDE_BUILTIN SLIT(":")
 578                 [alpha_tv] [] [alpha, mkListTy alpha] listTyCon
 579                 (pcGenerateDataSpecs alphaListTy)
 580 \end{code}
 581
 582 This is the @_Build@ data constructor, it does {\em not} appear inside
 583 listTyCon.  It has this type: \tr{((a -> b -> b) -> b -> b) -> [a]}.
 584 \begin{code}
 585 {- NOT USED:
 586 buildDataCon
 587   = pcDataCon buildDataConKey  pRELUDE_BUILTIN "Build"
 588         [alpha_tv] [] [
 589                 mkSigmaTy [beta_tv] []
 590                         ((alpha `UniFun` (beta `UniFun` beta))
 591                         `UniFun` (beta
 592                         `UniFun` beta))] listTyCon nullSpecEnv
 593 -}
 594 \end{code}
 595
 596 %************************************************************************
 597 %*                                                                      *
 598 \subsection[TysWiredIn-Tuples]{The @Tuple@ types}
 599 %*                                                                      *
 600 %************************************************************************
 601
 602 The tuple types are definitely magic, because they form an infinite
 603 family.
 604
 605 \begin{itemize}
 606 \item
 607 They have a special family of type constructors, of type
 608 @TyCon@\srcloc{uniType/TyCon.lhs}.
 609 These contain the tycon arity, but don't require a Unique.
 610
 611 \item
 612 They have a special family of constructors, of type
 613 @Id@\srcloc{basicTypes/Id.lhs}.  Again these contain their arity but
 614 don't need a Unique.
 615
 616 \item
 617 There should be a magic way of generating the info tables and
 618 entry code for all tuples.
 619
 620 But at the moment we just compile a Haskell source
 621 file\srcloc{lib/prelude/...} containing declarations like:
 622 \begin{verbatim}
 623 data Tuple0             = Tup0
 624 data Tuple2  a b        = Tup2  a b
 625 data Tuple3  a b c      = Tup3  a b c
 626 data Tuple4  a b c d    = Tup4  a b c d
 627 ...
 628 \end{verbatim}
 629 The print-names associated with the magic @Id@s for tuple constructors
 630 ``just happen'' to be the same as those generated by these
 631 declarations.
 632
 633 \item
 634 The instance environment should have a magic way to know
 635 that each tuple type is an instances of classes @Eq@, @Ix@, @Ord@ and
 636 so on. \ToDo{Not implemented yet.}
 637
 638 \item
 639 There should also be a way to generate the appropriate code for each
 640 of these instances, but (like the info tables and entry code) it is
 641 done by enumeration\srcloc{lib/prelude/InTup?.hs}.
 642 \end{itemize}
 643
 644 \begin{code}
 645 mkTupleTy :: Int -> [UniType] -> UniType
 646
 647 mkTupleTy arity tys = applyTyCon (mkTupleTyCon arity) tys
 648
 649 unitTy = mkTupleTy 0 []
 650 \end{code}
 651
 652 %************************************************************************
 653 %*                                                                      *
 654 \subsection[TysWiredIn-Ratios]{@Ratio@ and @Rational@}
 655 %*                                                                      *
 656 %************************************************************************
 657
 658 ToDo: make this (mostly) go away.
 659
 660 \begin{code}
 661 rationalTy :: UniType
 662
 663 mkRatioTy ty = UniData ratioTyCon [ty]
 664 rationalTy   = mkRatioTy integerTy
 665
 666 ratioTyCon = pcDataTyCon ratioTyConKey pRELUDE_RATIO SLIT("Ratio") [alpha_tv] [ratioDataCon]
 667
 668 ratioDataCon = pcDataCon ratioDataConKey pRELUDE_RATIO SLIT(":%")
 669                 [alpha_tv] [{-(integralClass,alpha)-}] [alpha, alpha] ratioTyCon nullSpecEnv
 670         -- context omitted to match lib/prelude/ defn of "data Ratio ..."
 671
 672 rationalTyCon
 673   = mkSynonymTyCon
 674       rationalTyConKey
 675       (mkPreludeCoreName pRELUDE_RATIO SLIT("Rational"))
 676       0  -- arity
 677       [] -- tyvars
 678       rationalTy -- == mkRatioTy integerTy
 679       True -- unabstract
 680 \end{code}
 681
 682 %************************************************************************
 683 %*                                                                      *
 684 \subsection[TysWiredIn-_Lift]{@_Lift@ type: to support array indexing}
 685 %*                                                                      *
 686 %************************************************************************
 687
 688 Again, deeply turgid: \tr{data _Lift a = _Lift a}.
 689
 690 \begin{code}
 691 mkLiftTy ty = applyTyCon liftTyCon [ty]
 692
 693 {-
 694 mkLiftTy ty
 695   = mkSigmaTy tvs theta (UniData liftTyCon [tau])
 696   where
 697     (tvs, theta, tau) = splitType ty
 698
 699 isLiftTy ty
 700   = case getUniDataTyCon_maybe tau of
 701       Just (tycon, tys, _) -> tycon == liftTyCon
 702       Nothing -> False
 703   where
 704     (tvs, theta, tau) = splitType ty
 705 -}
 706
 707
 708 alphaLiftTy = mkSigmaTy [alpha_tv] [] (UniData liftTyCon [alpha])
 709
 710 liftTyCon
 711   = pcDataTyCon liftTyConKey pRELUDE_BUILTIN SLIT("_Lift") [alpha_tv] [liftDataCon]
 712
 713 liftDataCon
 714   = pcDataCon liftDataConKey pRELUDE_BUILTIN SLIT("_Lift")
 715                 [alpha_tv] [] [alpha] liftTyCon
 716                 ((pcGenerateDataSpecs alphaLiftTy) `addOneToSpecEnv`
 717                  (SpecInfo [Just realWorldStatePrimTy] 0 bottom))
 718   where
 719     bottom = panic "liftDataCon:State# _RealWorld"
 720 \end{code}
 721
 722
 723 %************************************************************************
 724 %*                                                                      *
 725 \subsection[TysWiredIn-for-convenience]{Types wired in for convenience (e.g., @String@)}
 726 %*                                                                      *
 727 %************************************************************************
 728
 729 \begin{code}
 730 stringTy = mkListTy charTy
 731
 732 stringTyCon
 733  = mkSynonymTyCon
 734      stringTyConKey
 735      (mkPreludeCoreName pRELUDE_CORE SLIT("String"))
 736      0
 737      []   -- type variables
 738      stringTy
 739      True -- unabstract
 740 \end{code}
 741
 742 \begin{code}
 743 {- UNUSED:
 744 packedStringTy = applyTyCon packedStringTyCon []
 745
 746 packedStringTyCon
 747   = pcDataTyCon packedStringTyConKey pRELUDE_PS SLIT("_PackedString") []
 748         [psDataCon, cpsDataCon]
 749
 750 psDataCon
 751   = pcDataCon psDataConKey pRELUDE_PS SLIT("_PS")
 752                 [] [] [intPrimTy, byteArrayPrimTy] packedStringTyCon
 753
 754 cpsDataCon
 755   = pcDataCon cpsDataConKey pRELUDE_PS SLIT("_CPS")
 756                 [] [] [addrPrimTy] packedStringTyCon
 757 -}
 758 \end{code}