utils/ext-core/Prims.hs

   1 {- This module really should be auto-generated from the master primops.txt file.
   2    It is roughly correct (but may be slightly incomplete) wrt/ GHC5.02. -}
   3
   4 module Prims where
   5
   6 import Core
   7 import Env
   8 import Check
   9
  10 initialEnv :: Menv
  11 initialEnv = efromlist [(primMname,primEnv),
  12                      (errMname,errorEnv)]
  13
  14 primEnv :: Envs
  15 primEnv = Envs {tcenv_=efromlist primTcs,
  16                 tsenv_=eempty,
  17                 cenv_=efromlist primDcs,
  18                 venv_=efromlist primVals}
  19
  20 errorEnv :: Envs
  21 errorEnv = Envs {tcenv_=eempty,
  22                  tsenv_=eempty,
  23                  cenv_=eempty,
  24                  venv_=efromlist errorVals}
  25
  26 {- Components of static environment -}
  27
  28 primTcs :: [(Tcon,Kind)]
  29 primTcs =
  30         map (\ ((m,tc),k) -> (tc,k))
  31         ([(tcArrow,ktArrow),
  32          (tcAddrzh,ktAddrzh),
  33          (tcCharzh,ktCharzh),
  34          (tcDoublezh,ktDoublezh),
  35          (tcFloatzh,ktFloatzh),
  36          (tcIntzh,ktIntzh),
  37          (tcInt32zh,ktInt32zh),
  38          (tcInt64zh,ktInt64zh),
  39          (tcWordzh,ktWordzh),
  40          (tcWord32zh,ktWord32zh),
  41          (tcWord64zh,ktWord64zh),
  42          (tcRealWorld, ktRealWorld),
  43          (tcStatezh, ktStatezh),
  44          (tcArrayzh,ktArrayzh),
  45          (tcByteArrayzh,ktByteArrayzh),
  46          (tcMutableArrayzh,ktMutableArrayzh),
  47          (tcMutableByteArrayzh,ktMutableByteArrayzh),
  48          (tcMutVarzh,ktMutVarzh),
  49          (tcMVarzh,ktMVarzh),
  50          (tcWeakzh,ktWeakzh),
  51          (tcForeignObjzh, ktForeignObjzh),
  52          (tcStablePtrzh, ktStablePtrzh),
  53          (tcThreadIdzh, ktThreadIdzh),
  54          (tcZCTCCallable, ktZCTCCallable),
  55          (tcZCTCReturnable, ktZCTCReturnable)]
  56        ++ [(tcUtuple n, ktUtuple n) | n <- [1..maxUtuple]])
  57
  58
  59 primDcs :: [(Dcon,Ty)]
  60 primDcs = map (\ ((m,c),t) -> (c,t))
  61               [(dcUtuple n, dcUtupleTy n) | n <- [1..maxUtuple]]
  62
  63 primVals :: [(Var,Ty)]
  64 primVals =
  65         opsAddrzh ++
  66         opsCharzh ++
  67         opsDoublezh ++
  68         opsFloatzh ++
  69         opsIntzh ++
  70         opsInt32zh ++
  71         opsInt64zh ++
  72         opsIntegerzh ++
  73         opsWordzh ++
  74         opsWord32zh ++
  75         opsWord64zh ++
  76         opsSized ++
  77         opsArray ++
  78         opsMutVarzh ++
  79         opsState ++
  80         opsExn ++
  81         opsMVar ++
  82         opsWeak ++
  83         opsForeignObjzh ++
  84         opsStablePtrzh ++
  85         opsConc ++
  86         opsMisc
  87
  88
  89 dcUtuples :: [(Qual Dcon,Ty)]
  90 dcUtuples = map ( \n -> (dcUtuple n, typ n)) [1..100]
  91      where typ n = foldr ( \tv t -> Tforall (tv,Kopen) t)
  92                                 (foldr ( \tv t -> tArrow (Tvar tv) t)
  93                                              (tUtuple (map Tvar tvs)) tvs) tvs
  94                       where tvs = map ( \i -> ("a" ++ (show i))) [1..n]
  95
  96 pv = qual primMname
  97 pvz = (qual primMname) . (++ "zh")
  98
  99 {- Addrzh -}
 100 tcAddrzh = pvz "Addr"
 101 tAddrzh = Tcon tcAddrzh
 102 ktAddrzh = Kunlifted
 103
 104 opsAddrzh = [
 105  ("gtAddrzh",tcompare tAddrzh),
 106  ("geAddrzh",tcompare tAddrzh),
 107  ("eqAddrzh",tcompare tAddrzh),
 108  ("neAddrzh",tcompare tAddrzh),
 109  ("ltAddrzh",tcompare tAddrzh),
 110  ("leAddrzh",tcompare tAddrzh),
 111  ("nullAddrzh", tAddrzh),
 112  ("plusAddrzh", tArrow tAddrzh (tArrow tIntzh tAddrzh)),
 113  ("minusAddrzh", tArrow tAddrzh (tArrow tAddrzh tIntzh)),
 114  ("remAddrzh", tArrow tAddrzh (tArrow tIntzh tIntzh))]
 115
 116 {- Charzh -}
 117
 118 tcCharzh = pvz "Char"
 119 tCharzh = Tcon tcCharzh
 120 ktCharzh = Kunlifted
 121
 122 opsCharzh = [
 123  ("gtCharzh", tcompare tCharzh),
 124  ("geCharzh", tcompare tCharzh),
 125  ("eqCharzh", tcompare tCharzh),
 126  ("neCharzh", tcompare tCharzh),
 127  ("ltCharzh", tcompare tCharzh),
 128  ("leCharzh", tcompare tCharzh),
 129  ("ordzh",    tArrow tCharzh tIntzh)]
 130
 131
 132 {- Doublezh -}
 133
 134 tcDoublezh = pvz "Double"
 135 tDoublezh = Tcon tcDoublezh
 136 ktDoublezh = Kunlifted
 137
 138 opsDoublezh = [
 139  ("zgzhzh", tcompare tDoublezh),
 140  ("zgzezhzh", tcompare tDoublezh),
 141  ("zezezhzh", tcompare tDoublezh),
 142  ("zszezhzh", tcompare tDoublezh),
 143  ("zlzhzh", tcompare tDoublezh),
 144  ("zlzezhzh", tcompare tDoublezh),
 145  ("zpzhzh", tdyadic tDoublezh),
 146  ("zmzhzh", tdyadic tDoublezh),
 147  ("ztzhzh", tdyadic tDoublezh),
 148  ("zszhzh", tdyadic tDoublezh),
 149  ("negateDoublezh", tmonadic tDoublezh),
 150  ("double2Intzh", tArrow tDoublezh tIntzh),
 151  ("double2Floatzh", tArrow tDoublezh tFloatzh),
 152  ("expDoublezh", tmonadic tDoublezh),
 153  ("logDoublezh", tmonadic tDoublezh),
 154  ("sqrtDoublezh", tmonadic tDoublezh),
 155  ("sinDoublezh", tmonadic tDoublezh),
 156  ("cosDoublezh", tmonadic tDoublezh),
 157  ("tanDoublezh", tmonadic tDoublezh),
 158  ("asinDoublezh", tmonadic tDoublezh),
 159  ("acosDoublezh", tmonadic tDoublezh),
 160  ("atanDoublezh", tmonadic tDoublezh),
 161  ("sinhDoublezh", tmonadic tDoublezh),
 162  ("coshDoublezh", tmonadic tDoublezh),
 163  ("tanhDoublezh", tmonadic tDoublezh),
 164  ("ztztzhzh", tdyadic tDoublezh),
 165  ("decodeDoublezh", tArrow tDoublezh (tUtuple[tIntzh,tIntzh,tByteArrayzh]))]
 166
 167
 168 {- Floatzh -}
 169
 170 tcFloatzh = pvz "Float"
 171 tFloatzh = Tcon tcFloatzh
 172 ktFloatzh = Kunlifted
 173
 174 opsFloatzh = [
 175  ("gtFloatzh", tcompare tFloatzh),
 176  ("geFloatzh", tcompare tFloatzh),
 177  ("eqFloatzh", tcompare tFloatzh),
 178  ("neFloatzh", tcompare tFloatzh),
 179  ("ltFloatzh", tcompare tFloatzh),
 180  ("leFloatzh", tcompare tFloatzh),
 181  ("plusFloatzh", tdyadic tFloatzh),
 182  ("minusFloatzh", tdyadic tFloatzh),
 183  ("timesFloatzh", tdyadic tFloatzh),
 184  ("divideFloatzh", tdyadic tFloatzh),
 185  ("negateFloatzh", tmonadic tFloatzh),
 186  ("float2Intzh", tArrow tFloatzh tIntzh),
 187  ("expFloatzh", tmonadic tFloatzh),
 188  ("logFloatzh", tmonadic tFloatzh),
 189  ("sqrtFloatzh", tmonadic tFloatzh),
 190  ("sinFloatzh", tmonadic tFloatzh),
 191  ("cosFloatzh", tmonadic tFloatzh),
 192  ("tanFloatzh", tmonadic tFloatzh),
 193  ("asinFloatzh", tmonadic tFloatzh),
 194  ("acosFloatzh", tmonadic tFloatzh),
 195  ("atanFloatzh", tmonadic tFloatzh),
 196  ("sinhFloatzh", tmonadic tFloatzh),
 197  ("coshFloatzh", tmonadic tFloatzh),
 198  ("tanhFloatzh", tmonadic tFloatzh),
 199  ("powerFloatzh", tdyadic tFloatzh),
 200  ("float2Doublezh", tArrow tFloatzh tDoublezh),
 201  ("decodeFloatzh", tArrow tFloatzh (tUtuple[tIntzh,tIntzh,tByteArrayzh]))]
 202
 203
 204 {- Intzh -}
 205
 206 tcIntzh = pvz "Int"
 207 tIntzh = Tcon tcIntzh
 208 ktIntzh = Kunlifted
 209
 210 opsIntzh = [
 211  ("zpzh", tdyadic tIntzh),
 212  ("zmzh", tdyadic tIntzh),
 213  ("ztzh", tdyadic tIntzh),
 214  ("quotIntzh", tdyadic tIntzh),
 215  ("remIntzh", tdyadic tIntzh),
 216  ("gcdIntzh", tdyadic tIntzh),
 217  ("negateIntzh", tmonadic tIntzh),
 218  ("addIntCzh", tArrow tIntzh (tArrow tIntzh (tUtuple [tIntzh, tIntzh]))),
 219  ("subIntCzh", tArrow tIntzh (tArrow tIntzh (tUtuple [tIntzh, tIntzh]))),
 220  ("mulIntCzh", tArrow tIntzh (tArrow tIntzh (tUtuple [tIntzh, tIntzh]))),
 221  ("zgzh", tcompare tIntzh),
 222  ("zgzezh", tcompare tIntzh),
 223  ("zezezh", tcompare tIntzh),
 224  ("zszezh", tcompare tIntzh),
 225  ("zlzh", tcompare tIntzh),
 226  ("zlzezh", tcompare tIntzh),
 227  ("chrzh", tArrow tIntzh tCharzh),
 228  ("int2Wordzh", tArrow tIntzh tWordzh),
 229  ("int2Floatzh", tArrow tIntzh tFloatzh),
 230  ("int2Doublezh", tArrow tIntzh tDoublezh),
 231  ("intToInt32zh", tArrow tIntzh tInt32zh),
 232  ("int2Integerzh", tArrow tIntzh tIntegerzhRes),
 233  ("iShiftLzh", tdyadic tIntzh),
 234  ("iShiftRAzh", tdyadic tIntzh),
 235  ("iShiftRLh", tdyadic tIntzh)]
 236
 237
 238 {- Int32zh -}
 239
 240 tcInt32zh = pvz "Int32"
 241 tInt32zh = Tcon tcInt32zh
 242 ktInt32zh = Kunlifted
 243
 244 opsInt32zh = [
 245  ("int32ToIntzh", tArrow tInt32zh tIntzh),
 246  ("int32ToIntegerzh", tArrow tInt32zh tIntegerzhRes)]
 247
 248
 249 {- Int64zh -}
 250
 251 tcInt64zh = pvz "Int64"
 252 tInt64zh = Tcon tcInt64zh
 253 ktInt64zh = Kunlifted
 254
 255 opsInt64zh = [
 256  ("int64ToIntegerzh", tArrow tInt64zh tIntegerzhRes)]
 257
 258 {- Integerzh -}
 259
 260 -- not actuallly a primitive type
 261 tIntegerzhRes = tUtuple [tIntzh, tByteArrayzh]
 262 tIntegerzhTo t = tArrow tIntzh (tArrow tByteArrayzh t)
 263 tdyadicIntegerzh = tIntegerzhTo (tIntegerzhTo tIntegerzhRes)
 264
 265 opsIntegerzh = [
 266  ("plusIntegerzh", tdyadicIntegerzh),
 267  ("minusIntegerzh", tdyadicIntegerzh),
 268  ("timesIntegerzh", tdyadicIntegerzh),
 269  ("gcdIntegerzh", tdyadicIntegerzh),
 270  ("gcdIntegerIntzh", tIntegerzhTo (tArrow tIntzh tIntzh)),
 271  ("divExactIntegerzh", tdyadicIntegerzh),
 272  ("quotIntegerzh", tdyadicIntegerzh),
 273  ("remIntegerzh", tdyadicIntegerzh),
 274  ("cmpIntegerzh", tIntegerzhTo (tIntegerzhTo tIntzh)),
 275  ("cmpIntegerIntzh", tIntegerzhTo (tArrow tIntzh tIntzh)),
 276  ("quotRemIntegerzh", tIntegerzhTo (tIntegerzhTo (tUtuple [tIntzh,tByteArrayzh,tIntzh,tByteArrayzh]))),
 277  ("divModIntegerzh", tIntegerzhTo (tIntegerzhTo (tUtuple [tIntzh,tByteArrayzh,tIntzh,tByteArrayzh]))),
 278  ("integer2Intzh", tIntegerzhTo tIntzh),
 279  ("integer2Wordzh", tIntegerzhTo tWordzh),
 280  ("integerToInt32zh", tIntegerzhTo tInt32zh),
 281  ("integerToWord32zh", tIntegerzhTo tWord32zh),
 282  ("integerToInt64zh", tIntegerzhTo tInt64zh),
 283  ("integerToWord64zh", tIntegerzhTo tWord64zh),
 284  ("andIntegerzh", tdyadicIntegerzh),
 285  ("orIntegerzh", tdyadicIntegerzh),
 286  ("xorIntegerzh", tdyadicIntegerzh),
 287  ("complementIntegerzh", tIntegerzhTo tIntegerzhRes)]
 288
 289
 290
 291 {- Wordzh -}
 292
 293 tcWordzh = pvz "Word"
 294 tWordzh = Tcon tcWordzh
 295 ktWordzh = Kunlifted
 296
 297 opsWordzh = [
 298  ("plusWordzh", tdyadic tWordzh),
 299  ("minusWordzh", tdyadic tWordzh),
 300  ("timesWordzh", tdyadic tWordzh),
 301  ("quotWordzh",   tdyadic tWordzh),
 302  ("remWordzh",   tdyadic tWordzh),
 303  ("andzh",    tdyadic tWordzh),
 304  ("orzh",    tdyadic tWordzh),
 305  ("xorzh",    tdyadic tWordzh),
 306  ("notzh",    tmonadic tWordzh),
 307  ("shiftLzh", tArrow tWordzh (tArrow tIntzh tWordzh)),
 308  ("shiftRLzh", tArrow tWordzh (tArrow tIntzh tWordzh)),
 309  ("word2Intzh", tArrow tWordzh tIntzh),
 310  ("wordToWord32zh", tArrow tWordzh tWord32zh),
 311  ("word2Integerzh", tArrow tWordzh tIntegerzhRes),
 312  ("gtWordzh", tcompare tWordzh),
 313  ("geWordzh", tcompare tWordzh),
 314  ("eqWordzh", tcompare tWordzh),
 315  ("neWordzh", tcompare tWordzh),
 316  ("ltWordzh", tcompare tWordzh),
 317  ("leWordzh", tcompare tWordzh)]
 318
 319 {- Word32zh -}
 320
 321 tcWord32zh = pvz "Word32"
 322 tWord32zh = Tcon tcWord32zh
 323 ktWord32zh = Kunlifted
 324
 325 opsWord32zh = [
 326  ("word32ToWordzh", tArrow tWord32zh tWordzh),
 327  ("word32ToIntegerzh", tArrow tWord32zh tIntegerzhRes)]
 328
 329 {- Word64zh -}
 330
 331 tcWord64zh = pvz "Word64"
 332 tWord64zh = Tcon tcWord64zh
 333 ktWord64zh = Kunlifted
 334
 335 opsWord64zh = [
 336  ("word64ToIntegerzh", tArrow tWord64zh tIntegerzhRes)]
 337
 338 {- Explicitly sized Intzh and Wordzh -}
 339
 340 opsSized = [
 341  ("narrow8Intzh", tmonadic tIntzh),
 342  ("narrow16Intzh", tmonadic tIntzh),
 343  ("narrow32Intzh", tmonadic tIntzh),
 344  ("narrow8Wordzh", tmonadic tWordzh),
 345  ("narrow16Wordzh", tmonadic tWordzh),
 346  ("narrow32Wordzh", tmonadic tWordzh)]
 347
 348 {- Arrays -}
 349
 350 tcArrayzh = pvz "Array"
 351 tArrayzh t = Tapp (Tcon tcArrayzh) t
 352 ktArrayzh = Karrow Klifted Kunlifted
 353
 354 tcByteArrayzh = pvz "ByteArray"
 355 tByteArrayzh = Tcon tcByteArrayzh
 356 ktByteArrayzh = Kunlifted
 357
 358 tcMutableArrayzh = pvz "MutableArray"
 359 tMutableArrayzh s t = Tapp (Tapp (Tcon tcMutableArrayzh) s) t
 360 ktMutableArrayzh = Karrow Klifted (Karrow Klifted Kunlifted)
 361
 362 tcMutableByteArrayzh = pvz "MutableByteArray"
 363 tMutableByteArrayzh s = Tapp (Tcon tcMutableByteArrayzh) s
 364 ktMutableByteArrayzh = Karrow Klifted Kunlifted
 365
 366 opsArray = [
 367  ("newArrayzh", Tforall ("a",Klifted)
 368                        (Tforall ("s",Klifted)
 369                                 (tArrow tIntzh
 370                                        (tArrow (Tvar "a")
 371                                                (tArrow (tStatezh (Tvar "s"))
 372                                                        (tUtuple [tStatezh (Tvar "s"),tMutableArrayzh (Tvar "s") (Tvar "a")])))))),
 373  ("newByteArrayzh", Tforall ("s",Klifted)
 374                            (tArrow tIntzh
 375                                    (tArrow (tStatezh (Tvar "s"))
 376                                            (tUtuple [tStatezh (Tvar "s"),tMutableByteArrayzh (Tvar "s")])))),
 377  ("newPinnedByteArrayzh", Tforall ("s",Klifted)
 378                            (tArrow tIntzh
 379                                    (tArrow (tStatezh (Tvar "s"))
 380                                            (tUtuple [tStatezh (Tvar "s"),tMutableByteArrayzh (Tvar "s")])))),
 381  ("byteArrayContentszh", tArrow tByteArrayzh tAddrzh),
 382  ("indexCharArrayzh", tArrow tByteArrayzh (tArrow tIntzh tCharzh)),
 383  ("indexWideCharArrayzh", tArrow tByteArrayzh (tArrow tIntzh tCharzh)),
 384  ("indexIntArrayzh", tArrow tByteArrayzh (tArrow tIntzh tIntzh)),
 385  ("indexWordArrayzh", tArrow tByteArrayzh (tArrow tIntzh tWordzh)),
 386  ("indexAddrArrayzh", tArrow tByteArrayzh (tArrow tIntzh tAddrzh)),
 387  ("indexFloatArrayzh", tArrow tByteArrayzh (tArrow tIntzh tFloatzh)),
 388  ("indexDoubleArrayzh", tArrow tByteArrayzh (tArrow tIntzh tDoublezh)),
 389  ("indexStablePtrArrayzh", Tforall ("a",Klifted) (tArrow tByteArrayzh (tArrow tIntzh (tStablePtrzh (Tvar "a"))))),
 390  ("indexInt8Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tIntzh)),
 391  ("indexInt16Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tIntzh)),
 392  ("indexInt32Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tInt32zh)),
 393  ("indexInt64Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tInt64zh)),
 394  ("indexWord8Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tWordzh)),
 395  ("indexWord16Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tWordzh)),
 396  ("indexWord32Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tWord32zh)),
 397  ("indexWord64Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tWord64zh)),
 398  ("readCharArrayzh", tReadMutableByteArrayzh tCharzh),
 399  ("readWideCharArrayzh", tReadMutableByteArrayzh tCharzh),
 400  ("readIntArrayzh", tReadMutableByteArrayzh tIntzh),
 401  ("readWordArrayzh", tReadMutableByteArrayzh tWordzh),
 402  ("readAddrArrayzh", tReadMutableByteArrayzh tAddrzh),
 403  ("readFloatArrayzh", tReadMutableByteArrayzh tFloatzh),
 404  ("readDoubleArrayzh", tReadMutableByteArrayzh tDoublezh),
 405  ("readStablePtrArrayzh", Tforall ("s",Klifted)
 406                                  (Tforall ("a",Klifted)
 407                                           (tArrow (tMutableByteArrayzh (Tvar "s"))
 408                                                   (tArrow tIntzh
 409                                                          (tArrow (tStatezh (Tvar "s"))
 410                                                                  (tUtuple [tStatezh (Tvar "s"),tStablePtrzh (Tvar "a")])))))),
 411  ("readInt8Arrayzh", tReadMutableByteArrayzh tIntzh),
 412  ("readInt16Arrayzh", tReadMutableByteArrayzh tIntzh),
 413  ("readInt32Arrayzh", tReadMutableByteArrayzh tInt32zh),
 414  ("readInt64Arrayzh", tReadMutableByteArrayzh tInt64zh),
 415  ("readWord8Arrayzh", tReadMutableByteArrayzh tWordzh),
 416  ("readWord16Arrayzh", tReadMutableByteArrayzh tWordzh),
 417  ("readWord32Arrayzh", tReadMutableByteArrayzh tWord32zh),
 418  ("readWord64Arrayzh", tReadMutableByteArrayzh tWord64zh),
 419
 420  ("writeCharArrayzh", tWriteMutableByteArrayzh tCharzh),
 421  ("writeWideCharArrayzh", tWriteMutableByteArrayzh tCharzh),
 422  ("writeIntArrayzh", tWriteMutableByteArrayzh tIntzh),
 423  ("writeWordArrayzh", tWriteMutableByteArrayzh tWordzh),
 424  ("writeAddrArrayzh", tWriteMutableByteArrayzh tAddrzh),
 425  ("writeFloatArrayzh", tWriteMutableByteArrayzh tFloatzh),
 426  ("writeDoubleArrayzh", tWriteMutableByteArrayzh tDoublezh),
 427  ("writeStablePtrArrayzh", Tforall ("s",Klifted)
 428                                   (Tforall ("a",Klifted)
 429                                            (tArrow (tMutableByteArrayzh (Tvar "s"))
 430                                                    (tArrow tIntzh
 431                                                           (tArrow (tStablePtrzh (Tvar "a"))
 432                                                                   (tArrow (tStatezh (Tvar "s"))
 433                                                                           (tStatezh (Tvar "s")))))))),
 434  ("writeInt8Arrayzh", tWriteMutableByteArrayzh tIntzh),
 435  ("writeInt16Arrayzh", tWriteMutableByteArrayzh tIntzh),
 436  ("writeInt32Arrayzh", tWriteMutableByteArrayzh tIntzh),
 437  ("writeInt64Arrayzh", tWriteMutableByteArrayzh tInt64zh),
 438  ("writeWord8Arrayzh", tWriteMutableByteArrayzh tWordzh),
 439  ("writeWord16Arrayzh", tWriteMutableByteArrayzh tWordzh),
 440  ("writeWord32Arrayzh", tWriteMutableByteArrayzh tWord32zh),
 441  ("writeWord64Arrayzh", tWriteMutableByteArrayzh tWord64zh),
 442
 443  ("indexCharOffAddrzh", tArrow tAddrzh (tArrow tIntzh tCharzh)),
 444  ("indexWideCharOffAddrzh", tArrow tAddrzh (tArrow tIntzh tCharzh)),
 445  ("indexIntOffAddrzh", tArrow tAddrzh (tArrow tIntzh tIntzh)),
 446  ("indexWordOffAddrzh", tArrow tAddrzh (tArrow tIntzh tWordzh)),
 447  ("indexAddrOffAddrzh", tArrow tAddrzh (tArrow tIntzh tAddrzh)),
 448  ("indexFloatOffAddrzh", tArrow tAddrzh (tArrow tIntzh tFloatzh)),
 449  ("indexDoubleOffAddrzh", tArrow tAddrzh (tArrow tIntzh tDoublezh)),
 450  ("indexStablePtrOffAddrzh", Tforall ("a",Klifted) (tArrow tAddrzh (tArrow tIntzh (tStablePtrzh (Tvar "a"))))),
 451  ("indexInt8OffAddrzh", tArrow tAddrzh (tArrow tIntzh tIntzh)),
 452  ("indexInt16OffAddrzh", tArrow tAddrzh (tArrow tIntzh tIntzh)),
 453  ("indexInt32OffAddrzh", tArrow tAddrzh (tArrow tIntzh tInt32zh)),
 454  ("indexInt64OffAddrzh", tArrow tAddrzh (tArrow tIntzh tInt64zh)),
 455  ("indexWord8OffAddrzh", tArrow tAddrzh (tArrow tIntzh tWordzh)),
 456  ("indexWord16OffAddrzh", tArrow tAddrzh (tArrow tIntzh tWordzh)),
 457  ("indexWord32ffAddrzh", tArrow tAddrzh (tArrow tIntzh tWord32zh)),
 458  ("indexWord64OffAddrzh", tArrow tAddrzh (tArrow tIntzh tWord64zh)),
 459
 460  ("indexCharOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tCharzh)),
 461  ("indexWideCharOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tCharzh)),
 462  ("indexIntOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tIntzh)),
 463  ("indexWordOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWordzh)),
 464  ("indexAddrOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tAddrzh)),
 465  ("indexFloatOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tFloatzh)),
 466  ("indexDoubleOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tDoublezh)),
 467  ("indexStablePtrOffForeignObjzh", Tforall ("a",Klifted) (tArrow tForeignObjzh (tArrow tIntzh (tStablePtrzh (Tvar "a"))))),
 468  ("indexInt8OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tIntzh)),
 469  ("indexInt16OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tIntzh)),
 470  ("indexInt32OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tInt32zh)),
 471  ("indexInt64OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tInt64zh)),
 472  ("indexWord8OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWordzh)),
 473  ("indexWord16OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWordzh)),
 474  ("indexWord32ffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWord32zh)),
 475  ("indexWord64OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWord64zh)),
 476
 477  ("readCharOffAddrzh", tReadOffAddrzh tCharzh),
 478  ("readWideCharOffAddrzh", tReadOffAddrzh tCharzh),
 479  ("readIntOffAddrzh", tReadOffAddrzh tIntzh),
 480  ("readWordOffAddrzh", tReadOffAddrzh tWordzh),
 481  ("readAddrOffAddrzh", tReadOffAddrzh tAddrzh),
 482  ("readFloatOffAddrzh", tReadOffAddrzh tFloatzh),
 483  ("readDoubleOffAddrzh", tReadOffAddrzh tDoublezh),
 484  ("readStablePtrOffAddrzh", Tforall ("s",Klifted)
 485                                 (Tforall ("a",Klifted)
 486                                      (tArrow tAddrzh
 487                                              (tArrow tIntzh
 488                                                     (tArrow (tStatezh (Tvar "s"))
 489                                                             (tUtuple [tStatezh (Tvar "s"),tStablePtrzh (Tvar "a")])))))),
 490  ("readInt8OffAddrzh", tReadOffAddrzh tIntzh),
 491  ("readInt16OffAddrzh", tReadOffAddrzh tIntzh),
 492  ("readInt32OffAddrzh", tReadOffAddrzh tInt32zh),
 493  ("readInt64OffAddrzh", tReadOffAddrzh tInt64zh),
 494  ("readWord8OffAddrzh", tReadOffAddrzh tWordzh),
 495  ("readWord16OffAddrzh", tReadOffAddrzh tWordzh),
 496  ("readWord32OffAddrzh", tReadOffAddrzh tWord32zh),
 497  ("readWord64OffAddrzh", tReadOffAddrzh tWord64zh),
 498
 499  ("writeCharOffAddrzh", tWriteOffAddrzh tCharzh),
 500  ("writeWideCharOffAddrzh", tWriteOffAddrzh tCharzh),
 501  ("writeIntOffAddrzh", tWriteOffAddrzh tIntzh),
 502  ("writeWordOffAddrzh", tWriteOffAddrzh tWordzh),
 503  ("writeAddrOffAddrzh", tWriteOffAddrzh tAddrzh),
 504  ("writeFloatOffAddrzh", tWriteOffAddrzh tFloatzh),
 505  ("writeDoubleOffAddrzh", tWriteOffAddrzh tDoublezh),
 506  ("writeStablePtrOffAddrzh", Tforall ("a",Klifted) (tWriteOffAddrzh (tStablePtrzh (Tvar "a")))),
 507  ("writeInt8OffAddrzh", tWriteOffAddrzh tIntzh),
 508  ("writeInt16OffAddrzh", tWriteOffAddrzh tIntzh),
 509  ("writeInt32OffAddrzh", tWriteOffAddrzh tInt32zh),
 510  ("writeInt64OffAddrzh", tWriteOffAddrzh tInt64zh),
 511  ("writeWord8OffAddrzh", tWriteOffAddrzh tWordzh),
 512  ("writeWord16OffAddrzh", tWriteOffAddrzh tWordzh),
 513  ("writeWord32OffAddrzh", tWriteOffAddrzh tWord32zh),
 514  ("writeWord64OffAddrzh", tWriteOffAddrzh tWord64zh),
 515
 516  ("sameMutableArrayzh", Tforall ("s",Klifted)
 517                                (Tforall ("a",Klifted)
 518                                         (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a"))
 519                                                 (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a"))
 520                                                         tBool)))),
 521  ("sameMutableByteArrayzh", Tforall ("s",Klifted)
 522                                    (tArrow (tMutableByteArrayzh (Tvar "s"))
 523                                            (tArrow (tMutableByteArrayzh (Tvar "s"))
 524                                                    tBool))),
 525  ("readArrayzh",Tforall ("s",Klifted)
 526                         (Tforall ("a",Klifted)
 527                                  (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a"))
 528                                          (tArrow tIntzh
 529                                                  (tArrow (tStatezh (Tvar "s"))
 530                                                          (tUtuple[tStatezh (Tvar "s"), Tvar "a"])))))),
 531  ("writeArrayzh",Tforall ("s",Klifted)
 532                          (Tforall ("a",Klifted)
 533                                   (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a"))
 534                                           (tArrow tIntzh
 535                                                   (tArrow (Tvar "a")
 536                                                           (tArrow (tStatezh (Tvar "s"))
 537                                                                   (tStatezh (Tvar "s")))))))),
 538  ("indexArrayzh", Tforall ("a",Klifted)
 539                           (tArrow (tArrayzh (Tvar "a"))
 540                                   (tArrow tIntzh
 541                                           (tUtuple[Tvar "a"])))),
 542  ("unsafeFreezzeArrayzh",Tforall ("s",Klifted)
 543                                 (Tforall ("a",Klifted)
 544                                          (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a"))
 545                                                  (tArrow (tStatezh (Tvar "s"))
 546                                                          (tUtuple[tStatezh (Tvar "s"),tArrayzh (Tvar "a")]))))),
 547  ("unsafeFreezzeByteArrayzh",Tforall ("s",Klifted)
 548                                     (tArrow (tMutableByteArrayzh (Tvar "s"))
 549                                             (tArrow (tStatezh (Tvar "s"))
 550                                                     (tUtuple[tStatezh (Tvar "s"),tByteArrayzh])))),
 551  ("unsafeThawArrayzh",Tforall ("a",Klifted)
 552                              (Tforall ("s",Klifted)
 553                                       (tArrow (tArrayzh (Tvar "a"))
 554                                               (tArrow (tStatezh (Tvar "s"))
 555                                                       (tUtuple[tStatezh (Tvar "s"),tMutableArrayzh (Tvar "s") (Tvar "a")]))))),
 556  ("sizzeofByteArrayzh", tArrow tByteArrayzh tIntzh),
 557  ("sizzeofMutableByteArrayzh", Tforall ("s",Klifted) (tArrow (tMutableByteArrayzh (Tvar "s")) tIntzh))]
 558  where
 559  tReadMutableByteArrayzh t =
 560      Tforall ("s",Klifted)
 561              (tArrow (tMutableByteArrayzh (Tvar "s"))
 562                      (tArrow tIntzh
 563                             (tArrow (tStatezh (Tvar "s"))
 564                                     (tUtuple [tStatezh (Tvar "s"),t]))))
 565
 566  tWriteMutableByteArrayzh t =
 567      Tforall ("s",Klifted)
 568              (tArrow (tMutableByteArrayzh (Tvar "s"))
 569                      (tArrow tIntzh
 570                             (tArrow t
 571                                     (tArrow (tStatezh (Tvar "s"))
 572                                             (tStatezh (Tvar "s"))))))
 573
 574  tReadOffAddrzh t =
 575      Tforall ("s",Klifted)
 576              (tArrow tAddrzh
 577                      (tArrow tIntzh
 578                             (tArrow (tStatezh (Tvar "s"))
 579                                     (tUtuple [tStatezh (Tvar "s"),t]))))
 580
 581
 582  tWriteOffAddrzh t =
 583      Tforall ("s",Klifted)
 584              (tArrow tAddrzh
 585                      (tArrow tIntzh
 586                             (tArrow t
 587                                     (tArrow (tStatezh (Tvar "s"))
 588                                             (tStatezh (Tvar "s"))))))
 589
 590 {- MutVars -}
 591
 592 tcMutVarzh = pvz "MutVar"
 593 tMutVarzh s t = Tapp (Tapp (Tcon tcMutVarzh) s) t
 594 ktMutVarzh = Karrow Klifted (Karrow Klifted Kunlifted)
 595
 596 opsMutVarzh = [
 597  ("newMutVarzh", Tforall ("a",Klifted)
 598                     (Tforall ("s",Klifted)
 599                         (tArrow (Tvar "a") (tArrow (tStatezh (Tvar "s"))
 600                                                    (tUtuple [tStatezh (Tvar "s"),
 601                                                              tMutVarzh (Tvar "s") (Tvar "a")]))))),
 602  ("readMutVarzh", Tforall ("s",Klifted)
 603                     (Tforall ("a",Klifted)
 604                         (tArrow (tMutVarzh (Tvar "s")(Tvar "a"))
 605                                 (tArrow (tStatezh (Tvar "s"))
 606                                         (tUtuple [tStatezh (Tvar "s"), Tvar "a"]))))),
 607  ("writeMutVarzh", Tforall ("s",Klifted)
 608                     (Tforall ("a",Klifted)
 609                         (tArrow (tMutVarzh (Tvar "s") (Tvar "a"))
 610                                 (tArrow (Tvar "a")
 611                                         (tArrow (tStatezh (Tvar "s"))
 612                                                 (tStatezh (Tvar "s"))))))),
 613  ("sameMutVarzh", Tforall ("s",Klifted)
 614                     (Tforall ("a",Klifted)
 615                         (tArrow (tMutVarzh (Tvar "s") (Tvar "a"))
 616                                 (tArrow (tMutVarzh (Tvar "s") (Tvar "a"))
 617                                         tBool))))]
 618
 619 {- Real world and state. -}
 620
 621 -- tjc: why isn't this one unboxed?
 622 tcRealWorld = pv "RealWorld"
 623 tRealWorld = Tcon tcRealWorld
 624 ktRealWorld = Klifted
 625
 626 tcStatezh = pvz "State"
 627 tStatezh t = Tapp (Tcon tcStatezh) t
 628 ktStatezh = Karrow Klifted Kunlifted
 629
 630 tRWS = tStatezh tRealWorld
 631
 632 opsState = [
 633   ("realWorldzh", tRWS)]
 634
 635 {- Exceptions -}
 636
 637 -- no primitive type
 638 opsExn = [
 639  ("catchzh",
 640         let t' = tArrow tRWS (tUtuple [tRWS, Tvar "a"]) in
 641         Tforall ("a",Klifted)
 642                 (Tforall ("b",Klifted)
 643                          (tArrow t'
 644                                  (tArrow (tArrow (Tvar "b") t')
 645                                          t')))),
 646   ("raisezh", Tforall ("a",Klifted)
 647                       (Tforall ("b",Klifted)
 648                                (tArrow (Tvar "a") (Tvar "b")))),
 649   ("blockAsyncExceptionszh", Tforall ("a",Klifted)
 650                                     (tArrow (tArrow tRWS (tUtuple[tRWS,Tvar "a"]))
 651                                             (tArrow tRWS (tUtuple[tRWS,Tvar "a"])))),
 652   ("unblockAsyncExceptionszh", Tforall ("a",Klifted)
 653                                     (tArrow (tArrow tRWS (tUtuple[tRWS,Tvar "a"]))
 654                                             (tArrow tRWS (tUtuple[tRWS,Tvar "a"]))))]
 655
 656 {- Mvars -}
 657
 658 tcMVarzh = pvz "MVar"
 659 tMVarzh s t = Tapp (Tapp (Tcon tcMVarzh) s) t
 660 ktMVarzh = Karrow Klifted (Karrow Klifted Kunlifted)
 661
 662 opsMVar = [
 663  ("newMVarzh", Tforall ("s",Klifted)
 664                       (Tforall ("a",Klifted)
 665                                (tArrow (tStatezh (Tvar "s"))
 666                                        (tUtuple[tStatezh (Tvar "s"),tMVarzh (Tvar "s") (Tvar "a")])))),
 667  ("takeMVarzh", Tforall ("s",Klifted)
 668                       (Tforall ("a",Klifted)
 669                                (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
 670                                        (tArrow (tStatezh (Tvar "s"))
 671                                                (tUtuple[tStatezh (Tvar "s"),Tvar "a"]))))),
 672  ("tryTakeMVarzh", Tforall ("s",Klifted)
 673                       (Tforall ("a",Klifted)
 674                                (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
 675                                        (tArrow (tStatezh (Tvar "s"))
 676                                                (tUtuple[tStatezh (Tvar "s"),tIntzh,Tvar "a"]))))),
 677  ("putMVarzh", Tforall ("s",Klifted)
 678                       (Tforall ("a",Klifted)
 679                                (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
 680                                        (tArrow (Tvar "a")
 681                                                (tArrow (tStatezh (Tvar "s"))
 682                                                        (tStatezh (Tvar "s"))))))),
 683  ("tryPutMVarzh", Tforall ("s",Klifted)
 684                       (Tforall ("a",Klifted)
 685                                (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
 686                                        (tArrow (Tvar "a")
 687                                                (tArrow (tStatezh (Tvar "s"))
 688                                                        (tUtuple [tStatezh (Tvar "s"), tIntzh])))))),
 689  ("sameMVarzh", Tforall ("s",Klifted)
 690                       (Tforall ("a",Klifted)
 691                                (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
 692                                        (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
 693                                                tBool)))),
 694  ("isEmptyMVarzh", Tforall ("s",Klifted)
 695                       (Tforall ("a",Klifted)
 696                                (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
 697                                        (tArrow (tStatezh (Tvar "s"))
 698                                                (tUtuple[tStatezh (Tvar "s"),tIntzh])))))]
 699
 700
 701 {- Weak Objects -}
 702
 703 tcWeakzh = pvz "Weak"
 704 tWeakzh t = Tapp (Tcon tcWeakzh) t
 705 ktWeakzh = Karrow Klifted Kunlifted
 706
 707 opsWeak = [
 708   ("mkWeakzh", Tforall ("o",Kopen)
 709                       (Tforall ("b",Klifted)
 710                                (Tforall ("c",Klifted)
 711                                         (tArrow (Tvar "o")
 712                                                 (tArrow (Tvar "b")
 713                                                         (tArrow (Tvar "c")
 714                                                                 (tArrow tRWS (tUtuple[tRWS, tWeakzh (Tvar "b")])))))))),
 715   ("deRefWeakzh", Tforall ("a",Klifted)
 716                          (tArrow (tWeakzh (Tvar "a"))
 717                                  (tArrow tRWS (tUtuple[tRWS, tIntzh, Tvar "a"])))),
 718   ("finalizeWeakzh", Tforall ("a",Klifted)
 719                             (tArrow (tWeakzh (Tvar "a"))
 720                                     (tArrow tRWS
 721                                             (tUtuple[tRWS,tIntzh,
 722                                                      tArrow tRWS (tUtuple[tRWS, tUnit])]))))]
 723
 724
 725 {- Foreign Objects -}
 726
 727 tcForeignObjzh = pvz "ForeignObj"
 728 tForeignObjzh = Tcon tcForeignObjzh
 729 ktForeignObjzh = Kunlifted
 730
 731 opsForeignObjzh = [
 732  ("mkForeignObjzh", tArrow tAddrzh
 733                            (tArrow tRWS (tUtuple [tRWS,tForeignObjzh]))),
 734  ("writeForeignObjzh", Tforall ("s",Klifted)
 735                                (tArrow tForeignObjzh
 736                                        (tArrow tAddrzh
 737                                                (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s")))))),
 738  ("foreignObjToAddrzh", tArrow tForeignObjzh tAddrzh),
 739  ("touchzh", Tforall ("o",Kopen)
 740                      (tArrow (Tvar "o")
 741                              (tArrow tRWS tRWS)))]
 742
 743
 744 {- Stable Pointers (but not names) -}
 745
 746 tcStablePtrzh = pvz "StablePtr"
 747 tStablePtrzh t = Tapp (Tcon tcStablePtrzh) t
 748 ktStablePtrzh = Karrow Klifted Kunlifted
 749
 750 opsStablePtrzh = [
 751   ("makeStablePtrzh", Tforall ("a",Klifted)
 752                              (tArrow (Tvar "a")
 753                                      (tArrow tRWS (tUtuple[tRWS,tStablePtrzh (Tvar "a")])))),
 754   ("deRefStablePtrzh", Tforall ("a",Klifted)
 755                               (tArrow (tStablePtrzh (Tvar "a"))
 756                                       (tArrow tRWS (tUtuple[tRWS,Tvar "a"])))),
 757   ("eqStablePtrzh", Tforall ("a",Klifted)
 758                            (tArrow (tStablePtrzh (Tvar "a"))
 759                                    (tArrow (tStablePtrzh (Tvar "a")) tIntzh)))]
 760
 761 {- Concurrency  operations -}
 762
 763 tcThreadIdzh = pvz "ThreadId"
 764 tThreadIdzh = Tcon tcThreadIdzh
 765 ktThreadIdzh = Kunlifted
 766
 767 opsConc = [
 768   ("seqzh", Tforall ("a",Klifted)
 769                     (tArrow (Tvar "a") tIntzh)),
 770   ("parzh", Tforall ("a",Klifted)
 771                     (tArrow (Tvar "a") tIntzh)),
 772   ("delayzh", Tforall ("s",Klifted)
 773                      (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s"))))),
 774   ("waitReadzh", Tforall ("s",Klifted)
 775                      (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s"))))),
 776   ("waitWritezh", Tforall ("s",Klifted)
 777                      (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s"))))),
 778   ("forkzh", Tforall ("a",Klifted)
 779                     (tArrow (Tvar "a")
 780                             (tArrow tRWS (tUtuple[tRWS,tThreadIdzh])))),
 781   ("killThreadzh", Tforall ("a",Klifted)
 782                           (tArrow tThreadIdzh
 783                                   (tArrow (Tvar "a")
 784                                           (tArrow tRWS tRWS)))),
 785   ("yieldzh", tArrow tRWS tRWS),
 786   ("myThreadIdzh", tArrow tRWS (tUtuple[tRWS, tThreadIdzh]))]
 787
 788 {- Miscellaneous operations -}
 789
 790 opsMisc =  [
 791   ("dataToTagzh", Tforall ("a",Klifted)
 792                           (tArrow (Tvar "a") tIntzh)),
 793   ("tagToEnumzh", Tforall ("a",Klifted)
 794                           (tArrow tIntzh (Tvar "a"))),
 795   ("unsafeCoercezh", Tforall ("a",Kopen)
 796                              (Tforall ("b",Kopen)
 797                                       (tArrow (Tvar "a") (Tvar "b")))) -- maybe unneeded
 798   ]
 799
 800 {- CCallable and CReturnable.
 801    We just define the type constructors for the dictionaries
 802    corresponding to these pseudo-classes. -}
 803
 804 tcZCTCCallable = pv "ZCTCCallable"
 805 ktZCTCCallable = Karrow Kopen Klifted  -- ??
 806 tcZCTCReturnable = pv "ZCTCReturnable"
 807 ktZCTCReturnable = Karrow Kopen Klifted  -- ??
 808
 809 {- Non-primitive, but mentioned in the types of primitives. -}
 810
 811 bv = qual baseMname
 812
 813 tcUnit = bv "Unit"
 814 tUnit = Tcon tcUnit
 815 ktUnit = Klifted
 816 tcBool = bv "Bool"
 817 tBool = Tcon tcBool
 818 ktBool = Klifted
 819
 820 {- Properly defined in PrelError, but needed in many modules before that. -}
 821 errorVals = [
 822  ("error", Tforall ("a",Kopen) (tArrow tString (Tvar "a"))),
 823  ("irrefutPatError", Tforall ("a",Kopen) (tArrow tString (Tvar "a"))),
 824  ("patError", Tforall ("a",Kopen) (tArrow tString (Tvar "a")))]
 825
 826 tcChar = bv "Char"
 827 tChar = Tcon tcChar
 828 ktChar = Klifted
 829 tcList = bv "ZMZN"
 830 tList t = Tapp (Tcon tcList) t
 831 ktList = Karrow Klifted Klifted
 832 tString = tList tChar
 833
 834 {- Utilities for building types -}
 835 tmonadic t = tArrow t t
 836 tdyadic t = tArrow t (tArrow t t)
 837 tcompare t = tArrow t (tArrow t tBool)
 838