-\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}
-%* *
-%************************************************************************
-
-@encodeFloat#@ and @decodeFloat#@ are 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}
-%* *
-%************************************************************************
-
-@encodeDouble#@ and @decodeDouble#@ are 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 IntegerCmpOp = integerCompare SLIT("cmpInteger#")
-
-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]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
-
-primOpInfo Word2IntegerOp
- = mkGenPrimOp SLIT("word2Integer#") [] [wordPrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
-
-primOpInfo Addr2IntegerOp
- = mkGenPrimOp SLIT("addr2Integer#") [] [addrPrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
-
-primOpInfo IntegerToInt64Op
- = mkGenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy
-
-primOpInfo Int64ToIntegerOp
- = mkGenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
-
-primOpInfo Word64ToIntegerOp
- = mkGenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
-
-primOpInfo IntegerToWord64Op
- = mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy
-\end{code}
-
-Encoding and decoding of floating-point numbers is sorta
-Integer-related.
-
-\begin{code}
-primOpInfo FloatEncodeOp
- = mkGenPrimOp SLIT("encodeFloat#") [] an_Integer_and_Int_tys floatPrimTy
-
-primOpInfo DoubleEncodeOp
- = mkGenPrimOp SLIT("encodeDouble#") [] an_Integer_and_Int_tys doublePrimTy
-
-primOpInfo FloatDecodeOp
- = mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy]
- (unboxedQuadruple [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy])
-primOpInfo DoubleDecodeOp
- = mkGenPrimOp SLIT("decodeDouble#") [] [doublePrimTy]
- (unboxedQuadruple [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy])
-\end{code}
-
-%************************************************************************
-%* *
-\subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
-%* *
-%************************************************************************
-
-\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])
-
----------------------------------------------------------------------------
-
-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:
-
-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]
- (unboxedPair [realWorldStatePrimTy, elt])
-
----------------------------------------------------------------------------
--- Primitive arrays full of unboxed bytes:
-
-primOpInfo (ReadByteArrayOp kind)
- = let
- s = alphaTy; s_tv = alphaTyVar
-
- op_str = _PK_ ("read" ++ primRepString kind ++ "Array#")
- relevant_type = assoc "primOpInfo{ReadByteArrayOp}" tbl kind
- state = mkStatePrimTy s
-
- tvs
- | kind == StablePtrRep = [s_tv, betaTyVar]
- | otherwise = [s_tv]
- in
- mkGenPrimOp op_str tvs
- [mkMutableByteArrayPrimTy s, intPrimTy, state]
- (unboxedPair [state, relevant_type])
- where
- tbl = [ (CharRep, charPrimTy),
- (IntRep, intPrimTy),
- (WordRep, wordPrimTy),
- (AddrRep, addrPrimTy),
- (FloatRep, floatPrimTy),
- (StablePtrRep, mkStablePtrPrimTy betaTy),
- (DoubleRep, doublePrimTy) ]
-
- -- How come there's no Word byte arrays? ADR
-
-primOpInfo (WriteByteArrayOp kind)
- = let
- s = alphaTy; s_tv = alphaTyVar
- op_str = _PK_ ("write" ++ primRepString kind ++ "Array#")
- prim_ty = mkTyConApp (primRepTyCon kind) []
-
- (the_prim_ty, tvs)
- | kind == StablePtrRep = (mkStablePtrPrimTy betaTy, [s_tv, betaTyVar])
- | otherwise = (prim_ty, [s_tv])
-
- in
- mkGenPrimOp op_str tvs
- [mkMutableByteArrayPrimTy s, intPrimTy, the_prim_ty, mkStatePrimTy s]
- (mkStatePrimTy s)
-
-primOpInfo (IndexByteArrayOp kind)
- = let
- op_str = _PK_ ("index" ++ primRepString kind ++ "Array#")
-
- (prim_tycon_args, tvs)
- | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
- | otherwise = ([],[])
- in
- mkGenPrimOp op_str tvs [byteArrayPrimTy, intPrimTy]
- (mkTyConApp (primRepTyCon kind) prim_tycon_args)
-
-primOpInfo (IndexOffForeignObjOp kind)
- = let
- op_str = _PK_ ("index" ++ primRepString kind ++ "OffForeignObj#")
-
- (prim_tycon_args, tvs)
- | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
- | otherwise = ([], [])
- in
- mkGenPrimOp op_str tvs [foreignObjPrimTy, intPrimTy]
- (mkTyConApp (primRepTyCon kind) prim_tycon_args)
-
-primOpInfo (IndexOffAddrOp kind)
- = let
- op_str = _PK_ ("index" ++ primRepString kind ++ "OffAddr#")
-
- (prim_tycon_args, tvs)
- | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
- | otherwise = ([], [])
- in
- mkGenPrimOp op_str tvs [addrPrimTy, intPrimTy]
- (mkTyConApp (primRepTyCon kind) prim_tycon_args)
-
-primOpInfo (WriteOffAddrOp kind)
- = let
- s = alphaTy; s_tv = alphaTyVar
- op_str = _PK_ ("write" ++ primRepString kind ++ "OffAddr#")
- prim_ty = mkTyConApp (primRepTyCon kind) []
- in
- mkGenPrimOp op_str [s_tv]
- [addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s]
- (mkStatePrimTy s)
-
----------------------------------------------------------------------------
-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 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 :: IO a -> (IOError -> IO a) -> IO a
-catch :: a -> (b -> a) -> a
-
-\begin{code}
-primOpInfo CatchOp
- = let
- a = alphaTy; a_tv = alphaTyVar
- b = betaTy; b_tv = betaTyVar;
- in
- mkGenPrimOp SLIT("catch#") [a_tv, b_tv] [a, mkFunTy b a] a
-
-primOpInfo RaiseOp
- = let
- a = alphaTy; a_tv = alphaTyVar
- b = betaTy; b_tv = betaTyVar;
- in
- mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
-\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 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}
-%* *
-%************************************************************************