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 module TysWiredIn (
  14         addrDataCon,
  15         addrTy,
  16         addrTyCon,
  17         boolTy,
  18         boolTyCon,
  19         charDataCon,
  20         charTy,
  21         charTyCon,
  22         consDataCon,
  23         doubleDataCon,
  24         doubleTy,
  25         isDoubleTy,
  26         doubleTyCon,
  27         falseDataCon,
  28         floatDataCon,
  29         floatTy,
  30         isFloatTy,
  31         floatTyCon,
  32         getStatePairingConInfo,
  33
  34         intDataCon,
  35         intTy,
  36         intTyCon,
  37         isIntTy,
  38         inIntRange,
  39
  40         int8TyCon,
  41         int16TyCon,
  42         int32TyCon,
  43
  44         int64TyCon,
  45         int64DataCon,
  46 --      int64Ty,
  47
  48         integerTy,
  49         integerTyCon,
  50         integerDataCon,
  51         isIntegerTy,
  52
  53         liftDataCon,
  54         liftTyCon,
  55         listTyCon,
  56         foreignObjTyCon,
  57
  58         mkLiftTy,
  59         mkListTy,
  60         mkTupleTy,
  61         tupleTyCon, tupleCon, unitTyCon, unitDataCon, pairTyCon, pairDataCon,
  62         nilDataCon,
  63         realWorldStateTy,
  64         return2GMPsTyCon,
  65         returnIntAndGMPTyCon,
  66
  67         -- ST and STret types
  68         mkStateTy,
  69         mkStateTransformerTy,
  70         mkSTretTy,
  71         stTyCon,
  72         stDataCon,
  73         stRetDataCon,
  74         stRetTyCon,
  75
  76         -- CCall result types
  77         stateAndAddrPrimTyCon,
  78         stateAndArrayPrimTyCon,
  79         stateAndByteArrayPrimTyCon,
  80         stateAndCharPrimTyCon,
  81         stateAndDoublePrimTyCon,
  82         stateAndFloatPrimTyCon,
  83         stateAndIntPrimTyCon,
  84         stateAndInt64PrimTyCon,
  85         stateAndForeignObjPrimTyCon,
  86         stateAndMutableArrayPrimTyCon,
  87         stateAndMutableByteArrayPrimTyCon,
  88         stateAndPtrPrimTyCon,
  89         stateAndPtrPrimDataCon,
  90         stateAndStablePtrPrimTyCon,
  91         stateAndSynchVarPrimTyCon,
  92         stateAndWordPrimTyCon,
  93         stateAndWord64PrimTyCon,
  94         stateDataCon,
  95         stateTyCon,
  96
  97         stablePtrTyCon,
  98         stringTy,
  99         trueDataCon,
 100         unitTy,
 101         wordDataCon,
 102         wordTy,
 103         wordTyCon,
 104
 105         word8TyCon,
 106         word16TyCon,
 107         word32TyCon,
 108
 109         word64DataCon,
 110 --      word64Ty,
 111         word64TyCon,
 112
 113         isFFIArgumentTy,  -- :: Type -> Bool
 114         isFFIResultTy,    -- :: Type -> Bool
 115         isFFIExternalTy,  -- :: Type -> Bool
 116         isAddrTy,         -- :: Type -> Bool
 117
 118     ) where
 119
 120 #include "HsVersions.h"
 121
 122 import {-# SOURCE #-} MkId ( mkDataCon, mkTupleCon )
 123 import {-# SOURCE #-} Id ( Id, StrictnessMark(..) )
 124
 125 -- friends:
 126 import PrelMods
 127 import TysPrim
 128
 129 -- others:
 130 import Kind             ( mkBoxedTypeKind, mkArrowKind )
 131 import Name             ( mkWiredInTyConName, mkWiredInIdName )
 132 import TyCon            ( mkDataTyCon, mkTupleTyCon, mkSynTyCon,
 133                           TyCon, Arity
 134                         )
 135 import BasicTypes       ( Module, NewOrData(..), RecFlag(..) )
 136 import Type             ( Type, mkTyConTy, mkTyConApp, mkSigmaTy, mkTyVarTys,
 137                           mkFunTy, mkFunTys, splitTyConApp_maybe, splitAlgTyConApp_maybe,
 138                           GenType(..), ThetaType, TauType, isUnpointedType )
 139 import TyVar            ( GenTyVar, TyVar, tyVarKind, alphaTyVars, alphaTyVar, betaTyVar )
 140 import Lex              ( mkTupNameStr )
 141 import Unique
 142 import CmdLineOpts      ( opt_GlasgowExts )
 143 import Util             ( assoc, panic )
 144
 145
 146 alpha_tyvar       = [alphaTyVar]
 147 alpha_ty          = [alphaTy]
 148 alpha_beta_tyvars = [alphaTyVar, betaTyVar]
 149
 150 pcRecDataTyCon, pcNonRecDataTyCon, pcNonRecNewTyCon
 151         :: Unique{-TyConKey-} -> Module -> FAST_STRING
 152         -> [TyVar] -> [Id] -> TyCon
 153
 154 pcRecDataTyCon    = pc_tycon DataType Recursive
 155 pcNonRecDataTyCon = pc_tycon DataType NonRecursive
 156 pcNonRecNewTyCon  = pc_tycon NewType  NonRecursive
 157
 158 pc_tycon new_or_data is_rec key mod str tyvars cons
 159   = tycon
 160   where
 161     tycon = mkDataTyCon name tycon_kind
 162                 tyvars
 163                 []              -- No context
 164                 cons
 165                 []              -- No derivings
 166                 Nothing         -- Not a dictionary
 167                 new_or_data
 168                 is_rec
 169
 170     name = mkWiredInTyConName key mod str tycon
 171     tycon_kind = foldr (mkArrowKind . tyVarKind) mkBoxedTypeKind tyvars
 172
 173 pcSynTyCon key mod str kind arity tyvars expansion
 174   = tycon
 175   where
 176     tycon = mkSynTyCon name kind arity tyvars expansion
 177     name  = mkWiredInTyConName key mod str tycon
 178
 179 pcDataCon :: Unique{-DataConKey-} -> Module -> FAST_STRING
 180           -> [TyVar] -> ThetaType -> [TauType] -> TyCon -> Id
 181 pcDataCon key mod str tyvars context arg_tys tycon
 182   = data_con
 183   where
 184     data_con = mkDataCon name
 185                 [ NotMarkedStrict | a <- arg_tys ]
 186                 [ {- no labelled fields -} ]
 187                 tyvars context [] [] arg_tys tycon
 188     name = mkWiredInIdName key mod str data_con
 189 \end{code}
 190
 191 %************************************************************************
 192 %*                                                                      *
 193 \subsection[TysWiredIn-tuples]{The tuple types}
 194 %*                                                                      *
 195 %************************************************************************
 196
 197 \begin{code}
 198 tupleTyCon :: Arity -> TyCon
 199 tupleTyCon arity
 200   = tycon
 201   where
 202     tycon = mkTupleTyCon uniq name arity
 203     uniq  = mkTupleTyConUnique arity
 204     name  = mkWiredInTyConName uniq mod_name (mkTupNameStr arity) tycon
 205     mod_name | arity == 0 = pREL_BASE
 206              | otherwise  = pREL_TUP
 207
 208 tupleCon :: Arity -> Id
 209 tupleCon arity
 210   = tuple_con
 211   where
 212     tuple_con = mkTupleCon arity name ty
 213     uniq      = mkTupleDataConUnique arity
 214     name      = mkWiredInIdName uniq mod_name (mkTupNameStr arity) tuple_con
 215     mod_name  | arity == 0 = pREL_BASE
 216               | otherwise  = pREL_TUP
 217     ty          = mkSigmaTy tyvars [] (mkFunTys tyvar_tys (mkTyConApp tycon tyvar_tys))
 218     tyvars      = take arity alphaTyVars
 219     tyvar_tys   = mkTyVarTys tyvars
 220     tycon       = tupleTyCon arity
 221
 222 unitTyCon = tupleTyCon 0
 223 pairTyCon = tupleTyCon 2
 224
 225 unitDataCon = tupleCon 0
 226 pairDataCon = tupleCon 2
 227 \end{code}
 228
 229
 230 %************************************************************************
 231 %*                                                                      *
 232 \subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)}
 233 %*                                                                      *
 234 %************************************************************************
 235
 236 \begin{code}
 237 charTy = mkTyConTy charTyCon
 238
 239 charTyCon = pcNonRecDataTyCon charTyConKey  pREL_BASE  SLIT("Char") [] [charDataCon]
 240 charDataCon = pcDataCon charDataConKey pREL_BASE SLIT("C#") [] [] [charPrimTy] charTyCon
 241
 242 stringTy = mkListTy charTy -- convenience only
 243 \end{code}
 244
 245 \begin{code}
 246 intTy = mkTyConTy intTyCon
 247
 248 intTyCon = pcNonRecDataTyCon intTyConKey pREL_BASE SLIT("Int") [] [intDataCon]
 249 intDataCon = pcDataCon intDataConKey pREL_BASE SLIT("I#") [] [] [intPrimTy] intTyCon
 250
 251 isIntTy :: GenType flexi -> Bool
 252 isIntTy ty
 253   = case (splitAlgTyConApp_maybe ty) of
 254         Just (tycon, [], _) -> uniqueOf tycon == intTyConKey
 255         _                   -> False
 256
 257 inIntRange :: Integer -> Bool   -- Tells if an integer lies in the legal range of Ints
 258 inIntRange i = (min_int <= i) && (i <= max_int)
 259
 260 max_int, min_int :: Integer
 261 max_int = toInteger maxInt
 262 min_int = toInteger minInt
 263
 264 int8TyCon = pcNonRecDataTyCon int8TyConKey iNT SLIT("Int8") [] [int8DataCon]
 265   where
 266    int8DataCon = pcDataCon int8DataConKey iNT SLIT("I8#") [] [] [intPrimTy] int8TyCon
 267
 268 int16TyCon = pcNonRecDataTyCon int16TyConKey iNT SLIT("Int16") [] [int16DataCon]
 269   where
 270    int16DataCon = pcDataCon int16DataConKey iNT SLIT("I16#") [] [] [intPrimTy] int16TyCon
 271
 272 int32TyCon = pcNonRecDataTyCon int32TyConKey iNT SLIT("Int32") [] [int32DataCon]
 273   where
 274    int32DataCon = pcDataCon int32DataConKey iNT SLIT("I32#") [] [] [intPrimTy] int32TyCon
 275
 276 int64Ty = mkTyConTy int64TyCon
 277
 278 int64TyCon = pcNonRecDataTyCon int64TyConKey pREL_CCALL SLIT("Int64") [] [int64DataCon]
 279 int64DataCon = pcDataCon int64DataConKey pREL_CCALL SLIT("I64#") [] [] [int64PrimTy] int64TyCon
 280 \end{code}
 281
 282 \begin{code}
 283
 284 wordTy = mkTyConTy wordTyCon
 285
 286 wordTyCon = pcNonRecDataTyCon wordTyConKey   pREL_FOREIGN SLIT("Word") [] [wordDataCon]
 287 wordDataCon = pcDataCon wordDataConKey pREL_FOREIGN SLIT("W#") [] [] [wordPrimTy] wordTyCon
 288
 289 word8TyCon = pcNonRecDataTyCon word8TyConKey   wORD SLIT("Word8") [] [word8DataCon]
 290   where
 291    word8DataCon = pcDataCon word8DataConKey wORD SLIT("W8#") [] [] [wordPrimTy] word8TyCon
 292
 293 word16TyCon = pcNonRecDataTyCon word16TyConKey   wORD SLIT("Word16") [] [word16DataCon]
 294   where
 295    word16DataCon = pcDataCon word16DataConKey wORD SLIT("W16#") [] [] [wordPrimTy] word16TyCon
 296
 297 word32TyCon = pcNonRecDataTyCon word32TyConKey   wORD SLIT("Word32") [] [word32DataCon]
 298   where
 299    word32DataCon = pcDataCon word32DataConKey wORD SLIT("W32#") [] [] [wordPrimTy] word32TyCon
 300
 301 word64Ty = mkTyConTy word64TyCon
 302
 303 word64TyCon = pcNonRecDataTyCon word64TyConKey   pREL_CCALL SLIT("Word64") [] [word64DataCon]
 304 word64DataCon = pcDataCon word64DataConKey pREL_CCALL SLIT("W64#") [] [] [word64PrimTy] word64TyCon
 305 \end{code}
 306
 307 \begin{code}
 308 addrTy = mkTyConTy addrTyCon
 309
 310 addrTyCon = pcNonRecDataTyCon addrTyConKey   pREL_ADDR SLIT("Addr") [] [addrDataCon]
 311 addrDataCon = pcDataCon addrDataConKey pREL_ADDR SLIT("A#") [] [] [addrPrimTy] addrTyCon
 312
 313 isAddrTy :: GenType flexi -> Bool
 314 isAddrTy ty
 315   = case (splitAlgTyConApp_maybe ty) of
 316         Just (tycon, [], _) -> uniqueOf tycon == addrTyConKey
 317         _                   -> False
 318
 319 \end{code}
 320
 321 \begin{code}
 322 floatTy = mkTyConTy floatTyCon
 323
 324 floatTyCon = pcNonRecDataTyCon floatTyConKey pREL_BASE SLIT("Float") [] [floatDataCon]
 325 floatDataCon = pcDataCon floatDataConKey pREL_BASE SLIT("F#") [] [] [floatPrimTy] floatTyCon
 326
 327 isFloatTy :: GenType flexi -> Bool
 328 isFloatTy ty
 329   = case (splitAlgTyConApp_maybe ty) of
 330         Just (tycon, [], _) -> uniqueOf tycon == floatTyConKey
 331         _                   -> False
 332
 333 \end{code}
 334
 335 \begin{code}
 336 doubleTy = mkTyConTy doubleTyCon
 337
 338 isDoubleTy :: GenType flexi -> Bool
 339 isDoubleTy ty
 340   = case (splitAlgTyConApp_maybe ty) of
 341         Just (tycon, [], _) -> uniqueOf tycon == doubleTyConKey
 342         _                   -> False
 343
 344 doubleTyCon = pcNonRecDataTyCon doubleTyConKey pREL_BASE SLIT("Double") [] [doubleDataCon]
 345 doubleDataCon = pcDataCon doubleDataConKey pREL_BASE SLIT("D#") [] [] [doublePrimTy] doubleTyCon
 346 \end{code}
 347
 348 \begin{code}
 349 mkStateTy ty     = mkTyConApp stateTyCon [ty]
 350 realWorldStateTy = mkStateTy realWorldTy -- a common use
 351
 352 stateTyCon = pcNonRecDataTyCon stateTyConKey pREL_ST SLIT("State") alpha_tyvar [stateDataCon]
 353 stateDataCon
 354   = pcDataCon stateDataConKey pREL_ST SLIT("S#")
 355         alpha_tyvar [] [mkStatePrimTy alphaTy] stateTyCon
 356 \end{code}
 357
 358 \begin{code}
 359 stablePtrTyCon
 360   = pcNonRecDataTyCon stablePtrTyConKey pREL_FOREIGN SLIT("StablePtr")
 361         alpha_tyvar [stablePtrDataCon]
 362   where
 363     stablePtrDataCon
 364       = pcDataCon stablePtrDataConKey pREL_FOREIGN SLIT("StablePtr")
 365             alpha_tyvar [] [mkStablePtrPrimTy alphaTy] stablePtrTyCon
 366 \end{code}
 367
 368 \begin{code}
 369 foreignObjTyCon
 370   = pcNonRecDataTyCon foreignObjTyConKey pREL_IO_BASE SLIT("ForeignObj")
 371         [] [foreignObjDataCon]
 372   where
 373     foreignObjDataCon
 374       = pcDataCon foreignObjDataConKey pREL_IO_BASE SLIT("ForeignObj")
 375             [] [] [foreignObjPrimTy] foreignObjTyCon
 376 \end{code}
 377
 378 %************************************************************************
 379 %*                                                                      *
 380 \subsection[TysWiredIn-Integer]{@Integer@ and its related ``pairing'' types}
 381 %*                                                                      *
 382 %************************************************************************
 383
 384 @Integer@ and its pals are not really primitive.  @Integer@ itself, first:
 385 \begin{code}
 386 integerTy :: GenType t
 387 integerTy    = mkTyConTy integerTyCon
 388
 389 integerTyCon = pcNonRecDataTyCon integerTyConKey pREL_BASE SLIT("Integer") [] [integerDataCon]
 390
 391 integerDataCon = pcDataCon integerDataConKey pREL_BASE SLIT("J#")
 392                 [] [] [intPrimTy, intPrimTy, byteArrayPrimTy] integerTyCon
 393
 394 isIntegerTy :: GenType flexi -> Bool
 395 isIntegerTy ty
 396   = case (splitAlgTyConApp_maybe ty) of
 397         Just (tycon, [], _) -> uniqueOf tycon == integerTyConKey
 398         _                   -> False
 399 \end{code}
 400
 401 And the other pairing types:
 402 \begin{code}
 403 return2GMPsTyCon = pcNonRecDataTyCon return2GMPsTyConKey
 404         pREL_NUM SLIT("Return2GMPs") [] [return2GMPsDataCon]
 405
 406 return2GMPsDataCon
 407   = pcDataCon return2GMPsDataConKey pREL_NUM SLIT("Return2GMPs") [] []
 408         [intPrimTy, intPrimTy, byteArrayPrimTy,
 409          intPrimTy, intPrimTy, byteArrayPrimTy] return2GMPsTyCon
 410
 411 returnIntAndGMPTyCon = pcNonRecDataTyCon returnIntAndGMPTyConKey
 412         pREL_NUM SLIT("ReturnIntAndGMP") [] [returnIntAndGMPDataCon]
 413
 414 returnIntAndGMPDataCon
 415   = pcDataCon returnIntAndGMPDataConKey pREL_NUM SLIT("ReturnIntAndGMP") [] []
 416         [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy] returnIntAndGMPTyCon
 417 \end{code}
 418
 419 %************************************************************************
 420 %*                                                                      *
 421 \subsection[TysWiredIn-state-pairing]{``State-pairing'' types}
 422 %*                                                                      *
 423 %************************************************************************
 424
 425 These boring types pair a \tr{State#} with another primitive type.
 426 They are not really primitive, so they are given here, not in
 427 \tr{TysPrim.lhs}.
 428
 429 We fish one of these \tr{StateAnd<blah>#} things with
 430 @getStatePairingConInfo@ (given a little way down).
 431
 432 \begin{code}
 433 stateAndPtrPrimTyCon
 434   = pcNonRecDataTyCon stateAndPtrPrimTyConKey pREL_ST SLIT("StateAndPtr#")
 435                 alpha_beta_tyvars [stateAndPtrPrimDataCon]
 436 stateAndPtrPrimDataCon
 437   = pcDataCon stateAndPtrPrimDataConKey pREL_ST SLIT("StateAndPtr#")
 438                 alpha_beta_tyvars [] [mkStatePrimTy alphaTy, betaTy]
 439                 stateAndPtrPrimTyCon
 440
 441 stateAndCharPrimTyCon
 442   = pcNonRecDataTyCon stateAndCharPrimTyConKey pREL_ST SLIT("StateAndChar#")
 443                 alpha_tyvar [stateAndCharPrimDataCon]
 444 stateAndCharPrimDataCon
 445   = pcDataCon stateAndCharPrimDataConKey pREL_ST SLIT("StateAndChar#")
 446                 alpha_tyvar [] [mkStatePrimTy alphaTy, charPrimTy]
 447                 stateAndCharPrimTyCon
 448
 449 stateAndIntPrimTyCon
 450   = pcNonRecDataTyCon stateAndIntPrimTyConKey pREL_ST SLIT("StateAndInt#")
 451                 alpha_tyvar [stateAndIntPrimDataCon]
 452 stateAndIntPrimDataCon
 453   = pcDataCon stateAndIntPrimDataConKey pREL_ST SLIT("StateAndInt#")
 454                 alpha_tyvar [] [mkStatePrimTy alphaTy, intPrimTy]
 455                 stateAndIntPrimTyCon
 456
 457 stateAndInt64PrimTyCon
 458   = pcNonRecDataTyCon stateAndInt64PrimTyConKey pREL_ST SLIT("StateAndInt64#")
 459                 alpha_tyvar [stateAndInt64PrimDataCon]
 460 stateAndInt64PrimDataCon
 461   = pcDataCon stateAndInt64PrimDataConKey pREL_ST SLIT("StateAndInt64#")
 462                 alpha_tyvar [] [mkStatePrimTy alphaTy, int64PrimTy]
 463                 stateAndInt64PrimTyCon
 464
 465 stateAndWordPrimTyCon
 466   = pcNonRecDataTyCon stateAndWordPrimTyConKey pREL_ST SLIT("StateAndWord#")
 467                 alpha_tyvar [stateAndWordPrimDataCon]
 468 stateAndWordPrimDataCon
 469   = pcDataCon stateAndWordPrimDataConKey pREL_ST SLIT("StateAndWord#")
 470                 alpha_tyvar [] [mkStatePrimTy alphaTy, wordPrimTy]
 471                 stateAndWordPrimTyCon
 472
 473 stateAndWord64PrimTyCon
 474   = pcNonRecDataTyCon stateAndWord64PrimTyConKey pREL_ST SLIT("StateAndWord64#")
 475                 alpha_tyvar [stateAndWord64PrimDataCon]
 476 stateAndWord64PrimDataCon
 477   = pcDataCon stateAndWord64PrimDataConKey pREL_ST SLIT("StateAndWord64#")
 478                 alpha_tyvar [] [mkStatePrimTy alphaTy, word64PrimTy]
 479                 stateAndWord64PrimTyCon
 480
 481 stateAndAddrPrimTyCon
 482   = pcNonRecDataTyCon stateAndAddrPrimTyConKey pREL_ST SLIT("StateAndAddr#")
 483                 alpha_tyvar [stateAndAddrPrimDataCon]
 484 stateAndAddrPrimDataCon
 485   = pcDataCon stateAndAddrPrimDataConKey pREL_ST SLIT("StateAndAddr#")
 486                 alpha_tyvar [] [mkStatePrimTy alphaTy, addrPrimTy]
 487                 stateAndAddrPrimTyCon
 488
 489 stateAndStablePtrPrimTyCon
 490   = pcNonRecDataTyCon stateAndStablePtrPrimTyConKey pREL_FOREIGN SLIT("StateAndStablePtr#")
 491                 alpha_beta_tyvars [stateAndStablePtrPrimDataCon]
 492 stateAndStablePtrPrimDataCon
 493   = pcDataCon stateAndStablePtrPrimDataConKey pREL_FOREIGN SLIT("StateAndStablePtr#")
 494                 alpha_beta_tyvars []
 495                 [mkStatePrimTy alphaTy, mkTyConApp stablePtrPrimTyCon [betaTy]]
 496                 stateAndStablePtrPrimTyCon
 497
 498 stateAndForeignObjPrimTyCon
 499   = pcNonRecDataTyCon stateAndForeignObjPrimTyConKey pREL_IO_BASE SLIT("StateAndForeignObj#")
 500                 alpha_tyvar [stateAndForeignObjPrimDataCon]
 501 stateAndForeignObjPrimDataCon
 502   = pcDataCon stateAndForeignObjPrimDataConKey pREL_IO_BASE SLIT("StateAndForeignObj#")
 503                 alpha_tyvar []
 504                 [mkStatePrimTy alphaTy, mkTyConTy foreignObjPrimTyCon]
 505                 stateAndForeignObjPrimTyCon
 506
 507 stateAndFloatPrimTyCon
 508   = pcNonRecDataTyCon stateAndFloatPrimTyConKey pREL_ST SLIT("StateAndFloat#")
 509                 alpha_tyvar [stateAndFloatPrimDataCon]
 510 stateAndFloatPrimDataCon
 511   = pcDataCon stateAndFloatPrimDataConKey pREL_ST SLIT("StateAndFloat#")
 512                 alpha_tyvar [] [mkStatePrimTy alphaTy, floatPrimTy]
 513                 stateAndFloatPrimTyCon
 514
 515 stateAndDoublePrimTyCon
 516   = pcNonRecDataTyCon stateAndDoublePrimTyConKey pREL_ST SLIT("StateAndDouble#")
 517                 alpha_tyvar [stateAndDoublePrimDataCon]
 518 stateAndDoublePrimDataCon
 519   = pcDataCon stateAndDoublePrimDataConKey pREL_ST SLIT("StateAndDouble#")
 520                 alpha_tyvar [] [mkStatePrimTy alphaTy, doublePrimTy]
 521                 stateAndDoublePrimTyCon
 522 \end{code}
 523
 524 \begin{code}
 525 stateAndArrayPrimTyCon
 526   = pcNonRecDataTyCon stateAndArrayPrimTyConKey pREL_ARR SLIT("StateAndArray#")
 527                 alpha_beta_tyvars [stateAndArrayPrimDataCon]
 528 stateAndArrayPrimDataCon
 529   = pcDataCon stateAndArrayPrimDataConKey pREL_ARR SLIT("StateAndArray#")
 530                 alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkArrayPrimTy betaTy]
 531                 stateAndArrayPrimTyCon
 532
 533 stateAndMutableArrayPrimTyCon
 534   = pcNonRecDataTyCon stateAndMutableArrayPrimTyConKey pREL_ARR SLIT("StateAndMutableArray#")
 535                 alpha_beta_tyvars [stateAndMutableArrayPrimDataCon]
 536 stateAndMutableArrayPrimDataCon
 537   = pcDataCon stateAndMutableArrayPrimDataConKey pREL_ARR SLIT("StateAndMutableArray#")
 538                 alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkMutableArrayPrimTy alphaTy betaTy]
 539                 stateAndMutableArrayPrimTyCon
 540
 541 stateAndByteArrayPrimTyCon
 542   = pcNonRecDataTyCon stateAndByteArrayPrimTyConKey pREL_ARR SLIT("StateAndByteArray#")
 543                 alpha_tyvar [stateAndByteArrayPrimDataCon]
 544 stateAndByteArrayPrimDataCon
 545   = pcDataCon stateAndByteArrayPrimDataConKey pREL_ARR SLIT("StateAndByteArray#")
 546                 alpha_tyvar [] [mkStatePrimTy alphaTy, byteArrayPrimTy]
 547                 stateAndByteArrayPrimTyCon
 548
 549 stateAndMutableByteArrayPrimTyCon
 550   = pcNonRecDataTyCon stateAndMutableByteArrayPrimTyConKey pREL_ARR SLIT("StateAndMutableByteArray#")
 551                 alpha_tyvar [stateAndMutableByteArrayPrimDataCon]
 552 stateAndMutableByteArrayPrimDataCon
 553   = pcDataCon stateAndMutableByteArrayPrimDataConKey pREL_ARR SLIT("StateAndMutableByteArray#")
 554                 alpha_tyvar [] [mkStatePrimTy alphaTy, mkTyConApp mutableByteArrayPrimTyCon alpha_ty]
 555                 stateAndMutableByteArrayPrimTyCon
 556
 557 stateAndSynchVarPrimTyCon
 558   = pcNonRecDataTyCon stateAndSynchVarPrimTyConKey pREL_CONC SLIT("StateAndSynchVar#")
 559                 alpha_beta_tyvars [stateAndSynchVarPrimDataCon]
 560 stateAndSynchVarPrimDataCon
 561   = pcDataCon stateAndSynchVarPrimDataConKey pREL_CONC SLIT("StateAndSynchVar#")
 562                 alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkSynchVarPrimTy alphaTy betaTy]
 563                 stateAndSynchVarPrimTyCon
 564 \end{code}
 565
 566 The ccall-desugaring mechanism uses this function to figure out how to
 567 rebox the result.  It's really a HACK, especially the part about
 568 how many types to drop from \tr{tys_applied}.
 569
 570 \begin{code}
 571 getStatePairingConInfo
 572         :: Type -- primitive type
 573         -> (Id,         -- state pair constructor for prim type
 574             Type)       -- type of state pair
 575
 576 getStatePairingConInfo prim_ty
 577   = case (splitTyConApp_maybe prim_ty) of
 578       Nothing -> panic "getStatePairingConInfo:1"
 579       Just (prim_tycon, tys_applied) ->
 580         let
 581             (pair_con, pair_tycon, num_tys) = assoc "getStatePairingConInfo" tbl prim_tycon
 582             pair_ty = mkTyConApp pair_tycon (realWorldTy : drop num_tys tys_applied)
 583         in
 584         (pair_con, pair_ty)
 585   where
 586     tbl = [
 587         (charPrimTyCon, (stateAndCharPrimDataCon, stateAndCharPrimTyCon, 0)),
 588         (intPrimTyCon, (stateAndIntPrimDataCon, stateAndIntPrimTyCon, 0)),
 589         (wordPrimTyCon, (stateAndWordPrimDataCon, stateAndWordPrimTyCon, 0)),
 590         (int64PrimTyCon, (stateAndInt64PrimDataCon, stateAndInt64PrimTyCon, 0)),
 591         (word64PrimTyCon, (stateAndWord64PrimDataCon, stateAndWord64PrimTyCon, 0)),
 592         (addrPrimTyCon, (stateAndAddrPrimDataCon, stateAndAddrPrimTyCon, 0)),
 593         (stablePtrPrimTyCon, (stateAndStablePtrPrimDataCon, stateAndStablePtrPrimTyCon, 0)),
 594         (foreignObjPrimTyCon, (stateAndForeignObjPrimDataCon, stateAndForeignObjPrimTyCon, 0)),
 595         (floatPrimTyCon, (stateAndFloatPrimDataCon, stateAndFloatPrimTyCon, 0)),
 596         (doublePrimTyCon, (stateAndDoublePrimDataCon, stateAndDoublePrimTyCon, 0)),
 597         (arrayPrimTyCon, (stateAndArrayPrimDataCon, stateAndArrayPrimTyCon, 0)),
 598         (mutableArrayPrimTyCon, (stateAndMutableArrayPrimDataCon, stateAndMutableArrayPrimTyCon, 1)),
 599         (byteArrayPrimTyCon, (stateAndByteArrayPrimDataCon, stateAndByteArrayPrimTyCon, 0)),
 600         (mutableByteArrayPrimTyCon, (stateAndMutableByteArrayPrimDataCon, stateAndMutableByteArrayPrimTyCon, 1)),
 601         (synchVarPrimTyCon, (stateAndSynchVarPrimDataCon, stateAndSynchVarPrimTyCon, 1))
 602         -- (PtrPrimTyCon, (stateAndPtrPrimDataCon, stateAndPtrPrimTyCon, 0)),
 603         ]
 604 \end{code}
 605
 606
 607 %************************************************************************
 608 %*                                                                      *
 609 \subsection[TysWiredIn-ext-type]{External types}
 610 %*                                                                      *
 611 %************************************************************************
 612
 613 The compiler's foreign function interface supports the passing of a
 614 restricted set of types as arguments and results (the restricting factor
 615 being the )
 616
 617 \begin{code}
 618 isFFIArgumentTy :: Type -> Bool
 619 isFFIArgumentTy ty =
 620   (opt_GlasgowExts && isUnpointedType ty) || --leave out for now: maybeToBool (maybeBoxedPrimType ty))) ||
 621   case (splitAlgTyConApp_maybe ty) of
 622     Just (tycon, _, _) -> (uniqueOf tycon) `elem` primArgTyConKeys
 623     _                  -> False
 624
 625 -- types that can be passed as arguments to "foreign" functions
 626 primArgTyConKeys
 627   = [ intTyConKey, int8TyConKey, int16TyConKey, int32TyConKey, int64TyConKey
 628     , wordTyConKey, word8TyConKey, word16TyConKey, word32TyConKey, word64TyConKey
 629     , floatTyConKey, doubleTyConKey
 630     , addrTyConKey, charTyConKey, foreignObjTyConKey
 631     , stablePtrTyConKey, byteArrayTyConKey, mutableByteArrayTyConKey
 632     ]
 633
 634 -- types that can be passed from the outside world into Haskell.
 635 -- excludes (mutable) byteArrays.
 636 isFFIExternalTy :: Type -> Bool
 637 isFFIExternalTy ty =
 638   (opt_GlasgowExts && isUnpointedType ty) || --leave out for now: maybeToBool (maybeBoxedPrimType ty))) ||
 639   case (splitAlgTyConApp_maybe ty) of
 640     Just (tycon, _, _) ->
 641        let
 642         u_tycon = uniqueOf tycon
 643        in
 644        (u_tycon `elem` primArgTyConKeys) &&
 645        not (u_tycon `elem` notLegalExternalTyCons)
 646     _                  -> False
 647
 648
 649 isFFIResultTy :: Type -> Bool
 650 isFFIResultTy ty =
 651    not (isUnpointedType ty) &&
 652    case (splitAlgTyConApp_maybe ty) of
 653     Just (tycon, _, _) ->
 654         let
 655          u_tycon = uniqueOf tycon
 656         in
 657         (u_tycon == uniqueOf unitTyCon) ||
 658         ((u_tycon `elem` primArgTyConKeys) &&
 659          not (u_tycon `elem` notLegalExternalTyCons))
 660     _                  -> False
 661
 662 -- it's illegal to return foreign objects and (mutable)
 663 -- bytearrays from a _ccall_ / foreign declaration
 664 -- (or be passed them as arguments in foreign exported functions).
 665 notLegalExternalTyCons =
 666   [ foreignObjTyConKey, byteArrayTyConKey, mutableByteArrayTyConKey ]
 667
 668 \end{code}
 669
 670
 671 %************************************************************************
 672 %*                                                                      *
 673 \subsection[TysWiredIn-ST]{The basic @_ST@ state-transformer type}
 674 %*                                                                      *
 675 %************************************************************************
 676
 677 The only reason this is wired in is because we have to represent the
 678 type of runST.
 679
 680 \begin{code}
 681 mkStateTransformerTy s a = mkTyConApp stTyCon [s, a]
 682
 683 stTyCon = pcNonRecNewTyCon stTyConKey pREL_ST SLIT("ST") alpha_beta_tyvars [stDataCon]
 684
 685 stDataCon = pcDataCon stDataConKey pREL_ST SLIT("ST")
 686                         alpha_beta_tyvars [] [ty] stTyCon
 687   where
 688     ty = mkFunTy (mkStatePrimTy alphaTy) (mkSTretTy alphaTy betaTy)
 689
 690 mkSTretTy alpha beta = mkTyConApp stRetTyCon [alpha,beta]
 691
 692 stRetTyCon
 693   = pcNonRecDataTyCon stRetTyConKey pREL_ST SLIT("STret")
 694         alpha_beta_tyvars [stRetDataCon]
 695 stRetDataCon
 696   = pcDataCon stRetDataConKey pREL_ST SLIT("STret")
 697         alpha_beta_tyvars [] [mkStatePrimTy alphaTy, betaTy]
 698                 stRetTyCon
 699 \end{code}
 700
 701 %************************************************************************
 702 %*                                                                      *
 703 \subsection[TysWiredIn-Bool]{The @Bool@ type}
 704 %*                                                                      *
 705 %************************************************************************
 706
 707 An ordinary enumeration type, but deeply wired in.  There are no
 708 magical operations on @Bool@ (just the regular Prelude code).
 709
 710 {\em BEGIN IDLE SPECULATION BY SIMON}
 711
 712 This is not the only way to encode @Bool@.  A more obvious coding makes
 713 @Bool@ just a boxed up version of @Bool#@, like this:
 714 \begin{verbatim}
 715 type Bool# = Int#
 716 data Bool = MkBool Bool#
 717 \end{verbatim}
 718
 719 Unfortunately, this doesn't correspond to what the Report says @Bool@
 720 looks like!  Furthermore, we get slightly less efficient code (I
 721 think) with this coding. @gtInt@ would look like this:
 722
 723 \begin{verbatim}
 724 gtInt :: Int -> Int -> Bool
 725 gtInt x y = case x of I# x# ->
 726             case y of I# y# ->
 727             case (gtIntPrim x# y#) of
 728                 b# -> MkBool b#
 729 \end{verbatim}
 730
 731 Notice that the result of the @gtIntPrim@ comparison has to be turned
 732 into an integer (here called @b#@), and returned in a @MkBool@ box.
 733
 734 The @if@ expression would compile to this:
 735 \begin{verbatim}
 736 case (gtInt x y) of
 737   MkBool b# -> case b# of { 1# -> e1; 0# -> e2 }
 738 \end{verbatim}
 739
 740 I think this code is a little less efficient than the previous code,
 741 but I'm not certain.  At all events, corresponding with the Report is
 742 important.  The interesting thing is that the language is expressive
 743 enough to describe more than one alternative; and that a type doesn't
 744 necessarily need to be a straightforwardly boxed version of its
 745 primitive counterpart.
 746
 747 {\em END IDLE SPECULATION BY SIMON}
 748
 749 \begin{code}
 750 boolTy = mkTyConTy boolTyCon
 751
 752 boolTyCon = pcNonRecDataTyCon boolTyConKey pREL_BASE SLIT("Bool") [] [falseDataCon, trueDataCon]
 753
 754 falseDataCon = pcDataCon falseDataConKey pREL_BASE SLIT("False") [] [] [] boolTyCon
 755 trueDataCon  = pcDataCon trueDataConKey  pREL_BASE SLIT("True")  [] [] [] boolTyCon
 756 \end{code}
 757
 758 %************************************************************************
 759 %*                                                                      *
 760 \subsection[TysWiredIn-List]{The @List@ type (incl ``build'' magic)}
 761 %*                                                                      *
 762 %************************************************************************
 763
 764 Special syntax, deeply wired in, but otherwise an ordinary algebraic
 765 data types:
 766 \begin{verbatim}
 767 data [] a = [] | a : (List a)
 768 data () = ()
 769 data (,) a b = (,,) a b
 770 ...
 771 \end{verbatim}
 772
 773 \begin{code}
 774 mkListTy :: GenType t -> GenType t
 775 mkListTy ty = mkTyConApp listTyCon [ty]
 776
 777 alphaListTy = mkSigmaTy alpha_tyvar [] (mkTyConApp listTyCon alpha_ty)
 778
 779 listTyCon = pcRecDataTyCon listTyConKey pREL_BASE SLIT("[]")
 780                         alpha_tyvar [nilDataCon, consDataCon]
 781
 782 nilDataCon  = pcDataCon nilDataConKey  pREL_BASE SLIT("[]") alpha_tyvar [] [] listTyCon
 783 consDataCon = pcDataCon consDataConKey pREL_BASE SLIT(":")
 784                 alpha_tyvar [] [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon
 785 -- Interesting: polymorphic recursion would help here.
 786 -- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy
 787 -- gets the over-specific type (Type -> Type)
 788 \end{code}
 789
 790 %************************************************************************
 791 %*                                                                      *
 792 \subsection[TysWiredIn-Tuples]{The @Tuple@ types}
 793 %*                                                                      *
 794 %************************************************************************
 795
 796 The tuple types are definitely magic, because they form an infinite
 797 family.
 798
 799 \begin{itemize}
 800 \item
 801 They have a special family of type constructors, of type @TyCon@
 802 These contain the tycon arity, but don't require a Unique.
 803
 804 \item
 805 They have a special family of constructors, of type
 806 @Id@. Again these contain their arity but don't need a Unique.
 807
 808 \item
 809 There should be a magic way of generating the info tables and
 810 entry code for all tuples.
 811
 812 But at the moment we just compile a Haskell source
 813 file\srcloc{lib/prelude/...} containing declarations like:
 814 \begin{verbatim}
 815 data Tuple0             = Tup0
 816 data Tuple2  a b        = Tup2  a b
 817 data Tuple3  a b c      = Tup3  a b c
 818 data Tuple4  a b c d    = Tup4  a b c d
 819 ...
 820 \end{verbatim}
 821 The print-names associated with the magic @Id@s for tuple constructors
 822 ``just happen'' to be the same as those generated by these
 823 declarations.
 824
 825 \item
 826 The instance environment should have a magic way to know
 827 that each tuple type is an instances of classes @Eq@, @Ix@, @Ord@ and
 828 so on. \ToDo{Not implemented yet.}
 829
 830 \item
 831 There should also be a way to generate the appropriate code for each
 832 of these instances, but (like the info tables and entry code) it is
 833 done by enumeration\srcloc{lib/prelude/InTup?.hs}.
 834 \end{itemize}
 835
 836 \begin{code}
 837 mkTupleTy :: Int -> [GenType t] -> GenType t
 838
 839 mkTupleTy arity tys = mkTyConApp (tupleTyCon arity) tys
 840
 841 unitTy    = mkTupleTy 0 []
 842 \end{code}
 843
 844 %************************************************************************
 845 %*                                                                      *
 846 \subsection[TysWiredIn-_Lift]{@_Lift@ type: to support array indexing}
 847 %*                                                                      *
 848 %************************************************************************
 849
 850 Again, deeply turgid: \tr{data _Lift a = _Lift a}.
 851
 852 \begin{code}
 853 mkLiftTy ty = mkTyConApp liftTyCon [ty]
 854
 855 {-
 856 mkLiftTy ty
 857   = mkSigmaTy tvs theta (mkTyConApp liftTyCon [tau])
 858   where
 859     (tvs, theta, tau) = splitSigmaTy ty
 860
 861 isLiftTy ty
 862   = case (splitAlgTyConApp_maybeExpandingDicts tau) of
 863       Just (tycon, tys, _) -> tycon == liftTyCon
 864       Nothing -> False
 865   where
 866     (tvs, theta, tau) = splitSigmaTy ty
 867 -}
 868
 869
 870 alphaLiftTy = mkSigmaTy alpha_tyvar [] (mkTyConApp liftTyCon alpha_ty)
 871
 872 liftTyCon
 873   = pcNonRecDataTyCon liftTyConKey pREL_BASE SLIT("Lift") alpha_tyvar [liftDataCon]
 874
 875 liftDataCon
 876   = pcDataCon liftDataConKey pREL_BASE SLIT("Lift")
 877                 alpha_tyvar [] alpha_ty liftTyCon
 878   where
 879     bottom = panic "liftDataCon:State# _RealWorld"
 880 \end{code}