\section[PrimOp]{Primitive operations (machine-level)}
\begin{code}
-#include "HsVersions.h"
-
module PrimOp (
PrimOp(..), allThePrimOps,
tagOf_PrimOp, -- ToDo: rm
pprPrimOp, showPrimOp
) where
-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"
import PrimRep -- most of it
import TysPrim
import TysWiredIn
import CStrings ( identToC )
-import CgCompInfo ( mIN_MP_INT_SIZE, mP_STRUCT_SIZE )
-import HeapOffs ( addOff, intOff, totHdrSize )
-import PprStyle ( codeStyle, PprStyle(..){-ToDo:rm-} )
-import PprType ( pprParendGenType, GenTyVar{-instance Outputable-} )
-import Pretty
+import CallConv ( CallConv, pprCallConv )
+import Constants ( mIN_MP_INT_SIZE, mP_STRUCT_SIZE )
+import HeapOffs ( addOff, intOff, totHdrSize, HeapOffset )
+import Outputable
+import PprType ( pprParendType )
import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
import TyCon ( TyCon{-instances-} )
-import Type ( getAppDataTyConExpandingDicts, maybeAppDataTyConExpandingDicts,
- mkForAllTys, mkFunTys, applyTyCon, typePrimRep
+import Type ( mkForAllTys, mkFunTy, mkFunTys, mkTyConApp, typePrimRep,
+ splitAlgTyConApp, Type
)
-import TyVar ( alphaTyVar, betaTyVar, gammaTyVar, GenTyVar{-instance Eq-} )
+import TyVar --( alphaTyVar, betaTyVar, gammaTyVar )
import Unique ( Unique{-instance Eq-} )
import Util ( panic#, assoc, panic{-ToDo:rm-} )
+
+import GlaExts ( Int(..), Int#, (==#) )
\end{code}
%************************************************************************
-- IntAbsOp unused?? ADR
| IntAddOp | IntSubOp | IntMulOp | IntQuotOp
| IntRemOp | IntNegOp | IntAbsOp
+ | ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical}
-- Word#-related ops:
- | AndOp | OrOp | NotOp
- | SllOp | SraOp | SrlOp -- shift {left,right} {arithmetic,logical}
- | ISllOp | ISraOp | ISrlOp -- equivs on Int#s
+ | WordQuotOp | WordRemOp
+ | AndOp | OrOp | NotOp | XorOp
+ | SllOp | SrlOp -- shift {left,right} {logical}
| Int2WordOp | Word2IntOp -- casts
-- Addr#-related ops:
| IntegerCmpOp
- | Integer2IntOp | Int2IntegerOp
- | Word2IntegerOp
+ | Integer2IntOp | Integer2WordOp
+ | Int2IntegerOp | Word2IntegerOp
| Addr2IntegerOp -- "Addr" is *always* a literal string
+ -- casting to/from Integer and 64-bit (un)signed quantities.
+ | IntegerToInt64Op | Int64ToIntegerOp
+ | IntegerToWord64Op | Word64ToIntegerOp
-- ?? gcd, etc?
| FloatEncodeOp | FloatDecodeOp
-- This is just a cheesy encoding of a bunch of ops.
-- Note that ForeignObjRep is not included -- the only way of
-- creating a ForeignObj is with a ccall or casm.
+ | IndexOffForeignObjOp PrimRep
+ | WriteOffAddrOp PrimRep
| UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
+ | SizeofByteArrayOp | SizeofMutableByteArrayOp
| NewSynchVarOp -- for MVars and IVars
+ | SameMVarOp
| TakeMVarOp | PutMVarOp
| ReadIVarOp | WriteIVarOp
- | MakeForeignObjOp -- foreign objects (malloc pointers or any old URL)
+ | MakeForeignObjOp -- foreign objects (malloc pointers or any old URL)
+ | WriteForeignObjOp -- modifying foreign objects [obscuro factor: 200]
| MakeStablePtrOp | DeRefStablePtrOp
\end{code}
A special ``trap-door'' to use in making calls direct to C functions:
\begin{code}
- | CCallOp FAST_STRING -- An "unboxed" ccall# to this named function
- Bool -- True <=> really a "casm"
- Bool -- True <=> might invoke Haskell GC
- [Type] -- Unboxed argument; the state-token
- -- argument will have been put *first*
- Type -- Return type; one of the "StateAnd<blah>#" types
+ | CCallOp (Maybe FAST_STRING) -- Nothing => first argument (an Addr#) is the function pointer
+ -- Just fn => An "unboxed" ccall# to `fn'.
+
+ Bool -- True <=> really a "casm"
+ Bool -- True <=> might invoke Haskell GC
+ CallConv -- calling convention to use.
+ [Type] -- Unboxed arguments; the state-token
+ -- argument will have been put *first*
+ Type -- Return type; one of the "StateAnd<blah>#" types
-- (... to be continued ... )
\end{code}
| ParAtForNowOp -- specifies initial destination of global par
| CopyableOp -- marks copyable code
| NoFollowOp -- marks non-followup expression
+
\end{code}
Deriving Ix is what we really want! ToDo
(Chk around before deleting...)
\begin{code}
-tagOf_PrimOp CharGtOp = (ILIT(1) :: FAST_INT)
-tagOf_PrimOp CharGeOp = ILIT( 2)
-tagOf_PrimOp CharEqOp = ILIT( 3)
-tagOf_PrimOp CharNeOp = ILIT( 4)
-tagOf_PrimOp CharLtOp = ILIT( 5)
-tagOf_PrimOp CharLeOp = ILIT( 6)
-tagOf_PrimOp IntGtOp = ILIT( 7)
-tagOf_PrimOp IntGeOp = ILIT( 8)
-tagOf_PrimOp IntEqOp = ILIT( 9)
-tagOf_PrimOp IntNeOp = ILIT( 10)
-tagOf_PrimOp IntLtOp = ILIT( 11)
-tagOf_PrimOp IntLeOp = ILIT( 12)
-tagOf_PrimOp WordGtOp = ILIT( 13)
-tagOf_PrimOp WordGeOp = ILIT( 14)
-tagOf_PrimOp WordEqOp = ILIT( 15)
-tagOf_PrimOp WordNeOp = ILIT( 16)
-tagOf_PrimOp WordLtOp = ILIT( 17)
-tagOf_PrimOp WordLeOp = ILIT( 18)
-tagOf_PrimOp AddrGtOp = ILIT( 19)
-tagOf_PrimOp AddrGeOp = ILIT( 20)
-tagOf_PrimOp AddrEqOp = ILIT( 21)
-tagOf_PrimOp AddrNeOp = ILIT( 22)
-tagOf_PrimOp AddrLtOp = ILIT( 23)
-tagOf_PrimOp AddrLeOp = ILIT( 24)
-tagOf_PrimOp FloatGtOp = ILIT( 25)
-tagOf_PrimOp FloatGeOp = ILIT( 26)
-tagOf_PrimOp FloatEqOp = ILIT( 27)
-tagOf_PrimOp FloatNeOp = ILIT( 28)
-tagOf_PrimOp FloatLtOp = ILIT( 29)
-tagOf_PrimOp FloatLeOp = ILIT( 30)
-tagOf_PrimOp DoubleGtOp = ILIT( 31)
-tagOf_PrimOp DoubleGeOp = ILIT( 32)
-tagOf_PrimOp DoubleEqOp = ILIT( 33)
-tagOf_PrimOp DoubleNeOp = ILIT( 34)
-tagOf_PrimOp DoubleLtOp = ILIT( 35)
-tagOf_PrimOp DoubleLeOp = ILIT( 36)
-tagOf_PrimOp OrdOp = ILIT( 37)
-tagOf_PrimOp ChrOp = ILIT( 38)
-tagOf_PrimOp IntAddOp = ILIT( 39)
-tagOf_PrimOp IntSubOp = ILIT( 40)
-tagOf_PrimOp IntMulOp = ILIT( 41)
-tagOf_PrimOp IntQuotOp = ILIT( 42)
-tagOf_PrimOp IntRemOp = ILIT( 44)
-tagOf_PrimOp IntNegOp = ILIT( 45)
-tagOf_PrimOp IntAbsOp = ILIT( 46)
-tagOf_PrimOp AndOp = ILIT( 47)
-tagOf_PrimOp OrOp = ILIT( 48)
-tagOf_PrimOp NotOp = ILIT( 49)
-tagOf_PrimOp SllOp = ILIT( 50)
-tagOf_PrimOp SraOp = ILIT( 51)
-tagOf_PrimOp SrlOp = ILIT( 52)
-tagOf_PrimOp ISllOp = ILIT( 53)
-tagOf_PrimOp ISraOp = ILIT( 54)
-tagOf_PrimOp ISrlOp = ILIT( 55)
-tagOf_PrimOp Int2WordOp = ILIT( 56)
-tagOf_PrimOp Word2IntOp = ILIT( 57)
-tagOf_PrimOp Int2AddrOp = ILIT( 58)
-tagOf_PrimOp Addr2IntOp = ILIT( 59)
-tagOf_PrimOp FloatAddOp = ILIT( 60)
-tagOf_PrimOp FloatSubOp = ILIT( 61)
-tagOf_PrimOp FloatMulOp = ILIT( 62)
-tagOf_PrimOp FloatDivOp = ILIT( 63)
-tagOf_PrimOp FloatNegOp = ILIT( 64)
-tagOf_PrimOp Float2IntOp = ILIT( 65)
-tagOf_PrimOp Int2FloatOp = ILIT( 66)
-tagOf_PrimOp FloatExpOp = ILIT( 67)
-tagOf_PrimOp FloatLogOp = ILIT( 68)
-tagOf_PrimOp FloatSqrtOp = ILIT( 69)
-tagOf_PrimOp FloatSinOp = ILIT( 70)
-tagOf_PrimOp FloatCosOp = ILIT( 71)
-tagOf_PrimOp FloatTanOp = ILIT( 72)
-tagOf_PrimOp FloatAsinOp = ILIT( 73)
-tagOf_PrimOp FloatAcosOp = ILIT( 74)
-tagOf_PrimOp FloatAtanOp = ILIT( 75)
-tagOf_PrimOp FloatSinhOp = ILIT( 76)
-tagOf_PrimOp FloatCoshOp = ILIT( 77)
-tagOf_PrimOp FloatTanhOp = ILIT( 78)
-tagOf_PrimOp FloatPowerOp = ILIT( 79)
-tagOf_PrimOp DoubleAddOp = ILIT( 80)
-tagOf_PrimOp DoubleSubOp = ILIT( 81)
-tagOf_PrimOp DoubleMulOp = ILIT( 82)
-tagOf_PrimOp DoubleDivOp = ILIT( 83)
-tagOf_PrimOp DoubleNegOp = ILIT( 84)
-tagOf_PrimOp Double2IntOp = ILIT( 85)
-tagOf_PrimOp Int2DoubleOp = ILIT( 86)
-tagOf_PrimOp Double2FloatOp = ILIT( 87)
-tagOf_PrimOp Float2DoubleOp = ILIT( 88)
-tagOf_PrimOp DoubleExpOp = ILIT( 89)
-tagOf_PrimOp DoubleLogOp = ILIT( 90)
-tagOf_PrimOp DoubleSqrtOp = ILIT( 91)
-tagOf_PrimOp DoubleSinOp = ILIT( 92)
-tagOf_PrimOp DoubleCosOp = ILIT( 93)
-tagOf_PrimOp DoubleTanOp = ILIT( 94)
-tagOf_PrimOp DoubleAsinOp = ILIT( 95)
-tagOf_PrimOp DoubleAcosOp = ILIT( 96)
-tagOf_PrimOp DoubleAtanOp = ILIT( 97)
-tagOf_PrimOp DoubleSinhOp = ILIT( 98)
-tagOf_PrimOp DoubleCoshOp = ILIT( 99)
-tagOf_PrimOp DoubleTanhOp = ILIT(100)
-tagOf_PrimOp DoublePowerOp = ILIT(101)
-tagOf_PrimOp IntegerAddOp = ILIT(102)
-tagOf_PrimOp IntegerSubOp = ILIT(103)
-tagOf_PrimOp IntegerMulOp = ILIT(104)
-tagOf_PrimOp IntegerQuotRemOp = ILIT(105)
-tagOf_PrimOp IntegerDivModOp = ILIT(106)
-tagOf_PrimOp IntegerNegOp = ILIT(107)
-tagOf_PrimOp IntegerCmpOp = ILIT(108)
-tagOf_PrimOp Integer2IntOp = ILIT(109)
-tagOf_PrimOp Int2IntegerOp = ILIT(110)
-tagOf_PrimOp Word2IntegerOp = ILIT(111)
-tagOf_PrimOp Addr2IntegerOp = ILIT(112)
-tagOf_PrimOp FloatEncodeOp = ILIT(113)
-tagOf_PrimOp FloatDecodeOp = ILIT(114)
-tagOf_PrimOp DoubleEncodeOp = ILIT(115)
-tagOf_PrimOp DoubleDecodeOp = ILIT(116)
-tagOf_PrimOp NewArrayOp = ILIT(117)
-tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(118)
-tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(119)
-tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(120)
-tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(121)
-tagOf_PrimOp (NewByteArrayOp DoubleRep)= ILIT(122)
-tagOf_PrimOp SameMutableArrayOp = ILIT(123)
-tagOf_PrimOp SameMutableByteArrayOp = ILIT(124)
-tagOf_PrimOp ReadArrayOp = ILIT(125)
-tagOf_PrimOp WriteArrayOp = ILIT(126)
-tagOf_PrimOp IndexArrayOp = ILIT(127)
-tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(128)
-tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(129)
-tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(130)
-tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(131)
-tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(132)
-tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(133)
-tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(134)
-tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(135)
-tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(136)
-tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(137)
-tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(138)
-tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(139)
-tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(140)
-tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(141)
-tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(142)
-tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(143)
-tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(144)
-tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(145)
-tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(146)
-tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(147)
-tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(148)
-tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(149)
-tagOf_PrimOp NewSynchVarOp = ILIT(150)
-tagOf_PrimOp TakeMVarOp = ILIT(151)
-tagOf_PrimOp PutMVarOp = ILIT(152)
-tagOf_PrimOp ReadIVarOp = ILIT(153)
-tagOf_PrimOp WriteIVarOp = ILIT(154)
-tagOf_PrimOp MakeForeignObjOp = ILIT(155)
-tagOf_PrimOp MakeStablePtrOp = ILIT(156)
-tagOf_PrimOp DeRefStablePtrOp = ILIT(157)
-tagOf_PrimOp (CCallOp _ _ _ _ _) = ILIT(158)
-tagOf_PrimOp ErrorIOPrimOp = ILIT(159)
-tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(160)
-tagOf_PrimOp SeqOp = ILIT(161)
-tagOf_PrimOp ParOp = ILIT(162)
-tagOf_PrimOp ForkOp = ILIT(163)
-tagOf_PrimOp DelayOp = ILIT(164)
-tagOf_PrimOp WaitReadOp = ILIT(165)
-tagOf_PrimOp WaitWriteOp = ILIT(166)
-
-tagOf_PrimOp ParGlobalOp = ILIT(167)
-tagOf_PrimOp ParLocalOp = ILIT(168)
-tagOf_PrimOp ParAtOp = ILIT(169)
-tagOf_PrimOp ParAtAbsOp = ILIT(170)
-tagOf_PrimOp ParAtRelOp = ILIT(171)
-tagOf_PrimOp ParAtForNowOp = ILIT(172)
-tagOf_PrimOp CopyableOp = ILIT(173)
-tagOf_PrimOp NoFollowOp = ILIT(174)
+tagOf_PrimOp CharGtOp = (ILIT(1) :: FAST_INT)
+tagOf_PrimOp CharGeOp = ILIT( 2)
+tagOf_PrimOp CharEqOp = ILIT( 3)
+tagOf_PrimOp CharNeOp = ILIT( 4)
+tagOf_PrimOp CharLtOp = ILIT( 5)
+tagOf_PrimOp CharLeOp = ILIT( 6)
+tagOf_PrimOp IntGtOp = ILIT( 7)
+tagOf_PrimOp IntGeOp = ILIT( 8)
+tagOf_PrimOp IntEqOp = ILIT( 9)
+tagOf_PrimOp IntNeOp = ILIT( 10)
+tagOf_PrimOp IntLtOp = ILIT( 11)
+tagOf_PrimOp IntLeOp = ILIT( 12)
+tagOf_PrimOp WordGtOp = ILIT( 13)
+tagOf_PrimOp WordGeOp = ILIT( 14)
+tagOf_PrimOp WordEqOp = ILIT( 15)
+tagOf_PrimOp WordNeOp = ILIT( 16)
+tagOf_PrimOp WordLtOp = ILIT( 17)
+tagOf_PrimOp WordLeOp = ILIT( 18)
+tagOf_PrimOp AddrGtOp = ILIT( 19)
+tagOf_PrimOp AddrGeOp = ILIT( 20)
+tagOf_PrimOp AddrEqOp = ILIT( 21)
+tagOf_PrimOp AddrNeOp = ILIT( 22)
+tagOf_PrimOp AddrLtOp = ILIT( 23)
+tagOf_PrimOp AddrLeOp = ILIT( 24)
+tagOf_PrimOp FloatGtOp = ILIT( 25)
+tagOf_PrimOp FloatGeOp = ILIT( 26)
+tagOf_PrimOp FloatEqOp = ILIT( 27)
+tagOf_PrimOp FloatNeOp = ILIT( 28)
+tagOf_PrimOp FloatLtOp = ILIT( 29)
+tagOf_PrimOp FloatLeOp = ILIT( 30)
+tagOf_PrimOp DoubleGtOp = ILIT( 31)
+tagOf_PrimOp DoubleGeOp = ILIT( 32)
+tagOf_PrimOp DoubleEqOp = ILIT( 33)
+tagOf_PrimOp DoubleNeOp = ILIT( 34)
+tagOf_PrimOp DoubleLtOp = ILIT( 35)
+tagOf_PrimOp DoubleLeOp = ILIT( 36)
+tagOf_PrimOp OrdOp = ILIT( 37)
+tagOf_PrimOp ChrOp = ILIT( 38)
+tagOf_PrimOp IntAddOp = ILIT( 39)
+tagOf_PrimOp IntSubOp = ILIT( 40)
+tagOf_PrimOp IntMulOp = ILIT( 41)
+tagOf_PrimOp IntQuotOp = ILIT( 42)
+tagOf_PrimOp IntRemOp = ILIT( 43)
+tagOf_PrimOp IntNegOp = ILIT( 44)
+tagOf_PrimOp IntAbsOp = ILIT( 45)
+tagOf_PrimOp WordQuotOp = ILIT( 46)
+tagOf_PrimOp WordRemOp = ILIT( 47)
+tagOf_PrimOp AndOp = ILIT( 48)
+tagOf_PrimOp OrOp = ILIT( 49)
+tagOf_PrimOp NotOp = ILIT( 50)
+tagOf_PrimOp XorOp = ILIT( 51)
+tagOf_PrimOp SllOp = ILIT( 52)
+tagOf_PrimOp SrlOp = ILIT( 53)
+tagOf_PrimOp ISllOp = ILIT( 54)
+tagOf_PrimOp ISraOp = ILIT( 55)
+tagOf_PrimOp ISrlOp = ILIT( 56)
+tagOf_PrimOp Int2WordOp = ILIT( 57)
+tagOf_PrimOp Word2IntOp = ILIT( 58)
+tagOf_PrimOp Int2AddrOp = ILIT( 59)
+tagOf_PrimOp Addr2IntOp = ILIT( 60)
+
+tagOf_PrimOp FloatAddOp = ILIT( 61)
+tagOf_PrimOp FloatSubOp = ILIT( 62)
+tagOf_PrimOp FloatMulOp = ILIT( 63)
+tagOf_PrimOp FloatDivOp = ILIT( 64)
+tagOf_PrimOp FloatNegOp = ILIT( 65)
+tagOf_PrimOp Float2IntOp = ILIT( 66)
+tagOf_PrimOp Int2FloatOp = ILIT( 67)
+tagOf_PrimOp FloatExpOp = ILIT( 68)
+tagOf_PrimOp FloatLogOp = ILIT( 69)
+tagOf_PrimOp FloatSqrtOp = ILIT( 70)
+tagOf_PrimOp FloatSinOp = ILIT( 71)
+tagOf_PrimOp FloatCosOp = ILIT( 72)
+tagOf_PrimOp FloatTanOp = ILIT( 73)
+tagOf_PrimOp FloatAsinOp = ILIT( 74)
+tagOf_PrimOp FloatAcosOp = ILIT( 75)
+tagOf_PrimOp FloatAtanOp = ILIT( 76)
+tagOf_PrimOp FloatSinhOp = ILIT( 77)
+tagOf_PrimOp FloatCoshOp = ILIT( 78)
+tagOf_PrimOp FloatTanhOp = ILIT( 79)
+tagOf_PrimOp FloatPowerOp = ILIT( 80)
+tagOf_PrimOp DoubleAddOp = ILIT( 81)
+tagOf_PrimOp DoubleSubOp = ILIT( 82)
+tagOf_PrimOp DoubleMulOp = ILIT( 83)
+tagOf_PrimOp DoubleDivOp = ILIT( 84)
+tagOf_PrimOp DoubleNegOp = ILIT( 85)
+tagOf_PrimOp Double2IntOp = ILIT( 86)
+tagOf_PrimOp Int2DoubleOp = ILIT( 87)
+tagOf_PrimOp Double2FloatOp = ILIT( 88)
+tagOf_PrimOp Float2DoubleOp = ILIT( 89)
+tagOf_PrimOp DoubleExpOp = ILIT( 90)
+tagOf_PrimOp DoubleLogOp = ILIT( 91)
+tagOf_PrimOp DoubleSqrtOp = ILIT( 92)
+tagOf_PrimOp DoubleSinOp = ILIT( 93)
+tagOf_PrimOp DoubleCosOp = ILIT( 94)
+tagOf_PrimOp DoubleTanOp = ILIT( 95)
+tagOf_PrimOp DoubleAsinOp = ILIT( 96)
+tagOf_PrimOp DoubleAcosOp = ILIT( 97)
+tagOf_PrimOp DoubleAtanOp = ILIT( 98)
+tagOf_PrimOp DoubleSinhOp = ILIT( 99)
+tagOf_PrimOp DoubleCoshOp = ILIT(100)
+tagOf_PrimOp DoubleTanhOp = ILIT(101)
+tagOf_PrimOp DoublePowerOp = ILIT(102)
+tagOf_PrimOp IntegerAddOp = ILIT(103)
+tagOf_PrimOp IntegerSubOp = ILIT(104)
+tagOf_PrimOp IntegerMulOp = ILIT(105)
+tagOf_PrimOp IntegerQuotRemOp = ILIT(106)
+tagOf_PrimOp IntegerDivModOp = ILIT(107)
+tagOf_PrimOp IntegerNegOp = ILIT(108)
+tagOf_PrimOp IntegerCmpOp = ILIT(109)
+tagOf_PrimOp Integer2IntOp = ILIT(110)
+tagOf_PrimOp Integer2WordOp = ILIT(111)
+tagOf_PrimOp Int2IntegerOp = ILIT(112)
+tagOf_PrimOp Word2IntegerOp = ILIT(113)
+tagOf_PrimOp Addr2IntegerOp = ILIT(114)
+tagOf_PrimOp IntegerToInt64Op = ILIT(115)
+tagOf_PrimOp Int64ToIntegerOp = ILIT(116)
+tagOf_PrimOp IntegerToWord64Op = ILIT(117)
+tagOf_PrimOp Word64ToIntegerOp = ILIT(118)
+tagOf_PrimOp FloatEncodeOp = ILIT(119)
+tagOf_PrimOp FloatDecodeOp = ILIT(120)
+tagOf_PrimOp DoubleEncodeOp = ILIT(121)
+tagOf_PrimOp DoubleDecodeOp = ILIT(122)
+tagOf_PrimOp NewArrayOp = ILIT(123)
+tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(124)
+tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(125)
+tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(126)
+tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(127)
+tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(128)
+tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(129)
+tagOf_PrimOp SameMutableArrayOp = ILIT(130)
+tagOf_PrimOp SameMutableByteArrayOp = ILIT(131)
+tagOf_PrimOp ReadArrayOp = ILIT(132)
+tagOf_PrimOp WriteArrayOp = ILIT(133)
+tagOf_PrimOp IndexArrayOp = ILIT(134)
+tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(135)
+tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(136)
+tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(137)
+tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(138)
+tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(139)
+tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(140)
+tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(141)
+tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(142)
+tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(143)
+tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(144)
+tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(145)
+tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(146)
+tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(147)
+tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(148)
+tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(149)
+tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(150)
+tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(151)
+tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(152)
+tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(153)
+tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(154)
+tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(155)
+tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(156)
+tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(157)
+tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(158)
+tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(159)
+tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(160)
+tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(161)
+tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(162)
+tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(163)
+tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(164)
+tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(165)
+tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(166)
+tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(167)
+tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(168)
+tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(169)
+tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(170)
+tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(171)
+tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(172)
+tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(173)
+tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(174)
+tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(175)
+tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(176)
+tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(177)
+tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(178)
+tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(179)
+tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(180)
+tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(181)
+tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(182)
+tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(183)
+tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(184)
+tagOf_PrimOp SizeofByteArrayOp = ILIT(185)
+tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(186)
+tagOf_PrimOp NewSynchVarOp = ILIT(187)
+tagOf_PrimOp TakeMVarOp = ILIT(188)
+tagOf_PrimOp PutMVarOp = ILIT(189)
+tagOf_PrimOp ReadIVarOp = ILIT(190)
+tagOf_PrimOp WriteIVarOp = ILIT(191)
+tagOf_PrimOp MakeForeignObjOp = ILIT(192)
+tagOf_PrimOp WriteForeignObjOp = ILIT(193)
+tagOf_PrimOp MakeStablePtrOp = ILIT(194)
+tagOf_PrimOp DeRefStablePtrOp = ILIT(195)
+tagOf_PrimOp (CCallOp _ _ _ _ _ _) = ILIT(196)
+tagOf_PrimOp ErrorIOPrimOp = ILIT(197)
+tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(198)
+tagOf_PrimOp SeqOp = ILIT(199)
+tagOf_PrimOp ParOp = ILIT(200)
+tagOf_PrimOp ForkOp = ILIT(201)
+tagOf_PrimOp DelayOp = ILIT(202)
+tagOf_PrimOp WaitReadOp = ILIT(203)
+tagOf_PrimOp WaitWriteOp = ILIT(204)
+tagOf_PrimOp ParGlobalOp = ILIT(205)
+tagOf_PrimOp ParLocalOp = ILIT(206)
+tagOf_PrimOp ParAtOp = ILIT(207)
+tagOf_PrimOp ParAtAbsOp = ILIT(208)
+tagOf_PrimOp ParAtRelOp = ILIT(209)
+tagOf_PrimOp ParAtForNowOp = ILIT(210)
+tagOf_PrimOp CopyableOp = ILIT(211)
+tagOf_PrimOp NoFollowOp = ILIT(212)
+tagOf_PrimOp SameMVarOp = ILIT(213)
tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
IntQuotOp,
IntRemOp,
IntNegOp,
+ WordQuotOp,
+ WordRemOp,
AndOp,
OrOp,
NotOp,
+ XorOp,
SllOp,
- SraOp,
SrlOp,
ISllOp,
ISraOp,
Word2IntOp,
Int2AddrOp,
Addr2IntOp,
+
FloatAddOp,
FloatSubOp,
FloatMulOp,
IntegerNegOp,
IntegerCmpOp,
Integer2IntOp,
+ Integer2WordOp,
Int2IntegerOp,
Word2IntegerOp,
Addr2IntegerOp,
+ IntegerToInt64Op,
+ Int64ToIntegerOp,
+ IntegerToWord64Op,
+ Word64ToIntegerOp,
FloatEncodeOp,
FloatDecodeOp,
DoubleEncodeOp,
NewArrayOp,
NewByteArrayOp CharRep,
NewByteArrayOp IntRep,
+ NewByteArrayOp WordRep,
NewByteArrayOp AddrRep,
NewByteArrayOp FloatRep,
NewByteArrayOp DoubleRep,
IndexArrayOp,
ReadByteArrayOp CharRep,
ReadByteArrayOp IntRep,
+ ReadByteArrayOp WordRep,
ReadByteArrayOp AddrRep,
ReadByteArrayOp FloatRep,
ReadByteArrayOp DoubleRep,
+ ReadByteArrayOp Int64Rep,
+ ReadByteArrayOp Word64Rep,
WriteByteArrayOp CharRep,
WriteByteArrayOp IntRep,
+ WriteByteArrayOp WordRep,
WriteByteArrayOp AddrRep,
WriteByteArrayOp FloatRep,
WriteByteArrayOp DoubleRep,
+ WriteByteArrayOp Int64Rep,
+ WriteByteArrayOp Word64Rep,
IndexByteArrayOp CharRep,
IndexByteArrayOp IntRep,
+ IndexByteArrayOp WordRep,
IndexByteArrayOp AddrRep,
IndexByteArrayOp FloatRep,
IndexByteArrayOp DoubleRep,
+ IndexByteArrayOp Int64Rep,
+ IndexByteArrayOp Word64Rep,
IndexOffAddrOp CharRep,
IndexOffAddrOp IntRep,
+ IndexOffAddrOp WordRep,
IndexOffAddrOp AddrRep,
IndexOffAddrOp FloatRep,
IndexOffAddrOp DoubleRep,
+ IndexOffAddrOp Int64Rep,
+ IndexOffAddrOp Word64Rep,
+ IndexOffForeignObjOp CharRep,
+ IndexOffForeignObjOp AddrRep,
+ IndexOffForeignObjOp IntRep,
+ IndexOffForeignObjOp WordRep,
+ IndexOffForeignObjOp FloatRep,
+ IndexOffForeignObjOp DoubleRep,
+ IndexOffForeignObjOp Int64Rep,
+ IndexOffForeignObjOp Word64Rep,
+ WriteOffAddrOp CharRep,
+ WriteOffAddrOp IntRep,
+ WriteOffAddrOp WordRep,
+ WriteOffAddrOp AddrRep,
+ WriteOffAddrOp FloatRep,
+ WriteOffAddrOp DoubleRep,
+ WriteOffAddrOp Int64Rep,
+ WriteOffAddrOp Word64Rep,
UnsafeFreezeArrayOp,
UnsafeFreezeByteArrayOp,
+ SizeofByteArrayOp,
+ SizeofMutableByteArrayOp,
NewSynchVarOp,
+ SameMVarOp,
ReadArrayOp,
TakeMVarOp,
PutMVarOp,
ReadIVarOp,
WriteIVarOp,
MakeForeignObjOp,
+ WriteForeignObjOp,
MakeStablePtrOp,
DeRefStablePtrOp,
ReallyUnsafePtrEqualityOp,
primOpInfo CharLtOp = Compare SLIT("ltChar#") charPrimTy
primOpInfo CharLeOp = Compare SLIT("leChar#") charPrimTy
-primOpInfo IntGtOp = Compare SLIT("gtInt#") intPrimTy
-primOpInfo IntGeOp = Compare SLIT("geInt#") intPrimTy
-primOpInfo IntEqOp = Compare SLIT("eqInt#") intPrimTy
-primOpInfo IntNeOp = Compare SLIT("neInt#") intPrimTy
-primOpInfo IntLtOp = Compare SLIT("ltInt#") intPrimTy
-primOpInfo IntLeOp = Compare SLIT("leInt#") intPrimTy
+primOpInfo IntGtOp = Compare SLIT(">#") intPrimTy
+primOpInfo IntGeOp = Compare SLIT(">=#") intPrimTy
+primOpInfo IntEqOp = Compare SLIT("==#") intPrimTy
+primOpInfo IntNeOp = Compare SLIT("/=#") intPrimTy
+primOpInfo IntLtOp = Compare SLIT("<#") intPrimTy
+primOpInfo IntLeOp = Compare SLIT("<=#") intPrimTy
primOpInfo WordGtOp = Compare SLIT("gtWord#") wordPrimTy
primOpInfo WordGeOp = Compare SLIT("geWord#") wordPrimTy
primOpInfo FloatLtOp = Compare SLIT("ltFloat#") floatPrimTy
primOpInfo FloatLeOp = Compare SLIT("leFloat#") floatPrimTy
-primOpInfo DoubleGtOp = Compare SLIT("gtDouble#") doublePrimTy
-primOpInfo DoubleGeOp = Compare SLIT("geDouble#") doublePrimTy
-primOpInfo DoubleEqOp = Compare SLIT("eqDouble#") doublePrimTy
-primOpInfo DoubleNeOp = Compare SLIT("neDouble#") doublePrimTy
-primOpInfo DoubleLtOp = Compare SLIT("ltDouble#") doublePrimTy
-primOpInfo DoubleLeOp = Compare SLIT("leDouble#") doublePrimTy
+primOpInfo DoubleGtOp = Compare SLIT(">##") doublePrimTy
+primOpInfo DoubleGeOp = Compare SLIT(">=##") doublePrimTy
+primOpInfo DoubleEqOp = Compare SLIT("==##") doublePrimTy
+primOpInfo DoubleNeOp = Compare SLIT("/=##") doublePrimTy
+primOpInfo DoubleLtOp = Compare SLIT("<##") doublePrimTy
+primOpInfo DoubleLeOp = Compare SLIT("<=##") doublePrimTy
+
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
-primOpInfo IntAddOp = Dyadic SLIT("plusInt#") intPrimTy
-primOpInfo IntSubOp = Dyadic SLIT("minusInt#") intPrimTy
-primOpInfo IntMulOp = Dyadic SLIT("timesInt#") intPrimTy
+primOpInfo IntAddOp = Dyadic SLIT("+#") intPrimTy
+primOpInfo IntSubOp = Dyadic SLIT("-#") intPrimTy
+primOpInfo IntMulOp = Dyadic SLIT("*#") intPrimTy
primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy
primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy
primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy
+primOpInfo IntAbsOp = Monadic SLIT("absInt#") intPrimTy
\end{code}
%************************************************************************
A @Word#@ is an unsigned @Int#@.
\begin{code}
+primOpInfo WordQuotOp = Dyadic SLIT("quotWord#") wordPrimTy
+primOpInfo WordRemOp = Dyadic SLIT("remWord#") wordPrimTy
+
primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy
primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy
+primOpInfo XorOp = Dyadic SLIT("xor#") wordPrimTy
primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy
primOpInfo SllOp
= PrimResult SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
-primOpInfo SraOp
- = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
primOpInfo SrlOp
= PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
primOpInfo Addr2IntOp = Coercing SLIT("addr2Int#") addrPrimTy intPrimTy
\end{code}
+
%************************************************************************
%* *
\subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
similar).
\begin{code}
-primOpInfo DoubleAddOp = Dyadic SLIT("plusDouble#") doublePrimTy
-primOpInfo DoubleSubOp = Dyadic SLIT("minusDouble#") doublePrimTy
-primOpInfo DoubleMulOp = Dyadic SLIT("timesDouble#") doublePrimTy
-primOpInfo DoubleDivOp = Dyadic SLIT("divideDouble#") doublePrimTy
+primOpInfo DoubleAddOp = Dyadic SLIT("+##") doublePrimTy
+primOpInfo DoubleSubOp = Dyadic SLIT("-##") doublePrimTy
+primOpInfo DoubleMulOp = Dyadic SLIT("*##") doublePrimTy
+primOpInfo DoubleDivOp = Dyadic SLIT("/##") doublePrimTy
primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy
primOpInfo Double2IntOp = Coercing SLIT("double2Int#") doublePrimTy intPrimTy
primOpInfo DoubleSinhOp = Monadic SLIT("sinhDouble#") doublePrimTy
primOpInfo DoubleCoshOp = Monadic SLIT("coshDouble#") doublePrimTy
primOpInfo DoubleTanhOp = Monadic SLIT("tanhDouble#") doublePrimTy
-primOpInfo DoublePowerOp= Dyadic SLIT("powerDouble#") doublePrimTy
+primOpInfo DoublePowerOp= Dyadic SLIT("**##") doublePrimTy
\end{code}
%************************************************************************
primOpInfo Integer2IntOp
= PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep []
+primOpInfo Integer2WordOp
+ = PrimResult SLIT("integer2Word#") [] one_Integer_ty wordPrimTyCon IntRep []
+
primOpInfo Int2IntegerOp
= AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon []
primOpInfo Addr2IntegerOp
= AlgResult SLIT("addr2Integer#") [] [addrPrimTy] integerTyCon []
+
+primOpInfo IntegerToInt64Op
+ = PrimResult SLIT("integerToInt64#") [] one_Integer_ty int64PrimTyCon Int64Rep []
+
+primOpInfo Int64ToIntegerOp
+ = AlgResult SLIT("int64ToInteger#") [] [int64PrimTy] integerTyCon []
+
+primOpInfo Word64ToIntegerOp
+ = AlgResult SLIT("word64ToInteger#") [] [word64PrimTy] integerTyCon []
+
+primOpInfo IntegerToWord64Op
+ = PrimResult SLIT("integerToWord64#") [] one_Integer_ty word64PrimTyCon Word64Rep []
\end{code}
Encoding and decoding of floating-point numbers is sorta
where
tbl = [ (CharRep, stateAndCharPrimTyCon),
(IntRep, stateAndIntPrimTyCon),
+ (WordRep, stateAndWordPrimTyCon),
(AddrRep, stateAndAddrPrimTyCon),
(FloatRep, stateAndFloatPrimTyCon),
(DoubleRep, stateAndDoublePrimTyCon) ]
in
PrimResult op_str [] [addrPrimTy, intPrimTy] prim_tycon kind []
+primOpInfo (IndexOffForeignObjOp kind)
+ = let
+ (str, _, prim_tycon) = getPrimRepInfo kind
+ op_str = _PK_ ("index" ++ str ++ "OffForeignObj#")
+ in
+ PrimResult op_str [] [foreignObjPrimTy, intPrimTy] prim_tycon kind []
+
+primOpInfo (WriteOffAddrOp kind)
+ = let
+ s = alphaTy; s_tv = alphaTyVar
+
+ (str, prim_ty, _) = getPrimRepInfo kind
+ op_str = _PK_ ("write" ++ str ++ "OffAddr#")
+ in
+ -- NB: *Prim*Result --
+ PrimResult op_str [s_tv]
+ [addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s]
+ statePrimTyCon VoidRep [s]
+
---------------------------------------------------------------------------
primOpInfo UnsafeFreezeArrayOp
= let {
AlgResult SLIT("unsafeFreezeByteArray#") [s_tv]
[mkMutableByteArrayPrimTy s, mkStatePrimTy s]
stateAndByteArrayPrimTyCon [s]
+---------------------------------------------------------------------------
+primOpInfo SizeofByteArrayOp
+ = PrimResult
+ SLIT("sizeofByteArray#") []
+ [byteArrayPrimTy]
+ intPrimTyCon IntRep []
+
+primOpInfo SizeofMutableByteArrayOp
+ = let { s = alphaTy; s_tv = alphaTyVar } in
+ PrimResult
+ SLIT("sizeofMutableByteArray#") [s_tv]
+ [mkMutableByteArrayPrimTy s]
+ intPrimTyCon IntRep []
+
\end{code}
%************************************************************************
AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
stateAndSynchVarPrimTyCon [s, elt]
+primOpInfo SameMVarOp
+ = let {
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
+ mvar_ty = mkSynchVarPrimTy s elt
+ } in
+ AlgResult SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty]
+ boolTyCon []
+
primOpInfo TakeMVarOp
= let {
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
%************************************************************************
%* *
-\subsubsection[PrimOps-makeForeignObj]{PrimOpInfo for Foreign Objects}
+\subsubsection[PrimOps-ForeignObj]{PrimOpInfo for Foreign Objects}
%* *
%************************************************************************
associated with the object is invoked (currently, each ForeignObj has a
direct reference to its finaliser). -- SOF
-The only function defined over @ForeignObj@s is:
+A @ForeignObj@ is created by the @makeForeignObj#@ primitive:
\begin{pseudocode}
makeForeignObj# :: Addr# -- foreign object
-> StateAndForeignObj# _RealWorld# ForeignObj#
\end{pseudocode}
+
\begin{code}
primOpInfo MakeForeignObjOp
= AlgResult SLIT("makeForeignObj#") []
stateAndForeignObjPrimTyCon [realWorldTy]
\end{code}
+[Experimental--SOF]
+In addition, another @ForeignObj@ primitive is provided for destructively modifying
+the external object wrapped up inside a @ForeignObj@. This primitive is used
+when a mixed programming interface of implicit and explicit de-allocation is used,
+e.g., if @ForeignObj@s are used to implement @Handle@s, then @Handle@s can be
+released either explicitly (through @hClose@) or implicitly (via a finaliser).
+When releasing/closing the @Handle@ explicitly, care must be taken to avoid having
+the finaliser for the embedded @ForeignObj@ attempt the same thing later.
+We deal with this situation, by allowing the programmer to destructively modify
+the data field of the @ForeignObj@ to hold a special value the finaliser recognises,
+and does not attempt to free (e.g., filling the data slot with \tr{NULL}).
+
+\begin{pseudocode}
+writeForeignObj# :: ForeignObj# -- foreign object
+ -> Addr# -- new data value
+ -> StateAndForeignObj# _RealWorld# ForeignObj#
+\end{pseudocode}
+
+\begin{code}
+primOpInfo WriteForeignObjOp
+ = let {
+ s = alphaTy; s_tv = alphaTyVar
+ } in
+ PrimResult SLIT("writeForeignObj#") [s_tv]
+ [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s]
+ statePrimTyCon VoidRep [s]
+\end{code}
+
%************************************************************************
%* *
\subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
\begin{code}
-- HWL: The first 4 Int# in all par... annotations denote:
-- name, granularity info, size of result, degree of parallelism
+-- Same structure as _seq_ i.e. returns Int#
primOpInfo ParGlobalOp -- parGlobal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
- = AlgResult SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] liftTyCon [betaTy]
+ = PrimResult SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
primOpInfo ParLocalOp -- parLocal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
- = AlgResult SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] liftTyCon [betaTy]
+ = PrimResult SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
primOpInfo ParAtOp -- parAt# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
- = AlgResult SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [alphaTy,betaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] liftTyCon [gammaTy]
+ = PrimResult SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
primOpInfo ParAtAbsOp -- parAtAbs# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
- = AlgResult SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] liftTyCon [betaTy]
+ = PrimResult SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
primOpInfo ParAtRelOp -- parAtRel# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
- = AlgResult SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] liftTyCon [betaTy]
+ = PrimResult SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
primOpInfo ParAtForNowOp -- parAtForNow# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
- = AlgResult SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [alphaTy,betaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] liftTyCon [gammaTy]
+ = PrimResult SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
primOpInfo CopyableOp -- copyable# :: a -> a
- = AlgResult SLIT("copyable#") [alphaTyVar] [alphaTy] liftTyCon [alphaTy]
+ = PrimResult SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
primOpInfo NoFollowOp -- noFollow# :: a -> a
- = AlgResult SLIT("noFollow#") [alphaTyVar] [alphaTy] liftTyCon [alphaTy]
+ = PrimResult SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
-primOpInfo ErrorIOPrimOp -- errorIO# :: PrimIO () -> State# RealWorld#
- = PrimResult SLIT("errorIO#") []
- [mkPrimIoTy unitTy]
+-- errorIO# :: (State# RealWorld# -> a) -> State# RealWorld#
+primOpInfo ErrorIOPrimOp
+ = PrimResult SLIT("errorIO#") [alphaTyVar]
+ [mkFunTy realWorldStatePrimTy alphaTy]
statePrimTyCon VoidRep [realWorldTy]
\end{code}
%************************************************************************
\begin{code}
-primOpInfo (CCallOp _ _ _ arg_tys result_ty)
+primOpInfo (CCallOp _ _ _ _ arg_tys result_ty)
= AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
where
- (result_tycon, tys_applied, _) = -- _trace "PrimOp.getAppDataTyConExpandingDicts" $
- getAppDataTyConExpandingDicts result_ty
+ (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty
#ifdef DEBUG
primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
(addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
(intOff mIN_MP_INT_SIZE))
primOpHeapReq Addr2IntegerOp = VariableHeapRequired
+primOpHeapReq IntegerToInt64Op = FixedHeapRequired
+ (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
+ (intOff mIN_MP_INT_SIZE))
+primOpHeapReq Word64ToIntegerOp = FixedHeapRequired
+ (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
+ (intOff mIN_MP_INT_SIZE))
+primOpHeapReq Int64ToIntegerOp = FixedHeapRequired
+ (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
+ (intOff mIN_MP_INT_SIZE))
+primOpHeapReq IntegerToWord64Op = FixedHeapRequired
+ (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
+ (intOff mIN_MP_INT_SIZE))
primOpHeapReq FloatDecodeOp = FixedHeapRequired
(addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
(addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
(addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
(intOff mIN_MP_INT_SIZE)))
--- ccall may allocate heap if it is explicitly allowed to (_ccall_gc_)
--- or if it returns a ForeignObj.
+{-
+ ccall may allocate heap if it is explicitly allowed to (_ccall_gc_)
+ or if it returns a ForeignObj.
-primOpHeapReq (CCallOp _ _ mayGC@True _ _) = VariableHeapRequired
-primOpHeapReq (CCallOp _ _ mayGC@False _ _) = NoHeapRequired
+ Hmm..the allocation for makeForeignObj# is known (and fixed), so
+ why do we need to be so indeterminate about it? --SOF
+-}
+primOpHeapReq (CCallOp _ _ mayGC@True _ _ _) = VariableHeapRequired
+primOpHeapReq (CCallOp _ _ mayGC@False _ _ _) = NoHeapRequired
primOpHeapReq MakeForeignObjOp = VariableHeapRequired
+primOpHeapReq WriteForeignObjOp = NoHeapRequired
-- this occasionally has to expand the Stable Pointer table
primOpHeapReq MakeStablePtrOp = VariableHeapRequired
primOpHeapReq IntegerCmpOp = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE))
primOpHeapReq Integer2IntOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
+primOpHeapReq Integer2WordOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
primOpHeapReq FloatEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
primOpHeapReq DoubleEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
primOpOkForSpeculation DoubleAcosOp = False -- Arg out of domain
-- CCall
-primOpOkForSpeculation (CCallOp _ _ _ _ _)= False -- Could be expensive!
+primOpOkForSpeculation (CCallOp _ _ _ _ _ _) = False -- Could be expensive!
-- errorIO#
primOpOkForSpeculation ErrorIOPrimOp = False -- Could be disastrous!
fragilePrimOp ParOp = True
fragilePrimOp ForkOp = True
fragilePrimOp SeqOp = True
-fragilePrimOp MakeForeignObjOp = True -- SOF
+fragilePrimOp MakeForeignObjOp = True -- SOF
+fragilePrimOp WriteForeignObjOp = True -- SOF
fragilePrimOp MakeStablePtrOp = True
fragilePrimOp DeRefStablePtrOp = True -- ??? JSM & ADR
\begin{code}
primOpNeedsWrapper :: PrimOp -> Bool
-primOpNeedsWrapper (CCallOp _ _ _ _ _) = True
-
-primOpNeedsWrapper NewArrayOp = True -- ToDo: for nativeGen only!(JSM)
-primOpNeedsWrapper (NewByteArrayOp _) = True
-
-primOpNeedsWrapper IntegerAddOp = True
-primOpNeedsWrapper IntegerSubOp = True
-primOpNeedsWrapper IntegerMulOp = True
-primOpNeedsWrapper IntegerQuotRemOp = True
-primOpNeedsWrapper IntegerDivModOp = True
-primOpNeedsWrapper IntegerNegOp = True
-primOpNeedsWrapper IntegerCmpOp = True
-primOpNeedsWrapper Integer2IntOp = True
-primOpNeedsWrapper Int2IntegerOp = True
-primOpNeedsWrapper Word2IntegerOp = True
-primOpNeedsWrapper Addr2IntegerOp = True
+primOpNeedsWrapper (CCallOp _ _ _ _ _ _) = True
+
+primOpNeedsWrapper NewArrayOp = True -- ToDo: for nativeGen only!(JSM)
+primOpNeedsWrapper (NewByteArrayOp _) = True
+
+primOpNeedsWrapper IntegerAddOp = True
+primOpNeedsWrapper IntegerSubOp = True
+primOpNeedsWrapper IntegerMulOp = True
+primOpNeedsWrapper IntegerQuotRemOp = True
+primOpNeedsWrapper IntegerDivModOp = True
+primOpNeedsWrapper IntegerNegOp = True
+primOpNeedsWrapper IntegerCmpOp = True
+primOpNeedsWrapper Integer2IntOp = True
+primOpNeedsWrapper Integer2WordOp = True
+primOpNeedsWrapper Int2IntegerOp = True
+primOpNeedsWrapper Word2IntegerOp = True
+primOpNeedsWrapper Addr2IntegerOp = True
+primOpNeedsWrapper IntegerToInt64Op = True
+primOpNeedsWrapper IntegerToWord64Op = True
+primOpNeedsWrapper Word64ToIntegerOp = True
+primOpNeedsWrapper Int64ToIntegerOp = True
primOpNeedsWrapper FloatExpOp = True
primOpNeedsWrapper FloatLogOp = True
primOpNeedsWrapper DoubleDecodeOp = True
primOpNeedsWrapper MakeForeignObjOp = True
+primOpNeedsWrapper WriteForeignObjOp = True
primOpNeedsWrapper MakeStablePtrOp = True
primOpNeedsWrapper DeRefStablePtrOp = True
\begin{code}
primOp_str op
= case (primOpInfo op) of
- Dyadic str _ -> str
- Monadic str _ -> str
- Compare str _ -> str
- Coercing str _ _ -> str
+ Dyadic str _ -> str
+ Monadic str _ -> str
+ Compare str _ -> str
+ Coercing str _ _ -> str
PrimResult str _ _ _ _ _ -> str
- AlgResult str _ _ _ _ -> str
+ AlgResult str _ _ _ _ -> str
\end{code}
@primOpType@ duplicates some work of @primOpId@, but since we
Dyadic str ty -> dyadic_fun_ty ty
Monadic str ty -> monadic_fun_ty ty
Compare str ty -> compare_fun_ty ty
- Coercing str ty1 ty2 -> mkFunTys [ty1] ty2
+ Coercing str ty1 ty2 -> mkFunTy ty1 ty2
PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
- mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon prim_tycon res_tys))
+ mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp prim_tycon res_tys))
AlgResult str tyvars arg_tys tycon res_tys ->
- mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon tycon res_tys))
+ mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp tycon res_tys))
\end{code}
\begin{code}
commutableOp IntMulOp = True
commutableOp AndOp = True
commutableOp OrOp = True
+commutableOp XorOp = True
commutableOp IntEqOp = True
commutableOp IntNeOp = True
commutableOp IntegerAddOp = True
Utils:
\begin{code}
dyadic_fun_ty ty = mkFunTys [ty, ty] ty
-monadic_fun_ty ty = mkFunTys [ty] ty
+monadic_fun_ty ty = mkFunTy ty ty
compare_fun_ty ty = mkFunTys [ty, ty] boolTy
\end{code}
Output stuff:
\begin{code}
-pprPrimOp :: PprStyle -> PrimOp -> Pretty
-showPrimOp :: PprStyle -> PrimOp -> String
+pprPrimOp :: PrimOp -> SDoc
+showPrimOp :: PrimOp -> String
-showPrimOp sty op
- = ppShow 1000{-random-} (pprPrimOp sty op)
+showPrimOp op = showSDoc (pprPrimOp op)
-pprPrimOp sty (CCallOp fun is_casm may_gc arg_tys res_ty)
+pprPrimOp (CCallOp fun is_casm may_gc cconv arg_tys res_ty)
= let
+ callconv = text "{-" <> pprCallConv cconv <> text "-}"
+
before
- = if is_casm then
- if may_gc then "(_casm_GC_ ``" else "(_casm_ ``"
- else
- if may_gc then "(_ccall_GC_ " else "(_ccall_ "
+ | is_casm && may_gc = "_casm_GC_ ``"
+ | is_casm = "casm_ ``"
+ | may_gc = "_ccall_GC_ "
+ | otherwise = "_ccall_ "
after
- = if is_casm then ppStr "''" else ppNil
+ | is_casm = text "''"
+ | otherwise = empty
pp_tys
- = ppBesides [ppStr " { [",
- ppIntersperse pp'SP{-'-} (map (pprParendGenType sty) arg_tys),
- ppRbrack, ppSP, pprParendGenType sty res_ty, ppStr " })"]
+ = hsep (map pprParendType (res_ty:arg_tys))
+ ppr_fun =
+ case fun of
+ Nothing -> ptext SLIT("<dynamic>")
+ Just fn -> ptext fn
+
in
- ppBesides [ppStr before, ppPStr fun, after, pp_tys]
+ hcat [ ifPprDebug callconv
+ , text before , ppr_fun , after, space, brackets pp_tys]
+
+pprPrimOp other_op
+ = getPprStyle $ \ sty ->
+ if codeStyle sty then -- For C just print the primop itself
+ identToC str
+ else if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
+ ptext SLIT("PrelGHC.") <> ptext str
+ else -- Unqualified is good enough
+ ptext str
+ where
+ str = primOp_str other_op
-pprPrimOp sty other_op
- = let
- str = primOp_str other_op
- in
- if codeStyle sty
- then identToC str
- else ppPStr str
instance Outputable PrimOp where
- ppr sty op = pprPrimOp sty op
+ ppr op = pprPrimOp op
\end{code}
projects / ghc-hetmet.git / blobdiff