From: sewardj Date: Mon, 7 Aug 2000 14:11:49 +0000 (+0000) Subject: [project @ 2000-08-07 14:11:48 by sewardj] X-Git-Tag: Approximately_9120_patches~3911 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=014a3451c3179b6c485e67dd1463966d588be96a;p=ghc-hetmet.git [project @ 2000-08-07 14:11:48 by sewardj] Reorganise the way primops are done. Most of the information about primops, their types and relevant attributes is in prelude/primops.txt. A supporting program in fptools/ghc/utils/genprimopcode reads this file and generates various bits of code which are #include'd into prelude/PrimOp.lhs. Eventually this mechanism will be extended to generate PrelGHC.hi and C code for primops in the bytecode evaluator. Also, add a few primops for creating, reading and writing BCOs. --- diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile index a7caff0..9a0fd79 100644 --- a/ghc/compiler/Makefile +++ b/ghc/compiler/Makefile @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Makefile,v 1.85 2000/07/21 08:45:05 rrt Exp $ +# $Id: Makefile,v 1.86 2000/08/07 14:11:48 sewardj Exp $ TOP = .. include $(TOP)/mk/boilerplate.mk @@ -229,6 +229,38 @@ SRC_C_OPTS += -O -I. -IcodeGen # ---------------------------------------------------------------------------- +# Generate supporting stuff for prelude/PrimOp.lhs +# from prelude/primops.txt + +GENPOC=$(TOP)/utils/genprimopcode/genprimopcode + +prelude/PrimOp.o : prelude/PrimOp.lhs prelude/primops.txt + $(RM) primop-data-decl.hs + $(RM) primop-tag + $(RM) primop-list + $(RM) primop-has-side-effects.hs + $(RM) primop-out-of-line.hs + $(RM) primop-commutable.hs + $(RM) primop-needs-wrapper.hs + $(RM) primop-can-fail.hs + $(RM) primop-strictness.hs + $(RM) primop-usage.hs + $(RM) primop-primop-info.hs + $(GENPOC) --data-decl < prelude/primops.txt > primop-data-decl.hs + $(GENPOC) --primop-tag < prelude/primops.txt > primop-tag.hs + $(GENPOC) --primop-list < prelude/primops.txt > primop-list.hs + $(GENPOC) --has-side-effects < prelude/primops.txt > primop-has-side-effects.hs + $(GENPOC) --out-of-line < prelude/primops.txt > primop-out-of-line.hs + $(GENPOC) --commutable < prelude/primops.txt > primop-commutable.hs + $(GENPOC) --needs-wrapper < prelude/primops.txt > primop-needs-wrapper.hs + $(GENPOC) --can-fail < prelude/primops.txt > primop-can-fail.hs + $(GENPOC) --strictness < prelude/primops.txt > primop-strictness.hs + $(GENPOC) --usage < prelude/primops.txt > primop-usage.hs + $(GENPOC) --primop-primop-info < prelude/primops.txt > primop-primop-info.hs + $(RM) $@ + $(HC) -c -o $@ $(HC_OPTS) prelude/PrimOp.lhs + +# ---------------------------------------------------------------------------- # Parsers/lexers parser/hschooks.o : parser/hschooks.c diff --git a/ghc/compiler/basicTypes/Unique.lhs b/ghc/compiler/basicTypes/Unique.lhs index 0634b51..abe3856 100644 --- a/ghc/compiler/basicTypes/Unique.lhs +++ b/ghc/compiler/basicTypes/Unique.lhs @@ -50,6 +50,7 @@ module Unique ( arrayPrimTyConKey, assertIdKey, augmentIdKey, + bcoPrimTyConKey, bindIOIdKey, boolTyConKey, boundedClassKey, @@ -567,6 +568,7 @@ kindConKey = mkPreludeTyConUnique 67 boxityConKey = mkPreludeTyConUnique 68 typeConKey = mkPreludeTyConUnique 69 threadIdPrimTyConKey = mkPreludeTyConUnique 70 +bcoPrimTyConKey = mkPreludeTyConUnique 71 \end{code} %************************************************************************ diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs index b06cac3..4db56ed 100644 --- a/ghc/compiler/nativeGen/MachMisc.lhs +++ b/ghc/compiler/nativeGen/MachMisc.lhs @@ -284,6 +284,7 @@ primRepToSize ArrayRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( primRepToSize ByteArrayRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,))) primRepToSize WeakPtrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,))) primRepToSize ForeignObjRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,))) +primRepToSize BCORep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,))) primRepToSize StablePtrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,))) primRepToSize ThreadIdRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,))) -- SUP: Wrong!!! Only for testing the rest of the NCG diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs index 7576dd8..dc3bee7 100644 --- a/ghc/compiler/nativeGen/StixPrim.lhs +++ b/ghc/compiler/nativeGen/StixPrim.lhs @@ -170,62 +170,6 @@ primCode [] WriteArrayOp [obj, ix, v] in returnUs (\xs -> assign : xs) -primCode lhs@[_] (IndexByteArrayOp pk) args - = primCode lhs (ReadByteArrayOp pk) args - --- NB: indexing in "pk" units, *not* in bytes (WDP 95/09) - -primCode [lhs] (ReadByteArrayOp pk) [obj, ix] - = let - lhs' = amodeToStix lhs - obj' = amodeToStix obj - ix' = amodeToStix ix - base = StIndex IntRep obj' arrWordsHS - assign = StAssign pk lhs' (StInd pk (StIndex pk base ix')) - in - returnUs (\xs -> assign : xs) - -primCode lhs@[_] (ReadOffAddrOp pk) args - = primCode lhs (IndexOffAddrOp pk) args - -primCode [lhs] (IndexOffAddrOp pk) [obj, ix] - = let - lhs' = amodeToStix lhs - obj' = amodeToStix obj - ix' = amodeToStix ix - assign = StAssign pk lhs' (StInd pk (StIndex pk obj' ix')) - in - returnUs (\xs -> assign : xs) - -primCode [lhs] (IndexOffForeignObjOp pk) [obj, ix] - = let - lhs' = amodeToStix lhs - obj' = amodeToStix obj - ix' = amodeToStix ix - obj'' = StIndex AddrRep obj' fixedHS - assign = StAssign pk lhs' (StInd pk (StIndex pk obj'' ix')) - in - returnUs (\xs -> assign : xs) - -primCode [] (WriteOffAddrOp pk) [obj, ix, v] - = let - obj' = amodeToStix obj - ix' = amodeToStix ix - v' = amodeToStix v - assign = StAssign pk (StInd pk (StIndex pk obj' ix')) v' - in - returnUs (\xs -> assign : xs) - -primCode [] (WriteByteArrayOp pk) [obj, ix, v] - = let - obj' = amodeToStix obj - ix' = amodeToStix ix - v' = amodeToStix v - base = StIndex IntRep obj' arrWordsHS - assign = StAssign pk (StInd pk (StIndex pk base ix')) v' - in - returnUs (\xs -> assign : xs) - primCode [] WriteForeignObjOp [obj, v] = let obj' = amodeToStix obj @@ -234,6 +178,78 @@ primCode [] WriteForeignObjOp [obj, v] assign = StAssign AddrRep (StInd AddrRep obj'') v' in returnUs (\xs -> assign : xs) + +-- NB: indexing in "pk" units, *not* in bytes (WDP 95/09) +primCode ls IndexByteArrayOp_Char rs = primCode_ReadByteArrayOp CharRep ls rs +primCode ls IndexByteArrayOp_Int rs = primCode_ReadByteArrayOp IntRep ls rs +primCode ls IndexByteArrayOp_Word rs = primCode_ReadByteArrayOp WordRep ls rs +primCode ls IndexByteArrayOp_Addr rs = primCode_ReadByteArrayOp AddrRep ls rs +primCode ls IndexByteArrayOp_Float rs = primCode_ReadByteArrayOp FloatRep ls rs +primCode ls IndexByteArrayOp_Double rs = primCode_ReadByteArrayOp DoubleRep ls rs +primCode ls IndexByteArrayOp_StablePtr rs = primCode_ReadByteArrayOp StablePtrRep ls rs +primCode ls IndexByteArrayOp_Int64 rs = primCode_ReadByteArrayOp Int64Rep ls rs +primCode ls IndexByteArrayOp_Word64 rs = primCode_ReadByteArrayOp Word64Rep ls rs + +primCode ls ReadByteArrayOp_Char rs = primCode_ReadByteArrayOp CharRep ls rs +primCode ls ReadByteArrayOp_Int rs = primCode_ReadByteArrayOp IntRep ls rs +primCode ls ReadByteArrayOp_Word rs = primCode_ReadByteArrayOp WordRep ls rs +primCode ls ReadByteArrayOp_Addr rs = primCode_ReadByteArrayOp AddrRep ls rs +primCode ls ReadByteArrayOp_Float rs = primCode_ReadByteArrayOp FloatRep ls rs +primCode ls ReadByteArrayOp_Double rs = primCode_ReadByteArrayOp DoubleRep ls rs +primCode ls ReadByteArrayOp_StablePtr rs = primCode_ReadByteArrayOp StablePtrRep ls rs +primCode ls ReadByteArrayOp_Int64 rs = primCode_ReadByteArrayOp Int64Rep ls rs +primCode ls ReadByteArrayOp_Word64 rs = primCode_ReadByteArrayOp Word64Rep ls rs + +primCode ls ReadOffAddrOp_Char rs = primCode_IndexOffAddrOp CharRep ls rs +primCode ls ReadOffAddrOp_Int rs = primCode_IndexOffAddrOp IntRep ls rs +primCode ls ReadOffAddrOp_Word rs = primCode_IndexOffAddrOp WordRep ls rs +primCode ls ReadOffAddrOp_Addr rs = primCode_IndexOffAddrOp AddrRep ls rs +primCode ls ReadOffAddrOp_Float rs = primCode_IndexOffAddrOp FloatRep ls rs +primCode ls ReadOffAddrOp_Double rs = primCode_IndexOffAddrOp DoubleRep ls rs +primCode ls ReadOffAddrOp_StablePtr rs = primCode_IndexOffAddrOp StablePtrRep ls rs +primCode ls ReadOffAddrOp_Int64 rs = primCode_IndexOffAddrOp Int64Rep ls rs +primCode ls ReadOffAddrOp_Word64 rs = primCode_IndexOffAddrOp Word64Rep ls rs + +primCode ls IndexOffAddrOp_Char rs = primCode_IndexOffAddrOp CharRep ls rs +primCode ls IndexOffAddrOp_Int rs = primCode_IndexOffAddrOp IntRep ls rs +primCode ls IndexOffAddrOp_Word rs = primCode_IndexOffAddrOp WordRep ls rs +primCode ls IndexOffAddrOp_Addr rs = primCode_IndexOffAddrOp AddrRep ls rs +primCode ls IndexOffAddrOp_Float rs = primCode_IndexOffAddrOp FloatRep ls rs +primCode ls IndexOffAddrOp_Double rs = primCode_IndexOffAddrOp DoubleRep ls rs +primCode ls IndexOffAddrOp_StablePtr rs = primCode_IndexOffAddrOp StablePtrRep ls rs +primCode ls IndexOffAddrOp_Int64 rs = primCode_IndexOffAddrOp Int64Rep ls rs +primCode ls IndexOffAddrOp_Word64 rs = primCode_IndexOffAddrOp Word64Rep ls rs + +primCode ls IndexOffForeignObjOp_Char rs = primCode_IndexOffForeignObjOp CharRep ls rs +primCode ls IndexOffForeignObjOp_Int rs = primCode_IndexOffForeignObjOp IntRep ls rs +primCode ls IndexOffForeignObjOp_Word rs = primCode_IndexOffForeignObjOp WordRep ls rs +primCode ls IndexOffForeignObjOp_Addr rs = primCode_IndexOffForeignObjOp AddrRep ls rs +primCode ls IndexOffForeignObjOp_Float rs = primCode_IndexOffForeignObjOp FloatRep ls rs +primCode ls IndexOffForeignObjOp_Double rs = primCode_IndexOffForeignObjOp DoubleRep ls rs +primCode ls IndexOffForeignObjOp_StablePtr rs = primCode_IndexOffForeignObjOp StablePtrRep ls rs +primCode ls IndexOffForeignObjOp_Int64 rs = primCode_IndexOffForeignObjOp Int64Rep ls rs +primCode ls IndexOffForeignObjOp_Word64 rs = primCode_IndexOffForeignObjOp Word64Rep ls rs + +primCode ls WriteOffAddrOp_Char rs = primCode_WriteOffAddrOp CharRep ls rs +primCode ls WriteOffAddrOp_Int rs = primCode_WriteOffAddrOp IntRep ls rs +primCode ls WriteOffAddrOp_Word rs = primCode_WriteOffAddrOp WordRep ls rs +primCode ls WriteOffAddrOp_Addr rs = primCode_WriteOffAddrOp AddrRep ls rs +primCode ls WriteOffAddrOp_Float rs = primCode_WriteOffAddrOp FloatRep ls rs +primCode ls WriteOffAddrOp_Double rs = primCode_WriteOffAddrOp DoubleRep ls rs +primCode ls WriteOffAddrOp_StablePtr rs = primCode_WriteOffAddrOp StablePtrRep ls rs +primCode ls WriteOffAddrOp_Int64 rs = primCode_WriteOffAddrOp Int64Rep ls rs +primCode ls WriteOffAddrOp_Word64 rs = primCode_WriteOffAddrOp Word64Rep ls rs + +primCode ls WriteByteArrayOp_Char rs = primCode_WriteByteArrayOp CharRep ls rs +primCode ls WriteByteArrayOp_Int rs = primCode_WriteByteArrayOp IntRep ls rs +primCode ls WriteByteArrayOp_Word rs = primCode_WriteByteArrayOp WordRep ls rs +primCode ls WriteByteArrayOp_Addr rs = primCode_WriteByteArrayOp AddrRep ls rs +primCode ls WriteByteArrayOp_Float rs = primCode_WriteByteArrayOp FloatRep ls rs +primCode ls WriteByteArrayOp_Double rs = primCode_WriteByteArrayOp DoubleRep ls rs +primCode ls WriteByteArrayOp_StablePtr rs = primCode_WriteByteArrayOp StablePtrRep ls rs +primCode ls WriteByteArrayOp_Int64 rs = primCode_WriteByteArrayOp Int64Rep ls rs +primCode ls WriteByteArrayOp_Word64 rs = primCode_WriteByteArrayOp Word64Rep ls rs + \end{code} ToDo: saving/restoring of volatile regs around ccalls. @@ -331,6 +347,63 @@ primCode lhs op rhs returnUs (\ xs -> simplePrim pk lhs' op rhs' : xs) \end{code} +Helper fns for some array ops. + +\begin{code} +primCode_ReadByteArrayOp pk [lhs] [obj, ix] + = let + lhs' = amodeToStix lhs + obj' = amodeToStix obj + ix' = amodeToStix ix + base = StIndex IntRep obj' arrWordsHS + assign = StAssign pk lhs' (StInd pk (StIndex pk base ix')) + in + returnUs (\xs -> assign : xs) + + +primCode_IndexOffAddrOp pk [lhs] [obj, ix] + = let + lhs' = amodeToStix lhs + obj' = amodeToStix obj + ix' = amodeToStix ix + assign = StAssign pk lhs' (StInd pk (StIndex pk obj' ix')) + in + returnUs (\xs -> assign : xs) + + +primCode_IndexOffForeignObjOp pk [lhs] [obj, ix] + = let + lhs' = amodeToStix lhs + obj' = amodeToStix obj + ix' = amodeToStix ix + obj'' = StIndex AddrRep obj' fixedHS + assign = StAssign pk lhs' (StInd pk (StIndex pk obj'' ix')) + in + returnUs (\xs -> assign : xs) + + +primCode_WriteOffAddrOp pk [] [obj, ix, v] + = let + obj' = amodeToStix obj + ix' = amodeToStix ix + v' = amodeToStix v + assign = StAssign pk (StInd pk (StIndex pk obj' ix')) v' + in + returnUs (\xs -> assign : xs) + + +primCode_WriteByteArrayOp pk [] [obj, ix, v] + = let + obj' = amodeToStix obj + ix' = amodeToStix ix + v' = amodeToStix v + base = StIndex IntRep obj' arrWordsHS + assign = StAssign pk (StInd pk (StIndex pk base ix')) v' + in + returnUs (\xs -> assign : xs) + +\end{code} + \begin{code} simpleCoercion :: PrimRep diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs index 94666c7..ae88f95 100644 --- a/ghc/compiler/prelude/PrelInfo.lhs +++ b/ghc/compiler/prelude/PrelInfo.lhs @@ -157,6 +157,7 @@ prim_tycons , intPrimTyCon , int64PrimTyCon , foreignObjPrimTyCon + , bcoPrimTyCon , weakPrimTyCon , mutableArrayPrimTyCon , mutableByteArrayPrimTyCon @@ -211,6 +212,7 @@ knownKeyNames , (byteArrayTyCon_RDR, byteArrayTyConKey) , (mutableByteArrayTyCon_RDR, mutableByteArrayTyConKey) , (foreignObjTyCon_RDR, foreignObjTyConKey) + , (bcoPrimTyCon_RDR, bcoPrimTyConKey) , (stablePtrTyCon_RDR, stablePtrTyConKey) , (stablePtrDataCon_RDR, stablePtrDataConKey) diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs index 0d4328d..3c2d26c 100644 --- a/ghc/compiler/prelude/PrelNames.lhs +++ b/ghc/compiler/prelude/PrelNames.lhs @@ -42,6 +42,7 @@ module PrelNames orderingTyCon_RDR, rationalTyCon_RDR, ratioTyCon_RDR, byteArrayTyCon_RDR, mutableByteArrayTyCon_RDR, foreignObjTyCon_RDR, + bcoPrimTyCon_RDR, intTyCon_RDR, stablePtrTyCon_RDR, stablePtrDataCon_RDR, int8TyCon_RDR, int16TyCon_RDR, int32TyCon_RDR, int64TyCon_RDR, word8TyCon_RDR, word16TyCon_RDR, word32TyCon_RDR, word64TyCon_RDR, @@ -182,6 +183,7 @@ byteArrayTyCon_RDR = tcQual pREL_BYTEARR_Name SLIT("ByteArray") mutableByteArrayTyCon_RDR = tcQual pREL_BYTEARR_Name SLIT("MutableByteArray") foreignObjTyCon_RDR = tcQual pREL_IO_BASE_Name SLIT("ForeignObj") +bcoPrimTyCon_RDR = tcQual pREL_BASE_Name SLIT("BCO#") stablePtrTyCon_RDR = tcQual pREL_STABLE_Name SLIT("StablePtr") stablePtrDataCon_RDR = dataQual pREL_STABLE_Name SLIT("StablePtr") deRefStablePtr_RDR = varQual pREL_STABLE_Name SLIT("deRefStablePtr") diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs index 34d49c7..9b7681f 100644 --- a/ghc/compiler/prelude/PrimOp.lhs +++ b/ghc/compiler/prelude/PrimOp.lhs @@ -29,16 +29,15 @@ import PrimRep -- most of it import TysPrim import TysWiredIn -import Demand ( Demand, wwLazy, wwPrim, wwStrict, StrictnessInfo(..) ) +import Demand ( wwLazy, wwPrim, wwStrict, StrictnessInfo(..) ) import Var ( TyVar, Id ) import CallConv ( CallConv, pprCallConv ) -import PprType ( pprParendType ) import Name ( Name, mkWiredInIdName ) import RdrName ( RdrName, mkRdrQual ) import OccName ( OccName, pprOccName, mkSrcVarOcc ) import TyCon ( TyCon, tyConArity ) -import Type ( Type, mkForAllTys, mkForAllTy, mkFunTy, mkFunTys, mkTyVarTys, - mkTyConTy, mkTyConApp, typePrimRep,mkTyVarTy, +import Type ( Type, mkForAllTys, mkFunTy, mkFunTys, mkTyVarTys, + mkTyConApp, typePrimRep, splitFunTy_maybe, splitAlgTyConApp_maybe, splitTyConApp_maybe, UsageAnn(..), mkUsgTy ) @@ -47,7 +46,7 @@ import BasicTypes ( Arity, Boxity(..) ) import CStrings ( CLabelString, pprCLabelString ) import PrelNames ( pREL_GHC, pREL_GHC_Name ) import Outputable -import Util ( assoc, zipWithEqual ) +import Util ( zipWithEqual ) import GlaExts ( Int(..), Int#, (==#) ) \end{code} @@ -60,183 +59,11 @@ import GlaExts ( Int(..), Int#, (==#) ) These are in \tr{state-interface.verb} order. \begin{code} -data PrimOp - -- dig the FORTRAN/C influence on the names... - - -- comparisons: - - = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp - | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp - | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp - | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp - | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp - | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp - - -- Char#-related ops: - | OrdOp | ChrOp - - -- Int#-related ops: - | IntAddOp | IntSubOp | IntMulOp | IntQuotOp - | IntRemOp | IntNegOp - | ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical} - | IntAddCOp - | IntSubCOp - | IntMulCOp - | IntGcdOp - - -- Word#-related ops: - | WordQuotOp | WordRemOp - | AndOp | OrOp | NotOp | XorOp - | SllOp | SrlOp -- shift {left,right} {logical} - | Int2WordOp | Word2IntOp -- casts - - -- Addr#-related ops: - | Int2AddrOp | Addr2IntOp -- casts - - -- Float#-related ops: - | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp - | Float2IntOp | Int2FloatOp - - | FloatExpOp | FloatLogOp | FloatSqrtOp - | FloatSinOp | FloatCosOp | FloatTanOp - | FloatAsinOp | FloatAcosOp | FloatAtanOp - | FloatSinhOp | FloatCoshOp | FloatTanhOp - -- not all machines have these available conveniently: - -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp - | FloatPowerOp -- ** op - - -- Double#-related ops: - | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp - | Double2IntOp | Int2DoubleOp - | Double2FloatOp | Float2DoubleOp - - | DoubleExpOp | DoubleLogOp | DoubleSqrtOp - | DoubleSinOp | DoubleCosOp | DoubleTanOp - | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp - | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp - -- not all machines have these available conveniently: - -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp - | DoublePowerOp -- ** op - - -- Integer (and related...) ops: - -- slightly weird -- to match GMP package. - | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerGcdOp - | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp - | IntegerIntGcdOp | IntegerDivExactOp - | IntegerQuotOp | IntegerRemOp - - | IntegerCmpOp - | IntegerCmpIntOp - - | Integer2IntOp | Integer2WordOp - | Int2IntegerOp | Word2IntegerOp - | Addr2IntegerOp - -- casting to/from Integer and 64-bit (un)signed quantities. - | IntegerToInt64Op | Int64ToIntegerOp - | IntegerToWord64Op | Word64ToIntegerOp - -- ?? gcd, etc? - - | FloatDecodeOp - | DoubleDecodeOp - - -- primitive ops for primitive arrays - - | NewArrayOp - | NewByteArrayOp PrimRep - - | SameMutableArrayOp - | SameMutableByteArrayOp - - | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs - - | ReadByteArrayOp PrimRep - | WriteByteArrayOp PrimRep - | IndexByteArrayOp PrimRep - | ReadOffAddrOp PrimRep - | WriteOffAddrOp PrimRep - | IndexOffAddrOp PrimRep - -- PrimRep can be one of : - -- {Char,Int,Word,Addr,Float,Double,StablePtr,Int64,Word64}Rep. - -- 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 - - | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp - | UnsafeThawArrayOp - | SizeofByteArrayOp | SizeofMutableByteArrayOp - - -- Mutable variables - | NewMutVarOp - | ReadMutVarOp - | WriteMutVarOp - | SameMutVarOp - - -- for MVars - | NewMVarOp - | TakeMVarOp - | PutMVarOp - | SameMVarOp - | TryTakeMVarOp - | IsEmptyMVarOp - - -- exceptions - | CatchOp - | RaiseOp - | BlockAsyncExceptionsOp - | UnblockAsyncExceptionsOp - - -- foreign objects - | MkForeignObjOp - | WriteForeignObjOp - - -- weak pointers - | MkWeakOp - | DeRefWeakOp - | FinalizeWeakOp - - -- stable names - | MakeStableNameOp - | EqStableNameOp - | StableNameToIntOp - - -- stable pointers - | MakeStablePtrOp - | DeRefStablePtrOp - | EqStablePtrOp - - -- Foreign calls - | CCallOp CCall - -- Operation to test two closure addresses for equality (yes really!) - -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT! - | ReallyUnsafePtrEqualityOp - - -- parallel stuff - | SeqOp - | ParOp - - -- concurrency - | ForkOp - | KillThreadOp - | YieldOp - | MyThreadIdOp - | DelayOp - | WaitReadOp - | WaitWriteOp - - -- more parallel stuff - | ParGlobalOp -- named global par - | ParLocalOp -- named local par - | ParAtOp -- specifies destination of local par - | ParAtAbsOp -- specifies destination of local par (abs processor) - | ParAtRelOp -- specifies destination of local par (rel processor) - | ParAtForNowOp -- specifies initial destination of global par - | CopyableOp -- marks copyable code - | NoFollowOp -- marks non-followup expression - - -- tag-related - | DataToTagOp - | TagToEnumOp + +-- supplies: +-- data PrimOp = ... +#include "primop-data-decl.hs" + | CCallOp CCall -- and don't forget to add CCall \end{code} Used for the Ord instance @@ -245,266 +72,12 @@ Used for the Ord instance primOpTag :: PrimOp -> Int primOpTag op = IBOX( tagOf_PrimOp op ) -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 IntGcdOp = ILIT( 43) -tagOf_PrimOp IntRemOp = ILIT( 44) -tagOf_PrimOp IntNegOp = ILIT( 45) -tagOf_PrimOp WordQuotOp = ILIT( 47) -tagOf_PrimOp WordRemOp = ILIT( 48) -tagOf_PrimOp AndOp = ILIT( 49) -tagOf_PrimOp OrOp = ILIT( 50) -tagOf_PrimOp NotOp = ILIT( 51) -tagOf_PrimOp XorOp = ILIT( 52) -tagOf_PrimOp SllOp = ILIT( 53) -tagOf_PrimOp SrlOp = ILIT( 54) -tagOf_PrimOp ISllOp = ILIT( 55) -tagOf_PrimOp ISraOp = ILIT( 56) -tagOf_PrimOp ISrlOp = ILIT( 57) -tagOf_PrimOp IntAddCOp = ILIT( 58) -tagOf_PrimOp IntSubCOp = ILIT( 59) -tagOf_PrimOp IntMulCOp = ILIT( 60) -tagOf_PrimOp Int2WordOp = ILIT( 61) -tagOf_PrimOp Word2IntOp = ILIT( 62) -tagOf_PrimOp Int2AddrOp = ILIT( 63) -tagOf_PrimOp Addr2IntOp = ILIT( 64) -tagOf_PrimOp FloatAddOp = ILIT( 65) -tagOf_PrimOp FloatSubOp = ILIT( 66) -tagOf_PrimOp FloatMulOp = ILIT( 67) -tagOf_PrimOp FloatDivOp = ILIT( 68) -tagOf_PrimOp FloatNegOp = ILIT( 69) -tagOf_PrimOp Float2IntOp = ILIT( 70) -tagOf_PrimOp Int2FloatOp = ILIT( 71) -tagOf_PrimOp FloatExpOp = ILIT( 72) -tagOf_PrimOp FloatLogOp = ILIT( 73) -tagOf_PrimOp FloatSqrtOp = ILIT( 74) -tagOf_PrimOp FloatSinOp = ILIT( 75) -tagOf_PrimOp FloatCosOp = ILIT( 76) -tagOf_PrimOp FloatTanOp = ILIT( 77) -tagOf_PrimOp FloatAsinOp = ILIT( 78) -tagOf_PrimOp FloatAcosOp = ILIT( 79) -tagOf_PrimOp FloatAtanOp = ILIT( 80) -tagOf_PrimOp FloatSinhOp = ILIT( 81) -tagOf_PrimOp FloatCoshOp = ILIT( 82) -tagOf_PrimOp FloatTanhOp = ILIT( 83) -tagOf_PrimOp FloatPowerOp = ILIT( 84) -tagOf_PrimOp DoubleAddOp = ILIT( 85) -tagOf_PrimOp DoubleSubOp = ILIT( 86) -tagOf_PrimOp DoubleMulOp = ILIT( 87) -tagOf_PrimOp DoubleDivOp = ILIT( 88) -tagOf_PrimOp DoubleNegOp = ILIT( 89) -tagOf_PrimOp Double2IntOp = ILIT( 90) -tagOf_PrimOp Int2DoubleOp = ILIT( 91) -tagOf_PrimOp Double2FloatOp = ILIT( 92) -tagOf_PrimOp Float2DoubleOp = ILIT( 93) -tagOf_PrimOp DoubleExpOp = ILIT( 94) -tagOf_PrimOp DoubleLogOp = ILIT( 95) -tagOf_PrimOp DoubleSqrtOp = ILIT( 96) -tagOf_PrimOp DoubleSinOp = ILIT( 97) -tagOf_PrimOp DoubleCosOp = ILIT( 98) -tagOf_PrimOp DoubleTanOp = ILIT( 99) -tagOf_PrimOp DoubleAsinOp = ILIT(100) -tagOf_PrimOp DoubleAcosOp = ILIT(101) -tagOf_PrimOp DoubleAtanOp = ILIT(102) -tagOf_PrimOp DoubleSinhOp = ILIT(103) -tagOf_PrimOp DoubleCoshOp = ILIT(104) -tagOf_PrimOp DoubleTanhOp = ILIT(105) -tagOf_PrimOp DoublePowerOp = ILIT(106) -tagOf_PrimOp IntegerAddOp = ILIT(107) -tagOf_PrimOp IntegerSubOp = ILIT(108) -tagOf_PrimOp IntegerMulOp = ILIT(109) -tagOf_PrimOp IntegerGcdOp = ILIT(110) -tagOf_PrimOp IntegerIntGcdOp = ILIT(111) -tagOf_PrimOp IntegerDivExactOp = ILIT(112) -tagOf_PrimOp IntegerQuotOp = ILIT(113) -tagOf_PrimOp IntegerRemOp = ILIT(114) -tagOf_PrimOp IntegerQuotRemOp = ILIT(115) -tagOf_PrimOp IntegerDivModOp = ILIT(116) -tagOf_PrimOp IntegerNegOp = ILIT(117) -tagOf_PrimOp IntegerCmpOp = ILIT(118) -tagOf_PrimOp IntegerCmpIntOp = ILIT(119) -tagOf_PrimOp Integer2IntOp = ILIT(120) -tagOf_PrimOp Integer2WordOp = ILIT(121) -tagOf_PrimOp Int2IntegerOp = ILIT(122) -tagOf_PrimOp Word2IntegerOp = ILIT(123) -tagOf_PrimOp Addr2IntegerOp = ILIT(125) -tagOf_PrimOp IntegerToInt64Op = ILIT(127) -tagOf_PrimOp Int64ToIntegerOp = ILIT(128) -tagOf_PrimOp IntegerToWord64Op = ILIT(129) -tagOf_PrimOp Word64ToIntegerOp = ILIT(130) -tagOf_PrimOp FloatDecodeOp = ILIT(131) -tagOf_PrimOp DoubleDecodeOp = ILIT(132) -tagOf_PrimOp NewArrayOp = ILIT(133) -tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(134) -tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(135) -tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(136) -tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(137) -tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(138) -tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(139) -tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(140) -tagOf_PrimOp SameMutableArrayOp = ILIT(141) -tagOf_PrimOp SameMutableByteArrayOp = ILIT(142) -tagOf_PrimOp ReadArrayOp = ILIT(143) -tagOf_PrimOp WriteArrayOp = ILIT(144) -tagOf_PrimOp IndexArrayOp = ILIT(145) -tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(146) -tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(147) -tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(148) -tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(149) -tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(150) -tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(151) -tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(152) -tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(153) -tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(154) -tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(155) -tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(156) -tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(157) -tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(158) -tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(159) -tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(160) -tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(161) -tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(162) -tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(163) -tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(164) -tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(165) -tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(166) -tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(167) -tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(168) -tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(169) -tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(170) -tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(171) -tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(172) -tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(173) -tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(174) -tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(175) -tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(176) -tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(177) -tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(178) -tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(179) -tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(180) -tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(181) -tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(182) -tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(183) -tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(184) -tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(185) -tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(186) -tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(187) -tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(188) -tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(189) -tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(190) -tagOf_PrimOp (ReadOffAddrOp CharRep) = ILIT(191) -tagOf_PrimOp (ReadOffAddrOp IntRep) = ILIT(192) -tagOf_PrimOp (ReadOffAddrOp WordRep) = ILIT(193) -tagOf_PrimOp (ReadOffAddrOp AddrRep) = ILIT(194) -tagOf_PrimOp (ReadOffAddrOp FloatRep) = ILIT(195) -tagOf_PrimOp (ReadOffAddrOp DoubleRep) = ILIT(196) -tagOf_PrimOp (ReadOffAddrOp StablePtrRep) = ILIT(197) -tagOf_PrimOp (ReadOffAddrOp ForeignObjRep) = ILIT(198) -tagOf_PrimOp (ReadOffAddrOp Int64Rep) = ILIT(199) -tagOf_PrimOp (ReadOffAddrOp Word64Rep) = ILIT(200) -tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(201) -tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(202) -tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(203) -tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(205) -tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(206) -tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(207) -tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(208) -tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(209) -tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(210) -tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(211) -tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(212) -tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(213) -tagOf_PrimOp UnsafeThawArrayOp = ILIT(214) -tagOf_PrimOp SizeofByteArrayOp = ILIT(215) -tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(216) -tagOf_PrimOp NewMVarOp = ILIT(217) -tagOf_PrimOp TakeMVarOp = ILIT(218) -tagOf_PrimOp PutMVarOp = ILIT(219) -tagOf_PrimOp SameMVarOp = ILIT(220) -tagOf_PrimOp TryTakeMVarOp = ILIT(221) -tagOf_PrimOp IsEmptyMVarOp = ILIT(222) -tagOf_PrimOp MkForeignObjOp = ILIT(223) -tagOf_PrimOp WriteForeignObjOp = ILIT(224) -tagOf_PrimOp MkWeakOp = ILIT(225) -tagOf_PrimOp DeRefWeakOp = ILIT(226) -tagOf_PrimOp FinalizeWeakOp = ILIT(227) -tagOf_PrimOp MakeStableNameOp = ILIT(228) -tagOf_PrimOp EqStableNameOp = ILIT(229) -tagOf_PrimOp StableNameToIntOp = ILIT(230) -tagOf_PrimOp MakeStablePtrOp = ILIT(231) -tagOf_PrimOp DeRefStablePtrOp = ILIT(232) -tagOf_PrimOp EqStablePtrOp = ILIT(234) -tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(235) -tagOf_PrimOp SeqOp = ILIT(236) -tagOf_PrimOp ParOp = ILIT(237) -tagOf_PrimOp ForkOp = ILIT(238) -tagOf_PrimOp KillThreadOp = ILIT(239) -tagOf_PrimOp YieldOp = ILIT(240) -tagOf_PrimOp MyThreadIdOp = ILIT(241) -tagOf_PrimOp DelayOp = ILIT(242) -tagOf_PrimOp WaitReadOp = ILIT(243) -tagOf_PrimOp WaitWriteOp = ILIT(244) -tagOf_PrimOp ParGlobalOp = ILIT(245) -tagOf_PrimOp ParLocalOp = ILIT(246) -tagOf_PrimOp ParAtOp = ILIT(247) -tagOf_PrimOp ParAtAbsOp = ILIT(248) -tagOf_PrimOp ParAtRelOp = ILIT(249) -tagOf_PrimOp ParAtForNowOp = ILIT(250) -tagOf_PrimOp CopyableOp = ILIT(251) -tagOf_PrimOp NoFollowOp = ILIT(252) -tagOf_PrimOp NewMutVarOp = ILIT(253) -tagOf_PrimOp ReadMutVarOp = ILIT(254) -tagOf_PrimOp WriteMutVarOp = ILIT(255) -tagOf_PrimOp SameMutVarOp = ILIT(256) -tagOf_PrimOp CatchOp = ILIT(257) -tagOf_PrimOp RaiseOp = ILIT(258) -tagOf_PrimOp BlockAsyncExceptionsOp = ILIT(259) -tagOf_PrimOp UnblockAsyncExceptionsOp = ILIT(260) -tagOf_PrimOp DataToTagOp = ILIT(261) -tagOf_PrimOp TagToEnumOp = ILIT(262) - +-- supplies +-- tagOf_PrimOp :: PrimOp -> FAST_INT +#include "primop-tag.hs" tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op) + instance Eq PrimOp where op1 == op2 = tagOf_PrimOp op1 _EQ_ tagOf_PrimOp op2 @@ -526,266 +99,10 @@ instance Show PrimOp where An @Enum@-derived list would be better; meanwhile... (ToDo) \begin{code} -allThePrimOps -- Except CCall, which is really a family of primops - = [ CharGtOp, - CharGeOp, - CharEqOp, - CharNeOp, - CharLtOp, - CharLeOp, - IntGtOp, - IntGeOp, - IntEqOp, - IntNeOp, - IntLtOp, - IntLeOp, - WordGtOp, - WordGeOp, - WordEqOp, - WordNeOp, - WordLtOp, - WordLeOp, - AddrGtOp, - AddrGeOp, - AddrEqOp, - AddrNeOp, - AddrLtOp, - AddrLeOp, - FloatGtOp, - FloatGeOp, - FloatEqOp, - FloatNeOp, - FloatLtOp, - FloatLeOp, - DoubleGtOp, - DoubleGeOp, - DoubleEqOp, - DoubleNeOp, - DoubleLtOp, - DoubleLeOp, - OrdOp, - ChrOp, - IntAddOp, - IntSubOp, - IntMulOp, - IntQuotOp, - IntRemOp, - IntGcdOp, - IntNegOp, - WordQuotOp, - WordRemOp, - AndOp, - OrOp, - NotOp, - XorOp, - SllOp, - SrlOp, - ISllOp, - ISraOp, - ISrlOp, - IntAddCOp, - IntSubCOp, - IntMulCOp, - Int2WordOp, - Word2IntOp, - Int2AddrOp, - Addr2IntOp, - - FloatAddOp, - FloatSubOp, - FloatMulOp, - FloatDivOp, - FloatNegOp, - Float2IntOp, - Int2FloatOp, - FloatExpOp, - FloatLogOp, - FloatSqrtOp, - FloatSinOp, - FloatCosOp, - FloatTanOp, - FloatAsinOp, - FloatAcosOp, - FloatAtanOp, - FloatSinhOp, - FloatCoshOp, - FloatTanhOp, - FloatPowerOp, - DoubleAddOp, - DoubleSubOp, - DoubleMulOp, - DoubleDivOp, - DoubleNegOp, - Double2IntOp, - Int2DoubleOp, - Double2FloatOp, - Float2DoubleOp, - DoubleExpOp, - DoubleLogOp, - DoubleSqrtOp, - DoubleSinOp, - DoubleCosOp, - DoubleTanOp, - DoubleAsinOp, - DoubleAcosOp, - DoubleAtanOp, - DoubleSinhOp, - DoubleCoshOp, - DoubleTanhOp, - DoublePowerOp, - IntegerAddOp, - IntegerSubOp, - IntegerMulOp, - IntegerGcdOp, - IntegerIntGcdOp, - IntegerDivExactOp, - IntegerQuotOp, - IntegerRemOp, - IntegerQuotRemOp, - IntegerDivModOp, - IntegerNegOp, - IntegerCmpOp, - IntegerCmpIntOp, - Integer2IntOp, - Integer2WordOp, - Int2IntegerOp, - Word2IntegerOp, - Addr2IntegerOp, - IntegerToInt64Op, - Int64ToIntegerOp, - IntegerToWord64Op, - Word64ToIntegerOp, - FloatDecodeOp, - DoubleDecodeOp, - NewArrayOp, - NewByteArrayOp CharRep, - NewByteArrayOp IntRep, - NewByteArrayOp WordRep, - NewByteArrayOp AddrRep, - NewByteArrayOp FloatRep, - NewByteArrayOp DoubleRep, - NewByteArrayOp StablePtrRep, - SameMutableArrayOp, - SameMutableByteArrayOp, - ReadArrayOp, - WriteArrayOp, - IndexArrayOp, - ReadByteArrayOp CharRep, - ReadByteArrayOp IntRep, - ReadByteArrayOp WordRep, - ReadByteArrayOp AddrRep, - ReadByteArrayOp FloatRep, - ReadByteArrayOp DoubleRep, - ReadByteArrayOp StablePtrRep, - ReadByteArrayOp Int64Rep, - ReadByteArrayOp Word64Rep, - WriteByteArrayOp CharRep, - WriteByteArrayOp IntRep, - WriteByteArrayOp WordRep, - WriteByteArrayOp AddrRep, - WriteByteArrayOp FloatRep, - WriteByteArrayOp DoubleRep, - WriteByteArrayOp StablePtrRep, - WriteByteArrayOp Int64Rep, - WriteByteArrayOp Word64Rep, - IndexByteArrayOp CharRep, - IndexByteArrayOp IntRep, - IndexByteArrayOp WordRep, - IndexByteArrayOp AddrRep, - IndexByteArrayOp FloatRep, - IndexByteArrayOp DoubleRep, - IndexByteArrayOp StablePtrRep, - IndexByteArrayOp Int64Rep, - IndexByteArrayOp Word64Rep, - IndexOffForeignObjOp CharRep, - IndexOffForeignObjOp AddrRep, - IndexOffForeignObjOp IntRep, - IndexOffForeignObjOp WordRep, - IndexOffForeignObjOp FloatRep, - IndexOffForeignObjOp DoubleRep, - IndexOffForeignObjOp StablePtrRep, - IndexOffForeignObjOp Int64Rep, - IndexOffForeignObjOp Word64Rep, - IndexOffAddrOp CharRep, - IndexOffAddrOp IntRep, - IndexOffAddrOp WordRep, - IndexOffAddrOp AddrRep, - IndexOffAddrOp FloatRep, - IndexOffAddrOp DoubleRep, - IndexOffAddrOp StablePtrRep, - IndexOffAddrOp Int64Rep, - IndexOffAddrOp Word64Rep, - ReadOffAddrOp CharRep, - ReadOffAddrOp IntRep, - ReadOffAddrOp WordRep, - ReadOffAddrOp AddrRep, - ReadOffAddrOp FloatRep, - ReadOffAddrOp DoubleRep, - ReadOffAddrOp ForeignObjRep, - ReadOffAddrOp StablePtrRep, - ReadOffAddrOp Int64Rep, - ReadOffAddrOp Word64Rep, - WriteOffAddrOp CharRep, - WriteOffAddrOp IntRep, - WriteOffAddrOp WordRep, - WriteOffAddrOp AddrRep, - WriteOffAddrOp FloatRep, - WriteOffAddrOp DoubleRep, - WriteOffAddrOp ForeignObjRep, - WriteOffAddrOp StablePtrRep, - WriteOffAddrOp Int64Rep, - WriteOffAddrOp Word64Rep, - UnsafeFreezeArrayOp, - UnsafeFreezeByteArrayOp, - UnsafeThawArrayOp, - SizeofByteArrayOp, - SizeofMutableByteArrayOp, - NewMutVarOp, - ReadMutVarOp, - WriteMutVarOp, - SameMutVarOp, - CatchOp, - RaiseOp, - BlockAsyncExceptionsOp, - UnblockAsyncExceptionsOp, - NewMVarOp, - TakeMVarOp, - PutMVarOp, - SameMVarOp, - TryTakeMVarOp, - IsEmptyMVarOp, - MkForeignObjOp, - WriteForeignObjOp, - MkWeakOp, - DeRefWeakOp, - FinalizeWeakOp, - MakeStableNameOp, - EqStableNameOp, - StableNameToIntOp, - MakeStablePtrOp, - DeRefStablePtrOp, - EqStablePtrOp, - ReallyUnsafePtrEqualityOp, - ParGlobalOp, - ParLocalOp, - ParAtOp, - ParAtAbsOp, - ParAtRelOp, - ParAtForNowOp, - CopyableOp, - NoFollowOp, - SeqOp, - ParOp, - ForkOp, - KillThreadOp, - YieldOp, - MyThreadIdOp, - DelayOp, - WaitReadOp, - WaitWriteOp, - DataToTagOp, - TagToEnumOp - ] +allThePrimOps :: [PrimOp] +allThePrimOps = +#include "primop-list.hs" +-- Doesn't include CCall, which is really a family of primops \end{code} %************************************************************************ @@ -823,36 +140,6 @@ mkCompare str ty = Compare (mkSrcVarOcc str) ty mkGenPrimOp str tvs tys ty = GenPrimOp (mkSrcVarOcc str) tvs tys ty \end{code} -Utility bits: -\begin{code} -one_Integer_ty = [intPrimTy, byteArrayPrimTy] -two_Integer_tys - = [intPrimTy, byteArrayPrimTy, -- first Integer pieces - intPrimTy, byteArrayPrimTy] -- second '' pieces -an_Integer_and_Int_tys - = [intPrimTy, byteArrayPrimTy, -- Integer - intPrimTy] - -unboxedSingleton = mkTupleTy Unboxed 1 -unboxedPair = mkTupleTy Unboxed 2 -unboxedTriple = mkTupleTy Unboxed 3 -unboxedQuadruple = mkTupleTy Unboxed 4 - -mkIOTy ty = mkFunTy realWorldStatePrimTy - (unboxedPair [realWorldStatePrimTy,ty]) - -integerMonadic name = mkGenPrimOp name [] one_Integer_ty - (unboxedPair one_Integer_ty) - -integerDyadic name = mkGenPrimOp name [] two_Integer_tys - (unboxedPair one_Integer_ty) - -integerDyadic2Results name = mkGenPrimOp name [] two_Integer_tys - (unboxedQuadruple two_Integer_tys) - -integerCompare name = mkGenPrimOp name [] two_Integer_tys intPrimTy -\end{code} - %************************************************************************ %* * \subsubsection{Strictness} @@ -862,45 +149,11 @@ integerCompare name = mkGenPrimOp name [] two_Integer_tys intPrimTy Not all primops are strict! \begin{code} -primOpStrictness :: Arity -> PrimOp -> StrictnessInfo +primOpStrictness :: PrimOp -> Arity -> StrictnessInfo -- See Demand.StrictnessInfo for discussion of what the results -- The arity should be the arity of the primop; that's why -- this function isn't exported. - -primOpStrictness arity SeqOp = StrictnessInfo [wwStrict] False - -- Seq is strict in its argument; see notes in ConFold.lhs - -primOpStrictness arity ParOp = StrictnessInfo [wwLazy] False - -- Note that Par is lazy to avoid that the sparked thing - -- gets evaluted strictly, which it should *not* be - -primOpStrictness arity ForkOp = StrictnessInfo [wwLazy, wwPrim] False - -primOpStrictness arity NewArrayOp = StrictnessInfo [wwPrim, wwLazy, wwPrim] False -primOpStrictness arity WriteArrayOp = StrictnessInfo [wwPrim, wwPrim, wwLazy, wwPrim] False - -primOpStrictness arity NewMutVarOp = StrictnessInfo [wwLazy, wwPrim] False -primOpStrictness arity WriteMutVarOp = StrictnessInfo [wwPrim, wwLazy, wwPrim] False - -primOpStrictness arity PutMVarOp = StrictnessInfo [wwPrim, wwLazy, wwPrim] False - -primOpStrictness arity CatchOp = StrictnessInfo [wwLazy, wwLazy, wwPrim] False - -- Catch is actually strict in its first argument - -- but we don't want to tell the strictness - -- analyser about that! - -primOpStrictness arity RaiseOp = StrictnessInfo [wwLazy] True -- NB: True => result is bottom -primOpStrictness arity BlockAsyncExceptionsOp = StrictnessInfo [wwLazy] False -primOpStrictness arity UnblockAsyncExceptionsOp = StrictnessInfo [wwLazy] False - -primOpStrictness arity MkWeakOp = StrictnessInfo [wwLazy, wwLazy, wwLazy, wwPrim] False -primOpStrictness arity MakeStableNameOp = StrictnessInfo [wwLazy, wwPrim] False -primOpStrictness arity MakeStablePtrOp = StrictnessInfo [wwLazy, wwPrim] False - -primOpStrictness arity DataToTagOp = StrictnessInfo [wwLazy] False - - -- The rest all have primitive-typed arguments -primOpStrictness arity other = StrictnessInfo (replicate arity wwPrim) False +#include "primop-strictness.hs" \end{code} %************************************************************************ @@ -914,725 +167,20 @@ else, notably a type, can be constructed) for each @PrimOp@. \begin{code} primOpInfo :: PrimOp -> PrimOpInfo +#include "primop-primop-info.hs" \end{code} -There's plenty of this stuff! - -\begin{code} -primOpInfo CharGtOp = mkCompare SLIT("gtChar#") charPrimTy -primOpInfo CharGeOp = mkCompare SLIT("geChar#") charPrimTy -primOpInfo CharEqOp = mkCompare SLIT("eqChar#") charPrimTy -primOpInfo CharNeOp = mkCompare SLIT("neChar#") charPrimTy -primOpInfo CharLtOp = mkCompare SLIT("ltChar#") charPrimTy -primOpInfo CharLeOp = mkCompare SLIT("leChar#") charPrimTy - -primOpInfo IntGtOp = mkCompare SLIT(">#") intPrimTy -primOpInfo IntGeOp = mkCompare SLIT(">=#") intPrimTy -primOpInfo IntEqOp = mkCompare SLIT("==#") intPrimTy -primOpInfo IntNeOp = mkCompare SLIT("/=#") intPrimTy -primOpInfo IntLtOp = mkCompare SLIT("<#") intPrimTy -primOpInfo IntLeOp = mkCompare SLIT("<=#") intPrimTy - -primOpInfo WordGtOp = mkCompare SLIT("gtWord#") wordPrimTy -primOpInfo WordGeOp = mkCompare SLIT("geWord#") wordPrimTy -primOpInfo WordEqOp = mkCompare SLIT("eqWord#") wordPrimTy -primOpInfo WordNeOp = mkCompare SLIT("neWord#") wordPrimTy -primOpInfo WordLtOp = mkCompare SLIT("ltWord#") wordPrimTy -primOpInfo WordLeOp = mkCompare SLIT("leWord#") wordPrimTy - -primOpInfo AddrGtOp = mkCompare SLIT("gtAddr#") addrPrimTy -primOpInfo AddrGeOp = mkCompare SLIT("geAddr#") addrPrimTy -primOpInfo AddrEqOp = mkCompare SLIT("eqAddr#") addrPrimTy -primOpInfo AddrNeOp = mkCompare SLIT("neAddr#") addrPrimTy -primOpInfo AddrLtOp = mkCompare SLIT("ltAddr#") addrPrimTy -primOpInfo AddrLeOp = mkCompare SLIT("leAddr#") addrPrimTy - -primOpInfo FloatGtOp = mkCompare SLIT("gtFloat#") floatPrimTy -primOpInfo FloatGeOp = mkCompare SLIT("geFloat#") floatPrimTy -primOpInfo FloatEqOp = mkCompare SLIT("eqFloat#") floatPrimTy -primOpInfo FloatNeOp = mkCompare SLIT("neFloat#") floatPrimTy -primOpInfo FloatLtOp = mkCompare SLIT("ltFloat#") floatPrimTy -primOpInfo FloatLeOp = mkCompare SLIT("leFloat#") floatPrimTy - -primOpInfo DoubleGtOp = mkCompare SLIT(">##") doublePrimTy -primOpInfo DoubleGeOp = mkCompare SLIT(">=##") doublePrimTy -primOpInfo DoubleEqOp = mkCompare SLIT("==##") doublePrimTy -primOpInfo DoubleNeOp = mkCompare SLIT("/=##") doublePrimTy -primOpInfo DoubleLtOp = mkCompare SLIT("<##") doublePrimTy -primOpInfo DoubleLeOp = mkCompare SLIT("<=##") doublePrimTy - -\end{code} - -%************************************************************************ -%* * -\subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s} -%* * -%************************************************************************ - -\begin{code} -primOpInfo OrdOp = mkGenPrimOp SLIT("ord#") [] [charPrimTy] intPrimTy -primOpInfo ChrOp = mkGenPrimOp SLIT("chr#") [] [intPrimTy] charPrimTy -\end{code} - -%************************************************************************ -%* * -\subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s} -%* * -%************************************************************************ - -\begin{code} -primOpInfo IntAddOp = mkDyadic SLIT("+#") intPrimTy -primOpInfo IntSubOp = mkDyadic SLIT("-#") intPrimTy -primOpInfo IntMulOp = mkDyadic SLIT("*#") intPrimTy -primOpInfo IntQuotOp = mkDyadic SLIT("quotInt#") intPrimTy -primOpInfo IntRemOp = mkDyadic SLIT("remInt#") intPrimTy -primOpInfo IntGcdOp = mkDyadic SLIT("gcdInt#") intPrimTy - -primOpInfo IntNegOp = mkMonadic SLIT("negateInt#") intPrimTy - -primOpInfo IntAddCOp = - mkGenPrimOp SLIT("addIntC#") [] [intPrimTy, intPrimTy] - (unboxedPair [intPrimTy, intPrimTy]) - -primOpInfo IntSubCOp = - mkGenPrimOp SLIT("subIntC#") [] [intPrimTy, intPrimTy] - (unboxedPair [intPrimTy, intPrimTy]) - -primOpInfo IntMulCOp = - mkGenPrimOp SLIT("mulIntC#") [] [intPrimTy, intPrimTy] - (unboxedPair [intPrimTy, intPrimTy]) -\end{code} - -%************************************************************************ -%* * -\subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s} -%* * -%************************************************************************ +Here are a load of comments from the old primOp info: A @Word#@ is an unsigned @Int#@. -\begin{code} -primOpInfo WordQuotOp = mkDyadic SLIT("quotWord#") wordPrimTy -primOpInfo WordRemOp = mkDyadic SLIT("remWord#") wordPrimTy - -primOpInfo AndOp = mkDyadic SLIT("and#") wordPrimTy -primOpInfo OrOp = mkDyadic SLIT("or#") wordPrimTy -primOpInfo XorOp = mkDyadic SLIT("xor#") wordPrimTy -primOpInfo NotOp = mkMonadic SLIT("not#") wordPrimTy - -primOpInfo SllOp - = mkGenPrimOp SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTy -primOpInfo SrlOp - = mkGenPrimOp SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTy - -primOpInfo ISllOp - = mkGenPrimOp SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTy -primOpInfo ISraOp - = mkGenPrimOp SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTy -primOpInfo ISrlOp - = mkGenPrimOp SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTy - -primOpInfo Int2WordOp = mkGenPrimOp SLIT("int2Word#") [] [intPrimTy] wordPrimTy -primOpInfo Word2IntOp = mkGenPrimOp SLIT("word2Int#") [] [wordPrimTy] intPrimTy -\end{code} - -%************************************************************************ -%* * -\subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s} -%* * -%************************************************************************ - -\begin{code} -primOpInfo Int2AddrOp = mkGenPrimOp SLIT("int2Addr#") [] [intPrimTy] addrPrimTy -primOpInfo Addr2IntOp = mkGenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy -\end{code} - - -%************************************************************************ -%* * -\subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s} -%* * -%************************************************************************ - @decodeFloat#@ is given w/ Integer-stuff (it's similar). -\begin{code} -primOpInfo FloatAddOp = mkDyadic SLIT("plusFloat#") floatPrimTy -primOpInfo FloatSubOp = mkDyadic SLIT("minusFloat#") floatPrimTy -primOpInfo FloatMulOp = mkDyadic SLIT("timesFloat#") floatPrimTy -primOpInfo FloatDivOp = mkDyadic SLIT("divideFloat#") floatPrimTy -primOpInfo FloatNegOp = mkMonadic SLIT("negateFloat#") floatPrimTy - -primOpInfo Float2IntOp = mkGenPrimOp SLIT("float2Int#") [] [floatPrimTy] intPrimTy -primOpInfo Int2FloatOp = mkGenPrimOp SLIT("int2Float#") [] [intPrimTy] floatPrimTy - -primOpInfo FloatExpOp = mkMonadic SLIT("expFloat#") floatPrimTy -primOpInfo FloatLogOp = mkMonadic SLIT("logFloat#") floatPrimTy -primOpInfo FloatSqrtOp = mkMonadic SLIT("sqrtFloat#") floatPrimTy -primOpInfo FloatSinOp = mkMonadic SLIT("sinFloat#") floatPrimTy -primOpInfo FloatCosOp = mkMonadic SLIT("cosFloat#") floatPrimTy -primOpInfo FloatTanOp = mkMonadic SLIT("tanFloat#") floatPrimTy -primOpInfo FloatAsinOp = mkMonadic SLIT("asinFloat#") floatPrimTy -primOpInfo FloatAcosOp = mkMonadic SLIT("acosFloat#") floatPrimTy -primOpInfo FloatAtanOp = mkMonadic SLIT("atanFloat#") floatPrimTy -primOpInfo FloatSinhOp = mkMonadic SLIT("sinhFloat#") floatPrimTy -primOpInfo FloatCoshOp = mkMonadic SLIT("coshFloat#") floatPrimTy -primOpInfo FloatTanhOp = mkMonadic SLIT("tanhFloat#") floatPrimTy -primOpInfo FloatPowerOp = mkDyadic SLIT("powerFloat#") floatPrimTy -\end{code} - -%************************************************************************ -%* * -\subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s} -%* * -%************************************************************************ - @decodeDouble#@ is given w/ Integer-stuff (it's similar). -\begin{code} -primOpInfo DoubleAddOp = mkDyadic SLIT("+##") doublePrimTy -primOpInfo DoubleSubOp = mkDyadic SLIT("-##") doublePrimTy -primOpInfo DoubleMulOp = mkDyadic SLIT("*##") doublePrimTy -primOpInfo DoubleDivOp = mkDyadic SLIT("/##") doublePrimTy -primOpInfo DoubleNegOp = mkMonadic SLIT("negateDouble#") doublePrimTy - -primOpInfo Double2IntOp = mkGenPrimOp SLIT("double2Int#") [] [doublePrimTy] intPrimTy -primOpInfo Int2DoubleOp = mkGenPrimOp SLIT("int2Double#") [] [intPrimTy] doublePrimTy - -primOpInfo Double2FloatOp = mkGenPrimOp SLIT("double2Float#") [] [doublePrimTy] floatPrimTy -primOpInfo Float2DoubleOp = mkGenPrimOp SLIT("float2Double#") [] [floatPrimTy] doublePrimTy - -primOpInfo DoubleExpOp = mkMonadic SLIT("expDouble#") doublePrimTy -primOpInfo DoubleLogOp = mkMonadic SLIT("logDouble#") doublePrimTy -primOpInfo DoubleSqrtOp = mkMonadic SLIT("sqrtDouble#") doublePrimTy -primOpInfo DoubleSinOp = mkMonadic SLIT("sinDouble#") doublePrimTy -primOpInfo DoubleCosOp = mkMonadic SLIT("cosDouble#") doublePrimTy -primOpInfo DoubleTanOp = mkMonadic SLIT("tanDouble#") doublePrimTy -primOpInfo DoubleAsinOp = mkMonadic SLIT("asinDouble#") doublePrimTy -primOpInfo DoubleAcosOp = mkMonadic SLIT("acosDouble#") doublePrimTy -primOpInfo DoubleAtanOp = mkMonadic SLIT("atanDouble#") doublePrimTy -primOpInfo DoubleSinhOp = mkMonadic SLIT("sinhDouble#") doublePrimTy -primOpInfo DoubleCoshOp = mkMonadic SLIT("coshDouble#") doublePrimTy -primOpInfo DoubleTanhOp = mkMonadic SLIT("tanhDouble#") doublePrimTy -primOpInfo DoublePowerOp= mkDyadic SLIT("**##") doublePrimTy -\end{code} - -%************************************************************************ -%* * -\subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)} -%* * -%************************************************************************ - -\begin{code} -primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#") - -primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#") -primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#") -primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#") -primOpInfo IntegerGcdOp = integerDyadic SLIT("gcdInteger#") -primOpInfo IntegerIntGcdOp = mkGenPrimOp SLIT("gcdIntegerInt#") [] an_Integer_and_Int_tys intPrimTy -primOpInfo IntegerDivExactOp = integerDyadic SLIT("divExactInteger#") -primOpInfo IntegerQuotOp = integerDyadic SLIT("quotInteger#") -primOpInfo IntegerRemOp = integerDyadic SLIT("remInteger#") - -primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#") -primOpInfo IntegerCmpIntOp - = mkGenPrimOp SLIT("cmpIntegerInt#") [] an_Integer_and_Int_tys intPrimTy - -primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#") -primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#") - -primOpInfo Integer2IntOp - = mkGenPrimOp SLIT("integer2Int#") [] one_Integer_ty intPrimTy - -primOpInfo Integer2WordOp - = mkGenPrimOp SLIT("integer2Word#") [] one_Integer_ty wordPrimTy - -primOpInfo Int2IntegerOp - = mkGenPrimOp SLIT("int2Integer#") [] [intPrimTy] - (unboxedPair one_Integer_ty) - -primOpInfo Word2IntegerOp - = mkGenPrimOp SLIT("word2Integer#") [] [wordPrimTy] - (unboxedPair one_Integer_ty) - -primOpInfo Addr2IntegerOp - = mkGenPrimOp SLIT("addr2Integer#") [] [addrPrimTy] - (unboxedPair one_Integer_ty) - -primOpInfo IntegerToInt64Op - = mkGenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy - -primOpInfo Int64ToIntegerOp - = mkGenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy] - (unboxedPair one_Integer_ty) - -primOpInfo Word64ToIntegerOp - = mkGenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy] - (unboxedPair one_Integer_ty) - -primOpInfo IntegerToWord64Op - = mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy -\end{code} - Decoding of floating-point numbers is sorta Integer-related. Encoding is done with plain ccalls now (see PrelNumExtra.lhs). -\begin{code} -primOpInfo FloatDecodeOp - = mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy] - (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy]) -primOpInfo DoubleDecodeOp - = mkGenPrimOp SLIT("decodeDouble#") [] [doublePrimTy] - (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy]) -\end{code} - -%************************************************************************ -%* * -\subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays} -%* * -%************************************************************************ - -\begin{verbatim} -newArray# :: Int# -> a -> State# s -> (# State# s, MutArr# s a #) -newFooArray# :: Int# -> State# s -> (# State# s, MutByteArr# s #) -\end{verbatim} - -\begin{code} -primOpInfo NewArrayOp - = let { - elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar; - state = mkStatePrimTy s - } in - mkGenPrimOp SLIT("newArray#") [s_tv, elt_tv] - [intPrimTy, elt, state] - (unboxedPair [state, mkMutableArrayPrimTy s elt]) - -primOpInfo (NewByteArrayOp kind) - = let - s = alphaTy; s_tv = alphaTyVar - - op_str = _PK_ ("new" ++ primRepString kind ++ "Array#") - state = mkStatePrimTy s - in - mkGenPrimOp op_str [s_tv] - [intPrimTy, state] - (unboxedPair [state, mkMutableByteArrayPrimTy s]) - ---------------------------------------------------------------------------- - -{- -sameMutableArray# :: MutArr# s a -> MutArr# s a -> Bool -sameMutableByteArray# :: MutByteArr# s -> MutByteArr# s -> Bool --} - -primOpInfo SameMutableArrayOp - = let { - elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar; - mut_arr_ty = mkMutableArrayPrimTy s elt - } in - mkGenPrimOp SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty] - boolTy - -primOpInfo SameMutableByteArrayOp - = let { - s = alphaTy; s_tv = alphaTyVar; - mut_arr_ty = mkMutableByteArrayPrimTy s - } in - mkGenPrimOp SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty] - boolTy - ---------------------------------------------------------------------------- --- Primitive arrays of Haskell pointers: - -{- -readArray# :: MutArr# s a -> Int# -> State# s -> (# State# s, a #) -writeArray# :: MutArr# s a -> Int# -> a -> State# s -> State# s -indexArray# :: Array# a -> Int# -> (# a #) --} - -primOpInfo ReadArrayOp - = let { - elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar; - state = mkStatePrimTy s - } in - mkGenPrimOp SLIT("readArray#") [s_tv, elt_tv] - [mkMutableArrayPrimTy s elt, intPrimTy, state] - (unboxedPair [state, elt]) - - -primOpInfo WriteArrayOp - = let { - elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar - } in - mkGenPrimOp SLIT("writeArray#") [s_tv, elt_tv] - [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s] - (mkStatePrimTy s) - -primOpInfo IndexArrayOp - = let { elt = alphaTy; elt_tv = alphaTyVar } in - mkGenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy] - (unboxedSingleton [elt]) - ---------------------------------------------------------------------------- --- Primitive arrays full of unboxed bytes: - -primOpInfo (ReadByteArrayOp kind) - = let - s = alphaTy; s_tv = alphaTyVar - - op_str = _PK_ ("read" ++ primRepString kind ++ "Array#") - (tvs, prim_ty) = mkPrimTyApp betaTyVars kind - state = mkStatePrimTy s - in - mkGenPrimOp op_str (s_tv:tvs) - [mkMutableByteArrayPrimTy s, intPrimTy, state] - (unboxedPair [state, prim_ty]) - -primOpInfo (WriteByteArrayOp kind) - = let - s = alphaTy; s_tv = alphaTyVar - op_str = _PK_ ("write" ++ primRepString kind ++ "Array#") - (tvs, prim_ty) = mkPrimTyApp betaTyVars kind - in - mkGenPrimOp op_str (s_tv:tvs) - [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s] - (mkStatePrimTy s) - -primOpInfo (IndexByteArrayOp kind) - = let - op_str = _PK_ ("index" ++ primRepString kind ++ "Array#") - (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind - in - mkGenPrimOp op_str tvs [byteArrayPrimTy, intPrimTy] prim_ty - -primOpInfo (IndexOffForeignObjOp kind) - = let - op_str = _PK_ ("index" ++ primRepString kind ++ "OffForeignObj#") - (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind - in - mkGenPrimOp op_str tvs [foreignObjPrimTy, intPrimTy] prim_ty - -primOpInfo (IndexOffAddrOp kind) - = let - op_str = _PK_ ("index" ++ primRepString kind ++ "OffAddr#") - (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind - in - mkGenPrimOp op_str tvs [addrPrimTy, intPrimTy] prim_ty - -primOpInfo (ReadOffAddrOp kind) - = let - s = alphaTy; s_tv = alphaTyVar - op_str = _PK_ ("read" ++ primRepString kind ++ "OffAddr#") - (tvs, prim_ty) = mkPrimTyApp betaTyVars kind - state = mkStatePrimTy s - in - mkGenPrimOp op_str (s_tv:tvs) - [addrPrimTy, intPrimTy, state] - (unboxedPair [state, prim_ty]) - -primOpInfo (WriteOffAddrOp kind) - = let - s = alphaTy; s_tv = alphaTyVar - op_str = _PK_ ("write" ++ primRepString kind ++ "OffAddr#") - (tvs, prim_ty) = mkPrimTyApp betaTyVars kind - in - mkGenPrimOp op_str (s_tv:tvs) - [addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s] - (mkStatePrimTy s) - ---------------------------------------------------------------------------- -{- -unsafeFreezeArray# :: MutArr# s a -> State# s -> (# State# s, Array# a #) -unsafeFreezeByteArray# :: MutByteArr# s -> State# s -> (# State# s, ByteArray# #) -unsafeThawArray# :: Array# a -> State# s -> (# State# s, MutArr# s a #) --} - -primOpInfo UnsafeFreezeArrayOp - = let { - elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar; - state = mkStatePrimTy s - } in - mkGenPrimOp SLIT("unsafeFreezeArray#") [s_tv, elt_tv] - [mkMutableArrayPrimTy s elt, state] - (unboxedPair [state, mkArrayPrimTy elt]) - -primOpInfo UnsafeFreezeByteArrayOp - = let { - s = alphaTy; s_tv = alphaTyVar; - state = mkStatePrimTy s - } in - mkGenPrimOp SLIT("unsafeFreezeByteArray#") [s_tv] - [mkMutableByteArrayPrimTy s, state] - (unboxedPair [state, byteArrayPrimTy]) - -primOpInfo UnsafeThawArrayOp - = let { - elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar; - state = mkStatePrimTy s - } in - mkGenPrimOp SLIT("unsafeThawArray#") [s_tv, elt_tv] - [mkArrayPrimTy elt, state] - (unboxedPair [state, mkMutableArrayPrimTy s elt]) - ---------------------------------------------------------------------------- -primOpInfo SizeofByteArrayOp - = mkGenPrimOp - SLIT("sizeofByteArray#") [] - [byteArrayPrimTy] - intPrimTy - -primOpInfo SizeofMutableByteArrayOp - = let { s = alphaTy; s_tv = alphaTyVar } in - mkGenPrimOp - SLIT("sizeofMutableByteArray#") [s_tv] - [mkMutableByteArrayPrimTy s] - intPrimTy -\end{code} - - -%************************************************************************ -%* * -\subsubsection[PrimOp-MutVars]{PrimOpInfo for mutable variable ops} -%* * -%************************************************************************ - -\begin{code} -primOpInfo NewMutVarOp - = let { - elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar; - state = mkStatePrimTy s - } in - mkGenPrimOp SLIT("newMutVar#") [s_tv, elt_tv] - [elt, state] - (unboxedPair [state, mkMutVarPrimTy s elt]) - -primOpInfo ReadMutVarOp - = let { - elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar; - state = mkStatePrimTy s - } in - mkGenPrimOp SLIT("readMutVar#") [s_tv, elt_tv] - [mkMutVarPrimTy s elt, state] - (unboxedPair [state, elt]) - - -primOpInfo WriteMutVarOp - = let { - elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar - } in - mkGenPrimOp SLIT("writeMutVar#") [s_tv, elt_tv] - [mkMutVarPrimTy s elt, elt, mkStatePrimTy s] - (mkStatePrimTy s) - -primOpInfo SameMutVarOp - = let { - elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar; - mut_var_ty = mkMutVarPrimTy s elt - } in - mkGenPrimOp SLIT("sameMutVar#") [s_tv, elt_tv] [mut_var_ty, mut_var_ty] - boolTy -\end{code} - -%************************************************************************ -%* * -\subsubsection[PrimOp-Exceptions]{PrimOpInfo for exceptions} -%* * -%************************************************************************ - -catch# :: (State# RealWorld -> (# State# RealWorld, a)) - -> (b -> State# RealWorld -> (# State# RealWorld, a)) - -> State# RealWorld - -> (# State# RealWorld, a) - -throw :: Exception -> a -raise# :: a -> b - -blockAsyncExceptions# :: IO a -> IO a -unblockAsyncExceptions# :: IO a -> IO a - -\begin{code} -primOpInfo CatchOp - = let - a = alphaTy; a_tv = alphaTyVar - b = betaTy; b_tv = betaTyVar; - io_a = mkIOTy a - in - mkGenPrimOp SLIT("catch#") [a_tv, b_tv] - [io_a, mkFunTy b io_a, realWorldStatePrimTy] - (unboxedPair [realWorldStatePrimTy, a]) - -primOpInfo RaiseOp - = let - a = alphaTy; a_tv = alphaTyVar - b = betaTy; b_tv = betaTyVar; - in - mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b - -primOpInfo BlockAsyncExceptionsOp - = let - a = alphaTy; a_tv = alphaTyVar - in - mkGenPrimOp SLIT("blockAsyncExceptions#") [a_tv] - [ mkIOTy a, realWorldStatePrimTy ] - (unboxedPair [realWorldStatePrimTy,a]) - -primOpInfo UnblockAsyncExceptionsOp - = let - a = alphaTy; a_tv = alphaTyVar - in - mkGenPrimOp SLIT("unblockAsyncExceptions#") [a_tv] - [ mkIOTy a, realWorldStatePrimTy ] - (unboxedPair [realWorldStatePrimTy,a]) -\end{code} - -%************************************************************************ -%* * -\subsubsection[PrimOp-MVars]{PrimOpInfo for synchronizing Variables} -%* * -%************************************************************************ - -\begin{code} -primOpInfo NewMVarOp - = let - elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar - state = mkStatePrimTy s - in - mkGenPrimOp SLIT("newMVar#") [s_tv, elt_tv] [state] - (unboxedPair [state, mkMVarPrimTy s elt]) - -primOpInfo TakeMVarOp - = let - elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar - state = mkStatePrimTy s - in - mkGenPrimOp SLIT("takeMVar#") [s_tv, elt_tv] - [mkMVarPrimTy s elt, state] - (unboxedPair [state, elt]) - -primOpInfo PutMVarOp - = let - elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar - in - mkGenPrimOp SLIT("putMVar#") [s_tv, elt_tv] - [mkMVarPrimTy s elt, elt, mkStatePrimTy s] - (mkStatePrimTy s) - -primOpInfo SameMVarOp - = let - elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar - mvar_ty = mkMVarPrimTy s elt - in - mkGenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy - -primOpInfo TryTakeMVarOp - = let - elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar - state = mkStatePrimTy s - in - mkGenPrimOp SLIT("tryTakeMVar#") [s_tv, elt_tv] - [mkMVarPrimTy s elt, state] - (unboxedTriple [state, intPrimTy, elt]) - -primOpInfo IsEmptyMVarOp - = let - elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar - state = mkStatePrimTy s - in - mkGenPrimOp SLIT("isEmptyMVar#") [s_tv, elt_tv] - [mkMVarPrimTy s elt, mkStatePrimTy s] - (unboxedPair [state, intPrimTy]) - -\end{code} - -%************************************************************************ -%* * -\subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations} -%* * -%************************************************************************ - -\begin{code} - -primOpInfo DelayOp - = let { - s = alphaTy; s_tv = alphaTyVar - } in - mkGenPrimOp SLIT("delay#") [s_tv] - [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s) - -primOpInfo WaitReadOp - = let { - s = alphaTy; s_tv = alphaTyVar - } in - mkGenPrimOp SLIT("waitRead#") [s_tv] - [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s) - -primOpInfo WaitWriteOp - = let { - s = alphaTy; s_tv = alphaTyVar - } in - mkGenPrimOp SLIT("waitWrite#") [s_tv] - [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s) -\end{code} - -%************************************************************************ -%* * -\subsubsection[PrimOp-Concurrency]{Concurrency Primitives} -%* * -%************************************************************************ - -\begin{code} --- fork# :: a -> State# RealWorld -> (# State# RealWorld, ThreadId# #) -primOpInfo ForkOp - = mkGenPrimOp SLIT("fork#") [alphaTyVar] - [alphaTy, realWorldStatePrimTy] - (unboxedPair [realWorldStatePrimTy, threadIdPrimTy]) - --- killThread# :: ThreadId# -> exception -> State# RealWorld -> State# RealWorld -primOpInfo KillThreadOp - = mkGenPrimOp SLIT("killThread#") [alphaTyVar] - [threadIdPrimTy, alphaTy, realWorldStatePrimTy] - realWorldStatePrimTy - --- yield# :: State# RealWorld -> State# RealWorld -primOpInfo YieldOp - = mkGenPrimOp SLIT("yield#") [] - [realWorldStatePrimTy] - realWorldStatePrimTy - --- myThreadId# :: State# RealWorld -> (# State# RealWorld, ThreadId# #) -primOpInfo MyThreadIdOp - = mkGenPrimOp SLIT("myThreadId#") [] - [realWorldStatePrimTy] - (unboxedPair [realWorldStatePrimTy, threadIdPrimTy]) -\end{code} - -************************************************************************ -%* * -\subsubsection[PrimOps-Foreign]{PrimOpInfo for Foreign Objects} -%* * -%************************************************************************ - -\begin{code} -primOpInfo MkForeignObjOp - = mkGenPrimOp SLIT("mkForeignObj#") [] - [addrPrimTy, realWorldStatePrimTy] - (unboxedPair [realWorldStatePrimTy, foreignObjPrimTy]) - -primOpInfo WriteForeignObjOp - = let { - s = alphaTy; s_tv = alphaTyVar - } in - mkGenPrimOp SLIT("writeForeignObj#") [s_tv] - [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s] (mkStatePrimTy s) -\end{code} - -************************************************************************ -%* * -\subsubsection[PrimOps-Weak]{PrimOpInfo for Weak Pointers} -%* * -%************************************************************************ - A @Weak@ Pointer is created by the @mkWeak#@ primitive: mkWeak# :: k -> v -> f -> State# RealWorld @@ -1643,13 +191,6 @@ In practice, you'll use the higher-level data Weak v = Weak# v mkWeak :: k -> v -> IO () -> IO (Weak v) -\begin{code} -primOpInfo MkWeakOp - = mkGenPrimOp SLIT("mkWeak#") [openAlphaTyVar, betaTyVar, gammaTyVar] - [mkTyVarTy openAlphaTyVar, betaTy, gammaTy, realWorldStatePrimTy] - (unboxedPair [realWorldStatePrimTy, mkWeakPrimTy betaTy]) -\end{code} - The following operation dereferences a weak pointer. The weak pointer may have been finalized, so the operation returns a result code which must be inspected before looking at the dereferenced value. @@ -1663,13 +204,6 @@ The higher-level op is deRefWeak :: Weak v -> IO (Maybe v) -\begin{code} -primOpInfo DeRefWeakOp - = mkGenPrimOp SLIT("deRefWeak#") [alphaTyVar] - [mkWeakPrimTy alphaTy, realWorldStatePrimTy] - (unboxedTriple [realWorldStatePrimTy, intPrimTy, alphaTy]) -\end{code} - Weak pointers can be finalized early by using the finalize# operation: finalizeWeak# :: Weak# v -> State# RealWorld -> @@ -1683,21 +217,6 @@ The Int# returned is either 1 if the weak pointer is still alive, with the finalizer returned as the third component. -\begin{code} -primOpInfo FinalizeWeakOp - = mkGenPrimOp SLIT("finalizeWeak#") [alphaTyVar] - [mkWeakPrimTy alphaTy, realWorldStatePrimTy] - (unboxedTriple [realWorldStatePrimTy, intPrimTy, - mkFunTy realWorldStatePrimTy - (unboxedPair [realWorldStatePrimTy,unitTy])]) -\end{code} - -%************************************************************************ -%* * -\subsubsection[PrimOp-stable-pointers]{PrimOpInfo for stable pointers and stable names} -%* * -%************************************************************************ - A {\em stable name/pointer} is an index into a table of stable name entries. Since the garbage collector is told about stable pointers, it is safe to pass a stable pointer to external systems such as C @@ -1752,45 +271,6 @@ Invariants: (c) stableNameToInt always returns the same Int for a given stable name. -\begin{code} -primOpInfo MakeStablePtrOp - = mkGenPrimOp SLIT("makeStablePtr#") [alphaTyVar] - [alphaTy, realWorldStatePrimTy] - (unboxedPair [realWorldStatePrimTy, - mkTyConApp stablePtrPrimTyCon [alphaTy]]) - -primOpInfo DeRefStablePtrOp - = mkGenPrimOp SLIT("deRefStablePtr#") [alphaTyVar] - [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy] - (unboxedPair [realWorldStatePrimTy, alphaTy]) - -primOpInfo EqStablePtrOp - = mkGenPrimOp SLIT("eqStablePtr#") [alphaTyVar, betaTyVar] - [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy betaTy] - intPrimTy - -primOpInfo MakeStableNameOp - = mkGenPrimOp SLIT("makeStableName#") [alphaTyVar] - [alphaTy, realWorldStatePrimTy] - (unboxedPair [realWorldStatePrimTy, - mkTyConApp stableNamePrimTyCon [alphaTy]]) - -primOpInfo EqStableNameOp - = mkGenPrimOp SLIT("eqStableName#") [alphaTyVar, betaTyVar] - [mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy] - intPrimTy - -primOpInfo StableNameToIntOp - = mkGenPrimOp SLIT("stableNameToInt#") [alphaTyVar] - [mkStableNamePrimTy alphaTy] - intPrimTy -\end{code} - -%************************************************************************ -%* * -\subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality} -%* * -%************************************************************************ [Alastair Reid is to blame for this!] @@ -1825,64 +305,13 @@ adding it. Up to you whether you add it. (Note that this could have been readily implemented using a @veryDangerousCCall@ before they were removed...) -\begin{code} -primOpInfo ReallyUnsafePtrEqualityOp - = mkGenPrimOp SLIT("reallyUnsafePtrEquality#") [alphaTyVar] - [alphaTy, alphaTy] intPrimTy -\end{code} - -%************************************************************************ -%* * -\subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)} -%* * -%************************************************************************ - -\begin{code} -primOpInfo SeqOp -- seq# :: a -> Int# - = mkGenPrimOp SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTy -primOpInfo ParOp -- par# :: a -> Int# - = mkGenPrimOp SLIT("par#") [alphaTyVar] [alphaTy] intPrimTy -\end{code} - -\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# -- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine -- `the processor containing the expression v'; it is not evaluated -primOpInfo ParGlobalOp -- parGlobal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int# - = mkGenPrimOp SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy - -primOpInfo ParLocalOp -- parLocal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int# - = mkGenPrimOp SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy - -primOpInfo ParAtOp -- parAt# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int# - = mkGenPrimOp SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy - -primOpInfo ParAtAbsOp -- parAtAbs# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int# - = mkGenPrimOp SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy - -primOpInfo ParAtRelOp -- parAtRel# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int# - = mkGenPrimOp SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy - -primOpInfo ParAtForNowOp -- parAtForNow# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int# - = mkGenPrimOp SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy - -primOpInfo CopyableOp -- copyable# :: a -> Int# - = mkGenPrimOp SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTy - -primOpInfo NoFollowOp -- noFollow# :: a -> Int# - = mkGenPrimOp SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTy -\end{code} - -%************************************************************************ -%* * -\subsubsection[PrimOp-tag]{PrimOpInfo for @dataToTag#@ and @tagToEnum#@} -%* * -%************************************************************************ - These primops are pretty wierd. dataToTag# :: a -> Int (arg must be an evaluated data type) @@ -1892,12 +321,6 @@ The constraints aren't currently checked by the front end, but the code generator will fall over if they aren't satisfied. \begin{code} -primOpInfo DataToTagOp - = mkGenPrimOp SLIT("dataToTag#") [alphaTyVar] [alphaTy] intPrimTy - -primOpInfo TagToEnumOp - = mkGenPrimOp SLIT("tagToEnum#") [alphaTyVar] [intPrimTy] alphaTy - #ifdef DEBUG primOpInfo op = pprPanic "primOpInfo:" (ppr op) #endif @@ -1913,55 +336,8 @@ Some PrimOps need to be called out-of-line because they either need to perform a heap check or they block. \begin{code} -primOpOutOfLine op - = case op of - TakeMVarOp -> True - TryTakeMVarOp -> True - PutMVarOp -> True - DelayOp -> True - WaitReadOp -> True - WaitWriteOp -> True - CatchOp -> True - RaiseOp -> True - BlockAsyncExceptionsOp -> True - UnblockAsyncExceptionsOp -> True - NewArrayOp -> True - NewByteArrayOp _ -> True - IntegerAddOp -> True - IntegerSubOp -> True - IntegerMulOp -> True - IntegerGcdOp -> True - IntegerDivExactOp -> True - IntegerQuotOp -> True - IntegerRemOp -> True - IntegerQuotRemOp -> True - IntegerDivModOp -> True - Int2IntegerOp -> True - Word2IntegerOp -> True - Addr2IntegerOp -> True - Word64ToIntegerOp -> True - Int64ToIntegerOp -> True - FloatDecodeOp -> True - DoubleDecodeOp -> True - MkWeakOp -> True - FinalizeWeakOp -> True - MakeStableNameOp -> True - MkForeignObjOp -> True - NewMutVarOp -> True - NewMVarOp -> True - ForkOp -> True - KillThreadOp -> True - YieldOp -> True - - UnsafeThawArrayOp -> True - -- UnsafeThawArrayOp doesn't perform any heap checks, - -- but it is of such an esoteric nature that - -- it is done out-of-line rather than require - -- the NCG to implement it. - - CCallOp c_call -> ccallMayGC c_call - - other -> False +primOpOutOfLine (CCallOp c_call) = ccallMayGC c_call +#include "primop-out-of-line.hs" \end{code} @@ -2021,27 +397,7 @@ primOpIsDupable op = not (primOpNeedsWrapper op) \begin{code} primOpCanFail :: PrimOp -> Bool --- Int. -primOpCanFail IntQuotOp = True -- Divide by zero -primOpCanFail IntRemOp = True -- Divide by zero - --- Integer -primOpCanFail IntegerQuotRemOp = True -- Divide by zero -primOpCanFail IntegerDivModOp = True -- Divide by zero - --- Float. ToDo: tan? tanh? -primOpCanFail FloatDivOp = True -- Divide by zero -primOpCanFail FloatLogOp = True -- Log of zero -primOpCanFail FloatAsinOp = True -- Arg out of domain -primOpCanFail FloatAcosOp = True -- Arg out of domain - --- Double. ToDo: tan? tanh? -primOpCanFail DoubleDivOp = True -- Divide by zero -primOpCanFail DoubleLogOp = True -- Log of zero -primOpCanFail DoubleAsinOp = True -- Arg out of domain -primOpCanFail DoubleAcosOp = True -- Arg out of domain - -primOpCanFail other_op = False +#include "primop-can-fail.hs" \end{code} And some primops have side-effects and so, for example, must not be @@ -2049,55 +405,8 @@ duplicated. \begin{code} primOpHasSideEffects :: PrimOp -> Bool - -primOpHasSideEffects ParOp = True -primOpHasSideEffects ForkOp = True -primOpHasSideEffects KillThreadOp = True -primOpHasSideEffects YieldOp = True -primOpHasSideEffects SeqOp = True - -primOpHasSideEffects MkForeignObjOp = True -primOpHasSideEffects WriteForeignObjOp = True -primOpHasSideEffects MkWeakOp = True -primOpHasSideEffects DeRefWeakOp = True -primOpHasSideEffects FinalizeWeakOp = True -primOpHasSideEffects MakeStablePtrOp = True -primOpHasSideEffects MakeStableNameOp = True -primOpHasSideEffects EqStablePtrOp = True -- SOF -primOpHasSideEffects DeRefStablePtrOp = True -- ??? JSM & ADR - --- In general, writes are considered a side effect, but --- reads and variable allocations are not --- Why? Because writes must not be omitted, but reads can be if their result is not used. --- (Sequencing of reads is maintained by data dependencies on the resulting --- world state.) -primOpHasSideEffects WriteArrayOp = True -primOpHasSideEffects (WriteByteArrayOp _) = True -primOpHasSideEffects (WriteOffAddrOp _) = True -primOpHasSideEffects WriteMutVarOp = True - -primOpHasSideEffects UnsafeFreezeArrayOp = True -primOpHasSideEffects UnsafeFreezeByteArrayOp = True -primOpHasSideEffects UnsafeThawArrayOp = True - -primOpHasSideEffects TakeMVarOp = True -primOpHasSideEffects TryTakeMVarOp = True -primOpHasSideEffects PutMVarOp = True -primOpHasSideEffects DelayOp = True -primOpHasSideEffects WaitReadOp = True -primOpHasSideEffects WaitWriteOp = True - -primOpHasSideEffects ParGlobalOp = True -primOpHasSideEffects ParLocalOp = True -primOpHasSideEffects ParAtOp = True -primOpHasSideEffects ParAtAbsOp = True -primOpHasSideEffects ParAtRelOp = True -primOpHasSideEffects ParAtForNowOp = True -primOpHasSideEffects CopyableOp = True -- Possibly not. ASP -primOpHasSideEffects NoFollowOp = True -- Possibly not. ASP primOpHasSideEffects (CCallOp _) = True - -primOpHasSideEffects other = False +#include "primop-has-side-effects.hs" \end{code} Inline primitive operations that perform calls need wrappers to save @@ -2105,50 +414,8 @@ any live variables that are stored in caller-saves registers. \begin{code} primOpNeedsWrapper :: PrimOp -> Bool - primOpNeedsWrapper (CCallOp _) = True - -primOpNeedsWrapper Integer2IntOp = True -primOpNeedsWrapper Integer2WordOp = True -primOpNeedsWrapper IntegerCmpOp = True -primOpNeedsWrapper IntegerCmpIntOp = True - -primOpNeedsWrapper FloatExpOp = True -primOpNeedsWrapper FloatLogOp = True -primOpNeedsWrapper FloatSqrtOp = True -primOpNeedsWrapper FloatSinOp = True -primOpNeedsWrapper FloatCosOp = True -primOpNeedsWrapper FloatTanOp = True -primOpNeedsWrapper FloatAsinOp = True -primOpNeedsWrapper FloatAcosOp = True -primOpNeedsWrapper FloatAtanOp = True -primOpNeedsWrapper FloatSinhOp = True -primOpNeedsWrapper FloatCoshOp = True -primOpNeedsWrapper FloatTanhOp = True -primOpNeedsWrapper FloatPowerOp = True - -primOpNeedsWrapper DoubleExpOp = True -primOpNeedsWrapper DoubleLogOp = True -primOpNeedsWrapper DoubleSqrtOp = True -primOpNeedsWrapper DoubleSinOp = True -primOpNeedsWrapper DoubleCosOp = True -primOpNeedsWrapper DoubleTanOp = True -primOpNeedsWrapper DoubleAsinOp = True -primOpNeedsWrapper DoubleAcosOp = True -primOpNeedsWrapper DoubleAtanOp = True -primOpNeedsWrapper DoubleSinhOp = True -primOpNeedsWrapper DoubleCoshOp = True -primOpNeedsWrapper DoubleTanhOp = True -primOpNeedsWrapper DoublePowerOp = True - -primOpNeedsWrapper MakeStableNameOp = True -primOpNeedsWrapper DeRefStablePtrOp = True - -primOpNeedsWrapper DelayOp = True -primOpNeedsWrapper WaitReadOp = True -primOpNeedsWrapper WaitWriteOp = True - -primOpNeedsWrapper other_op = False +#include "primop-needs-wrapper.hs" \end{code} \begin{code} @@ -2197,7 +464,7 @@ primOpOcc op = case (primOpInfo op) of primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictnessInfo) primOpSig op - = (tyvars, arg_tys, res_ty, arity, primOpStrictness arity op) + = (tyvars, arg_tys, res_ty, arity, primOpStrictness op arity) where arity = length arg_tys (tyvars, arg_tys, res_ty) @@ -2213,101 +480,46 @@ primOpSig op -- as required by the UsageSP inference. primOpUsg :: PrimOp -> ([TyVar],[Type],Type) -primOpUsg op - = case op of - - -- Refer to comment by `otherwise' clause; we need consider here - -- *only* primops that have arguments or results containing Haskell - -- pointers (things that are pointed). Unpointed values are - -- irrelevant to the usage analysis. The issue is whether pointed - -- values may be entered or duplicated by the primop. - - -- Remember that primops are *never* partially applied. - - NewArrayOp -> mangle [mkP, mkM, mkP ] mkM - SameMutableArrayOp -> mangle [mkP, mkP ] mkM - ReadArrayOp -> mangle [mkM, mkP, mkP ] mkM - WriteArrayOp -> mangle [mkM, mkP, mkM, mkP] mkR - IndexArrayOp -> mangle [mkM, mkP ] mkM - UnsafeFreezeArrayOp -> mangle [mkM, mkP ] mkM - UnsafeThawArrayOp -> mangle [mkM, mkP ] mkM - - NewMutVarOp -> mangle [mkM, mkP ] mkM - ReadMutVarOp -> mangle [mkM, mkP ] mkM - WriteMutVarOp -> mangle [mkM, mkM, mkP ] mkR - SameMutVarOp -> mangle [mkP, mkP ] mkM - - CatchOp -> -- [mkO, mkO . (inFun mkM mkO)] mkO - mangle [mkM, mkM . (inFun mkM mkM), mkP] mkM - -- might use caught action multiply - RaiseOp -> mangle [mkM ] mkM - - NewMVarOp -> mangle [mkP ] mkR - TakeMVarOp -> mangle [mkM, mkP ] mkM - PutMVarOp -> mangle [mkM, mkM, mkP ] mkR - SameMVarOp -> mangle [mkP, mkP ] mkM - TryTakeMVarOp -> mangle [mkM, mkP ] mkM - IsEmptyMVarOp -> mangle [mkP, mkP ] mkM - - ForkOp -> mangle [mkO, mkP ] mkR - KillThreadOp -> mangle [mkP, mkM, mkP ] mkR - - MkWeakOp -> mangle [mkZ, mkM, mkM, mkP] mkM - DeRefWeakOp -> mangle [mkM, mkP ] mkM - FinalizeWeakOp -> mangle [mkM, mkP ] (mkR . (inUB [id,id,inFun mkR mkM])) - - MakeStablePtrOp -> mangle [mkM, mkP ] mkM - DeRefStablePtrOp -> mangle [mkM, mkP ] mkM - EqStablePtrOp -> mangle [mkP, mkP ] mkR - MakeStableNameOp -> mangle [mkZ, mkP ] mkR - EqStableNameOp -> mangle [mkP, mkP ] mkR - StableNameToIntOp -> mangle [mkP ] mkR - - ReallyUnsafePtrEqualityOp -> mangle [mkZ, mkZ ] mkR - - SeqOp -> mangle [mkO ] mkR - ParOp -> mangle [mkO ] mkR - ParGlobalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM - ParLocalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM - ParAtOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM - ParAtAbsOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM - ParAtRelOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM - ParAtForNowOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM - CopyableOp -> mangle [mkZ ] mkR - NoFollowOp -> mangle [mkZ ] mkR - - CCallOp _ -> mangle [ ] mkM - - -- Things with no Haskell pointers inside: in actuality, usages are - -- irrelevant here (hence it doesn't matter that some of these - -- apparently permit duplication; since such arguments are never - -- ENTERed anyway, the usage annotation they get is entirely irrelevant - -- except insofar as it propagates to infect other values that *are* - -- pointed. - - otherwise -> nomangle +primOpUsg p@(CCallOp _) = mangle p [] mkM +#include "primop-usage.hs" + +-- Things with no Haskell pointers inside: in actuality, usages are +-- irrelevant here (hence it doesn't matter that some of these +-- apparently permit duplication; since such arguments are never +-- ENTERed anyway, the usage annotation they get is entirely irrelevant +-- except insofar as it propagates to infect other values that *are* +-- pointed. + + +-- Helper bits & pieces for usage info. - where mkZ = mkUsgTy UsOnce -- pointed argument used zero - mkO = mkUsgTy UsOnce -- pointed argument used once - mkM = mkUsgTy UsMany -- pointed argument used multiply - mkP = mkUsgTy UsOnce -- unpointed argument - mkR = mkUsgTy UsMany -- unpointed result - - (tyvars, arg_tys, res_ty, _, _) = primOpSig op - - nomangle = (tyvars, map mkP arg_tys, mkR res_ty) - - mangle fs g = (tyvars, zipWithEqual "primOpUsg" ($) fs arg_tys, g res_ty) - - inFun f g ty = case splitFunTy_maybe ty of - Just (a,b) -> mkFunTy (f a) (g b) - Nothing -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty) - - inUB fs ty = case splitTyConApp_maybe ty of - Just (tc,tys) -> ASSERT( tc == tupleTyCon Unboxed (length fs) ) - mkTupleTy Unboxed (length fs) (zipWithEqual "primOpUsg" - ($) fs tys) - Nothing -> pprPanic "primOpUsg:inUB" (ppr op <+> ppr ty) +mkZ = mkUsgTy UsOnce -- pointed argument used zero +mkO = mkUsgTy UsOnce -- pointed argument used once +mkM = mkUsgTy UsMany -- pointed argument used multiply +mkP = mkUsgTy UsOnce -- unpointed argument +mkR = mkUsgTy UsMany -- unpointed result + +nomangle op + = case primOpSig op of + (tyvars, arg_tys, res_ty, _, _) + -> (tyvars, map mkP arg_tys, mkR res_ty) + +mangle op fs g + = case primOpSig op of + (tyvars, arg_tys, res_ty, _, _) + -> (tyvars, zipWithEqual "primOpUsg" ($) fs arg_tys, g res_ty) + +inFun op f g ty + = case splitFunTy_maybe ty of + Just (a,b) -> mkFunTy (f a) (g b) + Nothing -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty) + +inUB op fs ty + = case splitTyConApp_maybe ty of + Just (tc,tys) -> ASSERT( tc == tupleTyCon Unboxed (length fs) ) + mkTupleTy Unboxed (length fs) (zipWithEqual "primOpUsg" + ($) fs tys) + Nothing -> pprPanic "primOpUsg:inUB" (ppr op <+> ppr ty) \end{code} \begin{code} @@ -2341,29 +553,7 @@ to the right hand side for strength reduction. \begin{code} commutableOp :: PrimOp -> Bool - -commutableOp CharEqOp = True -commutableOp CharNeOp = True -commutableOp IntAddOp = True -commutableOp IntMulOp = True -commutableOp AndOp = True -commutableOp OrOp = True -commutableOp XorOp = True -commutableOp IntEqOp = True -commutableOp IntNeOp = True -commutableOp IntegerAddOp = True -commutableOp IntegerMulOp = True -commutableOp IntegerGcdOp = True -commutableOp IntegerIntGcdOp = True -commutableOp FloatAddOp = True -commutableOp FloatMulOp = True -commutableOp FloatEqOp = True -commutableOp FloatNeOp = True -commutableOp DoubleAddOp = True -commutableOp DoubleMulOp = True -commutableOp DoubleEqOp = True -commutableOp DoubleNeOp = True -commutableOp _ = False +#include "primop-commutable.hs" \end{code} Utils: diff --git a/ghc/compiler/prelude/PrimRep.lhs b/ghc/compiler/prelude/PrimRep.lhs index 4c87fe5..70bb367 100644 --- a/ghc/compiler/prelude/PrimRep.lhs +++ b/ghc/compiler/prelude/PrimRep.lhs @@ -57,6 +57,7 @@ data PrimRep | WeakPtrRep | ForeignObjRep + | BCORep | StablePtrRep -- guaranteed to be represented by a pointer diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs index 1067336..ff4e305 100644 --- a/ghc/compiler/prelude/TysPrim.lhs +++ b/ghc/compiler/prelude/TysPrim.lhs @@ -10,7 +10,7 @@ types and operations.'' module TysPrim( alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar, alphaTy, betaTy, gammaTy, deltaTy, - openAlphaTyVar, openAlphaTyVars, + openAlphaTy, openAlphaTyVar, openAlphaTyVars, charPrimTyCon, charPrimTy, intPrimTyCon, intPrimTy, @@ -31,6 +31,7 @@ module TysPrim( mVarPrimTyCon, mkMVarPrimTy, stablePtrPrimTyCon, mkStablePtrPrimTy, stableNamePrimTyCon, mkStableNamePrimTy, + bcoPrimTyCon, bcoPrimTy, weakPrimTyCon, mkWeakPrimTy, foreignObjPrimTyCon, foreignObjPrimTy, threadIdPrimTyCon, threadIdPrimTy, @@ -50,7 +51,7 @@ import Name ( mkWiredInTyConName ) import PrimRep ( PrimRep(..), isFollowableRep ) import TyCon ( mkPrimTyCon, TyCon, ArgVrcs ) import Type ( Type, - mkTyConApp, mkTyConTy, mkTyVarTys, + mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy, unboxedTypeKind, boxedTypeKind, openTypeKind, mkArrowKinds ) import PrelNames ( pREL_GHC ) @@ -81,6 +82,8 @@ openAlphaTyVars :: [TyVar] openAlphaTyVars = [ mkSysTyVar u openTypeKind | u <- map mkAlphaTyVarUnique [2..] ] +openAlphaTy = mkTyVarTy openAlphaTyVar + vrcPos,vrcZero :: (Bool,Bool) vrcPos = (True,False) vrcZero = (False,False) @@ -268,6 +271,17 @@ foreignObjPrimTyCon = pcPrimTyCon foreignObjPrimTyConKey SLIT("ForeignObj#") 0 [ %************************************************************************ %* * +\subsection[TysPrim-BCOs]{The ``bytecode object'' type} +%* * +%************************************************************************ + +\begin{code} +bcoPrimTy = mkTyConTy bcoPrimTyCon +bcoPrimTyCon = pcPrimTyCon bcoPrimTyConKey SLIT("BCO#") 0 [] BCORep +\end{code} + +%************************************************************************ +%* * \subsection[TysPrim-Weak]{The ``weak pointer'' type} %* * %************************************************************************ diff --git a/ghc/compiler/prelude/primops.txt b/ghc/compiler/prelude/primops.txt new file mode 100644 index 0000000..64e7864 --- /dev/null +++ b/ghc/compiler/prelude/primops.txt @@ -0,0 +1,1147 @@ + +-- The default attribute values which apply if you don't specify +-- other ones. Attribute values can be True, False, or arbitrary +-- text between curly brackets. This is a kludge to enable +-- processors of this file to easily get hold of simple info +-- (eg, out_of_line), whilst avoiding parsing complex expressions +-- needed for strictness and usage info. + +defaults + has_side_effects = False + out_of_line = False + commutable = False + needs_wrapper = False + can_fail = False + strictness = { \ arity -> StrictnessInfo (replicate arity wwPrim) False } + usage = { nomangle other } + + +------------------------------------------------------------------------ +--- Addr# --- +------------------------------------------------------------------------ + +primop AddrGtOp "gtAddr#" Compare Addr# -> Addr# -> Bool +primop AddrGeOp "geAddr#" Compare Addr# -> Addr# -> Bool +primop AddrEqOp "eqAddr#" Compare Addr# -> Addr# -> Bool +primop AddrNeOp "neAddr#" Compare Addr# -> Addr# -> Bool +primop AddrLtOp "ltAddr#" Compare Addr# -> Addr# -> Bool +primop AddrLeOp "leAddr#" Compare Addr# -> Addr# -> Bool + +primop Addr2IntOp "addr2Int#" GenPrimOp Addr# -> Int# + +primop Addr2IntegerOp "addr2Integer#" GenPrimOp + Addr# -> (# Int#, ByteArr# #) + with out_of_line = True + + +------------------------------------------------------------------------ +--- Char# --- +------------------------------------------------------------------------ + +primop CharGtOp "gtChar#" Compare Char# -> Char# -> Bool +primop CharGeOp "geChar#" Compare Char# -> Char# -> Bool + +primop CharEqOp "eqChar#" Compare + Char# -> Char# -> Bool + with commutable = True + +primop CharNeOp "neChar#" Compare + Char# -> Char# -> Bool + with commutable = True + +primop CharLtOp "ltChar#" Compare Char# -> Char# -> Bool +primop CharLeOp "leChar#" Compare Char# -> Char# -> Bool + +primop OrdOp "ord#" GenPrimOp Char# -> Int# + +------------------------------------------------------------------------ +--- Double# --- +------------------------------------------------------------------------ + +primop DoubleGtOp ">##" Compare Double# -> Double# -> Bool +primop DoubleGeOp ">=##" Compare Double# -> Double# -> Bool + +primop DoubleEqOp "==##" Compare + Double# -> Double# -> Bool + with commutable = True + +primop DoubleNeOp "/=##" Compare + Double# -> Double# -> Bool + with commutable = True + +primop DoubleLtOp "<##" Compare Double# -> Double# -> Bool +primop DoubleLeOp "<=##" Compare Double# -> Double# -> Bool + +primop DoubleAddOp "+##" Dyadic + Double# -> Double# -> Double# + with commutable = True + +primop DoubleSubOp "-##" Dyadic Double# -> Double# -> Double# + +primop DoubleMulOp "*##" Dyadic + Double# -> Double# -> Double# + with commutable = True + +primop DoubleDivOp "/##" Dyadic + Double# -> Double# -> Double# + with can_fail = True + +primop DoubleNegOp "negateDouble#" Monadic Double# -> Double# + +primop Double2IntOp "double2Int#" GenPrimOp Double# -> Int# +primop Double2FloatOp "double2Float#" GenPrimOp Double# -> Float# + +primop DoubleExpOp "expDouble#" Monadic + Double# -> Double# + with needs_wrapper = True + +primop DoubleLogOp "logDouble#" Monadic + Double# -> Double# + with + needs_wrapper = True + can_fail = True + +primop DoubleSqrtOp "sqrtDouble#" Monadic + Double# -> Double# + with needs_wrapper = True + +primop DoubleSinOp "sinDouble#" Monadic + Double# -> Double# + with needs_wrapper = True + +primop DoubleCosOp "cosDouble#" Monadic + Double# -> Double# + with needs_wrapper = True + +primop DoubleTanOp "tanDouble#" Monadic + Double# -> Double# + with needs_wrapper = True + +primop DoubleAsinOp "asinDouble#" Monadic + Double# -> Double# + with + needs_wrapper = True + can_fail = True + +primop DoubleAcosOp "acosDouble#" Monadic + Double# -> Double# + with + needs_wrapper = True + can_fail = True + +primop DoubleAtanOp "atanDouble#" Monadic + Double# -> Double# + with + needs_wrapper = True + +primop DoubleSinhOp "sinhDouble#" Monadic + Double# -> Double# + with needs_wrapper = True + +primop DoubleCoshOp "coshDouble#" Monadic + Double# -> Double# + with needs_wrapper = True + +primop DoubleTanhOp "tanhDouble#" Monadic + Double# -> Double# + with needs_wrapper = True + +primop DoublePowerOp "**##" Dyadic + Double# -> Double# -> Double# + with needs_wrapper = True + +primop DoubleDecodeOp "decodeDouble#" GenPrimOp + Double# -> (# Int#, Int#, ByteArr# #) + with out_of_line = True + +------------------------------------------------------------------------ +--- Float# --- +------------------------------------------------------------------------ + +primop FloatGtOp "gtFloat#" Compare Float# -> Float# -> Bool +primop FloatGeOp "geFloat#" Compare Float# -> Float# -> Bool + +primop FloatEqOp "eqFloat#" Compare + Float# -> Float# -> Bool + with commutable = True + +primop FloatNeOp "neFloat#" Compare + Float# -> Float# -> Bool + with commutable = True + +primop FloatLtOp "ltFloat#" Compare Float# -> Float# -> Bool +primop FloatLeOp "leFloat#" Compare Float# -> Float# -> Bool + +primop FloatAddOp "plusFloat#" Dyadic + Float# -> Float# -> Float# + with commutable = True + +primop FloatSubOp "minusFloat#" Dyadic Float# -> Float# -> Float# + +primop FloatMulOp "timesFloat#" Dyadic + Float# -> Float# -> Float# + with commutable = True + +primop FloatDivOp "divideFloat#" Dyadic + Float# -> Float# -> Float# + with can_fail = True + +primop FloatNegOp "negateFloat#" Monadic Float# -> Float# + +primop Float2IntOp "float2Int#" GenPrimOp Float# -> Int# + +primop FloatExpOp "expFloat#" Monadic + Float# -> Float# + with needs_wrapper = True + +primop FloatLogOp "logFloat#" Monadic + Float# -> Float# + with needs_wrapper = True + can_fail = True + +primop FloatSqrtOp "sqrtFloat#" Monadic + Float# -> Float# + with needs_wrapper = True + +primop FloatSinOp "sinFloat#" Monadic + Float# -> Float# + with needs_wrapper = True + +primop FloatCosOp "cosFloat#" Monadic + Float# -> Float# + with needs_wrapper = True + +primop FloatTanOp "tanFloat#" Monadic + Float# -> Float# + with needs_wrapper = True + +primop FloatAsinOp "asinFloat#" Monadic + Float# -> Float# + with needs_wrapper = True + can_fail = True + +primop FloatAcosOp "acosFloat#" Monadic + Float# -> Float# + with needs_wrapper = True + can_fail = True + +primop FloatAtanOp "atanFloat#" Monadic + Float# -> Float# + with needs_wrapper = True + +primop FloatSinhOp "sinhFloat#" Monadic + Float# -> Float# + with needs_wrapper = True + +primop FloatCoshOp "coshFloat#" Monadic + Float# -> Float# + with needs_wrapper = True + +primop FloatTanhOp "tanhFloat#" Monadic + Float# -> Float# + with needs_wrapper = True + +primop FloatPowerOp "powerFloat#" Dyadic + Float# -> Float# -> Float# + with needs_wrapper = True + +primop Float2DoubleOp "float2Double#" GenPrimOp Float# -> Double# + +primop FloatDecodeOp "decodeFloat#" GenPrimOp + Float# -> (# Int#, Int#, ByteArr# #) + with out_of_line = True + +------------------------------------------------------------------------ +--- Int# --- +------------------------------------------------------------------------ + +primop IntAddOp "+#" Dyadic + Int# -> Int# -> Int# + with commutable = True + +primop IntSubOp "-#" Dyadic Int# -> Int# -> Int# + +primop IntMulOp "*#" + Dyadic Int# -> Int# -> Int# + with commutable = True + +primop IntQuotOp "quotInt#" Dyadic + Int# -> Int# -> Int# + with can_fail = True + +primop IntRemOp "remInt#" Dyadic + Int# -> Int# -> Int# + with can_fail = True + +primop IntGcdOp "gcdInt#" Dyadic Int# -> Int# -> Int# +primop IntNegOp "negateInt#" Monadic Int# -> Int# +primop IntAddCOp "addIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #) +primop IntSubCOp "subIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #) +primop IntMulCOp "mulIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #) +primop IntGtOp ">#" Compare Int# -> Int# -> Bool +primop IntGeOp ">=#" Compare Int# -> Int# -> Bool + +primop IntEqOp "==#" Compare + Int# -> Int# -> Bool + with commutable = True + +primop IntNeOp "/=#" Compare + Int# -> Int# -> Bool + with commutable = True + +primop IntLtOp "<#" Compare Int# -> Int# -> Bool +primop IntLeOp "<=#" Compare Int# -> Int# -> Bool + +primop ChrOp "chr#" GenPrimOp Int# -> Char# + +primop Int2WordOp "int2Word#" GenPrimOp Int# -> Word# +primop Int2AddrOp "int2Addr#"GenPrimOp Int# -> Addr# +primop Int2FloatOp "int2Float#" GenPrimOp Int# -> Float# +primop Int2DoubleOp "int2Double#" GenPrimOp Int# -> Double# + +primop Int2IntegerOp "int2Integer#" + GenPrimOp Int# -> (# Int#, ByteArr# #) + with out_of_line = True + +primop ISllOp "iShiftL#" GenPrimOp Int# -> Int# -> Int# +primop ISraOp "iShiftRA#" GenPrimOp Int# -> Int# -> Int# +primop ISrlOp "iShiftRL#" GenPrimOp Int# -> Int# -> Int# + +------------------------------------------------------------------------ +--- Int64# --- +------------------------------------------------------------------------ + +primop Int64ToIntegerOp "int64ToInteger#" GenPrimOp + Int64# -> (# Int#, ByteArr# #) + with out_of_line = True + + +------------------------------------------------------------------------ +--- Integer# --- +------------------------------------------------------------------------ + +primop IntegerNegOp "negateInteger#" GenPrimOp + Int# -> ByteArr# -> (# Int#, ByteArr# #) + +primop IntegerAddOp "plusInteger#" GenPrimOp + Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #) + with commutable = True + out_of_line = True + +primop IntegerSubOp "minusInteger#" GenPrimOp + Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #) + with out_of_line = True + +primop IntegerMulOp "timesInteger#" GenPrimOp + Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #) + with commutable = True + out_of_line = True + +primop IntegerGcdOp "gcdInteger#" GenPrimOp + Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #) + with commutable = True + out_of_line = True + +primop IntegerIntGcdOp "gcdIntegerInt#" GenPrimOp + Int# -> ByteArr# -> Int# -> Int# + with commutable = True + +primop IntegerDivExactOp "divExactInteger#" GenPrimOp + Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #) + with out_of_line = True + +primop IntegerQuotOp "quotInteger#" GenPrimOp + Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #) + with out_of_line = True + +primop IntegerRemOp "remInteger#" GenPrimOp + Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #) + with out_of_line = True + +primop IntegerCmpOp "cmpInteger#" GenPrimOp + Int# -> ByteArr# -> Int# -> ByteArr# -> Int# + with needs_wrapper = True + +primop IntegerCmpIntOp "cmpIntegerInt#" GenPrimOp + Int# -> ByteArr# -> Int# -> Int# + with needs_wrapper = True + +primop IntegerQuotRemOp "quotRemInteger#" GenPrimOp + Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr#, Int#, ByteArr# #) + with can_fail = True + out_of_line = True + +primop IntegerDivModOp "divModInteger#" GenPrimOp + Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr#, Int#, ByteArr# #) + with can_fail = True + out_of_line = True + +primop Integer2IntOp "integer2Int#" GenPrimOp + Int# -> ByteArr# -> Int# + with needs_wrapper = True + +primop Integer2WordOp "integer2Word#" GenPrimOp + Int# -> ByteArr# -> Word# + with needs_wrapper = True + +primop IntegerToInt64Op "integerToInt64#" GenPrimOp + Int# -> ByteArr# -> Int64# + +primop IntegerToWord64Op "integerToWord64#" GenPrimOp + Int# -> ByteArr# -> Word64# + +------------------------------------------------------------------------ +--- Word# --- +------------------------------------------------------------------------ + +primop WordQuotOp "quotWord#" Dyadic Word# -> Word# -> Word# +primop WordRemOp "remWord#" Dyadic Word# -> Word# -> Word# + +primop AndOp "and#" Dyadic + Word# -> Word# -> Word# + with commutable = True + +primop OrOp "or#" Dyadic + Word# -> Word# -> Word# + with commutable = True + +primop XorOp "xor#" Dyadic + Word# -> Word# -> Word# + with commutable = True + +primop NotOp "not#" Monadic Word# -> Word# + +primop SllOp "shiftL#" GenPrimOp Word# -> Int# -> Word# +primop SrlOp "shiftRL#" GenPrimOp Word# -> Int# -> Word# + + +primop Word2IntOp "word2Int#" GenPrimOp Word# -> Int# + +primop Word2IntegerOp "word2Integer#" GenPrimOp + Word# -> (# Int#, ByteArr# #) + with out_of_line = True + +primop WordGtOp "gtWord#" Compare Word# -> Word# -> Bool +primop WordGeOp "geWord#" Compare Word# -> Word# -> Bool +primop WordEqOp "eqWord#" Compare Word# -> Word# -> Bool +primop WordNeOp "neWord#" Compare Word# -> Word# -> Bool +primop WordLtOp "ltWord#" Compare Word# -> Word# -> Bool +primop WordLeOp "leWord#" Compare Word# -> Word# -> Bool + +------------------------------------------------------------------------ +--- Word64# --- +------------------------------------------------------------------------ + +primop Word64ToIntegerOp "word64ToInteger#" GenPrimOp + Word64# -> (# Int#, ByteArr# #) + with out_of_line = True + + +------------------------------------------------------------------------ +--- Arrays --- +------------------------------------------------------------------------ + +primop NewByteArrayOp_Char "newCharArray#" GenPrimOp + Int# -> State# s -> (# State# s, MutByteArr# s #) + with out_of_line = True + +primop NewByteArrayOp_Int "newIntArray#" GenPrimOp + Int# -> State# s -> (# State# s, MutByteArr# s #) + with out_of_line = True + +primop NewByteArrayOp_Word "newWordArray#" GenPrimOp + Int# -> State# s -> (# State# s, MutByteArr# s #) + with out_of_line = True + +primop NewByteArrayOp_Addr "newAddrArray#" GenPrimOp + Int# -> State# s -> (# State# s, MutByteArr# s #) + with out_of_line = True + +primop NewByteArrayOp_Float "newFloatArray#" GenPrimOp + Int# -> State# s -> (# State# s, MutByteArr# s #) + with out_of_line = True + +primop NewByteArrayOp_Double "newDoubleArray#" GenPrimOp + Int# -> State# s -> (# State# s, MutByteArr# s #) + with out_of_line = True + +primop NewByteArrayOp_StablePtr "newStablePtrArray#" GenPrimOp + Int# -> State# s -> (# State# s, MutByteArr# s #) + with out_of_line = True + + + +primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp + MutByteArr# s -> Int# -> State# s -> (# State# s, Char# #) + +primop ReadByteArrayOp_Int "readIntArray#" GenPrimOp + MutByteArr# s -> Int# -> State# s -> (# State# s, Int# #) + +primop ReadByteArrayOp_Word "readWordArray#" GenPrimOp + MutByteArr# s -> Int# -> State# s -> (# State# s, Word# #) + +primop ReadByteArrayOp_Addr "readAddrArray#" GenPrimOp + MutByteArr# s -> Int# -> State# s -> (# State# s, Addr# #) + +primop ReadByteArrayOp_Float "readFloatArray#" GenPrimOp + MutByteArr# s -> Int# -> State# s -> (# State# s, Float# #) + +primop ReadByteArrayOp_Double "readDoubleArray#" GenPrimOp + MutByteArr# s -> Int# -> State# s -> (# State# s, Double# #) + +primop ReadByteArrayOp_StablePtr "readStablePtrArray#" GenPrimOp + MutByteArr# s -> Int# -> State# s -> (# State# s, StablePtr# a #) + +primop ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp + MutByteArr# s -> Int# -> State# s -> (# State# s, Int64# #) + +primop ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp + MutByteArr# s -> Int# -> State# s -> (# State# s, Word64# #) + + + +primop WriteByteArrayOp_Char "writeCharArray#" GenPrimOp + MutByteArr# s -> Int# -> Char# -> State# s -> State# s + with has_side_effects = True + +primop WriteByteArrayOp_Int "writeIntArray#" GenPrimOp + MutByteArr# s -> Int# -> Int# -> State# s -> State# s + with has_side_effects = True + +primop WriteByteArrayOp_Word "writeWordArray#" GenPrimOp + MutByteArr# s -> Int# -> Word# -> State# s -> State# s + with has_side_effects = True + +primop WriteByteArrayOp_Addr "writeAddrArray#" GenPrimOp + MutByteArr# s -> Int# -> Addr# -> State# s -> State# s + with has_side_effects = True + +primop WriteByteArrayOp_Float "writeFloatArray#" GenPrimOp + MutByteArr# s -> Int# -> Float# -> State# s -> State# s + with has_side_effects = True + +primop WriteByteArrayOp_Double "writeDoubleArray#" GenPrimOp + MutByteArr# s -> Int# -> Double# -> State# s -> State# s + with has_side_effects = True + +primop WriteByteArrayOp_StablePtr "writeStablePtrArray#" GenPrimOp + MutByteArr# s -> Int# -> StablePtr# a -> State# s -> State# s + with has_side_effects = True + +primop WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp + MutByteArr# s -> Int# -> Int64# -> State# s -> State# s + with has_side_effects = True + +primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp + MutByteArr# s -> Int# -> Word64# -> State# s -> State# s + with has_side_effects = True + + +primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp + ByteArr# -> Int# -> Char# + +primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp + ByteArr# -> Int# -> Int# + +primop IndexByteArrayOp_Word "indexWordArray#" GenPrimOp + ByteArr# -> Int# -> Word# + +primop IndexByteArrayOp_Addr "indexAddrArray#" GenPrimOp + ByteArr# -> Int# -> Addr# + +primop IndexByteArrayOp_Float "indexFloatArray#" GenPrimOp + ByteArr# -> Int# -> Float# + +primop IndexByteArrayOp_Double "indexDoubleArray#" GenPrimOp + ByteArr# -> Int# -> Double# + +primop IndexByteArrayOp_StablePtr "indexStablePtrArray#" GenPrimOp + ByteArr# -> Int# -> StablePtr# a + +primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp + ByteArr# -> Int# -> Int64# + +primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp + ByteArr# -> Int# -> Word64# + + +primop IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp + Addr# -> Int# -> Char# + +primop IndexOffAddrOp_Int "indexIntOffAddr#" GenPrimOp + Addr# -> Int# -> Int# + +primop IndexOffAddrOp_Word "indexWordOffAddr#" GenPrimOp + Addr# -> Int# -> Word# + +primop IndexOffAddrOp_Addr "indexAddrOffAddr#" GenPrimOp + Addr# -> Int# -> Addr# + +primop IndexOffAddrOp_Float "indexFloatOffAddr#" GenPrimOp + Addr# -> Int# -> Float# + +primop IndexOffAddrOp_Double "indexDoubleOffAddr#" GenPrimOp + Addr# -> Int# -> Double# + +primop IndexOffAddrOp_StablePtr "indexStablePtrOffAddr#" GenPrimOp + Addr# -> Int# -> StablePtr# a + +primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp + Addr# -> Int# -> Int64# + +primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp + Addr# -> Int# -> Word64# + + +primop IndexOffForeignObjOp_Char "indexCharOffForeignObj#" GenPrimOp + ForeignObj# -> Int# -> Char# + +primop IndexOffForeignObjOp_Int "indexIntOffForeignObj#" GenPrimOp + ForeignObj# -> Int# -> Int# + +primop IndexOffForeignObjOp_Word "indexWordOffForeignObj#" GenPrimOp + ForeignObj# -> Int# -> Word# + +primop IndexOffForeignObjOp_Addr "indexAddrOffForeignObj#" GenPrimOp + ForeignObj# -> Int# -> Addr# + +primop IndexOffForeignObjOp_Float "indexFloatOffForeignObj#" GenPrimOp + ForeignObj# -> Int# -> Float# + +primop IndexOffForeignObjOp_Double "indexDoubleOffForeignObj#" GenPrimOp + ForeignObj# -> Int# -> Double# + +primop IndexOffForeignObjOp_StablePtr "indexStablePtrOffForeignObj#" GenPrimOp + ForeignObj# -> Int# -> StablePtr# a + +primop IndexOffForeignObjOp_Int64 "indexInt64OffForeignObj#" GenPrimOp + ForeignObj# -> Int# -> Int64# + +primop IndexOffForeignObjOp_Word64 "indexWord64OffForeignObj#" GenPrimOp + ForeignObj# -> Int# -> Word64# + + + +primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Char# #) + +primop ReadOffAddrOp_Int "readIntOffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Int# #) + +primop ReadOffAddrOp_Word "readWordOffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Word# #) + +primop ReadOffAddrOp_Addr "readAddrOffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Addr# #) + +primop ReadOffAddrOp_Float "readFloatOffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Float# #) + +primop ReadOffAddrOp_Double "readDoubleOffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Double# #) + +primop ReadOffAddrOp_StablePtr "readStablePtrOffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, StablePtr# a #) + +primop ReadOffAddrOp_ForeignObj "readForeignObjOffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, ForeignObj# #) + +primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Int64# #) + +primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Word64# #) + + +primop WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp + Addr# -> Int# -> Char# -> State# s -> State# s + with has_side_effects = True + +primop WriteOffAddrOp_Int "writeIntOffAddr#" GenPrimOp + Addr# -> Int# -> Int# -> State# s -> State# s + with has_side_effects = True + +primop WriteOffAddrOp_Word "writeWordOffAddr#" GenPrimOp + Addr# -> Int# -> Word# -> State# s -> State# s + with has_side_effects = True + +primop WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp + Addr# -> Int# -> Addr# -> State# s -> State# s + with has_side_effects = True + +primop WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp + Addr# -> Int# -> Float# -> State# s -> State# s + with has_side_effects = True + +primop WriteOffAddrOp_Double "writeDoubleOffAddr#" GenPrimOp + Addr# -> Int# -> Double# -> State# s -> State# s + with has_side_effects = True + +primop WriteOffAddrOp_StablePtr "writeStablePtrOffAddr#" GenPrimOp + Addr# -> Int# -> StablePtr# a -> State# s -> State# s + with has_side_effects = True + +primop WriteOffAddrOp_ForeignObj "writeForeignObjOffAddr#" GenPrimOp + Addr# -> Int# -> ForeignObj# -> State# s -> State# s + with has_side_effects = True + +primop WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp + Addr# -> Int# -> Int64# -> State# s -> State# s + with has_side_effects = True + +primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp + Addr# -> Int# -> Word64# -> State# s -> State# s + with has_side_effects = True + + + +primop NewArrayOp "newArray#" GenPrimOp + Int# -> a -> State# s -> (# State# s, MutArr# s a #) + with + strictness = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False } + usage = { mangle NewArrayOp [mkP, mkM, mkP] mkM } + out_of_line = True + +primop SameMutableArrayOp "sameMutableArray#" GenPrimOp + MutArr# s a -> MutArr# s a -> Bool + with + usage = { mangle SameMutableArrayOp [mkP, mkP] mkM } + +primop SameMutableByteArrayOp "sameMutableByteArray#" GenPrimOp + MutByteArr# s -> MutByteArr# s -> Bool + +primop ReadArrayOp "readArray#" GenPrimOp + MutArr# s a -> Int# -> State# s -> (# State# s, a #) + with + usage = { mangle ReadArrayOp [mkM, mkP, mkP] mkM } + +primop WriteArrayOp "writeArray#" GenPrimOp + MutArr# s a -> Int# -> a -> State# s -> State# s + with + usage = { mangle WriteArrayOp [mkM, mkP, mkM, mkP] mkR } + strictness = { \ arity -> StrictnessInfo [wwPrim, wwPrim, wwLazy, wwPrim] False } + has_side_effects = True + +primop IndexArrayOp "indexArray#" GenPrimOp + Array# a -> Int# -> (# a #) + with + usage = { mangle IndexArrayOp [mkM, mkP] mkM } + +primop UnsafeFreezeArrayOp "unsafeFreezeArray#" GenPrimOp + MutArr# s a -> State# s -> (# State# s, Array# a #) + with + usage = { mangle UnsafeFreezeArrayOp [mkM, mkP] mkM } + has_side_effects = True + +primop UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp + MutByteArr# s -> State# s -> (# State# s, ByteArr# #) + with + has_side_effects = True + +primop UnsafeThawArrayOp "unsafeThawArray#" GenPrimOp + Array# a -> State# s -> (# State# s, MutArr# s a #) + with + usage = { mangle UnsafeThawArrayOp [mkM, mkP] mkM } + out_of_line = True + +primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp + ByteArr# -> Int# + +primop SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp + MutByteArr# s -> Int# + +------------------------------------------------------------------------ +--- Mutable variables --- +------------------------------------------------------------------------ + +primop NewMutVarOp "newMutVar#" GenPrimOp + a -> State# s -> (# State# s, MutVar# s a #) + with + usage = { mangle NewMutVarOp [mkM, mkP] mkM } + strictness = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False } + out_of_line = True + +primop ReadMutVarOp "readMutVar#" GenPrimOp + MutVar# s a -> State# s -> (# State# s, a #) + with + usage = { mangle ReadMutVarOp [mkM, mkP] mkM } + +primop WriteMutVarOp "writeMutVar#" GenPrimOp + MutVar# s a -> a -> State# s -> State# s + with + strictness = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False } + usage = { mangle WriteMutVarOp [mkM, mkM, mkP] mkR } + has_side_effects = True + +primop SameMutVarOp "sameMutVar#" GenPrimOp + MutVar# s a -> MutVar# s a -> Bool + with + usage = { mangle SameMutVarOp [mkP, mkP] mkM } + +------------------------------------------------------------------------ +--- Exceptions --- +------------------------------------------------------------------------ + +primop CatchOp "catch#" GenPrimOp + (State# RealWorld -> (# State# RealWorld, a #) ) + -> (b -> State# RealWorld -> (# State# RealWorld, a #) ) + -> State# RealWorld + -> (# State# RealWorld, a #) + with + strictness = { \ arity -> StrictnessInfo [wwLazy, wwLazy, wwPrim] False } + -- Catch is actually strict in its first argument + -- but we don't want to tell the strictness + -- analyser about that! + usage = { mangle CatchOp [mkM, mkM . (inFun CatchOp mkM mkM), mkP] mkM } + -- [mkO, mkO . (inFun mkM mkO)] mkO + -- might use caught action multiply + out_of_line = True + +primop RaiseOp "raise#" GenPrimOp + a -> b + with + strictness = { \ arity -> StrictnessInfo [wwLazy] True } + -- NB: True => result is bottom + usage = { mangle RaiseOp [mkM] mkM } + out_of_line = True + +primop BlockAsyncExceptionsOp "blockAsyncExceptions#" GenPrimOp + (State# RealWorld -> (# State# RealWorld, a #)) + -> (State# RealWorld -> (# State# RealWorld, a #)) + with + strictness = { \ arity -> StrictnessInfo [wwLazy] False } + out_of_line = True + +primop UnblockAsyncExceptionsOp "unblockAsyncExceptions#" GenPrimOp + (State# RealWorld -> (# State# RealWorld, a #)) + -> (State# RealWorld -> (# State# RealWorld, a #)) + with + strictness = { \ arity -> StrictnessInfo [wwLazy] False } + out_of_line = True + +------------------------------------------------------------------------ +--- MVars (not the same as mutable variables!) --- +------------------------------------------------------------------------ + +primop NewMVarOp "newMVar#" GenPrimOp + State# s -> (# State# s, MVar# s a #) + with + usage = { mangle NewMVarOp [mkP] mkR } + out_of_line = True + +primop TakeMVarOp "takeMVar#" GenPrimOp + MVar# s a -> State# s -> (# State# s, a #) + with + usage = { mangle TakeMVarOp [mkM, mkP] mkM } + has_side_effects = True + out_of_line = True + +primop PutMVarOp "putMVar#" GenPrimOp + MVar# s a -> a -> State# s -> State# s + with + strictness = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False } + usage = { mangle PutMVarOp [mkM, mkM, mkP] mkR } + has_side_effects = True + out_of_line = True + +primop SameMVarOp "sameMVar#" GenPrimOp + MVar# s a -> MVar# s a -> Bool + with + usage = { mangle SameMVarOp [mkP, mkP] mkM } + +primop TryTakeMVarOp "tryTakeMVar#" GenPrimOp + MVar# s a -> State# s -> (# State# s, Int#, a #) + with + usage = { mangle TryTakeMVarOp [mkM, mkP] mkM } + has_side_effects = True + out_of_line = True + +primop IsEmptyMVarOp "isEmptyMVar#" GenPrimOp + MVar# s a -> State# s -> (# State# s, Int# #) + with + usage = { mangle IsEmptyMVarOp [mkP, mkP] mkM } + + +------------------------------------------------------------------------ +--- delay/wait operations --- +------------------------------------------------------------------------ + +primop DelayOp "delay#" GenPrimOp + Int# -> State# s -> State# s + with + needs_wrapper = True + has_side_effects = True + out_of_line = True + +primop WaitReadOp "waitRead#" GenPrimOp + Int# -> State# s -> State# s + with + needs_wrapper = True + has_side_effects = True + out_of_line = True + +primop WaitWriteOp "waitWrite#" GenPrimOp + Int# -> State# s -> State# s + with + needs_wrapper = True + has_side_effects = True + out_of_line = True + +------------------------------------------------------------------------ +--- concurrency primitives --- +------------------------------------------------------------------------ + +primop ForkOp "fork#" GenPrimOp + a -> State# RealWorld -> (# State# RealWorld, ThreadId# #) + with + usage = { mangle ForkOp [mkO, mkP] mkR } + strictness = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False } + has_side_effects = True + out_of_line = True + +primop KillThreadOp "killThread#" GenPrimOp + ThreadId# -> a -> State# RealWorld -> State# RealWorld + with + usage = { mangle KillThreadOp [mkP, mkM, mkP] mkR } + has_side_effects = True + out_of_line = True + +primop YieldOp "yield#" GenPrimOp + State# RealWorld -> State# RealWorld + with + has_side_effects = True + out_of_line = True + +primop MyThreadIdOp "myThreadId#" GenPrimOp + State# RealWorld -> (# State# RealWorld, ThreadId# #) + +------------------------------------------------------------------------ +--- foreign objects --- +------------------------------------------------------------------------ + +primop MkForeignObjOp "mkForeignObj#" GenPrimOp + Addr# -> State# RealWorld -> (# State# RealWorld, ForeignObj# #) + with + has_side_effects = True + out_of_line = True + +primop WriteForeignObjOp "writeForeignObj#" GenPrimOp + ForeignObj# -> Addr# -> State# s -> State# s + with + has_side_effects = True + +------------------------------------------------------------------------ +--- Bytecode objects --- +------------------------------------------------------------------------ + +primop NewBCOOp "newBCO#" GenPrimOp + Int# -> Int# -> Int# -> a -> State# RealWorld -> (# State# RealWorld, BCO# #) + with + has_side_effects = True + out_of_line = True + +primop WriteBCOPtrOp "writeBCOPtr#" GenPrimOp + BCO# -> Int# -> o -> State# RealWorld -> State# RealWorld + with + usage = { mangle WriteBCOPtrOp [mkP, mkP, mkM] mkR } + has_side_effects = True + +primop WriteBCONonPtrOp "writeBCONonPtr#" GenPrimOp + BCO# -> Int# -> Word# -> State# RealWorld -> State# RealWorld + with + has_side_effects = True + +primop WriteBCOInstrOp "writeBCOInstr#" GenPrimOp + BCO# -> Int# -> Word# -> State# RealWorld -> State# RealWorld + with + has_side_effects = True + +primop ReadBCOPtrOp "readBCOPtr#" GenPrimOp + BCO# -> Int# -> State# RealWorld -> (# State# RealWorld, Word# #) + with + usage = { mangle ReadBCOPtrOp [mkP, mkP] mkM } + +primop ReadBCONonPtrOp "readBCONonPtr#" GenPrimOp + BCO# -> Int# -> State# RealWorld -> (# State# RealWorld, Word# #) + +primop ReadBCOInstrOp "readBCOInstr#" GenPrimOp + BCO# -> Int# -> State# RealWorld -> (# State# RealWorld, Word# #) + +------------------------------------------------------------------------ +--- Weak pointers --- +------------------------------------------------------------------------ + +-- note that tyvar "o" denoted openAlphaTyVar + +primop MkWeakOp "mkWeak#" GenPrimOp + o -> b -> c -> State# RealWorld -> (# State# RealWorld, Weak# b #) + with + strictness = { \ arity -> StrictnessInfo [wwLazy, wwLazy, wwLazy, wwPrim] False } + usage = { mangle MkWeakOp [mkZ, mkM, mkM, mkP] mkM } + has_side_effects = True + out_of_line = True + +primop DeRefWeakOp "deRefWeak#" GenPrimOp + Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, a #) + with + usage = { mangle DeRefWeakOp [mkM, mkP] mkM } + has_side_effects = True + +primop FinalizeWeakOp "finalizeWeak#" GenPrimOp + Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, + (State# RealWorld -> (# State# RealWorld, Unit #)) #) + with + usage = { mangle FinalizeWeakOp [mkM, mkP] + (mkR . (inUB FinalizeWeakOp + [id,id,inFun FinalizeWeakOp mkR mkM])) } + has_side_effects = True + out_of_line = True + + +------------------------------------------------------------------------ +--- Stable pointers and names --- +------------------------------------------------------------------------ + +primop MakeStablePtrOp "makeStablePtr#" GenPrimOp + a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #) + with + strictness = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False } + usage = { mangle MakeStablePtrOp [mkM, mkP] mkM } + has_side_effects = True + +primop DeRefStablePtrOp "deRefStablePtr#" GenPrimOp + StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #) + with + usage = { mangle DeRefStablePtrOp [mkM, mkP] mkM } + needs_wrapper = True + has_side_effects = True + +primop EqStablePtrOp "eqStablePtr#" GenPrimOp + StablePtr# a -> StablePtr# a -> Int# + with + usage = { mangle EqStablePtrOp [mkP, mkP] mkR } + has_side_effects = True + +primop MakeStableNameOp "makeStableName#" GenPrimOp + a -> State# RealWorld -> (# State# RealWorld, StableName# a #) + with + usage = { mangle MakeStableNameOp [mkZ, mkP] mkR } + strictness = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False } + needs_wrapper = True + has_side_effects = True + out_of_line = True + +primop EqStableNameOp "eqStableName#" GenPrimOp + StableName# a -> StableName# a -> Int# + with + usage = { mangle EqStableNameOp [mkP, mkP] mkR } + +primop StableNameToIntOp "stableNameToInt#" GenPrimOp + StableName# a -> Int# + with + usage = { mangle StableNameToIntOp [mkP] mkR } + +------------------------------------------------------------------------ +--- Unsafe pointer equality (#1 Bad Guy: Alistair Reid :) --- +------------------------------------------------------------------------ + +primop ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp + a -> a -> Int# + with + usage = { mangle ReallyUnsafePtrEqualityOp [mkZ, mkZ] mkR } + +------------------------------------------------------------------------ +--- Parallelism --- +------------------------------------------------------------------------ + +primop SeqOp "seq#" GenPrimOp + a -> Int# + with + usage = { mangle SeqOp [mkO] mkR } + strictness = { \ arity -> StrictnessInfo [wwStrict] False } + -- Seq is strict in its argument; see notes in ConFold.lhs + has_side_effects = True + +primop ParOp "par#" GenPrimOp + a -> Int# + with + usage = { mangle ParOp [mkO] mkR } + strictness = { \ arity -> StrictnessInfo [wwLazy] False } + -- Note that Par is lazy to avoid that the sparked thing + -- gets evaluted strictly, which it should *not* be + has_side_effects = True + +-- 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# +-- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine +-- `the processor containing the expression v'; it is not evaluated + +primop ParGlobalOp "parGlobal#" GenPrimOp + a -> Int# -> Int# -> Int# -> Int# -> b -> Int# + with + usage = { mangle ParGlobalOp [mkO, mkP, mkP, mkP, mkP, mkM] mkM } + has_side_effects = True + +primop ParLocalOp "parLocal#" GenPrimOp + a -> Int# -> Int# -> Int# -> Int# -> b -> Int# + with + usage = { mangle ParLocalOp [mkO, mkP, mkP, mkP, mkP, mkM] mkM } + has_side_effects = True + +primop ParAtOp "parAt#" GenPrimOp + b -> a -> Int# -> Int# -> Int# -> Int# -> c -> Int# + with + usage = { mangle ParAtOp [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM } + has_side_effects = True + +primop ParAtAbsOp "parAtAbs#" GenPrimOp + a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int# + with + usage = { mangle ParAtAbsOp [mkO, mkP, mkP, mkP, mkP, mkM] mkM } + has_side_effects = True + +primop ParAtRelOp "parAtRel#" GenPrimOp + a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int# + with + usage = { mangle ParAtRelOp [mkO, mkP, mkP, mkP, mkP, mkM] mkM } + has_side_effects = True + +primop ParAtForNowOp "parAtForNow#" GenPrimOp + b -> a -> Int# -> Int# -> Int# -> Int# -> c -> Int# + with + usage = { mangle ParAtForNowOp [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM } + has_side_effects = True + +primop CopyableOp "copyable#" GenPrimOp + a -> Int# + with + usage = { mangle CopyableOp [mkZ] mkR } + has_side_effects = True + +primop NoFollowOp "noFollow#" GenPrimOp + a -> Int# + with + usage = { mangle NoFollowOp [mkZ] mkR } + has_side_effects = True + + +------------------------------------------------------------------------ +--- tag to enum stuff --- +------------------------------------------------------------------------ + +primop DataToTagOp "dataToTag#" GenPrimOp + a -> Int# + with + strictness = { \ arity -> StrictnessInfo [wwLazy] False } + +primop TagToEnumOp "tagToEnum#" GenPrimOp + Int# -> a + + +thats_all_folks + +------------------------------------------------------------------------ +--- --- +------------------------------------------------------------------------ +