-\begin{code}
-primOpInfo WordQuotOp = Dyadic SLIT("quotWord#") wordPrimTy
-primOpInfo WordRemOp = Dyadic SLIT("remWord#") wordPrimTy
-
-primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy
-primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy
-primOpInfo XorOp = Dyadic SLIT("xor#") wordPrimTy
-primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy
-
-primOpInfo SllOp
- = GenPrimOp SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTy
-primOpInfo SrlOp
- = GenPrimOp SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTy
-
-primOpInfo ISllOp
- = GenPrimOp SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTy
-primOpInfo ISraOp
- = GenPrimOp SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTy
-primOpInfo ISrlOp
- = GenPrimOp SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTy
-
-primOpInfo Int2WordOp = GenPrimOp SLIT("int2Word#") [] [intPrimTy] wordPrimTy
-primOpInfo Word2IntOp = GenPrimOp SLIT("word2Int#") [] [wordPrimTy] intPrimTy
-\end{code}
-
-%************************************************************************
-%* *
-\subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
-%* *
-%************************************************************************
-
-\begin{code}
-primOpInfo Int2AddrOp = GenPrimOp SLIT("int2Addr#") [] [intPrimTy] addrPrimTy
-primOpInfo Addr2IntOp = GenPrimOp 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 = Dyadic SLIT("plusFloat#") floatPrimTy
-primOpInfo FloatSubOp = Dyadic SLIT("minusFloat#") floatPrimTy
-primOpInfo FloatMulOp = Dyadic SLIT("timesFloat#") floatPrimTy
-primOpInfo FloatDivOp = Dyadic SLIT("divideFloat#") floatPrimTy
-primOpInfo FloatNegOp = Monadic SLIT("negateFloat#") floatPrimTy
-
-primOpInfo Float2IntOp = GenPrimOp SLIT("float2Int#") [] [floatPrimTy] intPrimTy
-primOpInfo Int2FloatOp = GenPrimOp SLIT("int2Float#") [] [intPrimTy] floatPrimTy
-
-primOpInfo FloatExpOp = Monadic SLIT("expFloat#") floatPrimTy
-primOpInfo FloatLogOp = Monadic SLIT("logFloat#") floatPrimTy
-primOpInfo FloatSqrtOp = Monadic SLIT("sqrtFloat#") floatPrimTy
-primOpInfo FloatSinOp = Monadic SLIT("sinFloat#") floatPrimTy
-primOpInfo FloatCosOp = Monadic SLIT("cosFloat#") floatPrimTy
-primOpInfo FloatTanOp = Monadic SLIT("tanFloat#") floatPrimTy
-primOpInfo FloatAsinOp = Monadic SLIT("asinFloat#") floatPrimTy
-primOpInfo FloatAcosOp = Monadic SLIT("acosFloat#") floatPrimTy
-primOpInfo FloatAtanOp = Monadic SLIT("atanFloat#") floatPrimTy
-primOpInfo FloatSinhOp = Monadic SLIT("sinhFloat#") floatPrimTy
-primOpInfo FloatCoshOp = Monadic SLIT("coshFloat#") floatPrimTy
-primOpInfo FloatTanhOp = Monadic SLIT("tanhFloat#") floatPrimTy
-primOpInfo FloatPowerOp = Dyadic 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 = Dyadic SLIT("+##") doublePrimTy
-primOpInfo DoubleSubOp = Dyadic SLIT("-##") doublePrimTy
-primOpInfo DoubleMulOp = Dyadic SLIT("*##") doublePrimTy
-primOpInfo DoubleDivOp = Dyadic SLIT("/##") doublePrimTy
-primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy
-
-primOpInfo Double2IntOp = GenPrimOp SLIT("double2Int#") [] [doublePrimTy] intPrimTy
-primOpInfo Int2DoubleOp = GenPrimOp SLIT("int2Double#") [] [intPrimTy] doublePrimTy
-
-primOpInfo Double2FloatOp = GenPrimOp SLIT("double2Float#") [] [doublePrimTy] floatPrimTy
-primOpInfo Float2DoubleOp = GenPrimOp SLIT("float2Double#") [] [floatPrimTy] doublePrimTy
-
-primOpInfo DoubleExpOp = Monadic SLIT("expDouble#") doublePrimTy
-primOpInfo DoubleLogOp = Monadic SLIT("logDouble#") doublePrimTy
-primOpInfo DoubleSqrtOp = Monadic SLIT("sqrtDouble#") doublePrimTy
-primOpInfo DoubleSinOp = Monadic SLIT("sinDouble#") doublePrimTy
-primOpInfo DoubleCosOp = Monadic SLIT("cosDouble#") doublePrimTy
-primOpInfo DoubleTanOp = Monadic SLIT("tanDouble#") doublePrimTy
-primOpInfo DoubleAsinOp = Monadic SLIT("asinDouble#") doublePrimTy
-primOpInfo DoubleAcosOp = Monadic SLIT("acosDouble#") doublePrimTy
-primOpInfo DoubleAtanOp = Monadic SLIT("atanDouble#") doublePrimTy
-primOpInfo DoubleSinhOp = Monadic SLIT("sinhDouble#") doublePrimTy
-primOpInfo DoubleCoshOp = Monadic SLIT("coshDouble#") doublePrimTy
-primOpInfo DoubleTanhOp = Monadic SLIT("tanhDouble#") doublePrimTy
-primOpInfo DoublePowerOp= Dyadic 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
- = GenPrimOp SLIT("integer2Int#") [] one_Integer_ty intPrimTy
-
-primOpInfo Integer2WordOp
- = GenPrimOp SLIT("integer2Word#") [] one_Integer_ty wordPrimTy
-
-primOpInfo Int2IntegerOp
- = GenPrimOp SLIT("int2Integer#") [] [intPrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
-
-primOpInfo Word2IntegerOp
- = GenPrimOp SLIT("word2Integer#") [] [wordPrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
-
-primOpInfo Addr2IntegerOp
- = GenPrimOp SLIT("addr2Integer#") [] [addrPrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
-
-primOpInfo IntegerToInt64Op
- = GenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy
-
-primOpInfo Int64ToIntegerOp
- = GenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
-
-primOpInfo Word64ToIntegerOp
- = GenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
-
-primOpInfo IntegerToWord64Op
- = GenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy
-\end{code}
-
-Encoding and decoding of floating-point numbers is sorta
-Integer-related.
-
-\begin{code}
-primOpInfo FloatEncodeOp
- = GenPrimOp SLIT("encodeFloat#") [] an_Integer_and_Int_tys floatPrimTy
-
-primOpInfo DoubleEncodeOp
- = GenPrimOp SLIT("encodeDouble#") [] an_Integer_and_Int_tys doublePrimTy
-
-primOpInfo FloatDecodeOp
- = GenPrimOp SLIT("decodeFloat#") [] [floatPrimTy]
- (unboxedQuadruple [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy])
-primOpInfo DoubleDecodeOp
- = GenPrimOp 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
- GenPrimOp 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
- GenPrimOp 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
- GenPrimOp 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
- GenPrimOp 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
- GenPrimOp 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
- GenPrimOp SLIT("writeArray#") [s_tv, elt_tv]
- [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
- (mkStatePrimTy s)
-
-primOpInfo IndexArrayOp
- = let { elt = alphaTy; elt_tv = alphaTyVar } in
- GenPrimOp 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
- GenPrimOp 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
- GenPrimOp 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
- GenPrimOp 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
- GenPrimOp 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
- GenPrimOp 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
- GenPrimOp 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
- GenPrimOp 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
- GenPrimOp SLIT("unsafeFreezeByteArray#") [s_tv]
- [mkMutableByteArrayPrimTy s, state]
- (unboxedPair [state, byteArrayPrimTy])
-
----------------------------------------------------------------------------
-primOpInfo SizeofByteArrayOp
- = GenPrimOp
- SLIT("sizeofByteArray#") []
- [byteArrayPrimTy]
- intPrimTy
-
-primOpInfo SizeofMutableByteArrayOp
- = let { s = alphaTy; s_tv = alphaTyVar } in
- GenPrimOp
- 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
- GenPrimOp 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
- GenPrimOp 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
- GenPrimOp 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
- GenPrimOp 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
- GenPrimOp 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
- GenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
-\end{code}