diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile
index a7caff020f6046e637780079eefd663ef476fc21..9a0fd791356b962d98c16148f991d7dd8695bcb6 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
@@ -228,6 +228,38 @@ simplStg/UpdAnal_HC_OPTS = -fno-strictness
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
diff --git a/ghc/compiler/basicTypes/Unique.lhs b/ghc/compiler/basicTypes/Unique.lhs
index 0634b513065f7e3c6c8b06f396964df83258337c..abe3856c38ef63ad2346e34ff80b4f25a8e8bac7 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 b06cac3504a72629640eee295000cf086db3d06b..4db56ed1be584a4a510309b49bd019dc0c29756f 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 7576dd80757b833568dbde243667f8d251260dc8..dc3bee7c93869128e3a256ff370625c1cffa4826 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 94666c7101ed3719dd805d082b066e190c9c898e..ae88f95dd64904a5db2cbf0db12d1160225cd569 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 0d4328d278d71f339e5b20c1c1b3d11553867743..3c2d26c21a4b1389d1eaac2c2b2751e80e579493 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 34d49c78edc3ee5dd0c2006964c4f9c7c2c559c1..9b7681f8bcf11c87127a29bd5e22a3734fb6b903 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 4c87fe5429a428ba854562e0ff47710ebc27c4f2..70bb36771dbe3c040d8929214e7abfe4b41cc53d 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 10673367a3b36ecce7913a333f9f5b2547887f86..ff4e30511491e1840711a3ea3e23e9f1bab0297e 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)
@@ -266,6 +269,17 @@ foreignObjPrimTy = mkTyConTy foreignObjPrimTyCon
foreignObjPrimTyCon = pcPrimTyCon foreignObjPrimTyConKey SLIT("ForeignObj#") 0 [] ForeignObjRep
\end{code}
+%************************************************************************
+%* *
+\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 0000000000000000000000000000000000000000..64e78647e50153d3e37f3a1728cd2b72a3073566
--- /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
+
+------------------------------------------------------------------------
+--- ---
+------------------------------------------------------------------------
+