{- This module really should be auto-generated from the master primops.txt file. It is roughly correct (but may be slightly incomplete) wrt/ GHC5.02. -} module Prims where import Core import Env import Check initialEnv :: Menv initialEnv = efromlist [(primMname,primEnv), ("PrelErr",errorEnv)] primEnv :: Envs primEnv = Envs {tcenv_=efromlist primTcs, tsenv_=eempty, cenv_=efromlist primDcs, venv_=efromlist primVals} errorEnv :: Envs errorEnv = Envs {tcenv_=eempty, tsenv_=eempty, cenv_=eempty, venv_=efromlist errorVals} {- Components of static environment -} primTcs :: [(Tcon,Kind)] primTcs = map (\ ((m,tc),k) -> (tc,k)) ([(tcArrow,ktArrow), (tcAddrzh,ktAddrzh), (tcCharzh,ktCharzh), (tcDoublezh,ktDoublezh), (tcFloatzh,ktFloatzh), (tcIntzh,ktIntzh), (tcInt32zh,ktInt32zh), (tcInt64zh,ktInt64zh), (tcWordzh,ktWordzh), (tcWord32zh,ktWord32zh), (tcWord64zh,ktWord64zh), (tcRealWorld, ktRealWorld), (tcStatezh, ktStatezh), (tcArrayzh,ktArrayzh), (tcByteArrayzh,ktByteArrayzh), (tcMutableArrayzh,ktMutableArrayzh), (tcMutableByteArrayzh,ktMutableByteArrayzh), (tcMutVarzh,ktMutVarzh), (tcMVarzh,ktMVarzh), (tcWeakzh,ktWeakzh), (tcForeignObjzh, ktForeignObjzh), (tcStablePtrzh, ktStablePtrzh), (tcThreadIdzh, ktThreadIdzh), (tcZCTCCallable, ktZCTCCallable), (tcZCTCReturnable, ktZCTCReturnable)] ++ [(tcUtuple n, ktUtuple n) | n <- [1..maxUtuple]]) primDcs :: [(Dcon,Ty)] primDcs = map (\ ((m,c),t) -> (c,t)) [(dcUtuple n, dcUtupleTy n) | n <- [1..maxUtuple]] primVals :: [(Var,Ty)] primVals = opsAddrzh ++ opsCharzh ++ opsDoublezh ++ opsFloatzh ++ opsIntzh ++ opsInt32zh ++ opsInt64zh ++ opsIntegerzh ++ opsWordzh ++ opsWord32zh ++ opsWord64zh ++ opsSized ++ opsArray ++ opsMutVarzh ++ opsState ++ opsExn ++ opsMVar ++ opsWeak ++ opsForeignObjzh ++ opsStablePtrzh ++ opsConc ++ opsMisc dcUtuples :: [(Qual Dcon,Ty)] dcUtuples = map ( \n -> (dcUtuple n, typ n)) [1..100] where typ n = foldr ( \tv t -> Tforall (tv,Kopen) t) (foldr ( \tv t -> tArrow (Tvar tv) t) (tUtuple (map Tvar tvs)) tvs) tvs where tvs = map ( \i -> ("a" ++ (show i))) [1..n] {- Addrzh -} tcAddrzh = (primMname,"Addrzh") tAddrzh = Tcon tcAddrzh ktAddrzh = Kunlifted opsAddrzh = [ ("gtAddrzh",tcompare tAddrzh), ("geAddrzh",tcompare tAddrzh), ("eqAddrzh",tcompare tAddrzh), ("neAddrzh",tcompare tAddrzh), ("ltAddrzh",tcompare tAddrzh), ("leAddrzh",tcompare tAddrzh), ("nullAddrzh", tAddrzh), ("plusAddrzh", tArrow tAddrzh (tArrow tIntzh tAddrzh)), ("minusAddrzh", tArrow tAddrzh (tArrow tAddrzh tIntzh)), ("remAddrzh", tArrow tAddrzh (tArrow tIntzh tIntzh))] {- Charzh -} tcCharzh = (primMname,"Charzh") tCharzh = Tcon tcCharzh ktCharzh = Kunlifted opsCharzh = [ ("gtCharzh", tcompare tCharzh), ("geCharzh", tcompare tCharzh), ("eqCharzh", tcompare tCharzh), ("neCharzh", tcompare tCharzh), ("ltCharzh", tcompare tCharzh), ("leCharzh", tcompare tCharzh), ("ordzh", tArrow tCharzh tIntzh)] {- Doublezh -} tcDoublezh = (primMname, "Doublezh") tDoublezh = Tcon tcDoublezh ktDoublezh = Kunlifted opsDoublezh = [ ("zgzhzh", tcompare tDoublezh), ("zgzezhzh", tcompare tDoublezh), ("zezezhzh", tcompare tDoublezh), ("zszezhzh", tcompare tDoublezh), ("zlzhzh", tcompare tDoublezh), ("zlzezhzh", tcompare tDoublezh), ("zpzhzh", tdyadic tDoublezh), ("zmzhzh", tdyadic tDoublezh), ("ztzhzh", tdyadic tDoublezh), ("zszhzh", tdyadic tDoublezh), ("negateDoublezh", tmonadic tDoublezh), ("double2Intzh", tArrow tDoublezh tIntzh), ("double2Floatzh", tArrow tDoublezh tFloatzh), ("expDoublezh", tmonadic tDoublezh), ("logDoublezh", tmonadic tDoublezh), ("sqrtDoublezh", tmonadic tDoublezh), ("sinDoublezh", tmonadic tDoublezh), ("cosDoublezh", tmonadic tDoublezh), ("tanDoublezh", tmonadic tDoublezh), ("asinDoublezh", tmonadic tDoublezh), ("acosDoublezh", tmonadic tDoublezh), ("atanDoublezh", tmonadic tDoublezh), ("sinhDoublezh", tmonadic tDoublezh), ("coshDoublezh", tmonadic tDoublezh), ("tanhDoublezh", tmonadic tDoublezh), ("ztztzhzh", tdyadic tDoublezh), ("decodeDoublezh", tArrow tDoublezh (tUtuple[tIntzh,tIntzh,tByteArrayzh]))] {- Floatzh -} tcFloatzh = (primMname, "Floatzh") tFloatzh = Tcon tcFloatzh ktFloatzh = Kunlifted opsFloatzh = [ ("gtFloatzh", tcompare tFloatzh), ("geFloatzh", tcompare tFloatzh), ("eqFloatzh", tcompare tFloatzh), ("neFloatzh", tcompare tFloatzh), ("ltFloatzh", tcompare tFloatzh), ("leFloatzh", tcompare tFloatzh), ("plusFloatzh", tdyadic tFloatzh), ("minusFloatzh", tdyadic tFloatzh), ("timesFloatzh", tdyadic tFloatzh), ("divideFloatzh", tdyadic tFloatzh), ("negateFloatzh", tmonadic tFloatzh), ("float2Intzh", tArrow tFloatzh tIntzh), ("expFloatzh", tmonadic tFloatzh), ("logFloatzh", tmonadic tFloatzh), ("sqrtFloatzh", tmonadic tFloatzh), ("sinFloatzh", tmonadic tFloatzh), ("cosFloatzh", tmonadic tFloatzh), ("tanFloatzh", tmonadic tFloatzh), ("asinFloatzh", tmonadic tFloatzh), ("acosFloatzh", tmonadic tFloatzh), ("atanFloatzh", tmonadic tFloatzh), ("sinhFloatzh", tmonadic tFloatzh), ("coshFloatzh", tmonadic tFloatzh), ("tanhFloatzh", tmonadic tFloatzh), ("powerFloatzh", tdyadic tFloatzh), ("float2Doublezh", tArrow tFloatzh tDoublezh), ("decodeFloatzh", tArrow tFloatzh (tUtuple[tIntzh,tIntzh,tByteArrayzh]))] {- Intzh -} tcIntzh = (primMname,"Intzh") tIntzh = Tcon tcIntzh ktIntzh = Kunlifted opsIntzh = [ ("zpzh", tdyadic tIntzh), ("zmzh", tdyadic tIntzh), ("ztzh", tdyadic tIntzh), ("quotIntzh", tdyadic tIntzh), ("remIntzh", tdyadic tIntzh), ("gcdIntzh", tdyadic tIntzh), ("negateIntzh", tmonadic tIntzh), ("addIntCzh", tArrow tIntzh (tArrow tIntzh (tUtuple [tIntzh, tIntzh]))), ("subIntCzh", tArrow tIntzh (tArrow tIntzh (tUtuple [tIntzh, tIntzh]))), ("mulIntCzh", tArrow tIntzh (tArrow tIntzh (tUtuple [tIntzh, tIntzh]))), ("zgzh", tcompare tIntzh), ("zgzezh", tcompare tIntzh), ("zezezh", tcompare tIntzh), ("zszezh", tcompare tIntzh), ("zlzh", tcompare tIntzh), ("zlzezh", tcompare tIntzh), ("chrzh", tArrow tIntzh tCharzh), ("int2Wordzh", tArrow tIntzh tWordzh), ("int2Floatzh", tArrow tIntzh tFloatzh), ("int2Doublezh", tArrow tIntzh tDoublezh), ("intToInt32zh", tArrow tIntzh tInt32zh), ("int2Integerzh", tArrow tIntzh tIntegerzhRes), ("iShiftLzh", tdyadic tIntzh), ("iShiftRAzh", tdyadic tIntzh), ("iShiftRLh", tdyadic tIntzh)] {- Int32zh -} tcInt32zh = (primMname,"Int32zh") tInt32zh = Tcon tcInt32zh ktInt32zh = Kunlifted opsInt32zh = [ ("int32ToIntzh", tArrow tInt32zh tIntzh), ("int32ToIntegerzh", tArrow tInt32zh tIntegerzhRes)] {- Int64zh -} tcInt64zh = (primMname,"Int64zh") tInt64zh = Tcon tcInt64zh ktInt64zh = Kunlifted opsInt64zh = [ ("int64ToIntegerzh", tArrow tInt64zh tIntegerzhRes)] {- Integerzh -} -- not actuallly a primitive type tIntegerzhRes = tUtuple [tIntzh, tByteArrayzh] tIntegerzhTo t = tArrow tIntzh (tArrow tByteArrayzh t) tdyadicIntegerzh = tIntegerzhTo (tIntegerzhTo tIntegerzhRes) opsIntegerzh = [ ("plusIntegerzh", tdyadicIntegerzh), ("minusIntegerzh", tdyadicIntegerzh), ("timesIntegerzh", tdyadicIntegerzh), ("gcdIntegerzh", tdyadicIntegerzh), ("gcdIntegerIntzh", tIntegerzhTo (tArrow tIntzh tIntzh)), ("divExactIntegerzh", tdyadicIntegerzh), ("quotIntegerzh", tdyadicIntegerzh), ("remIntegerzh", tdyadicIntegerzh), ("cmpIntegerzh", tIntegerzhTo (tIntegerzhTo tIntzh)), ("cmpIntegerIntzh", tIntegerzhTo (tArrow tIntzh tIntzh)), ("quotRemIntegerzh", tIntegerzhTo (tIntegerzhTo (tUtuple [tIntzh,tByteArrayzh,tIntzh,tByteArrayzh]))), ("divModIntegerzh", tIntegerzhTo (tIntegerzhTo (tUtuple [tIntzh,tByteArrayzh,tIntzh,tByteArrayzh]))), ("integer2Intzh", tIntegerzhTo tIntzh), ("integer2Wordzh", tIntegerzhTo tWordzh), ("integerToInt32zh", tIntegerzhTo tInt32zh), ("integerToWord32zh", tIntegerzhTo tWord32zh), ("integerToInt64zh", tIntegerzhTo tInt64zh), ("integerToWord64zh", tIntegerzhTo tWord64zh), ("andIntegerzh", tdyadicIntegerzh), ("orIntegerzh", tdyadicIntegerzh), ("xorIntegerzh", tdyadicIntegerzh), ("complementIntegerzh", tIntegerzhTo tIntegerzhRes)] {- Wordzh -} tcWordzh = (primMname,"Wordzh") tWordzh = Tcon tcWordzh ktWordzh = Kunlifted opsWordzh = [ ("plusWordzh", tdyadic tWordzh), ("minusWordzh", tdyadic tWordzh), ("timesWordzh", tdyadic tWordzh), ("quotWordzh", tdyadic tWordzh), ("remWordzh", tdyadic tWordzh), ("andzh", tdyadic tWordzh), ("orzh", tdyadic tWordzh), ("xorzh", tdyadic tWordzh), ("notzh", tmonadic tWordzh), ("shiftLzh", tArrow tWordzh (tArrow tIntzh tWordzh)), ("shiftRLzh", tArrow tWordzh (tArrow tIntzh tWordzh)), ("word2Intzh", tArrow tWordzh tIntzh), ("wordToWord32zh", tArrow tWordzh tWord32zh), ("word2Integerzh", tArrow tWordzh tIntegerzhRes), ("gtWordzh", tcompare tWordzh), ("geWordzh", tcompare tWordzh), ("eqWordzh", tcompare tWordzh), ("neWordzh", tcompare tWordzh), ("ltWordzh", tcompare tWordzh), ("leWordzh", tcompare tWordzh)] {- Word32zh -} tcWord32zh = (primMname,"Word32zh") tWord32zh = Tcon tcWord32zh ktWord32zh = Kunlifted opsWord32zh = [ ("word32ToWordzh", tArrow tWord32zh tWordzh), ("word32ToIntegerzh", tArrow tWord32zh tIntegerzhRes)] {- Word64zh -} tcWord64zh = (primMname,"Word64zh") tWord64zh = Tcon tcWord64zh ktWord64zh = Kunlifted opsWord64zh = [ ("word64ToIntegerzh", tArrow tWord64zh tIntegerzhRes)] {- Explicitly sized Intzh and Wordzh -} opsSized = [ ("narrow8Intzh", tmonadic tIntzh), ("narrow16Intzh", tmonadic tIntzh), ("narrow32Intzh", tmonadic tIntzh), ("narrow8Wordzh", tmonadic tWordzh), ("narrow16Wordzh", tmonadic tWordzh), ("narrow32Wordzh", tmonadic tWordzh)] {- Arrays -} tcArrayzh = (primMname,"Arrayzh") tArrayzh t = Tapp (Tcon tcArrayzh) t ktArrayzh = Karrow Klifted Kunlifted tcByteArrayzh = (primMname,"ByteArrayzh") tByteArrayzh = Tcon tcByteArrayzh ktByteArrayzh = Kunlifted tcMutableArrayzh = (primMname,"MutableArrayzh") tMutableArrayzh s t = Tapp (Tapp (Tcon tcMutableArrayzh) s) t ktMutableArrayzh = Karrow Klifted (Karrow Klifted Kunlifted) tcMutableByteArrayzh = (primMname,"MutableByteArrayzh") tMutableByteArrayzh s = Tapp (Tcon tcMutableByteArrayzh) s ktMutableByteArrayzh = Karrow Klifted Kunlifted opsArray = [ ("newArrayzh", Tforall ("a",Klifted) (Tforall ("s",Klifted) (tArrow tIntzh (tArrow (Tvar "a") (tArrow (tStatezh (Tvar "s")) (tUtuple [tStatezh (Tvar "s"),tMutableArrayzh (Tvar "s") (Tvar "a")])))))), ("newByteArrayzh", Tforall ("s",Klifted) (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tUtuple [tStatezh (Tvar "s"),tMutableByteArrayzh (Tvar "s")])))), ("newPinnedByteArrayzh", Tforall ("s",Klifted) (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tUtuple [tStatezh (Tvar "s"),tMutableByteArrayzh (Tvar "s")])))), ("byteArrayContentszh", tArrow tByteArrayzh tAddrzh), ("indexCharArrayzh", tArrow tByteArrayzh (tArrow tIntzh tCharzh)), ("indexWideCharArrayzh", tArrow tByteArrayzh (tArrow tIntzh tCharzh)), ("indexIntArrayzh", tArrow tByteArrayzh (tArrow tIntzh tIntzh)), ("indexWordArrayzh", tArrow tByteArrayzh (tArrow tIntzh tWordzh)), ("indexAddrArrayzh", tArrow tByteArrayzh (tArrow tIntzh tAddrzh)), ("indexFloatArrayzh", tArrow tByteArrayzh (tArrow tIntzh tFloatzh)), ("indexDoubleArrayzh", tArrow tByteArrayzh (tArrow tIntzh tDoublezh)), ("indexStablePtrArrayzh", Tforall ("a",Klifted) (tArrow tByteArrayzh (tArrow tIntzh (tStablePtrzh (Tvar "a"))))), ("indexInt8Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tIntzh)), ("indexInt16Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tIntzh)), ("indexInt32Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tInt32zh)), ("indexInt64Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tInt64zh)), ("indexWord8Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tWordzh)), ("indexWord16Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tWordzh)), ("indexWord32Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tWord32zh)), ("indexWord64Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tWord64zh)), ("readCharArrayzh", tReadMutableByteArrayzh tCharzh), ("readWideCharArrayzh", tReadMutableByteArrayzh tCharzh), ("readIntArrayzh", tReadMutableByteArrayzh tIntzh), ("readWordArrayzh", tReadMutableByteArrayzh tWordzh), ("readAddrArrayzh", tReadMutableByteArrayzh tAddrzh), ("readFloatArrayzh", tReadMutableByteArrayzh tFloatzh), ("readDoubleArrayzh", tReadMutableByteArrayzh tDoublezh), ("readStablePtrArrayzh", Tforall ("s",Klifted) (Tforall ("a",Klifted) (tArrow (tMutableByteArrayzh (Tvar "s")) (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tUtuple [tStatezh (Tvar "s"),tStablePtrzh (Tvar "a")])))))), ("readInt8Arrayzh", tReadMutableByteArrayzh tIntzh), ("readInt16Arrayzh", tReadMutableByteArrayzh tIntzh), ("readInt32Arrayzh", tReadMutableByteArrayzh tInt32zh), ("readInt64Arrayzh", tReadMutableByteArrayzh tInt64zh), ("readWord8Arrayzh", tReadMutableByteArrayzh tWordzh), ("readWord16Arrayzh", tReadMutableByteArrayzh tWordzh), ("readWord32Arrayzh", tReadMutableByteArrayzh tWord32zh), ("readWord64Arrayzh", tReadMutableByteArrayzh tWord64zh), ("writeCharArrayzh", tWriteMutableByteArrayzh tCharzh), ("writeWideCharArrayzh", tWriteMutableByteArrayzh tCharzh), ("writeIntArrayzh", tWriteMutableByteArrayzh tIntzh), ("writeWordArrayzh", tWriteMutableByteArrayzh tWordzh), ("writeAddrArrayzh", tWriteMutableByteArrayzh tAddrzh), ("writeFloatArrayzh", tWriteMutableByteArrayzh tFloatzh), ("writeDoubleArrayzh", tWriteMutableByteArrayzh tDoublezh), ("writeStablePtrArrayzh", Tforall ("s",Klifted) (Tforall ("a",Klifted) (tArrow (tMutableByteArrayzh (Tvar "s")) (tArrow tIntzh (tArrow (tStablePtrzh (Tvar "a")) (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s")))))))), ("writeInt8Arrayzh", tWriteMutableByteArrayzh tIntzh), ("writeInt16Arrayzh", tWriteMutableByteArrayzh tIntzh), ("writeInt32Arrayzh", tWriteMutableByteArrayzh tIntzh), ("writeInt64Arrayzh", tWriteMutableByteArrayzh tInt64zh), ("writeWord8Arrayzh", tWriteMutableByteArrayzh tWordzh), ("writeWord16Arrayzh", tWriteMutableByteArrayzh tWordzh), ("writeWord32Arrayzh", tWriteMutableByteArrayzh tWord32zh), ("writeWord64Arrayzh", tWriteMutableByteArrayzh tWord64zh), ("indexCharOffAddrzh", tArrow tAddrzh (tArrow tIntzh tCharzh)), ("indexWideCharOffAddrzh", tArrow tAddrzh (tArrow tIntzh tCharzh)), ("indexIntOffAddrzh", tArrow tAddrzh (tArrow tIntzh tIntzh)), ("indexWordOffAddrzh", tArrow tAddrzh (tArrow tIntzh tWordzh)), ("indexAddrOffAddrzh", tArrow tAddrzh (tArrow tIntzh tAddrzh)), ("indexFloatOffAddrzh", tArrow tAddrzh (tArrow tIntzh tFloatzh)), ("indexDoubleOffAddrzh", tArrow tAddrzh (tArrow tIntzh tDoublezh)), ("indexStablePtrOffAddrzh", Tforall ("a",Klifted) (tArrow tAddrzh (tArrow tIntzh (tStablePtrzh (Tvar "a"))))), ("indexInt8OffAddrzh", tArrow tAddrzh (tArrow tIntzh tIntzh)), ("indexInt16OffAddrzh", tArrow tAddrzh (tArrow tIntzh tIntzh)), ("indexInt32OffAddrzh", tArrow tAddrzh (tArrow tIntzh tInt32zh)), ("indexInt64OffAddrzh", tArrow tAddrzh (tArrow tIntzh tInt64zh)), ("indexWord8OffAddrzh", tArrow tAddrzh (tArrow tIntzh tWordzh)), ("indexWord16OffAddrzh", tArrow tAddrzh (tArrow tIntzh tWordzh)), ("indexWord32ffAddrzh", tArrow tAddrzh (tArrow tIntzh tWord32zh)), ("indexWord64OffAddrzh", tArrow tAddrzh (tArrow tIntzh tWord64zh)), ("indexCharOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tCharzh)), ("indexWideCharOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tCharzh)), ("indexIntOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tIntzh)), ("indexWordOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWordzh)), ("indexAddrOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tAddrzh)), ("indexFloatOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tFloatzh)), ("indexDoubleOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tDoublezh)), ("indexStablePtrOffForeignObjzh", Tforall ("a",Klifted) (tArrow tForeignObjzh (tArrow tIntzh (tStablePtrzh (Tvar "a"))))), ("indexInt8OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tIntzh)), ("indexInt16OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tIntzh)), ("indexInt32OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tInt32zh)), ("indexInt64OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tInt64zh)), ("indexWord8OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWordzh)), ("indexWord16OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWordzh)), ("indexWord32ffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWord32zh)), ("indexWord64OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWord64zh)), ("readCharOffAddrzh", tReadOffAddrzh tCharzh), ("readWideCharOffAddrzh", tReadOffAddrzh tCharzh), ("readIntOffAddrzh", tReadOffAddrzh tIntzh), ("readWordOffAddrzh", tReadOffAddrzh tWordzh), ("readAddrOffAddrzh", tReadOffAddrzh tAddrzh), ("readFloatOffAddrzh", tReadOffAddrzh tFloatzh), ("readDoubleOffAddrzh", tReadOffAddrzh tDoublezh), ("readStablePtrOffAddrzh", Tforall ("s",Klifted) (Tforall ("a",Klifted) (tArrow tAddrzh (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tUtuple [tStatezh (Tvar "s"),tStablePtrzh (Tvar "a")])))))), ("readInt8OffAddrzh", tReadOffAddrzh tIntzh), ("readInt16OffAddrzh", tReadOffAddrzh tIntzh), ("readInt32OffAddrzh", tReadOffAddrzh tInt32zh), ("readInt64OffAddrzh", tReadOffAddrzh tInt64zh), ("readWord8OffAddrzh", tReadOffAddrzh tWordzh), ("readWord16OffAddrzh", tReadOffAddrzh tWordzh), ("readWord32OffAddrzh", tReadOffAddrzh tWord32zh), ("readWord64OffAddrzh", tReadOffAddrzh tWord64zh), ("writeCharOffAddrzh", tWriteOffAddrzh tCharzh), ("writeWideCharOffAddrzh", tWriteOffAddrzh tCharzh), ("writeIntOffAddrzh", tWriteOffAddrzh tIntzh), ("writeWordOffAddrzh", tWriteOffAddrzh tWordzh), ("writeAddrOffAddrzh", tWriteOffAddrzh tAddrzh), ("writeFloatOffAddrzh", tWriteOffAddrzh tFloatzh), ("writeDoubleOffAddrzh", tWriteOffAddrzh tDoublezh), ("writeStablePtrOffAddrzh", Tforall ("a",Klifted) (tWriteOffAddrzh (tStablePtrzh (Tvar "a")))), ("writeInt8OffAddrzh", tWriteOffAddrzh tIntzh), ("writeInt16OffAddrzh", tWriteOffAddrzh tIntzh), ("writeInt32OffAddrzh", tWriteOffAddrzh tInt32zh), ("writeInt64OffAddrzh", tWriteOffAddrzh tInt64zh), ("writeWord8OffAddrzh", tWriteOffAddrzh tWordzh), ("writeWord16OffAddrzh", tWriteOffAddrzh tWordzh), ("writeWord32OffAddrzh", tWriteOffAddrzh tWord32zh), ("writeWord64OffAddrzh", tWriteOffAddrzh tWord64zh), ("sameMutableArrayzh", Tforall ("s",Klifted) (Tforall ("a",Klifted) (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a")) (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a")) tBool)))), ("sameMutableByteArrayzh", Tforall ("s",Klifted) (tArrow (tMutableByteArrayzh (Tvar "s")) (tArrow (tMutableByteArrayzh (Tvar "s")) tBool))), ("readArrayzh",Tforall ("s",Klifted) (Tforall ("a",Klifted) (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a")) (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tUtuple[tStatezh (Tvar "s"), Tvar "a"])))))), ("writeArrayzh",Tforall ("s",Klifted) (Tforall ("a",Klifted) (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a")) (tArrow tIntzh (tArrow (Tvar "a") (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s")))))))), ("indexArrayzh", Tforall ("a",Klifted) (tArrow (tArrayzh (Tvar "a")) (tArrow tIntzh (tUtuple[Tvar "a"])))), ("unsafeFreezzeArrayzh",Tforall ("s",Klifted) (Tforall ("a",Klifted) (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a")) (tArrow (tStatezh (Tvar "s")) (tUtuple[tStatezh (Tvar "s"),tArrayzh (Tvar "a")]))))), ("unsafeFreezzeByteArrayzh",Tforall ("s",Klifted) (tArrow (tMutableByteArrayzh (Tvar "s")) (tArrow (tStatezh (Tvar "s")) (tUtuple[tStatezh (Tvar "s"),tByteArrayzh])))), ("unsafeThawArrayzh",Tforall ("a",Klifted) (Tforall ("s",Klifted) (tArrow (tArrayzh (Tvar "a")) (tArrow (tStatezh (Tvar "s")) (tUtuple[tStatezh (Tvar "s"),tMutableArrayzh (Tvar "s") (Tvar "a")]))))), ("sizzeofByteArrayzh", tArrow tByteArrayzh tIntzh), ("sizzeofMutableByteArrayzh", Tforall ("s",Klifted) (tArrow (tMutableByteArrayzh (Tvar "s")) tIntzh))] where tReadMutableByteArrayzh t = Tforall ("s",Klifted) (tArrow (tMutableByteArrayzh (Tvar "s")) (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tUtuple [tStatezh (Tvar "s"),t])))) tWriteMutableByteArrayzh t = Tforall ("s",Klifted) (tArrow (tMutableByteArrayzh (Tvar "s")) (tArrow tIntzh (tArrow t (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s")))))) tReadOffAddrzh t = Tforall ("s",Klifted) (tArrow tAddrzh (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tUtuple [tStatezh (Tvar "s"),t])))) tWriteOffAddrzh t = Tforall ("s",Klifted) (tArrow tAddrzh (tArrow tIntzh (tArrow t (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s")))))) {- MutVars -} tcMutVarzh = (primMname,"MutVarzh") tMutVarzh s t = Tapp (Tapp (Tcon tcMutVarzh) s) t ktMutVarzh = Karrow Klifted (Karrow Klifted Kunlifted) opsMutVarzh = [ ("newMutVarzh", Tforall ("a",Klifted) (Tforall ("s",Klifted) (tArrow (Tvar "a") (tArrow (tStatezh (Tvar "s")) (tUtuple [tStatezh (Tvar "s"), tMutVarzh (Tvar "s") (Tvar "a")]))))), ("readMutVarzh", Tforall ("s",Klifted) (Tforall ("a",Klifted) (tArrow (tMutVarzh (Tvar "s")(Tvar "a")) (tArrow (tStatezh (Tvar "s")) (tUtuple [tStatezh (Tvar "s"), Tvar "a"]))))), ("writeMutVarzh", Tforall ("s",Klifted) (Tforall ("a",Klifted) (tArrow (tMutVarzh (Tvar "s") (Tvar "a")) (tArrow (Tvar "a") (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s"))))))), ("sameMutVarzh", Tforall ("s",Klifted) (Tforall ("a",Klifted) (tArrow (tMutVarzh (Tvar "s") (Tvar "a")) (tArrow (tMutVarzh (Tvar "s") (Tvar "a")) tBool))))] {- Real world and state. -} tcRealWorld = (primMname,"RealWorld") tRealWorld = Tcon tcRealWorld ktRealWorld = Klifted tcStatezh = (primMname, "Statezh") tStatezh t = Tapp (Tcon tcStatezh) t ktStatezh = Karrow Klifted Kunlifted tRWS = tStatezh tRealWorld opsState = [ ("realWorldzh", tRWS)] {- Exceptions -} -- no primitive type opsExn = [ ("catchzh", let t' = tArrow tRWS (tUtuple [tRWS, Tvar "a"]) in Tforall ("a",Klifted) (Tforall ("b",Klifted) (tArrow t' (tArrow (tArrow (Tvar "b") t') t')))), ("raisezh", Tforall ("a",Klifted) (Tforall ("b",Klifted) (tArrow (Tvar "a") (Tvar "b")))), ("blockAsyncExceptionszh", Tforall ("a",Klifted) (tArrow (tArrow tRWS (tUtuple[tRWS,Tvar "a"])) (tArrow tRWS (tUtuple[tRWS,Tvar "a"])))), ("unblockAsyncExceptionszh", Tforall ("a",Klifted) (tArrow (tArrow tRWS (tUtuple[tRWS,Tvar "a"])) (tArrow tRWS (tUtuple[tRWS,Tvar "a"]))))] {- Mvars -} tcMVarzh = (primMname, "MVarzh") tMVarzh s t = Tapp (Tapp (Tcon tcMVarzh) s) t ktMVarzh = Karrow Klifted (Karrow Klifted Kunlifted) opsMVar = [ ("newMVarzh", Tforall ("s",Klifted) (Tforall ("a",Klifted) (tArrow (tStatezh (Tvar "s")) (tUtuple[tStatezh (Tvar "s"),tMVarzh (Tvar "s") (Tvar "a")])))), ("takeMVarzh", Tforall ("s",Klifted) (Tforall ("a",Klifted) (tArrow (tMVarzh (Tvar "s") (Tvar "a")) (tArrow (tStatezh (Tvar "s")) (tUtuple[tStatezh (Tvar "s"),Tvar "a"]))))), ("tryTakeMVarzh", Tforall ("s",Klifted) (Tforall ("a",Klifted) (tArrow (tMVarzh (Tvar "s") (Tvar "a")) (tArrow (tStatezh (Tvar "s")) (tUtuple[tStatezh (Tvar "s"),tIntzh,Tvar "a"]))))), ("putMVarzh", Tforall ("s",Klifted) (Tforall ("a",Klifted) (tArrow (tMVarzh (Tvar "s") (Tvar "a")) (tArrow (Tvar "a") (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s"))))))), ("tryPutMVarzh", Tforall ("s",Klifted) (Tforall ("a",Klifted) (tArrow (tMVarzh (Tvar "s") (Tvar "a")) (tArrow (Tvar "a") (tArrow (tStatezh (Tvar "s")) (tUtuple [tStatezh (Tvar "s"), tIntzh])))))), ("sameMVarzh", Tforall ("s",Klifted) (Tforall ("a",Klifted) (tArrow (tMVarzh (Tvar "s") (Tvar "a")) (tArrow (tMVarzh (Tvar "s") (Tvar "a")) tBool)))), ("isEmptyMVarzh", Tforall ("s",Klifted) (Tforall ("a",Klifted) (tArrow (tMVarzh (Tvar "s") (Tvar "a")) (tArrow (tStatezh (Tvar "s")) (tUtuple[tStatezh (Tvar "s"),tIntzh])))))] {- Weak Objects -} tcWeakzh = (primMname, "Weakzh") tWeakzh t = Tapp (Tcon tcWeakzh) t ktWeakzh = Karrow Klifted Kunlifted opsWeak = [ ("mkWeakzh", Tforall ("o",Kopen) (Tforall ("b",Klifted) (Tforall ("c",Klifted) (tArrow (Tvar "o") (tArrow (Tvar "b") (tArrow (Tvar "c") (tArrow tRWS (tUtuple[tRWS, tWeakzh (Tvar "b")])))))))), ("deRefWeakzh", Tforall ("a",Klifted) (tArrow (tWeakzh (Tvar "a")) (tArrow tRWS (tUtuple[tRWS, tIntzh, Tvar "a"])))), ("finalizeWeakzh", Tforall ("a",Klifted) (tArrow (tWeakzh (Tvar "a")) (tArrow tRWS (tUtuple[tRWS,tIntzh, tArrow tRWS (tUtuple[tRWS, tUnit])]))))] {- Foreign Objects -} tcForeignObjzh = (primMname, "ForeignObjzh") tForeignObjzh = Tcon tcForeignObjzh ktForeignObjzh = Kunlifted opsForeignObjzh = [ ("mkForeignObjzh", tArrow tAddrzh (tArrow tRWS (tUtuple [tRWS,tForeignObjzh]))), ("writeForeignObjzh", Tforall ("s",Klifted) (tArrow tForeignObjzh (tArrow tAddrzh (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s")))))), ("foreignObjToAddrzh", tArrow tForeignObjzh tAddrzh), ("touchzh", Tforall ("o",Kopen) (tArrow (Tvar "o") (tArrow tRWS tRWS)))] {- Stable Pointers (but not names) -} tcStablePtrzh = (primMname, "StablePtrzh") tStablePtrzh t = Tapp (Tcon tcStablePtrzh) t ktStablePtrzh = Karrow Klifted Kunlifted opsStablePtrzh = [ ("makeStablePtrzh", Tforall ("a",Klifted) (tArrow (Tvar "a") (tArrow tRWS (tUtuple[tRWS,tStablePtrzh (Tvar "a")])))), ("deRefStablePtrzh", Tforall ("a",Klifted) (tArrow (tStablePtrzh (Tvar "a")) (tArrow tRWS (tUtuple[tRWS,Tvar "a"])))), ("eqStablePtrzh", Tforall ("a",Klifted) (tArrow (tStablePtrzh (Tvar "a")) (tArrow (tStablePtrzh (Tvar "a")) tIntzh)))] {- Concurrency operations -} tcThreadIdzh = (primMname,"ThreadIdzh") tThreadIdzh = Tcon tcThreadIdzh ktThreadIdzh = Kunlifted opsConc = [ ("seqzh", Tforall ("a",Klifted) (tArrow (Tvar "a") tIntzh)), ("parzh", Tforall ("a",Klifted) (tArrow (Tvar "a") tIntzh)), ("delayzh", Tforall ("s",Klifted) (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s"))))), ("waitReadzh", Tforall ("s",Klifted) (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s"))))), ("waitWritezh", Tforall ("s",Klifted) (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s"))))), ("forkzh", Tforall ("a",Klifted) (tArrow (Tvar "a") (tArrow tRWS (tUtuple[tRWS,tThreadIdzh])))), ("killThreadzh", Tforall ("a",Klifted) (tArrow tThreadIdzh (tArrow (Tvar "a") (tArrow tRWS tRWS)))), ("yieldzh", tArrow tRWS tRWS), ("myThreadIdzh", tArrow tRWS (tUtuple[tRWS, tThreadIdzh]))] {- Miscellaneous operations -} opsMisc = [ ("dataToTagzh", Tforall ("a",Klifted) (tArrow (Tvar "a") tIntzh)), ("tagToEnumzh", Tforall ("a",Klifted) (tArrow tIntzh (Tvar "a"))), ("unsafeCoercezh", Tforall ("a",Kopen) (Tforall ("b",Kopen) (tArrow (Tvar "a") (Tvar "b")))) -- maybe unneeded ] {- CCallable and CReturnable. We just define the type constructors for the dictionaries corresponding to these pseudo-classes. -} tcZCTCCallable = (primMname,"ZCTCCallable") ktZCTCCallable = Karrow Kopen Klifted -- ?? tcZCTCReturnable = (primMname,"ZCTCReturnable") ktZCTCReturnable = Karrow Kopen Klifted -- ?? {- Non-primitive, but mentioned in the types of primitives. -} tcUnit = ("PrelBase","Unit") tUnit = Tcon tcUnit ktUnit = Klifted tcBool = ("PrelBase","Bool") tBool = Tcon tcBool ktBool = Klifted {- Properly defined in PrelError, but needed in many modules before that. -} errorVals = [ ("error", Tforall ("a",Kopen) (tArrow tString (Tvar "a"))), ("irrefutPatError", Tforall ("a",Kopen) (tArrow tString (Tvar "a"))), ("patError", Tforall ("a",Kopen) (tArrow tString (Tvar "a")))] tcChar = ("PrelBase","Char") tChar = Tcon tcChar ktChar = Klifted tcList = ("PrelBase","ZMZN") tList t = Tapp (Tcon tcList) t ktList = Karrow Klifted Klifted tString = tList tChar {- Utilities for building types -} tmonadic t = tArrow t t tdyadic t = tArrow t (tArrow t t) tcompare t = tArrow t (tArrow t tBool)