How I spent my summer vacation.
Primops
-------
The format of the primops.txt.pp file has been enhanced to allow
(latex-style) primop descriptions to be included. There is a new flag
to genprimopcode that generates documentation including these
descriptions. A first cut at descriptions of the more interesting
primops has been made, and the file has been reordered a bit.
31-bit words
------------
The front end now can cope with the possibility of 31-bit (or even 30-bit)
Int# and Word# types. The only current use of this is to generate
external .core files that can be translated into OCAML source files
(OCAML uses a one-bit tag to distinguish integers from pointers).
The only way to get this right now is by hand-defining the preprocessor
symbol WORD_SIZE_IN_BITS, which is normally set automatically from
the familiar WORD_SIZE_IN_BYTES.
Just in case 31-bit words are used, we now have Int32# and Word32# primitive types
and an associated family of operators, paralleling the existing 64-bit
stuff. Of course, none of the operators actually need to be implemented
in the absence of a 31-bit backend.
There has also been some minor re-jigging of the 32 vs. 64 bit stuff.
See the description at the top of primops.txt.pp file for more details.
Note that, for the first time, the *type* of a primop can now depend
on the target word size.
Also, the family of primops intToInt8#, intToInt16#, etc.
have been renamed narrow8Int#, narrow16Int#, etc., to emphasize
that they work on Int#'s and don't actually convert between types.
Addresses
---------
As another part of coping with the possibility of 31-bit ints,
the addr2Int# and int2Addr# primops are now thoroughly deprecated
(and not even defined in the 31-bit case) and all uses
of them have been removed except from the (deprecated) module
hslibs/lang/Addr
Addr# should now be treated as a proper abstract type, and has these suitable operators:
nullAddr# : Int# -> Addr# (ignores its argument; nullary primops cause problems at various places)
plusAddr# : Addr# -> Int# -> Addr#
minusAddr : Addr# -> Addr# -> Int#
remAddr# : Addr# -> Int# -> Int#
Obviously, these don't allow completely arbitrary offsets if 31-bit ints are
in use, but they should do for all practical purposes.
It is also still possible to generate an address constant, and there is a built-in rule
that makes use of this to remove the nullAddr# calls.
Misc
----
There is a new compile flag -fno-code that causes GHC to quit after generating .hi files
and .core files (if requested) but before generating STG.
Z-encoded names for tuples have been rationalized; e.g.,
Z3H now means an unboxed 3-tuple, rather than an unboxed
tuple with 3 commas (i.e., a 4-tuple)!
Removed misc. litlits in hslibs/lang
Misc. small changes to external core format. The external core description
has also been substantially updated, and incorporates the automatically-generated
primop documentation; its in the repository at /papers/ext-core/core.tex.
A little make-system addition to allow passing CPP options to compiler and
library builds.
# -----------------------------------------------------------------------------
-# $Id: Makefile,v 1.189 2001/08/16 22:54:24 sof Exp $
+# $Id: Makefile,v 1.190 2001/08/17 17:18:51 apt Exp $
TOP = ..
include $(TOP)/mk/boilerplate.mk
primop-usage.hs-incl \
primop-primop-info.hs-incl
-SRC_CPP_OPTS += -I$(GHC_INCLUDE_DIR)
+SRC_CPP_OPTS += -I$(GHC_INCLUDE_DIR) -traditional
+SRC_CPP_OPTS += ${GhcCppOpts}
ifneq "$(BootingFromHc)" "YES"
prelude/PrimOp.lhs prelude/PrimOp.o: $(PRIMOP_BITS)
pprUnionTag Int8Rep = ptext SLIT("i8")
pprUnionTag IntRep = char 'i'
pprUnionTag WordRep = char 'w'
+pprUnionTag Int32Rep = char 'i'
+pprUnionTag Word32Rep = char 'w'
pprUnionTag AddrRep = char 'a'
pprUnionTag FloatRep = char 'f'
pprUnionTag DoubleRep = panic "pprUnionTag:Double?"
, inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
, word2IntLit, int2WordLit
- , intToInt8Lit, intToInt16Lit, intToInt32Lit
- , wordToWord8Lit, wordToWord16Lit, wordToWord32Lit
+ , narrow8IntLit, narrow16IntLit, narrow32IntLit
+ , narrow8WordLit, narrow16WordLit, narrow32WordLit
, char2IntLit, int2CharLit
, float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
- , addr2IntLit, int2AddrLit, float2DoubleLit, double2FloatLit
+ , nullAddrLit, float2DoubleLit, double2FloatLit
) where
#include "HsVersions.h"
| MachAddr Integer -- Whatever this machine thinks is a "pointer"
- | MachInt Integer -- Int# At least 32 bits
+ | MachInt Integer -- Int# At least WORD_SIZE_IN_BITS bits
| MachInt64 Integer -- Int64# At least 64 bits
- | MachWord Integer -- Word# At least 32 bits
+ | MachWord Integer -- Word# At least WORD_SIZE_IN_BITS bits
| MachWord64 Integer -- Word64# At least 64 bits
| MachFloat Rational
~~~~~~~~~
\begin{code}
word2IntLit, int2WordLit,
- intToInt8Lit, intToInt16Lit, intToInt32Lit,
- wordToWord8Lit, wordToWord16Lit, wordToWord32Lit,
+ narrow8IntLit, narrow16IntLit, narrow32IntLit,
+ narrow8WordLit, narrow16WordLit, narrow32WordLit,
char2IntLit, int2CharLit,
float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
- addr2IntLit, int2AddrLit, float2DoubleLit, double2FloatLit
+ float2DoubleLit, double2FloatLit
:: Literal -> Literal
word2IntLit (MachWord w)
| i < 0 = MachWord (1 + tARGET_MAX_WORD + i) -- (-1) ---> tARGET_MAX_WORD
| otherwise = MachWord i
-intToInt8Lit (MachInt i) = MachInt (toInteger (fromInteger i :: Int8))
-intToInt16Lit (MachInt i) = MachInt (toInteger (fromInteger i :: Int16))
-intToInt32Lit (MachInt i) = MachInt (toInteger (fromInteger i :: Int32))
-wordToWord8Lit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
-wordToWord16Lit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
-wordToWord32Lit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
+narrow8IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int8))
+narrow16IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int16))
+narrow32IntLit (MachInt i) = MachInt (toInteger (fromInteger i :: Int32))
+narrow8WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
+narrow16WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
+narrow32WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
char2IntLit (MachChar c) = MachInt (toInteger c)
int2CharLit (MachInt i) = MachChar (fromInteger i)
double2IntLit (MachDouble f) = MachInt (truncate f)
int2DoubleLit (MachInt i) = MachDouble (fromInteger i)
-addr2IntLit (MachAddr a) = MachInt a
-int2AddrLit (MachInt i) = MachAddr i
-
float2DoubleLit (MachFloat f) = MachDouble f
double2FloatLit (MachDouble d) = MachFloat d
+
+nullAddrLit :: Literal
+nullAddrLit = MachAddr 0
\end{code}
Predicates
$dm... default methods
$p... superclass selectors
$w... workers
- $T... compiler-generated tycons for dictionaries
- $D... ...ditto data cons
+ :T... compiler-generated tycons for dictionaries
+ :D... ...ditto data cons
$sf.. specialised version of f
in encoded form these appear as Zdfxxx etc
:... keywords (export:, letrec: etc.)
+--- I THINK THIS IS WRONG!
This knowledge is encoded in the following functions.
-@mk_deriv@ generates an @OccName@ from the one-char prefix and a string.
+@mk_deriv@ generates an @OccName@ from the prefix and a string.
NB: The string must already be encoded!
\begin{code}
foo## foozhzh
foo##1 foozhzh1
fooZ fooZZ
- :+ Zczp
- () Z0T
- (,,,,) Z4T 5-tuple
- (#,,,,#) Z4H unboxed 5-tuple
- (NB: the number is one different to the number of
- elements. No real reason except that () is a zero-tuple,
- while (,) is a 2-tuple.)
+ :+ ZCzp
+ () Z0T 0-tuple
+ (,,,,) Z5T 5-tuple
+ (# #) Z1H unboxed 1-tuple (note the space)
+ (#,,,,#) Z5H unboxed 5-tuple
+ (NB: There is no Z1T nor Z0H.)
\begin{code}
-- alreadyEncoded is used in ASSERTs to check for encoded
go [] = []
go (c:cs) = encode_ch c ++ go cs
+maybe_tuple "(# #)" = Just("Z1H")
maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of
- (n, '#' : ')' : cs) -> Just ('Z' : shows n "H")
+ (n, '#' : ')' : cs) -> Just ('Z' : shows (n+1) "H")
other -> Nothing
+maybe_tuple "()" = Just("Z0T")
maybe_tuple ('(' : cs) = case count_commas (0::Int) cs of
- (n, ')' : cs) -> Just ('Z' : shows n "T")
+ (n, ')' : cs) -> Just ('Z' : shows (n+1) "T")
other -> Nothing
maybe_tuple other = Nothing
| isDigit c = go (digitToInt c) rest
where
go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest
- go n ('T' : rest) = '(' : replicate n ',' ++ ')' : decode rest
- go n ('H' : rest) = '(' : '#' : replicate n ',' ++ '#' : ')' : decode rest
+ go 0 ('T' : rest) = "()" ++ (decode rest)
+ go n ('T' : rest) = '(' : replicate (n-1) ',' ++ ')' : decode rest
+ go 1 ('H' : rest) = "(# #)" ++ (decode rest)
+ go n ('H' : rest) = '(' : '#' : replicate (n-1) ',' ++ '#' : ')' : decode rest
go n ('U' : rest) = chr n : decode rest
go n other = pprPanic "decode_escape" (ppr n <+> text (c:rest))
%************************************************************************
%* *
-n\subsection{Lexical categories}
+\subsection{Lexical categories}
%* *
%************************************************************************
%
% (c) The GRASP Project, Glasgow University, 1992-1998
%
-% $Id: CgRetConv.lhs,v 1.29 2000/11/14 17:41:04 sewardj Exp $
+% $Id: CgRetConv.lhs,v 1.30 2001/08/17 17:18:52 apt Exp $
%
\section[CgRetConv]{Return conventions for the code generator}
dataReturnConvPrim IntRep = VanillaReg IntRep (_ILIT 1)
dataReturnConvPrim WordRep = VanillaReg WordRep (_ILIT 1)
+dataReturnConvPrim Int32Rep = VanillaReg Int32Rep (_ILIT 1)
+dataReturnConvPrim Word32Rep = VanillaReg Word32Rep (_ILIT 1)
dataReturnConvPrim Int64Rep = LongReg Int64Rep (_ILIT 1)
dataReturnConvPrim Word64Rep = LongReg Word64Rep (_ILIT 1)
dataReturnConvPrim AddrRep = VanillaReg AddrRep (_ILIT 1)
| Case Exp Vbind [Alt] {- non-empty list -}
| Coerce Ty Exp
| Note String Exp
- | Ccall String Ty
+ | External String Ty
data Bind
= Vb Vbind
make_exp (Var v) =
case globalIdDetails v of
DataConId _ -> C.Dcon (make_con_qid (Var.varName v))
- FCallId (CCall (CCallSpec (StaticTarget nm) _ _)) -> C.Ccall (_UNPK_ nm) (make_ty (varType v))
+ FCallId (CCall (CCallSpec (StaticTarget nm) _ _)) -> C.External (_UNPK_ nm) (make_ty (varType v))
+ FCallId _ -> error "MkExternalCore died: can't handle non-static-C foreign call"
_ -> C.Var (make_var_qid (Var.varName v))
+make_exp (Lit (l@(MachLabel s))) = C.External (_UNPK_ s) (make_ty (literalType l))
make_exp (Lit l) = C.Lit (make_lit l)
make_exp (App e (Type t)) = C.Appt (make_exp e) (make_ty t)
make_exp (App e1 e2) = C.App (make_exp e1) (make_exp e2)
MachWord64 i -> C.Lint i t
MachFloat r -> C.Lrational r t
MachDouble r -> C.Lrational r t
- MachLabel s -> C.Lstring (_UNPK_ s) t
_ -> error "MkExternalCore died: make_lit"
where
t = make_ty (literalType l)
{- Id generation. -}
-{- Use encoded strings, except restore '#'s.
+{- Use encoded strings.
Also, adjust casing to work around some badly-chosen internal names. -}
make_id :: Bool -> Name -> C.Id
make_id is_var nm =
case n of
- c:cs -> if isUpper c && is_var then (toLower c):(decode cs)
- else if isLower c && (not is_var) then (toUpper c):(decode cs)
- else decode n
+ 'Z':cs | is_var -> 'z':cs
+ 'z':cs | not is_var -> 'Z':cs
+ c:cs | isUpper c && is_var -> 'z':'d':n
+ c:cs | isLower c && (not is_var) -> 'Z':'d':n
+ _ -> n
where n = (occNameString . nameOccName) nm
- decode ('z':'h':cs) = '#':(decode cs)
- decode (c:cs) = c:(decode cs)
- decode [] = []
make_var_id :: Name -> C.Id
make_var_id = make_id True
$$ (indent (braces (vcat (punctuate (char ';') (map palt alts)))))
pexp (Coerce t e) = (text "%coerce" <+> paty t) $$ pexp e
pexp (Note s e) = (text "%note" <+> pstring s) $$ pexp e
-pexp (Ccall n t) = (text "%ccall" <+> pstring n) $$ paty t
+pexp (External n t) = (text "%external" <+> pstring n) $$ paty t
pexp e = pfexp e
| HscJava
| HscILX
| HscInterpreted
+ | HscNothing
deriving (Eq, Show)
defaultDynFlags = DynFlags {
{-# OPTIONS -#include "hschooks.h" #-}
-----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.65 2001/08/15 09:32:40 rrt Exp $
+-- $Id: DriverFlags.hs,v 1.66 2001/08/17 17:18:52 apt Exp $
--
-- Driver flags
--
, ( "fvia-c", NoArg (setLang HscC) )
, ( "fvia-C", NoArg (setLang HscC) )
, ( "filx", NoArg (setLang HscILX) )
+ , ( "fno-code", NoArg (setLang HscNothing) )
-- "active negatives"
, ( "fno-implicit-prelude", NoArg (setDynFlag Opt_NoImplicitPrelude) )
HscILX | split -> not_valid
| otherwise -> [ Unlit, Cpp, Hsc, Ilx2Il, Ilasm ]
#endif
+ HscNothing -> [ Unlit, Cpp, Hsc ]
| cish = [ Cc, As ]
HscRecomp pcs details iface stub_h_exists stub_c_exists
_maybe_interpreted_code -> do
- -- deal with stubs
- maybe_stub_o <- compileStub dyn_flags' stub_c_exists
- case maybe_stub_o of
- Nothing -> return ()
- Just stub_o -> add v_Ld_inputs stub_o
-
- return (Just output_fn)
+ -- deal with stubs
+ maybe_stub_o <- compileStub dyn_flags' stub_c_exists
+ case maybe_stub_o of
+ Nothing -> return ()
+ Just stub_o -> add v_Ld_inputs stub_o
+ case hscLang dyn_flags of
+ HscNothing -> return Nothing
+ _ -> return (Just output_fn)
}
-----------------------------------------------------------------------------
HscILX -> return (phaseInputExt Ilx2Il)
#endif
HscInterpreted -> return (error "no output file")
+ HscNothing -> return (error "no output file")
let dyn_flags' = dyn_flags { hscOutName = output_fn,
hscStubCOutName = basename ++ "_stub.c",
= do {
-- what target are we shooting for?
; let toInterp = dopt_HscLang dflags == HscInterpreted
+ ; let toNothing = dopt_HscLang dflags == HscNothing
; when (verbosity dflags >= 1) $
hPutStrLn stderr ("Compiling " ++
mkFinalIface ghci_mode dflags location
maybe_checked_iface new_iface tidy_details
- ------------------ Code generation ------------------
- abstractC <- _scc_ "CodeGen"
- codeGen dflags this_mod imported_modules
- cost_centre_info fe_binders
- local_tycons stg_binds
-
- ------------------ Code output -----------------------
- (stub_h_exists, stub_c_exists)
- <- codeOutput dflags this_mod local_tycons
- binds stg_binds
- c_code h_code abstractC
-
- return (stub_h_exists, stub_c_exists, Nothing, final_iface)
+ if toNothing
+ then do
+ return (False, False, Nothing, final_iface)
+ else do
+ ------------------ Code generation ------------------
+ abstractC <- _scc_ "CodeGen"
+ codeGen dflags this_mod imported_modules
+ cost_centre_info fe_binders
+ local_tycons stg_binds
+
+ ------------------ Code output -----------------------
+ (stub_h_exists, stub_c_exists)
+ <- codeOutput dflags this_mod local_tycons
+ binds stg_binds
+ c_code h_code abstractC
+
+ return (stub_h_exists, stub_c_exists, Nothing, final_iface)
; let final_details = tidy_details {md_binds = []}
AddrNeOp -> int_NE_code x y
AddrLtOp -> trivialCode (CMP ULT) x y
AddrLeOp -> trivialCode (CMP ULE) x y
-
+
FloatGtOp -> cmpF_code (FCMP TF LE) EQQ x y
FloatGeOp -> cmpF_code (FCMP TF LTT) EQQ x y
FloatEqOp -> cmpF_code (FCMP TF EQQ) NE x y
DoubleMulOp -> trivialFCode DoubleRep (FMUL TF) x y
DoubleDivOp -> trivialFCode DoubleRep (FDIV TF) x y
+ AddrAddOp -> trivialCode (ADD Q False) x y
+ AddrSubOp -> trivialCode (SUB Q False) x y
+ AddrRemOp -> trivialCode (REM Q True) x y
+
AndOp -> trivialCode AND x y
OrOp -> trivialCode OR x y
XorOp -> trivialCode XOR x y
DoubleMulOp -> trivialFCode DoubleRep GMUL x y
DoubleDivOp -> trivialFCode DoubleRep GDIV x y
+ AddrAddOp -> add_code L x y
+ AddrSubOp -> sub_code L x y
+ AddrRemOp -> trivialCode (IREM L) Nothing x y
+
AndOp -> let op = AND L in trivialCode op (Just op) x y
OrOp -> let op = OR L in trivialCode op (Just op) x y
XorOp -> let op = XOR L in trivialCode op (Just op) x y
DoubleMulOp -> trivialFCode DoubleRep FMUL x y
DoubleDivOp -> trivialFCode DoubleRep FDIV x y
+ AddrAddOp -> trivialCode (ADD False False) x y
+ AddrSubOp -> trivialCode (SUB False False) x y
+ AddrRemOp -> imul_div SLIT(".rem") x y
+
AndOp -> trivialCode (AND False) x y
OrOp -> trivialCode (OR False) x y
XorOp -> trivialCode (XOR False) x y
where
#include "HsVersions.h"
+#include "MachDeps.h"
import MachMisc
import Stix
primCode [res] Integer2WordOp arg@[sa,da]
= gmpInteger2Word res (sa,da)
-primCode [res] Int2AddrOp [arg]
- = simpleCoercion AddrRep res arg
-
-primCode [res] Addr2IntOp [arg]
- = simpleCoercion IntRep res arg
-
primCode [res] Int2WordOp [arg]
= simpleCoercion IntRep{-WordRep?-} res arg
primCode [res] Word2IntOp [arg]
= simpleCoercion IntRep res arg
+primCode [res] AddrNullOp [arg]
+ = let
+ assign = StAssign AddrRep (amodeToStix res) (StInt 0)
+ in
+ returnUs (\xs -> assign : xs)
+
primCode [res] AddrToHValueOp [arg]
= simpleCoercion PtrRep res arg
-primCode [res] IntToInt8Op [arg]
+#if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64)
+primCode [res] Int2AddrOp [arg]
+ = simpleCoercion AddrRep res arg
+
+primCode [res] Addr2IntOp [arg]
+ = simpleCoercion IntRep res arg
+#endif
+
+primCode [res] Narrow8IntOp [arg]
= narrowingCoercion IntRep Int8Rep res arg
-primCode [res] IntToInt16Op [arg]
+primCode [res] Narrow16IntOp [arg]
= narrowingCoercion IntRep Int16Rep res arg
-primCode [res] IntToInt32Op [arg]
+primCode [res] Narrow32IntOp [arg]
= narrowingCoercion IntRep Int32Rep res arg
-primCode [res] WordToWord8Op [arg]
+primCode [res] Narrow8WordOp [arg]
= narrowingCoercion WordRep Word8Rep res arg
-primCode [res] WordToWord16Op [arg]
+primCode [res] Narrow16WordOp [arg]
= narrowingCoercion WordRep Word16Rep res arg
-primCode [res] WordToWord32Op [arg]
+primCode [res] Narrow32WordOp [arg]
= narrowingCoercion WordRep Word32Rep res arg
\end{code}
funTyConName = tcQual pREL_GHC_Name SLIT("(->)") funTyConKey
charPrimTyConName = tcQual pREL_GHC_Name SLIT("Char#") charPrimTyConKey
intPrimTyConName = tcQual pREL_GHC_Name SLIT("Int#") intPrimTyConKey
+int32PrimTyConName = tcQual pREL_GHC_Name SLIT("Int32#") int32PrimTyConKey
int64PrimTyConName = tcQual pREL_GHC_Name SLIT("Int64#") int64PrimTyConKey
wordPrimTyConName = tcQual pREL_GHC_Name SLIT("Word#") wordPrimTyConKey
+word32PrimTyConName = tcQual pREL_GHC_Name SLIT("Word32#") word32PrimTyConKey
word64PrimTyConName = tcQual pREL_GHC_Name SLIT("Word64#") word64PrimTyConKey
addrPrimTyConName = tcQual pREL_GHC_Name SLIT("Addr#") addrPrimTyConKey
floatPrimTyConName = tcQual pREL_GHC_Name SLIT("Float#") floatPrimTyConKey
intTyConKey = mkPreludeTyConUnique 15
int8TyConKey = mkPreludeTyConUnique 16
int16TyConKey = mkPreludeTyConUnique 17
-int32TyConKey = mkPreludeTyConUnique 18
-int64PrimTyConKey = mkPreludeTyConUnique 19
-int64TyConKey = mkPreludeTyConUnique 20
-integerTyConKey = mkPreludeTyConUnique 21
-listTyConKey = mkPreludeTyConUnique 22
-foreignObjPrimTyConKey = mkPreludeTyConUnique 23
-foreignObjTyConKey = mkPreludeTyConUnique 24
-foreignPtrTyConKey = mkPreludeTyConUnique 25
-weakPrimTyConKey = mkPreludeTyConUnique 26
-mutableArrayPrimTyConKey = mkPreludeTyConUnique 27
-mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 28
-orderingTyConKey = mkPreludeTyConUnique 29
-mVarPrimTyConKey = mkPreludeTyConUnique 30
-ratioTyConKey = mkPreludeTyConUnique 31
-rationalTyConKey = mkPreludeTyConUnique 32
-realWorldTyConKey = mkPreludeTyConUnique 33
-stablePtrPrimTyConKey = mkPreludeTyConUnique 34
-stablePtrTyConKey = mkPreludeTyConUnique 35
-statePrimTyConKey = mkPreludeTyConUnique 36
-stableNamePrimTyConKey = mkPreludeTyConUnique 50
-stableNameTyConKey = mkPreludeTyConUnique 51
-mutableByteArrayTyConKey = mkPreludeTyConUnique 52
-mutVarPrimTyConKey = mkPreludeTyConUnique 53
-ioTyConKey = mkPreludeTyConUnique 55
-byteArrayTyConKey = mkPreludeTyConUnique 56
-wordPrimTyConKey = mkPreludeTyConUnique 57
-wordTyConKey = mkPreludeTyConUnique 58
-word8TyConKey = mkPreludeTyConUnique 59
-word16TyConKey = mkPreludeTyConUnique 60
-word32TyConKey = mkPreludeTyConUnique 61
-word64PrimTyConKey = mkPreludeTyConUnique 62
-word64TyConKey = mkPreludeTyConUnique 63
-liftedConKey = mkPreludeTyConUnique 64
-unliftedConKey = mkPreludeTyConUnique 65
-anyBoxConKey = mkPreludeTyConUnique 66
-kindConKey = mkPreludeTyConUnique 67
-boxityConKey = mkPreludeTyConUnique 68
-typeConKey = mkPreludeTyConUnique 69
-threadIdPrimTyConKey = mkPreludeTyConUnique 70
-bcoPrimTyConKey = mkPreludeTyConUnique 71
-ptrTyConKey = mkPreludeTyConUnique 72
-funPtrTyConKey = mkPreludeTyConUnique 73
+int32PrimTyConKey = mkPreludeTyConUnique 18
+int32TyConKey = mkPreludeTyConUnique 19
+int64PrimTyConKey = mkPreludeTyConUnique 20
+int64TyConKey = mkPreludeTyConUnique 21
+integerTyConKey = mkPreludeTyConUnique 22
+listTyConKey = mkPreludeTyConUnique 23
+foreignObjPrimTyConKey = mkPreludeTyConUnique 24
+foreignObjTyConKey = mkPreludeTyConUnique 25
+foreignPtrTyConKey = mkPreludeTyConUnique 26
+weakPrimTyConKey = mkPreludeTyConUnique 27
+mutableArrayPrimTyConKey = mkPreludeTyConUnique 28
+mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 29
+orderingTyConKey = mkPreludeTyConUnique 30
+mVarPrimTyConKey = mkPreludeTyConUnique 31
+ratioTyConKey = mkPreludeTyConUnique 32
+rationalTyConKey = mkPreludeTyConUnique 33
+realWorldTyConKey = mkPreludeTyConUnique 34
+stablePtrPrimTyConKey = mkPreludeTyConUnique 35
+stablePtrTyConKey = mkPreludeTyConUnique 36
+statePrimTyConKey = mkPreludeTyConUnique 50
+stableNamePrimTyConKey = mkPreludeTyConUnique 51
+stableNameTyConKey = mkPreludeTyConUnique 52
+mutableByteArrayTyConKey = mkPreludeTyConUnique 53
+mutVarPrimTyConKey = mkPreludeTyConUnique 55
+ioTyConKey = mkPreludeTyConUnique 56
+byteArrayTyConKey = mkPreludeTyConUnique 57
+wordPrimTyConKey = mkPreludeTyConUnique 58
+wordTyConKey = mkPreludeTyConUnique 59
+word8TyConKey = mkPreludeTyConUnique 60
+word16TyConKey = mkPreludeTyConUnique 61
+word32PrimTyConKey = mkPreludeTyConUnique 62
+word32TyConKey = mkPreludeTyConUnique 63
+word64PrimTyConKey = mkPreludeTyConUnique 64
+word64TyConKey = mkPreludeTyConUnique 65
+liftedConKey = mkPreludeTyConUnique 66
+unliftedConKey = mkPreludeTyConUnique 67
+anyBoxConKey = mkPreludeTyConUnique 68
+kindConKey = mkPreludeTyConUnique 69
+boxityConKey = mkPreludeTyConUnique 70
+typeConKey = mkPreludeTyConUnique 71
+threadIdPrimTyConKey = mkPreludeTyConUnique 72
+bcoPrimTyConKey = mkPreludeTyConUnique 73
+ptrTyConKey = mkPreludeTyConUnique 74
+funPtrTyConKey = mkPreludeTyConUnique 75
-- Usage type constructors
-usageConKey = mkPreludeTyConUnique 74
-usOnceTyConKey = mkPreludeTyConUnique 75
-usManyTyConKey = mkPreludeTyConUnique 76
+usageConKey = mkPreludeTyConUnique 76
+usOnceTyConKey = mkPreludeTyConUnique 77
+usManyTyConKey = mkPreludeTyConUnique 78
-- Generic Type Constructors
-crossTyConKey = mkPreludeTyConUnique 77
-plusTyConKey = mkPreludeTyConUnique 78
-genUnitTyConKey = mkPreludeTyConUnique 79
+crossTyConKey = mkPreludeTyConUnique 79
+plusTyConKey = mkPreludeTyConUnique 80
+genUnitTyConKey = mkPreludeTyConUnique 81
\end{code}
%************************************************************************
import Literal ( Literal(..), isLitLitLit, mkMachInt, mkMachWord
, literalType
, word2IntLit, int2WordLit
- , intToInt8Lit, intToInt16Lit, intToInt32Lit
- , wordToWord8Lit, wordToWord16Lit, wordToWord32Lit
+ , narrow8IntLit, narrow16IntLit, narrow32IntLit
+ , narrow8WordLit, narrow16WordLit, narrow32WordLit
, char2IntLit, int2CharLit
, float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
- , addr2IntLit, int2AddrLit, float2DoubleLit, double2FloatLit
+ , nullAddrLit, float2DoubleLit, double2FloatLit
)
import PrimOp ( PrimOp(..), primOpOcc )
import TysWiredIn ( trueDataConId, falseDataConId )
-- ToDo: something for integer-shift ops?
-- NotOp
+ primop_rule AddrNullOp = Just nullAddrRule
primop_rule SeqOp = Just seqRule
primop_rule TagToEnumOp = Just tagToEnumRule
primop_rule DataToTagOp = Just dataToTagRule
-- coercions
primop_rule Word2IntOp = Just (oneLit (litCoerce word2IntLit op_name))
primop_rule Int2WordOp = Just (oneLit (litCoerce int2WordLit op_name))
- primop_rule IntToInt8Op = Just (oneLit (litCoerce intToInt8Lit op_name))
- primop_rule IntToInt16Op = Just (oneLit (litCoerce intToInt16Lit op_name))
- primop_rule IntToInt32Op = Just (oneLit (litCoerce intToInt32Lit op_name))
- primop_rule WordToWord8Op = Just (oneLit (litCoerce wordToWord8Lit op_name))
- primop_rule WordToWord16Op = Just (oneLit (litCoerce wordToWord16Lit op_name))
- primop_rule WordToWord32Op = Just (oneLit (litCoerce wordToWord32Lit op_name))
+ primop_rule Narrow8IntOp = Just (oneLit (litCoerce narrow8IntLit op_name))
+ primop_rule Narrow16IntOp = Just (oneLit (litCoerce narrow16IntLit op_name))
+ primop_rule Narrow32IntOp = Just (oneLit (litCoerce narrow32IntLit op_name))
+ primop_rule Narrow8WordOp = Just (oneLit (litCoerce narrow8WordLit op_name))
+ primop_rule Narrow16WordOp = Just (oneLit (litCoerce narrow16WordLit op_name))
+ primop_rule Narrow32WordOp = Just (oneLit (litCoerce narrow32WordLit op_name))
primop_rule OrdOp = Just (oneLit (litCoerce char2IntLit op_name))
primop_rule ChrOp = Just (oneLit (litCoerce int2CharLit op_name))
primop_rule Float2IntOp = Just (oneLit (litCoerce float2IntLit op_name))
primop_rule Int2FloatOp = Just (oneLit (litCoerce int2FloatLit op_name))
primop_rule Double2IntOp = Just (oneLit (litCoerce double2IntLit op_name))
primop_rule Int2DoubleOp = Just (oneLit (litCoerce int2DoubleLit op_name))
- primop_rule Addr2IntOp = Just (oneLit (litCoerce addr2IntLit op_name))
- primop_rule Int2AddrOp = Just (oneLit (litCoerce int2AddrLit op_name))
-- SUP: Not sure what the standard says about precision in the following 2 cases
primop_rule Float2DoubleOp = Just (oneLit (litCoerce float2DoubleLit op_name))
primop_rule Double2FloatOp = Just (oneLit (litCoerce double2FloatLit op_name))
mkDoubleVal d = Lit (convFloating (MachDouble d))
\end{code}
+\begin{code}
+nullAddrRule _ = Just(SLIT("nullAddr"), Lit(nullAddrLit))
+\end{code}
+
%************************************************************************
%* *
Some PrimOps need to be called out-of-line because they either need to
perform a heap check or they block.
+
\begin{code}
+primOpOutOfLine :: PrimOp -> Bool
#include "primop-out-of-line.hs-incl"
\end{code}
foreignObjPrimTyCon, foreignObjPrimTy,
threadIdPrimTyCon, threadIdPrimTy,
+ int32PrimTyCon, int32PrimTy,
+ word32PrimTyCon, word32PrimTy,
+
int64PrimTyCon, int64PrimTy,
word64PrimTyCon, word64PrimTy,
, doublePrimTyCon
, floatPrimTyCon
, intPrimTyCon
+ , int32PrimTyCon
, int64PrimTyCon
, foreignObjPrimTyCon
, bcoPrimTyCon
, statePrimTyCon
, threadIdPrimTyCon
, wordPrimTyCon
+ , word32PrimTyCon
, word64PrimTyCon
]
\end{code}
intPrimTy = mkTyConTy intPrimTyCon
intPrimTyCon = pcPrimTyCon0 intPrimTyConName IntRep
+int32PrimTy = mkTyConTy int32PrimTyCon
+int32PrimTyCon = pcPrimTyCon0 int32PrimTyConName Int32Rep
+
int64PrimTy = mkTyConTy int64PrimTyCon
int64PrimTyCon = pcPrimTyCon0 int64PrimTyConName Int64Rep
wordPrimTy = mkTyConTy wordPrimTyCon
wordPrimTyCon = pcPrimTyCon0 wordPrimTyConName WordRep
+word32PrimTy = mkTyConTy word32PrimTyCon
+word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName Word32Rep
+
word64PrimTy = mkTyConTy word64PrimTyCon
word64PrimTyCon = pcPrimTyCon0 word64PrimTyConName Word64Rep
primRepTyCon Int8Rep = charPrimTyCon
primRepTyCon IntRep = intPrimTyCon
primRepTyCon WordRep = wordPrimTyCon
+primRepTyCon Int32Rep = int32PrimTyCon
primRepTyCon Int64Rep = int64PrimTyCon
+primRepTyCon Word32Rep = word32PrimTyCon
primRepTyCon Word64Rep = word64PrimTyCon
primRepTyCon AddrRep = addrPrimTyCon
primRepTyCon FloatRep = floatPrimTyCon
--- /dev/null
+-----------------------------------------------------------------------
+-- $Id: primops.txt,v 1.25 2001/08/17 17:18:53 apt Exp $
+--
+-- Primitive Operations
+--
+-----------------------------------------------------------------------
+
+-- This file is processed by the utility program genprimopcode to produce
+-- a number of include files within the compiler and optionally to produce
+-- human-readable documentation.
+--
+-- It should first be preprocessed.
+--
+-- To add a new primop, you currently need to update the following files:
+--
+-- - this file (ghc/compiler/prelude/primops.txt), which includes
+-- the type of the primop, and various other properties (its
+-- strictness attributes, whether it is defined as a macro
+-- or as out-of-line code, etc.)
+--
+-- - ghc/lib/std/PrelGHC.hi-boot, to declare the primop
+--
+-- - if the primop is inline (i.e. a macro), then:
+-- ghc/includes/PrimOps.h
+-- ghc/compiler/nativeGen/StixPrim.lhs
+-- ghc/compiler/nativeGen/MachCode.lhs (if implementation is machine-dependent)
+--
+-- - or, for an out-of-line primop:
+-- ghc/includes/PrimOps.h (just add the declaration)
+-- ghc/rts/PrimOps.hc (define it here)
+--
+-- - the User's Guide
+--
+
+-- This file is divided into named sections, each containing or more primop entries.
+-- Section headers have the format:
+--
+-- section "section-name" {description}
+--
+-- This information is used solely when producing documentation; it is otherwise ignored.
+-- The description is optional.
+--
+-- The format of each primop entry is as follows:
+--
+-- primop internal-name "name-in-program-text" type category {description} attributes
+
+-- The description is optional.
+
+-- 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 }
+
+-- Currently, documentation is produced using latex, so contents of description fields
+-- should be legal latex. Descriptions can contain matched pairs of embedded curly brackets.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+\f
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+section "The word size story."
+ {Haskell98 specifies that signed integers (type {\tt Int}) must contain at least 30
+ bits. GHC always implements {\tt Int} using the primitive type {\tt Int\#}, whose
+ size equals the {\tt MachDeps.h} constant {\tt WORD\_SIZE\_IN\_BITS}. This
+ is normally set based on the {\tt config.h} parameter {\tt 4},
+ i.e., 32 bits on 32-bit machines, 64 bits on 64-bit machines. However, it can
+ also be explicitly set to a smaller number, e.g., 31 bits, to allow the possibility
+ of using tag bits. Currently GHC itself has only 32-bit and 64-bit variants,
+ but 30 or 31-bit code can be exported as an external core file for use in
+ other back ends.
+
+ GHC also implements a primitive unsigned integer type {\tt Word\#} which always
+ has the same number of bits as {\tt Int\#}.
+
+ In addition, GHC supports families of explicit-sized integers and words at
+ 8, 16, 32, and 64 bits, with the usual arithmetic operations, comparisons,
+ and a range of conversions. The 8-bit and 16-bit sizes are always represented as
+ {\tt Int\#} and {\tt Word\#}, and the operations implemented in terms of the
+ the primops on these types, with suitable range restrictions on the results
+ (using the {\tt Narrow$n$Int\#} and {\tt Narrow$n$Word\#} families of primops.
+ The 32-bit sizes are represented using {\tt Int\#} and {\tt Word\#} when
+ {\tt WORD\_SIZE\_IN\_BITS} $\geq$ 32;
+ otherwise, these are represented using distinct primitive types {\tt Int32\#}
+ and {\tt Word32\#}. These (when needed) have a complete set of corresponding
+ operations; however, nearly all of these are implemented as external C functions
+ rather than as primops. Exactly the same story applies to the 64-bit sizes.
+ All of these details are hidden under the {\tt PrelInt} and {\tt PrelWord} modules,
+ which use {\tt \#if}-defs to invoke the appropriate types and operators.
+
+ Word size also matters for the families of primops
+ for indexing/reading/writing fixed-size quantities at offsets from
+ an array base, address, or foreign pointer. Here, a slightly different approach is taken.
+ The names of these primops are fixed, but their
+ {\it types} vary according to the value of {\tt WORD\_SIZE\_IN\_BITS}. For example, if
+ word size is at least 32 bits then an operator like \texttt{indexInt32Array\#}
+ has type {\tt ByteArr\# -> Int\# -> Int\#}; otherwise it has type
+ {\tt ByteArr\# -> Int\# -> Int32\#}. This approach confines the necessary {\tt \#if}-defs to this file;
+ no conditional compilation is needed in the files that expose these primops, namely \texttt{lib/std/PrelStorable.lhs},
+ \texttt{hslibs/lang/ArrayBase.hs}, and (in deprecated fashion) in \texttt{hslibs/lang/ForeignObj.lhs}
+ and \texttt{hslibs/lang/Addr.lhs}.
+
+ Finally, there are strongly deprecated primops for coercing between {\tt Addr\#}, the primitive
+ type of machine addresses, and {\tt Int\#}. These are pretty bogus anyway, but will work on
+ existing 32-bit and 64-bit GHC targets; they are completely bogus when tag bits are used in
+ {\tt Int\#}, so are not available in this case.
+}
+
+-- Define synonyms for indexing ops.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+------------------------------------------------------------------------
+section "Char#"
+ {Operations on 31-bit characters.}
+------------------------------------------------------------------------
+
+
+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#
+
+------------------------------------------------------------------------
+section "Int#"
+ {Operations on native-size integers (30+ bits).}
+------------------------------------------------------------------------
+
+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#
+ {Rounds towards zero.}
+ with can_fail = True
+
+primop IntRemOp "remInt#" Dyadic
+ Int# -> Int# -> Int#
+ {Satisfies \texttt{(quotInt\# x y) *\# y +\# (remInt\# x y) == x}.}
+ 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# #)
+ {Add with carry. First member of result is (wrapped) sum; second member is 0 iff no overflow occured.}
+primop IntSubCOp "subIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #)
+ {Subtract with carry. First member of result is (wrapped) difference; second member is 0 iff no overflow occured.}
+primop IntMulCOp "mulIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #)
+ {Multiply with carry. First member of result is (wrapped) product; second member is 0 iff no overflow occured.}
+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 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#
+ {Shift left. Return 0 if shifted by more than size of an Int\#.}
+primop ISraOp "iShiftRA#" GenPrimOp Int# -> Int# -> Int#
+ {Shift right arithemetic. Return 0 if shifted by more than size of an Int\#.}
+primop ISrlOp "iShiftRL#" GenPrimOp Int# -> Int# -> Int#
+ {Shift right logical. Return 0 if shifted by more than size of an Int\#.}
+
+------------------------------------------------------------------------
+section "Word#"
+ {Operations on native-sized unsigned words (30+ bits).}
+------------------------------------------------------------------------
+
+primop WordAddOp "plusWord#" Dyadic Word# -> Word# -> Word#
+ with commutable = True
+
+primop WordSubOp "minusWord#" Dyadic Word# -> Word# -> Word#
+
+primop WordMulOp "timesWord#" Dyadic Word# -> Word# -> Word#
+ with commutable = True
+
+primop WordQuotOp "quotWord#" Dyadic Word# -> Word# -> Word#
+ with can_fail = True
+
+primop WordRemOp "remWord#" Dyadic Word# -> Word# -> Word#
+ with can_fail = True
+
+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#
+ {Shift left logical. Return 0 if shifted by more than number of bits in a Word\#.}
+primop SrlOp "shiftRL#" GenPrimOp Word# -> Int# -> Word#
+ {Shift right logical. Return 0 if shifted by more than number of bits in a 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
+
+------------------------------------------------------------------------
+section "Narrowings"
+ {Explicit narrowing of native-sized ints or words.}
+------------------------------------------------------------------------
+
+primop Narrow8IntOp "narrow8Int#" Monadic Int# -> Int#
+primop Narrow16IntOp "narrow16Int#" Monadic Int# -> Int#
+primop Narrow32IntOp "narrow32Int#" Monadic Int# -> Int#
+primop Narrow8WordOp "narrow8Word#" Monadic Word# -> Word#
+primop Narrow16WordOp "narrow16Word#" Monadic Word# -> Word#
+primop Narrow32WordOp "narrow32Word#" Monadic Word# -> Word#
+
+
+
+
+
+
+------------------------------------------------------------------------
+section "Int64#"
+ {Operations on 64-bit unsigned words. This type is only used
+ if plain Int\# has less than 64 bits. In any case, the operations
+ are not primops; they are implemented (if needed) as ccalls instead.}
+------------------------------------------------------------------------
+
+primop Int64ToIntegerOp "int64ToInteger#" GenPrimOp
+ Int64# -> (# Int#, ByteArr# #)
+ with out_of_line = True
+
+------------------------------------------------------------------------
+section "Word64#"
+ {Operations on 64-bit unsigned words. This type is only used
+ if plain Word\# has less than 64 bits. In any case, the operations
+ are not primops; they are implemented (if needed) as ccalls instead.}
+------------------------------------------------------------------------
+
+primop Word64ToIntegerOp "word64ToInteger#" GenPrimOp
+ Word64# -> (# Int#, ByteArr# #)
+ with out_of_line = True
+
+
+
+------------------------------------------------------------------------
+section "Integer#"
+ {Operations on arbitrary-precision integers. These operations are
+implemented via the GMP package. An integer is represented as a pair
+consisting of an Int\# representing the number of 'limbs' in use and
+the sign, and a ByteArr\# containing the 'limbs' themselves. Such pairs
+are returned as unboxed pairs, but must be passed as separate components.}
+------------------------------------------------------------------------
+
+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# #)
+ {Greatest common divisor.}
+ with commutable = True
+ out_of_line = True
+
+primop IntegerIntGcdOp "gcdIntegerInt#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> Int#
+ {Greatest common divisor, where second argument is an ordinary Int\#.}
+ -- with commutable = True (surely not? APT 8/01)
+
+primop IntegerDivExactOp "divExactInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+ {Divisor is guaranteed to be a factor of dividend.}
+ with out_of_line = True
+
+primop IntegerQuotOp "quotInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+ {Rounds towards zero.}
+ with out_of_line = True
+
+primop IntegerRemOp "remInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+ {Satisfies \texttt{plusInteger\# (timesInteger\# (quotInteger\# x y) y) (remInteger\# x y) == x}.}
+ with out_of_line = True
+
+primop IntegerCmpOp "cmpInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> Int#
+ {Returns -1,0,1 according as first argument is less than, equal to, or greater than second argument.}
+ with needs_wrapper = True
+
+primop IntegerCmpIntOp "cmpIntegerInt#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> Int#
+ {Returns -1,0,1 according as first argument is less than, equal to, or greater than second argument, which
+ is an ordinary Int\#.}
+ with needs_wrapper = True
+
+primop IntegerQuotRemOp "quotRemInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr#, Int#, ByteArr# #)
+ {Compute quot and rem simulaneously.}
+ with can_fail = True
+ out_of_line = True
+
+primop IntegerDivModOp "divModInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr#, Int#, ByteArr# #)
+ {Compute div and mod simultaneously, where div rounds towards negative infinity
+ and\texttt{(q,r) = divModInteger\#(x,y)} implies \texttt{plusInteger\# (timesInteger\# q y) r = x}.}
+ 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#
+
+
+primop IntegerAndOp "andInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+ with out_of_line = True
+
+primop IntegerOrOp "orInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+ with out_of_line = True
+
+primop IntegerXorOp "xorInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+ with out_of_line = True
+
+primop IntegerComplementOp "complementInteger#" GenPrimOp
+ Int# -> ByteArr# -> (# Int#, ByteArr# #)
+ with out_of_line = True
+
+
+------------------------------------------------------------------------
+section "Double#"
+ {Operations on double-precision (64 bit) floating-point numbers.}
+------------------------------------------------------------------------
+
+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#
+ {Exponentiation.}
+ with needs_wrapper = True
+
+primop DoubleDecodeOp "decodeDouble#" GenPrimOp
+ Double# -> (# Int#, Int#, ByteArr# #)
+ {Convert to arbitrary-precision integer.
+ First Int\# in result is the exponent; second Int\# and ByteArr\# represent an Integer\#
+ holding the mantissa.}
+ with out_of_line = True
+
+------------------------------------------------------------------------
+section "Float#"
+ {Operations on single-precision (32-bit) floating-point numbers.}
+------------------------------------------------------------------------
+
+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# #)
+ {Convert to arbitrary-precision integer.
+ First Int\# in result is the exponent; second Int\# and ByteArr\# represent an Integer\#
+ holding the mantissa.}
+ with out_of_line = True
+
+------------------------------------------------------------------------
+section "Arrays"
+ {Operations on Array\#.}
+------------------------------------------------------------------------
+
+primop NewArrayOp "newArray#" GenPrimOp
+ Int# -> a -> State# s -> (# State# s, MutArr# s a #)
+ {Create a new mutable array of specified size (in bytes),
+ in the specified state thread,
+ with each element containing the specified initial value.}
+ 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 ReadArrayOp "readArray#" GenPrimOp
+ MutArr# s a -> Int# -> State# s -> (# State# s, a #)
+ {Read from specified index of mutable array. Result is not yet evaluated.}
+ with
+ usage = { mangle ReadArrayOp [mkM, mkP, mkP] mkM }
+
+primop WriteArrayOp "writeArray#" GenPrimOp
+ MutArr# s a -> Int# -> a -> State# s -> State# s
+ {Write to specified index of mutable array.}
+ 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 #)
+ {Read from specified index of immutable array. Result is packaged into
+ an unboxed singleton; the result itself is not yet evaluated.}
+ with
+ usage = { mangle IndexArrayOp [mkM, mkP] mkM }
+
+primop UnsafeFreezeArrayOp "unsafeFreezeArray#" GenPrimOp
+ MutArr# s a -> State# s -> (# State# s, Array# a #)
+ {Make a mutable array immutable, without copying.}
+ with
+ usage = { mangle UnsafeFreezeArrayOp [mkM, mkP] mkM }
+ has_side_effects = True
+
+primop UnsafeThawArrayOp "unsafeThawArray#" GenPrimOp
+ Array# a -> State# s -> (# State# s, MutArr# s a #)
+ {Make an immutable array mutable, without copying.}
+ with
+ usage = { mangle UnsafeThawArrayOp [mkM, mkP] mkM }
+ out_of_line = True
+
+------------------------------------------------------------------------
+section "Byte Arrays"
+ {Operations on ByteArray\#. A ByteArray\# is a just a region of
+ raw memory in the garbage-collected heap, which is not scanned
+ for pointers. It carries its own size (in bytes). There are
+ three sets of operations for accessing byte array contents:
+ index for reading from immutable byte arrays, and read/write
+ for mutable byte arrays. Each set contains operations for
+ a range of useful primitive data types. Each operation takes
+ an offset measured in terms of the size fo the primitive type
+ being read or written.}
+
+------------------------------------------------------------------------
+
+primop NewByteArrayOp_Char "newByteArray#" GenPrimOp
+ Int# -> State# s -> (# State# s, MutByteArr# s #)
+ {Create a new mutable byte array of specified size (in bytes), in
+ the specified state thread.}
+ with out_of_line = True
+
+primop NewPinnedByteArrayOp_Char "newPinnedByteArray#" GenPrimOp
+ Int# -> State# s -> (# State# s, MutByteArr# s #)
+ {Create a mutable byte array that the GC guarantees not to move.}
+ with out_of_line = True
+
+primop ByteArrayContents_Char "byteArrayContents#" GenPrimOp
+ ByteArr# -> Addr#
+ {Intended for use with pinned arrays; otherwise very unsafe!}
+
+primop SameMutableByteArrayOp "sameMutableByteArray#" GenPrimOp
+ MutByteArr# s -> MutByteArr# s -> Bool
+
+primop UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp
+ MutByteArr# s -> State# s -> (# State# s, ByteArr# #)
+ {Make a mutable byte array immutable, without copying.}
+ with
+ has_side_effects = True
+
+primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp
+ ByteArr# -> Int#
+
+primop SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp
+ MutByteArr# s -> Int#
+
+
+primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp
+ ByteArr# -> Int# -> Char#
+ {Read 8-bit character; offset in bytes.}
+
+primop IndexByteArrayOp_WideChar "indexWideCharArray#" GenPrimOp
+ ByteArr# -> Int# -> Char#
+ {Read 31-bit character; offset in 4-byte words.}
+
+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_Int8 "indexInt8Array#" GenPrimOp
+ ByteArr# -> Int# -> Int#
+
+primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp
+ ByteArr# -> Int# -> Int#
+
+primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp
+ ByteArr# -> Int# -> Int#
+
+primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp
+ ByteArr# -> Int# -> Int64#
+
+primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp
+ ByteArr# -> Int# -> Word#
+
+primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp
+ ByteArr# -> Int# -> Word#
+
+primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp
+ ByteArr# -> Int# -> Word#
+
+primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp
+ ByteArr# -> Int# -> Word64#
+
+primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp
+ MutByteArr# s -> Int# -> State# s -> (# State# s, Char# #)
+ {Read 8-bit character; offset in bytes.}
+
+primop ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp
+ MutByteArr# s -> Int# -> State# s -> (# State# s, Char# #)
+ {Read 31-bit character; offset in 4-byte words.}
+
+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_Int8 "readInt8Array#" GenPrimOp
+ MutByteArr# s -> Int# -> State# s -> (# State# s, Int# #)
+
+primop ReadByteArrayOp_Int16 "readInt16Array#" GenPrimOp
+ MutByteArr# s -> Int# -> State# s -> (# State# s, Int# #)
+
+primop ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp
+ MutByteArr# s -> Int# -> State# s -> (# State# s, Int# #)
+
+primop ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp
+ MutByteArr# s -> Int# -> State# s -> (# State# s, Int64# #)
+
+primop ReadByteArrayOp_Word8 "readWord8Array#" GenPrimOp
+ MutByteArr# s -> Int# -> State# s -> (# State# s, Word# #)
+
+primop ReadByteArrayOp_Word16 "readWord16Array#" GenPrimOp
+ MutByteArr# s -> Int# -> State# s -> (# State# s, Word# #)
+
+primop ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp
+ MutByteArr# s -> Int# -> State# s -> (# State# s, Word# #)
+
+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
+ {Write 8-bit character; offset in bytes.}
+ with has_side_effects = True
+
+primop WriteByteArrayOp_WideChar "writeWideCharArray#" GenPrimOp
+ MutByteArr# s -> Int# -> Char# -> State# s -> State# s
+ {Write 31-bit character; offset in 4-byte words.}
+ 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_Int8 "writeInt8Array#" GenPrimOp
+ MutByteArr# s -> Int# -> Int# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteByteArrayOp_Int16 "writeInt16Array#" GenPrimOp
+ MutByteArr# s -> Int# -> Int# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp
+ MutByteArr# s -> Int# -> Int# -> 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_Word8 "writeWord8Array#" GenPrimOp
+ MutByteArr# s -> Int# -> Word# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteByteArrayOp_Word16 "writeWord16Array#" GenPrimOp
+ MutByteArr# s -> Int# -> Word# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp
+ MutByteArr# s -> Int# -> Word# -> 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
+
+------------------------------------------------------------------------
+section "Addr#"
+ {Addr\# is an arbitrary machine address assumed to point outside
+ the garbage-collected heap.}
+------------------------------------------------------------------------
+
+primop AddrNullOp "nullAddr#" GenPrimOp Int# -> Addr#
+ {Returns null address. Argument is ignored (nullary primops
+ don't quite work!)}
+primop AddrAddOp "plusAddr#" GenPrimOp Addr# -> Int# -> Addr#
+primop AddrSubOp "minusAddr#" GenPrimOp Addr# -> Addr# -> Int#
+ {Result is meaningless if two Addr\#s are so far apart that their
+ difference doesn't fit in an Int\#.}
+primop AddrRemOp "remAddr#" GenPrimOp Addr# -> Int# -> Int#
+ {Return the remainder when the Addr\# arg, treated like an Int\#,
+ is divided by the Int\# arg.}
+
+primop Addr2IntOp "addr2Int#" GenPrimOp Addr# -> Int#
+ {Coerce directly from address to int. Strongly deprecated.}
+primop Int2AddrOp "int2Addr#" GenPrimOp Int# -> Addr#
+ {Coerce directly from int to address. Strongly deprecated.}
+
+
+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 IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp
+ Addr# -> Int# -> Char#
+ {Reads 8-bit character; offset in bytes.}
+
+primop IndexOffAddrOp_WideChar "indexWideCharOffAddr#" GenPrimOp
+ Addr# -> Int# -> Char#
+ {Reads 31-bit character; offset in 4-byte words.}
+
+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_Int8 "indexInt8OffAddr#" GenPrimOp
+ Addr# -> Int# -> Int#
+
+primop IndexOffAddrOp_Int16 "indexInt16OffAddr#" GenPrimOp
+ Addr# -> Int# -> Int#
+
+primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp
+ Addr# -> Int# -> Int#
+
+primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp
+ Addr# -> Int# -> Int64#
+
+primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word#
+
+primop IndexOffAddrOp_Word16 "indexWord16OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word#
+
+primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word#
+
+primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word64#
+
+primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Char# #)
+ {Reads 8-bit character; offset in bytes.}
+
+primop ReadOffAddrOp_WideChar "readWideCharOffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Char# #)
+ {Reads 31-bit character; offset in 4-byte words.}
+
+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_Int8 "readInt8OffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Int# #)
+
+primop ReadOffAddrOp_Int16 "readInt16OffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Int# #)
+
+primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Int# #)
+
+primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Int64# #)
+
+primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Word# #)
+
+primop ReadOffAddrOp_Word16 "readWord16OffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Word# #)
+
+primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Word# #)
+
+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_WideChar "writeWideCharOffAddr#" 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_ForeignObj "writeForeignObjOffAddr#" GenPrimOp
+ Addr# -> Int# -> ForeignObj# -> 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_Int8 "writeInt8OffAddr#" GenPrimOp
+ Addr# -> Int# -> Int# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteOffAddrOp_Int16 "writeInt16OffAddr#" GenPrimOp
+ Addr# -> Int# -> Int# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp
+ Addr# -> Int# -> Int# -> 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_Word8 "writeWord8OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteOffAddrOp_Word16 "writeWord16OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word# -> 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
+
+------------------------------------------------------------------------
+section "ForeignObj#"
+ {Operations on ForeignObj\#. The indexing operations are
+ all deprecated.}
+------------------------------------------------------------------------
+
+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
+
+primop ForeignObjToAddrOp "foreignObjToAddr#" GenPrimOp
+ ForeignObj# -> Addr#
+
+primop TouchOp "touch#" GenPrimOp
+ o -> State# RealWorld -> State# RealWorld
+ with
+ has_side_effects = True
+ strictness = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
+
+primop EqForeignObj "eqForeignObj#" GenPrimOp
+ ForeignObj# -> ForeignObj# -> Bool
+ with commutable = True
+
+primop IndexOffForeignObjOp_Char "indexCharOffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Char#
+ {Read 8-bit character; offset in bytes.}
+
+primop IndexOffForeignObjOp_WideChar "indexWideCharOffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Char#
+ {Read 31-bit character; offset in 4-byte words.}
+
+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_Int8 "indexInt8OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Int#
+
+primop IndexOffForeignObjOp_Int16 "indexInt16OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Int#
+
+primop IndexOffForeignObjOp_Int32 "indexInt32OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Int#
+
+primop IndexOffForeignObjOp_Int64 "indexInt64OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Int64#
+
+primop IndexOffForeignObjOp_Word8 "indexWord8OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Word#
+
+primop IndexOffForeignObjOp_Word16 "indexWord16OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Word#
+
+primop IndexOffForeignObjOp_Word32 "indexWord32OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Word#
+
+primop IndexOffForeignObjOp_Word64 "indexWord64OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Word64#
+
+
+
+------------------------------------------------------------------------
+section "Mutable variables"
+ {Operations on MutVar\#s, which behave like single-element mutable arrays.}
+------------------------------------------------------------------------
+
+primop NewMutVarOp "newMutVar#" GenPrimOp
+ a -> State# s -> (# State# s, MutVar# s a #)
+ {Create MutVar\# with specified initial value in specified state thread.}
+ 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 #)
+ {Read contents of MutVar\#. Result is not yet evaluated.}
+ with
+ usage = { mangle ReadMutVarOp [mkM, mkP] mkM }
+
+primop WriteMutVarOp "writeMutVar#" GenPrimOp
+ MutVar# s a -> a -> State# s -> State# s
+ {Write contents of MutVar\#.}
+ 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 }
+
+------------------------------------------------------------------------
+section "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
+
+------------------------------------------------------------------------
+section "Synchronized Mutable Variables"
+ {Operations on MVar\#s, which are shared mutable variables
+ ({\it not} the same as MutVar\#s!). (Note: in a non-concurrent implementation,
+ (MVar\# a) can be represented by (MutVar\# (Maybe a)).)}
+------------------------------------------------------------------------
+
+
+primop NewMVarOp "newMVar#" GenPrimOp
+ State# s -> (# State# s, MVar# s a #)
+ {Create new mvar; initially empty.}
+ with
+ usage = { mangle NewMVarOp [mkP] mkR }
+ out_of_line = True
+
+primop TakeMVarOp "takeMVar#" GenPrimOp
+ MVar# s a -> State# s -> (# State# s, a #)
+ {If mvar is empty, block until it becomes full.
+ Then remove and return its contents, and set it empty.}
+ with
+ usage = { mangle TakeMVarOp [mkM, mkP] mkM }
+ has_side_effects = True
+ out_of_line = True
+
+primop TryTakeMVarOp "tryTakeMVar#" GenPrimOp
+ MVar# s a -> State# s -> (# State# s, Int#, a #)
+ {If mvar is empty, immediately return with integer 0 and value undefined.
+ Otherwise, return with integer 1 and contents of mvar, and set mvar empty.}
+ with
+ usage = { mangle TryTakeMVarOp [mkM, mkP] mkM }
+ has_side_effects = True
+ out_of_line = True
+
+primop PutMVarOp "putMVar#" GenPrimOp
+ MVar# s a -> a -> State# s -> State# s
+ {If mvar is full, block until it becomes empty.
+ Then store value arg as its new contents.}
+ with
+ strictness = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
+ usage = { mangle PutMVarOp [mkM, mkM, mkP] mkR }
+ has_side_effects = True
+ out_of_line = True
+
+primop TryPutMVarOp "tryPutMVar#" GenPrimOp
+ MVar# s a -> a -> State# s -> (# State# s, Int# #)
+ {If mvar is full, immediately return with integer 0.
+ Otherwise, store value arg as mvar's new contents, and return with integer 1.}
+ with
+ strictness = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
+ usage = { mangle TryPutMVarOp [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 IsEmptyMVarOp "isEmptyMVar#" GenPrimOp
+ MVar# s a -> State# s -> (# State# s, Int# #)
+ {Return 1 if mvar is empty; 0 otherwise.}
+ with
+ usage = { mangle IsEmptyMVarOp [mkP, mkP] mkM }
+
+
+------------------------------------------------------------------------
+section "Delay/wait operations"
+------------------------------------------------------------------------
+
+primop DelayOp "delay#" GenPrimOp
+ Int# -> State# s -> State# s
+ {Sleep specified number of microseconds.}
+ with
+ needs_wrapper = True
+ has_side_effects = True
+ out_of_line = True
+
+primop WaitReadOp "waitRead#" GenPrimOp
+ Int# -> State# s -> State# s
+ {Block until input is available on specified file descriptor.}
+ with
+ needs_wrapper = True
+ has_side_effects = True
+ out_of_line = True
+
+primop WaitWriteOp "waitWrite#" GenPrimOp
+ Int# -> State# s -> State# s
+ {Block until output is possible on specified file descriptor.}
+ with
+ needs_wrapper = True
+ has_side_effects = True
+ out_of_line = True
+
+------------------------------------------------------------------------
+section "Concurrency primitives"
+ {(In a non-concurrent implementation, ThreadId\# can be as singleton
+ type, whose (unique) value is returned by myThreadId\#. The
+ other operations can be omitted.)}
+------------------------------------------------------------------------
+
+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# #)
+
+------------------------------------------------------------------------
+section "Weak pointers"
+------------------------------------------------------------------------
+
+-- note that tyvar "o" denotes 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
+
+------------------------------------------------------------------------
+section "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 }
+
+------------------------------------------------------------------------
+section "Unsafe pointer equality"
+-- (#1 Bad Guy: Alistair Reid :)
+------------------------------------------------------------------------
+
+primop ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp
+ a -> a -> Int#
+ with
+ usage = { mangle ReallyUnsafePtrEqualityOp [mkZ, mkZ] mkR }
+
+------------------------------------------------------------------------
+section "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
+
+-- copyable# and noFollow# are yet to be implemented (for GpH)
+--
+--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
+
+
+------------------------------------------------------------------------
+section "Tag to enum stuff"
+ {Convert back and forth between values of enumerated types
+ and small integers.}
+------------------------------------------------------------------------
+
+primop DataToTagOp "dataToTag#" GenPrimOp
+ a -> Int#
+ with
+ strictness = { \ arity -> StrictnessInfo [wwLazy] False }
+
+primop TagToEnumOp "tagToEnum#" GenPrimOp
+ Int# -> a
+
+------------------------------------------------------------------------
+section "Bytecode operations"
+ {Support for the bytecode interpreter and linker.}
+------------------------------------------------------------------------
+
+
+primop AddrToHValueOp "addrToHValue#" GenPrimOp
+ Addr# -> (# a #)
+ {Convert an Addr\# to a followable type.}
+
+primop MkApUpd0_Op "mkApUpd0#" GenPrimOp
+ a -> (# a #)
+ with
+ out_of_line = True
+
+primop NewBCOOp "newBCO#" GenPrimOp
+ ByteArr# -> ByteArr# -> Array# a -> ByteArr# -> State# s -> (# State# s, BCO# #)
+ with
+ has_side_effects = True
+ out_of_line = True
+
+------------------------------------------------------------------------
+--- ---
+------------------------------------------------------------------------
+
+thats_all_folks
+
+
+
-----------------------------------------------------------------------
--- $Id: primops.txt.pp,v 1.3 2001/08/17 00:14:49 sof Exp $
+-- $Id: primops.txt.pp,v 1.4 2001/08/17 17:18:53 apt Exp $
--
-- Primitive Operations
--
-----------------------------------------------------------------------
+-- This file is processed by the utility program genprimopcode to produce
+-- a number of include files within the compiler and optionally to produce
+-- human-readable documentation.
+--
+-- It should first be preprocessed.
+--
-- To add a new primop, you currently need to update the following files:
--
--- - this file (ghc/compiler/prelude/primops.txt.pp), which includes
+-- - this file (ghc/compiler/prelude/primops.txt), which includes
-- the type of the primop, and various other properties (its
-- strictness attributes, whether it is defined as a macro
-- or as out-of-line code, etc.)
--
--- - ghc/lib/std/PrelGHC.hi-boot.pp, to declare the primop
+-- - ghc/lib/std/PrelGHC.hi-boot, to declare the primop
--
-- - if the primop is inline (i.e. a macro), then:
-- ghc/includes/PrimOps.h
--- ghc/compiler/nativeGen/StixPrim.lhs
---
+-- ghc/compiler/nativeGen/StixPrim.lhs
+-- ghc/compiler/nativeGen/MachCode.lhs (if implementation is machine-dependent)
+--
-- - or, for an out-of-line primop:
-- ghc/includes/PrimOps.h (just add the declaration)
-- ghc/rts/PrimOps.hc (define it here)
--
--- - the Users Guide
+-- - the User's Guide
+--
+
+-- This file is divided into named sections, each containing or more primop entries.
+-- Section headers have the format:
+--
+-- section "section-name" {description}
+--
+-- This information is used solely when producing documentation; it is otherwise ignored.
+-- The description is optional.
+--
+-- The format of each primop entry is as follows:
--
+-- primop internal-name "name-in-program-text" type category {description} attributes
-#include "config.h"
-#include "Derived.h"
+-- The description is optional.
--- The default attribute values which apply if you dont specify
+-- 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
strictness = { \ arity -> StrictnessInfo (replicate arity wwPrim) False }
usage = { nomangle other }
+-- Currently, documentation is produced using latex, so contents of description fields
+-- should be legal latex. Descriptions can contain matched pairs of embedded curly brackets.
+
+#include "MachDeps.h"
+
+section "The word size story."
+ {Haskell98 specifies that signed integers (type {\tt Int}) must contain at least 30
+ bits. GHC always implements {\tt Int} using the primitive type {\tt Int\#}, whose
+ size equals the {\tt MachDeps.h} constant {\tt WORD\_SIZE\_IN\_BITS}. This
+ is normally set based on the {\tt config.h} parameter {\tt SIZEOF_LONG},
+ i.e., 32 bits on 32-bit machines, 64 bits on 64-bit machines. However, it can
+ also be explicitly set to a smaller number, e.g., 31 bits, to allow the possibility
+ of using tag bits. Currently GHC itself has only 32-bit and 64-bit variants,
+ but 30 or 31-bit code can be exported as an external core file for use in
+ other back ends.
+
+ GHC also implements a primitive unsigned integer type {\tt Word\#} which always
+ has the same number of bits as {\tt Int\#}.
+
+ In addition, GHC supports families of explicit-sized integers and words at
+ 8, 16, 32, and 64 bits, with the usual arithmetic operations, comparisons,
+ and a range of conversions. The 8-bit and 16-bit sizes are always represented as
+ {\tt Int\#} and {\tt Word\#}, and the operations implemented in terms of the
+ the primops on these types, with suitable range restrictions on the results
+ (using the {\tt Narrow$n$Int\#} and {\tt Narrow$n$Word\#} families of primops.
+ The 32-bit sizes are represented using {\tt Int\#} and {\tt Word\#} when
+ {\tt WORD\_SIZE\_IN\_BITS} $\geq$ 32;
+ otherwise, these are represented using distinct primitive types {\tt Int32\#}
+ and {\tt Word32\#}. These (when needed) have a complete set of corresponding
+ operations; however, nearly all of these are implemented as external C functions
+ rather than as primops. Exactly the same story applies to the 64-bit sizes.
+ All of these details are hidden under the {\tt PrelInt} and {\tt PrelWord} modules,
+ which use {\tt \#if}-defs to invoke the appropriate types and operators.
+
+ Word size also matters for the families of primops
+ for indexing/reading/writing fixed-size quantities at offsets from
+ an array base, address, or foreign pointer. Here, a slightly different approach is taken.
+ The names of these primops are fixed, but their
+ {\it types} vary according to the value of {\tt WORD\_SIZE\_IN\_BITS}. For example, if
+ word size is at least 32 bits then an operator like \texttt{indexInt32Array\#}
+ has type {\tt ByteArr\# -> Int\# -> Int\#}; otherwise it has type
+ {\tt ByteArr\# -> Int\# -> Int32\#}. This approach confines the necessary {\tt \#if}-defs to this file;
+ no conditional compilation is needed in the files that expose these primops, namely \texttt{lib/std/PrelStorable.lhs},
+ \texttt{hslibs/lang/ArrayBase.hs}, and (in deprecated fashion) in \texttt{hslibs/lang/ForeignObj.lhs}
+ and \texttt{hslibs/lang/Addr.lhs}.
+
+ Finally, there are strongly deprecated primops for coercing between {\tt Addr\#}, the primitive
+ type of machine addresses, and {\tt Int\#}. These are pretty bogus anyway, but will work on
+ existing 32-bit and 64-bit GHC targets; they are completely bogus when tag bits are used in
+ {\tt Int\#}, so are not available in this case.
+}
+
+-- Define synonyms for indexing ops.
+
+#if WORD_SIZE_IN_BITS < 32
+#define INT32 Int32#
+#define WORD32 Word32#
+#else
+#define INT32 Int#
+#define WORD32 Word#
+#endif
+
+#if WORD_SIZE_IN_BITS < 64
+#define INT64 Int64#
+#define WORD64 Word64#
+#else
+#define INT64 Int#
+#define WORD64 Word#
+#endif
------------------------------------------------------------------------
---- Support for the bytecode interpreter and linker ---
+section "Char#"
+ {Operations on 31-bit characters.}
------------------------------------------------------------------------
--- Convert an Addr# to a followable type
-primop AddrToHValueOp "addrToHValue#" GenPrimOp
- Addr# -> (# a #)
-primop MkApUpd0_Op "mkApUpd0#" GenPrimOp
- a -> (# a #)
- with
- out_of_line = True
+primop CharGtOp "gtChar#" Compare Char# -> Char# -> Bool
+primop CharGeOp "geChar#" Compare Char# -> Char# -> Bool
-primop NewBCOOp "newBCO#" GenPrimOp
- ByteArr# -> ByteArr# -> Array# a -> ByteArr# -> State# s -> (# State# s, BCO# #)
- with
- has_side_effects = True
- out_of_line = True
+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#
------------------------------------------------------------------------
---- Addr# ---
+section "Int#"
+ {Operations on native-size integers (30+ bits).}
------------------------------------------------------------------------
-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 IntAddOp "+#" Dyadic
+ Int# -> Int# -> Int#
+ with commutable = True
-primop Addr2IntOp "addr2Int#" GenPrimOp Addr# -> Int#
+primop IntSubOp "-#" Dyadic Int# -> Int# -> Int#
+primop IntMulOp "*#"
+ Dyadic Int# -> Int# -> Int#
+ with commutable = True
+
+primop IntQuotOp "quotInt#" Dyadic
+ Int# -> Int# -> Int#
+ {Rounds towards zero.}
+ with can_fail = True
+
+primop IntRemOp "remInt#" Dyadic
+ Int# -> Int# -> Int#
+ {Satisfies \texttt{(quotInt\# x y) *\# y +\# (remInt\# x y) == x}.}
+ 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# #)
+ {Add with carry. First member of result is (wrapped) sum; second member is 0 iff no overflow occured.}
+primop IntSubCOp "subIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #)
+ {Subtract with carry. First member of result is (wrapped) difference; second member is 0 iff no overflow occured.}
+primop IntMulCOp "mulIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #)
+ {Multiply with carry. First member of result is (wrapped) product; second member is 0 iff no overflow occured.}
+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 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#
+ {Shift left. Return 0 if shifted by more than size of an Int\#.}
+primop ISraOp "iShiftRA#" GenPrimOp Int# -> Int# -> Int#
+ {Shift right arithemetic. Return 0 if shifted by more than size of an Int\#.}
+primop ISrlOp "iShiftRL#" GenPrimOp Int# -> Int# -> Int#
+ {Shift right logical. Return 0 if shifted by more than size of an Int\#.}
------------------------------------------------------------------------
---- Char# ---
+section "Word#"
+ {Operations on native-sized unsigned words (30+ bits).}
------------------------------------------------------------------------
-primop CharGtOp "gtChar#" Compare Char# -> Char# -> Bool
-primop CharGeOp "geChar#" Compare Char# -> Char# -> Bool
+primop WordAddOp "plusWord#" Dyadic Word# -> Word# -> Word#
+ with commutable = True
-primop CharEqOp "eqChar#" Compare
- Char# -> Char# -> Bool
+primop WordSubOp "minusWord#" Dyadic Word# -> Word# -> Word#
+
+primop WordMulOp "timesWord#" Dyadic Word# -> Word# -> Word#
with commutable = True
-primop CharNeOp "neChar#" Compare
- Char# -> Char# -> Bool
+primop WordQuotOp "quotWord#" Dyadic Word# -> Word# -> Word#
+ with can_fail = True
+
+primop WordRemOp "remWord#" Dyadic Word# -> Word# -> Word#
+ with can_fail = True
+
+primop AndOp "and#" Dyadic Word# -> Word# -> Word#
with commutable = True
-primop CharLtOp "ltChar#" Compare Char# -> Char# -> Bool
-primop CharLeOp "leChar#" Compare Char# -> Char# -> Bool
+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#
+ {Shift left logical. Return 0 if shifted by more than number of bits in a Word\#.}
+primop SrlOp "shiftRL#" GenPrimOp Word# -> Int# -> Word#
+ {Shift right logical. Return 0 if shifted by more than number of bits in a 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
+
+------------------------------------------------------------------------
+section "Narrowings"
+ {Explicit narrowing of native-sized ints or words.}
+------------------------------------------------------------------------
+
+primop Narrow8IntOp "narrow8Int#" Monadic Int# -> Int#
+primop Narrow16IntOp "narrow16Int#" Monadic Int# -> Int#
+primop Narrow32IntOp "narrow32Int#" Monadic Int# -> Int#
+primop Narrow8WordOp "narrow8Word#" Monadic Word# -> Word#
+primop Narrow16WordOp "narrow16Word#" Monadic Word# -> Word#
+primop Narrow32WordOp "narrow32Word#" Monadic Word# -> Word#
+
+
+#if WORD_SIZE_IN_BITS < 32
+------------------------------------------------------------------------
+section "Int32#"
+ {Operations on 32-bit integers (Int32\#). This type is only used
+ if plain Int\# has less than 32 bits. In any case, the operations
+ are not primops; they are implemented (if needed) as ccalls instead.}
+------------------------------------------------------------------------
+
+primop Int32ToIntegerOp "int32ToInteger#" GenPrimOp
+ Int32# -> (# Int#, ByteArr# #)
+ with out_of_line = True
+
+
+------------------------------------------------------------------------
+section "Word32#"
+ {Operations on 32-bit unsigned words. This type is only used
+ if plain Word\# has less than 32 bits. In any case, the operations
+ are not primops; they are implemented (if needed) as ccalls instead.}
+------------------------------------------------------------------------
+
+primop Word32ToIntegerOp "word32ToInteger#" GenPrimOp
+ Word32# -> (# Int#, ByteArr# #)
+ with out_of_line = True
+
+
+#endif
+
+
+#if WORD_SIZE_IN_BITS < 64
+------------------------------------------------------------------------
+section "Int64#"
+ {Operations on 64-bit unsigned words. This type is only used
+ if plain Int\# has less than 64 bits. In any case, the operations
+ are not primops; they are implemented (if needed) as ccalls instead.}
+------------------------------------------------------------------------
+
+primop Int64ToIntegerOp "int64ToInteger#" GenPrimOp
+ Int64# -> (# Int#, ByteArr# #)
+ with out_of_line = True
+
+------------------------------------------------------------------------
+section "Word64#"
+ {Operations on 64-bit unsigned words. This type is only used
+ if plain Word\# has less than 64 bits. In any case, the operations
+ are not primops; they are implemented (if needed) as ccalls instead.}
+------------------------------------------------------------------------
+
+primop Word64ToIntegerOp "word64ToInteger#" GenPrimOp
+ Word64# -> (# Int#, ByteArr# #)
+ with out_of_line = True
+
+#endif
+
+------------------------------------------------------------------------
+section "Integer#"
+ {Operations on arbitrary-precision integers. These operations are
+implemented via the GMP package. An integer is represented as a pair
+consisting of an Int\# representing the number of 'limbs' in use and
+the sign, and a ByteArr\# containing the 'limbs' themselves. Such pairs
+are returned as unboxed pairs, but must be passed as separate components.}
+------------------------------------------------------------------------
+
+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# #)
+ {Greatest common divisor.}
+ with commutable = True
+ out_of_line = True
+
+primop IntegerIntGcdOp "gcdIntegerInt#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> Int#
+ {Greatest common divisor, where second argument is an ordinary Int\#.}
+ -- with commutable = True (surely not? APT 8/01)
+
+primop IntegerDivExactOp "divExactInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+ {Divisor is guaranteed to be a factor of dividend.}
+ with out_of_line = True
+
+primop IntegerQuotOp "quotInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+ {Rounds towards zero.}
+ with out_of_line = True
+
+primop IntegerRemOp "remInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+ {Satisfies \texttt{plusInteger\# (timesInteger\# (quotInteger\# x y) y) (remInteger\# x y) == x}.}
+ with out_of_line = True
+
+primop IntegerCmpOp "cmpInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> Int#
+ {Returns -1,0,1 according as first argument is less than, equal to, or greater than second argument.}
+ with needs_wrapper = True
+
+primop IntegerCmpIntOp "cmpIntegerInt#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> Int#
+ {Returns -1,0,1 according as first argument is less than, equal to, or greater than second argument, which
+ is an ordinary Int\#.}
+ with needs_wrapper = True
+
+primop IntegerQuotRemOp "quotRemInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr#, Int#, ByteArr# #)
+ {Compute quot and rem simulaneously.}
+ with can_fail = True
+ out_of_line = True
+
+primop IntegerDivModOp "divModInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr#, Int#, ByteArr# #)
+ {Compute div and mod simultaneously, where div rounds towards negative infinity
+ and\texttt{(q,r) = divModInteger\#(x,y)} implies \texttt{plusInteger\# (timesInteger\# q y) r = x}.}
+ 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
+
+#if WORD_SIZE_IN_BITS < 32
+primop IntegerToInt32Op "integerToInt32#" GenPrimOp
+ Int# -> ByteArr# -> Int32#
+
+primop IntegerToWord32Op "integerToWord32#" GenPrimOp
+ Int# -> ByteArr# -> Word32#
+#endif
+
+#if WORD_SIZE_IN_BITS < 64
+primop IntegerToInt64Op "integerToInt64#" GenPrimOp
+ Int# -> ByteArr# -> Int64#
+
+primop IntegerToWord64Op "integerToWord64#" GenPrimOp
+ Int# -> ByteArr# -> Word64#
+#endif
+
+primop IntegerAndOp "andInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+ with out_of_line = True
+
+primop IntegerOrOp "orInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+ with out_of_line = True
+
+primop IntegerXorOp "xorInteger#" GenPrimOp
+ Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+ with out_of_line = True
+
+primop IntegerComplementOp "complementInteger#" GenPrimOp
+ Int# -> ByteArr# -> (# Int#, ByteArr# #)
+ with out_of_line = True
-primop OrdOp "ord#" GenPrimOp Char# -> Int#
------------------------------------------------------------------------
---- Double# ---
+section "Double#"
+ {Operations on double-precision (64 bit) floating-point numbers.}
------------------------------------------------------------------------
primop DoubleGtOp ">##" Compare Double# -> Double# -> Bool
primop DoublePowerOp "**##" Dyadic
Double# -> Double# -> Double#
+ {Exponentiation.}
with needs_wrapper = True
primop DoubleDecodeOp "decodeDouble#" GenPrimOp
Double# -> (# Int#, Int#, ByteArr# #)
+ {Convert to arbitrary-precision integer.
+ First Int\# in result is the exponent; second Int\# and ByteArr\# represent an Integer\#
+ holding the mantissa.}
with out_of_line = True
------------------------------------------------------------------------
---- Float# ---
+section "Float#"
+ {Operations on single-precision (32-bit) floating-point numbers.}
------------------------------------------------------------------------
primop FloatGtOp "gtFloat#" Compare Float# -> Float# -> Bool
primop FloatDecodeOp "decodeFloat#" GenPrimOp
Float# -> (# Int#, Int#, ByteArr# #)
+ {Convert to arbitrary-precision integer.
+ First Int\# in result is the exponent; second Int\# and ByteArr\# represent an Integer\#
+ holding the mantissa.}
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# ---
-------------------------------------------------------------------------
-
-#ifdef SUPPORT_LONG_LONGS
-primop Int64ToIntegerOp "int64ToInteger#" GenPrimOp
- Int64# -> (# Int#, ByteArr# #)
- with out_of_line = True
-#endif
-
-
-------------------------------------------------------------------------
---- Integer# ---
-------------------------------------------------------------------------
-
-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
-
-#ifdef SUPPORT_LONG_LONGS
-primop IntegerToInt64Op "integerToInt64#" GenPrimOp
- Int# -> ByteArr# -> Int64#
-
-primop IntegerToWord64Op "integerToWord64#" GenPrimOp
- Int# -> ByteArr# -> Word64#
-#endif
-
-primop IntegerAndOp "andInteger#" GenPrimOp
- Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
- with out_of_line = True
-
-primop IntegerOrOp "orInteger#" GenPrimOp
- Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
- with out_of_line = True
-
-primop IntegerXorOp "xorInteger#" GenPrimOp
- Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
- with out_of_line = True
-
-primop IntegerComplementOp "complementInteger#" GenPrimOp
- Int# -> ByteArr# -> (# Int#, ByteArr# #)
- with out_of_line = True
-
-------------------------------------------------------------------------
---- Word# ---
+section "Arrays"
+ {Operations on Array\#.}
------------------------------------------------------------------------
-primop WordAddOp "plusWord#" Dyadic Word# -> Word# -> Word#
- with commutable = True
-
-primop WordSubOp "minusWord#" Dyadic Word# -> Word# -> Word#
-
-primop WordMulOp "timesWord#" Dyadic Word# -> Word# -> Word#
- with commutable = True
-
-primop WordQuotOp "quotWord#" Dyadic Word# -> Word# -> Word#
- with can_fail = True
-
-primop WordRemOp "remWord#" Dyadic Word# -> Word# -> Word#
- with can_fail = True
-
-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 NewArrayOp "newArray#" GenPrimOp
+ Int# -> a -> State# s -> (# State# s, MutArr# s a #)
+ {Create a new mutable array of specified size (in bytes),
+ in the specified state thread,
+ with each element containing the specified initial value.}
+ with
+ strictness = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
+ usage = { mangle NewArrayOp [mkP, mkM, mkP] mkM }
+ out_of_line = True
-primop SrlOp "shiftRL#" GenPrimOp Word# -> Int# -> Word#
+primop SameMutableArrayOp "sameMutableArray#" GenPrimOp
+ MutArr# s a -> MutArr# s a -> Bool
+ with
+ usage = { mangle SameMutableArrayOp [mkP, mkP] mkM }
-primop Word2IntOp "word2Int#" GenPrimOp Word# -> Int#
+primop ReadArrayOp "readArray#" GenPrimOp
+ MutArr# s a -> Int# -> State# s -> (# State# s, a #)
+ {Read from specified index of mutable array. Result is not yet evaluated.}
+ with
+ usage = { mangle ReadArrayOp [mkM, mkP, mkP] mkM }
-primop Word2IntegerOp "word2Integer#" GenPrimOp
- Word# -> (# Int#, ByteArr# #)
- with out_of_line = True
+primop WriteArrayOp "writeArray#" GenPrimOp
+ MutArr# s a -> Int# -> a -> State# s -> State# s
+ {Write to specified index of mutable array.}
+ with
+ usage = { mangle WriteArrayOp [mkM, mkP, mkM, mkP] mkR }
+ strictness = { \ arity -> StrictnessInfo [wwPrim, wwPrim, wwLazy, wwPrim] False }
+ has_side_effects = 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
+primop IndexArrayOp "indexArray#" GenPrimOp
+ Array# a -> Int# -> (# a #)
+ {Read from specified index of immutable array. Result is packaged into
+ an unboxed singleton; the result itself is not yet evaluated.}
+ with
+ usage = { mangle IndexArrayOp [mkM, mkP] mkM }
-------------------------------------------------------------------------
---- Word64# ---
-------------------------------------------------------------------------
+primop UnsafeFreezeArrayOp "unsafeFreezeArray#" GenPrimOp
+ MutArr# s a -> State# s -> (# State# s, Array# a #)
+ {Make a mutable array immutable, without copying.}
+ with
+ usage = { mangle UnsafeFreezeArrayOp [mkM, mkP] mkM }
+ has_side_effects = True
-#ifdef SUPPORT_LONG_LONGS
-primop Word64ToIntegerOp "word64ToInteger#" GenPrimOp
- Word64# -> (# Int#, ByteArr# #)
- with out_of_line = True
-#endif
+primop UnsafeThawArrayOp "unsafeThawArray#" GenPrimOp
+ Array# a -> State# s -> (# State# s, MutArr# s a #)
+ {Make an immutable array mutable, without copying.}
+ with
+ usage = { mangle UnsafeThawArrayOp [mkM, mkP] mkM }
+ out_of_line = True
------------------------------------------------------------------------
---- Explicitly sized Int# and Word# ---
-------------------------------------------------------------------------
+section "Byte Arrays"
+ {Operations on ByteArray\#. A ByteArray\# is a just a region of
+ raw memory in the garbage-collected heap, which is not scanned
+ for pointers. It carries its own size (in bytes). There are
+ three sets of operations for accessing byte array contents:
+ index for reading from immutable byte arrays, and read/write
+ for mutable byte arrays. Each set contains operations for
+ a range of useful primitive data types. Each operation takes
+ an offset measured in terms of the size fo the primitive type
+ being read or written.}
-primop IntToInt8Op "intToInt8#" Monadic Int# -> Int#
-primop IntToInt16Op "intToInt16#" Monadic Int# -> Int#
-primop IntToInt32Op "intToInt32#" Monadic Int# -> Int#
-primop WordToWord8Op "wordToWord8#" Monadic Word# -> Word#
-primop WordToWord16Op "wordToWord16#" Monadic Word# -> Word#
-primop WordToWord32Op "wordToWord32#" Monadic Word# -> Word#
-
-------------------------------------------------------------------------
---- Arrays ---
------------------------------------------------------------------------
-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 NewByteArrayOp_Char "newByteArray#" GenPrimOp
Int# -> State# s -> (# State# s, MutByteArr# s #)
+ {Create a new mutable byte array of specified size (in bytes), in
+ the specified state thread.}
with out_of_line = True
primop NewPinnedByteArrayOp_Char "newPinnedByteArray#" GenPrimOp
Int# -> State# s -> (# State# s, MutByteArr# s #)
+ {Create a mutable byte array that the GC guarantees not to move.}
with out_of_line = True
primop ByteArrayContents_Char "byteArrayContents#" GenPrimOp
ByteArr# -> Addr#
+ {Intended for use with pinned arrays; otherwise very unsafe!}
+
+primop SameMutableByteArrayOp "sameMutableByteArray#" GenPrimOp
+ MutByteArr# s -> MutByteArr# s -> Bool
+
+primop UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp
+ MutByteArr# s -> State# s -> (# State# s, ByteArr# #)
+ {Make a mutable byte array immutable, without copying.}
+ with
+ has_side_effects = True
+
+primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp
+ ByteArr# -> Int#
+
+primop SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp
+ MutByteArr# s -> Int#
+
primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp
ByteArr# -> Int# -> Char#
+ {Read 8-bit character; offset in bytes.}
primop IndexByteArrayOp_WideChar "indexWideCharArray#" GenPrimOp
ByteArr# -> Int# -> Char#
+ {Read 31-bit character; offset in 4-byte words.}
primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp
ByteArr# -> Int# -> Int#
ByteArr# -> Int# -> Int#
primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp
- ByteArr# -> Int# -> Int#
+ ByteArr# -> Int# -> INT32
-#ifdef SUPPORT_LONG_LONGS
primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp
- ByteArr# -> Int# -> Int64#
-#endif
+ ByteArr# -> Int# -> INT64
primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp
ByteArr# -> Int# -> Word#
ByteArr# -> Int# -> Word#
primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp
- ByteArr# -> Int# -> Word#
+ ByteArr# -> Int# -> WORD32
-#ifdef SUPPORT_LONG_LONGS
primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp
- ByteArr# -> Int# -> Word64#
-#endif
-
+ ByteArr# -> Int# -> WORD64
primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp
MutByteArr# s -> Int# -> State# s -> (# State# s, Char# #)
+ {Read 8-bit character; offset in bytes.}
primop ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp
MutByteArr# s -> Int# -> State# s -> (# State# s, Char# #)
+ {Read 31-bit character; offset in 4-byte words.}
primop ReadByteArrayOp_Int "readIntArray#" GenPrimOp
MutByteArr# s -> Int# -> State# s -> (# State# s, Int# #)
MutByteArr# s -> Int# -> State# s -> (# State# s, Int# #)
primop ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp
- MutByteArr# s -> Int# -> State# s -> (# State# s, Int# #)
+ MutByteArr# s -> Int# -> State# s -> (# State# s, INT32 #)
-#ifdef SUPPORT_LONG_LONGS
primop ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp
- MutByteArr# s -> Int# -> State# s -> (# State# s, Int64# #)
-#endif
+ MutByteArr# s -> Int# -> State# s -> (# State# s, INT64 #)
primop ReadByteArrayOp_Word8 "readWord8Array#" GenPrimOp
MutByteArr# s -> Int# -> State# s -> (# State# s, Word# #)
MutByteArr# s -> Int# -> State# s -> (# State# s, Word# #)
primop ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp
- MutByteArr# s -> Int# -> State# s -> (# State# s, Word# #)
+ MutByteArr# s -> Int# -> State# s -> (# State# s, WORD32 #)
-#ifdef SUPPORT_LONG_LONGS
primop ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp
- MutByteArr# s -> Int# -> State# s -> (# State# s, Word64# #)
-#endif
-
-
+ MutByteArr# s -> Int# -> State# s -> (# State# s, WORD64 #)
primop WriteByteArrayOp_Char "writeCharArray#" GenPrimOp
MutByteArr# s -> Int# -> Char# -> State# s -> State# s
+ {Write 8-bit character; offset in bytes.}
with has_side_effects = True
primop WriteByteArrayOp_WideChar "writeWideCharArray#" GenPrimOp
MutByteArr# s -> Int# -> Char# -> State# s -> State# s
+ {Write 31-bit character; offset in 4-byte words.}
with has_side_effects = True
primop WriteByteArrayOp_Int "writeIntArray#" GenPrimOp
with has_side_effects = True
primop WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp
- MutByteArr# s -> Int# -> Int# -> State# s -> State# s
+ MutByteArr# s -> Int# -> INT32 -> State# s -> State# s
with has_side_effects = True
-#ifdef SUPPORT_LONG_LONGS
primop WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp
- MutByteArr# s -> Int# -> Int64# -> State# s -> State# s
+ MutByteArr# s -> Int# -> INT64 -> State# s -> State# s
with has_side_effects = True
-#endif
primop WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp
MutByteArr# s -> Int# -> Word# -> State# s -> State# s
with has_side_effects = True
primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp
- MutByteArr# s -> Int# -> Word# -> State# s -> State# s
+ MutByteArr# s -> Int# -> WORD32 -> State# s -> State# s
with has_side_effects = True
-#ifdef SUPPORT_LONG_LONGS
primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp
- MutByteArr# s -> Int# -> Word64# -> State# s -> State# s
+ MutByteArr# s -> Int# -> WORD64 -> State# s -> State# s
with has_side_effects = True
+
+------------------------------------------------------------------------
+section "Addr#"
+ {Addr\# is an arbitrary machine address assumed to point outside
+ the garbage-collected heap.}
+------------------------------------------------------------------------
+
+primop AddrNullOp "nullAddr#" GenPrimOp Int# -> Addr#
+ {Returns null address. Argument is ignored (nullary primops
+ don't quite work!)}
+primop AddrAddOp "plusAddr#" GenPrimOp Addr# -> Int# -> Addr#
+primop AddrSubOp "minusAddr#" GenPrimOp Addr# -> Addr# -> Int#
+ {Result is meaningless if two Addr\#s are so far apart that their
+ difference doesn't fit in an Int\#.}
+primop AddrRemOp "remAddr#" GenPrimOp Addr# -> Int# -> Int#
+ {Return the remainder when the Addr\# arg, treated like an Int\#,
+ is divided by the Int\# arg.}
+#if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64)
+primop Addr2IntOp "addr2Int#" GenPrimOp Addr# -> Int#
+ {Coerce directly from address to int. Strongly deprecated.}
+primop Int2AddrOp "int2Addr#" GenPrimOp Int# -> Addr#
+ {Coerce directly from int to address. Strongly deprecated.}
#endif
+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 IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp
Addr# -> Int# -> Char#
+ {Reads 8-bit character; offset in bytes.}
primop IndexOffAddrOp_WideChar "indexWideCharOffAddr#" GenPrimOp
Addr# -> Int# -> Char#
+ {Reads 31-bit character; offset in 4-byte words.}
primop IndexOffAddrOp_Int "indexIntOffAddr#" GenPrimOp
Addr# -> Int# -> Int#
Addr# -> Int# -> Int#
primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp
- Addr# -> Int# -> Int#
+ Addr# -> Int# -> INT32
-#ifdef SUPPORT_LONG_LONGS
primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp
- Addr# -> Int# -> Int64#
-#endif
+ Addr# -> Int# -> INT64
primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp
Addr# -> Int# -> Word#
Addr# -> Int# -> Word#
primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp
- Addr# -> Int# -> Word#
+ Addr# -> Int# -> WORD32
-#ifdef SUPPORT_LONG_LONGS
primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp
- Addr# -> Int# -> Word64#
-#endif
-
-
-primop EqForeignObj "eqForeignObj#" GenPrimOp
- ForeignObj# -> ForeignObj# -> Bool
- with commutable = True
-
-primop IndexOffForeignObjOp_Char "indexCharOffForeignObj#" GenPrimOp
- ForeignObj# -> Int# -> Char#
-
-primop IndexOffForeignObjOp_WideChar "indexWideCharOffForeignObj#" 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_Int8 "indexInt8OffForeignObj#" GenPrimOp
- ForeignObj# -> Int# -> Int#
-
-primop IndexOffForeignObjOp_Int16 "indexInt16OffForeignObj#" GenPrimOp
- ForeignObj# -> Int# -> Int#
-
-primop IndexOffForeignObjOp_Int32 "indexInt32OffForeignObj#" GenPrimOp
- ForeignObj# -> Int# -> Int#
-
-#ifdef SUPPORT_LONG_LONGS
-primop IndexOffForeignObjOp_Int64 "indexInt64OffForeignObj#" GenPrimOp
- ForeignObj# -> Int# -> Int64#
-#endif
-
-primop IndexOffForeignObjOp_Word8 "indexWord8OffForeignObj#" GenPrimOp
- ForeignObj# -> Int# -> Word#
-
-primop IndexOffForeignObjOp_Word16 "indexWord16OffForeignObj#" GenPrimOp
- ForeignObj# -> Int# -> Word#
-
-primop IndexOffForeignObjOp_Word32 "indexWord32OffForeignObj#" GenPrimOp
- ForeignObj# -> Int# -> Word#
-
-#ifdef SUPPORT_LONG_LONGS
-primop IndexOffForeignObjOp_Word64 "indexWord64OffForeignObj#" GenPrimOp
- ForeignObj# -> Int# -> Word64#
-#endif
+ Addr# -> Int# -> WORD64
primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Char# #)
+ {Reads 8-bit character; offset in bytes.}
primop ReadOffAddrOp_WideChar "readWideCharOffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Char# #)
+ {Reads 31-bit character; offset in 4-byte words.}
primop ReadOffAddrOp_Int "readIntOffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Int# #)
Addr# -> Int# -> State# s -> (# State# s, Int# #)
primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp
- Addr# -> Int# -> State# s -> (# State# s, Int# #)
+ Addr# -> Int# -> State# s -> (# State# s, INT32 #)
-#ifdef SUPPORT_LONG_LONGS
primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp
- Addr# -> Int# -> State# s -> (# State# s, Int64# #)
-#endif
+ Addr# -> Int# -> State# s -> (# State# s, INT64 #)
primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Word# #)
Addr# -> Int# -> State# s -> (# State# s, Word# #)
primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp
- Addr# -> Int# -> State# s -> (# State# s, Word# #)
+ Addr# -> Int# -> State# s -> (# State# s, WORD32 #)
-#ifdef SUPPORT_LONG_LONGS
primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp
- Addr# -> Int# -> State# s -> (# State# s, Word64# #)
-#endif
+ Addr# -> Int# -> State# s -> (# State# s, WORD64 #)
primop WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp
with has_side_effects = True
primop WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp
- Addr# -> Int# -> Int# -> State# s -> State# s
+ Addr# -> Int# -> INT32 -> State# s -> State# s
with has_side_effects = True
-#ifdef SUPPORT_LONG_LONGS
primop WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp
- Addr# -> Int# -> Int64# -> State# s -> State# s
+ Addr# -> Int# -> INT64 -> State# s -> State# s
with has_side_effects = True
-#endif
primop WriteOffAddrOp_Word8 "writeWord8OffAddr#" GenPrimOp
Addr# -> Int# -> Word# -> State# s -> State# s
with has_side_effects = True
primop WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp
- Addr# -> Int# -> Word# -> State# s -> State# s
+ Addr# -> Int# -> WORD32 -> State# s -> State# s
with has_side_effects = True
-#ifdef SUPPORT_LONG_LONGS
primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp
- Addr# -> Int# -> Word64# -> State# s -> State# s
+ Addr# -> Int# -> WORD64 -> State# s -> State# s
with has_side_effects = True
-#endif
-
-
-
-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
+------------------------------------------------------------------------
+section "ForeignObj#"
+ {Operations on ForeignObj\#. The indexing operations are
+ all deprecated.}
+------------------------------------------------------------------------
-primop ReadArrayOp "readArray#" GenPrimOp
- MutArr# s a -> Int# -> State# s -> (# State# s, a #)
+primop MkForeignObjOp "mkForeignObj#" GenPrimOp
+ Addr# -> State# RealWorld -> (# State# RealWorld, ForeignObj# #)
with
- usage = { mangle ReadArrayOp [mkM, mkP, mkP] mkM }
+ has_side_effects = True
+ out_of_line = True
-primop WriteArrayOp "writeArray#" GenPrimOp
- MutArr# s a -> Int# -> a -> State# s -> State# s
+primop WriteForeignObjOp "writeForeignObj#" GenPrimOp
+ ForeignObj# -> Addr# -> 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 ForeignObjToAddrOp "foreignObjToAddr#" GenPrimOp
+ ForeignObj# -> Addr#
-primop UnsafeFreezeArrayOp "unsafeFreezeArray#" GenPrimOp
- MutArr# s a -> State# s -> (# State# s, Array# a #)
+primop TouchOp "touch#" GenPrimOp
+ o -> State# RealWorld -> State# RealWorld
with
- usage = { mangle UnsafeFreezeArrayOp [mkM, mkP] mkM }
has_side_effects = True
+ strictness = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
-primop UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp
- MutByteArr# s -> State# s -> (# State# s, ByteArr# #)
- with
- has_side_effects = True
+primop EqForeignObj "eqForeignObj#" GenPrimOp
+ ForeignObj# -> ForeignObj# -> Bool
+ with commutable = 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 IndexOffForeignObjOp_Char "indexCharOffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Char#
+ {Read 8-bit character; offset in bytes.}
+
+primop IndexOffForeignObjOp_WideChar "indexWideCharOffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Char#
+ {Read 31-bit character; offset in 4-byte words.}
+
+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_Int8 "indexInt8OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Int#
+
+primop IndexOffForeignObjOp_Int16 "indexInt16OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Int#
+
+primop IndexOffForeignObjOp_Int32 "indexInt32OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> INT32
+
+primop IndexOffForeignObjOp_Int64 "indexInt64OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> INT64
+
+primop IndexOffForeignObjOp_Word8 "indexWord8OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Word#
+
+primop IndexOffForeignObjOp_Word16 "indexWord16OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Word#
+
+primop IndexOffForeignObjOp_Word32 "indexWord32OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> WORD32
+
+primop IndexOffForeignObjOp_Word64 "indexWord64OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> WORD64
-primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp
- ByteArr# -> Int#
-primop SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp
- MutByteArr# s -> Int#
------------------------------------------------------------------------
---- Mutable variables ---
+section "Mutable variables"
+ {Operations on MutVar\#s, which behave like single-element mutable arrays.}
------------------------------------------------------------------------
primop NewMutVarOp "newMutVar#" GenPrimOp
a -> State# s -> (# State# s, MutVar# s a #)
+ {Create MutVar\# with specified initial value in specified state thread.}
with
usage = { mangle NewMutVarOp [mkM, mkP] mkM }
strictness = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
primop ReadMutVarOp "readMutVar#" GenPrimOp
MutVar# s a -> State# s -> (# State# s, a #)
+ {Read contents of MutVar\#. Result is not yet evaluated.}
with
usage = { mangle ReadMutVarOp [mkM, mkP] mkM }
primop WriteMutVarOp "writeMutVar#" GenPrimOp
MutVar# s a -> a -> State# s -> State# s
+ {Write contents of MutVar\#.}
with
strictness = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
usage = { mangle WriteMutVarOp [mkM, mkM, mkP] mkR }
usage = { mangle SameMutVarOp [mkP, mkP] mkM }
------------------------------------------------------------------------
---- Exceptions ---
+section "Exceptions"
------------------------------------------------------------------------
primop CatchOp "catch#" GenPrimOp
with
strictness = { \ arity -> StrictnessInfo [wwLazy, wwLazy, wwPrim] False }
-- Catch is actually strict in its first argument
- -- but we dont want to tell the strictness
+ -- 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
(State# RealWorld -> (# State# RealWorld, a #))
-> (State# RealWorld -> (# State# RealWorld, a #))
with
- strictness = { \ arity -> StrictnessInfo [wwLazy,wwPrim] False }
+ 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,wwPrim] False }
+ strictness = { \ arity -> StrictnessInfo [wwLazy] False }
out_of_line = True
------------------------------------------------------------------------
---- MVars (not the same as mutable variables!) ---
+section "Synchronized Mutable Variables"
+ {Operations on MVar\#s, which are shared mutable variables
+ ({\it not} the same as MutVar\#s!). (Note: in a non-concurrent implementation,
+ (MVar\# a) can be represented by (MutVar\# (Maybe a)).)}
------------------------------------------------------------------------
+
primop NewMVarOp "newMVar#" GenPrimOp
State# s -> (# State# s, MVar# s a #)
+ {Create new mvar; initially empty.}
with
usage = { mangle NewMVarOp [mkP] mkR }
out_of_line = True
primop TakeMVarOp "takeMVar#" GenPrimOp
MVar# s a -> State# s -> (# State# s, a #)
+ {If mvar is empty, block until it becomes full.
+ Then remove and return its contents, and set it empty.}
with
usage = { mangle TakeMVarOp [mkM, mkP] mkM }
has_side_effects = True
primop TryTakeMVarOp "tryTakeMVar#" GenPrimOp
MVar# s a -> State# s -> (# State# s, Int#, a #)
+ {If mvar is empty, immediately return with integer 0 and value undefined.
+ Otherwise, return with integer 1 and contents of mvar, and set mvar empty.}
with
usage = { mangle TryTakeMVarOp [mkM, mkP] mkM }
has_side_effects = True
primop PutMVarOp "putMVar#" GenPrimOp
MVar# s a -> a -> State# s -> State# s
+ {If mvar is full, block until it becomes empty.
+ Then store value arg as its new contents.}
with
strictness = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
usage = { mangle PutMVarOp [mkM, mkM, mkP] mkR }
primop TryPutMVarOp "tryPutMVar#" GenPrimOp
MVar# s a -> a -> State# s -> (# State# s, Int# #)
+ {If mvar is full, immediately return with integer 0.
+ Otherwise, store value arg as mvar's new contents, and return with integer 1.}
with
strictness = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
usage = { mangle TryPutMVarOp [mkM, mkM, mkP] mkR }
primop IsEmptyMVarOp "isEmptyMVar#" GenPrimOp
MVar# s a -> State# s -> (# State# s, Int# #)
+ {Return 1 if mvar is empty; 0 otherwise.}
with
usage = { mangle IsEmptyMVarOp [mkP, mkP] mkM }
------------------------------------------------------------------------
---- delay/wait operations ---
+section "Delay/wait operations"
------------------------------------------------------------------------
primop DelayOp "delay#" GenPrimOp
Int# -> State# s -> State# s
+ {Sleep specified number of microseconds.}
with
needs_wrapper = True
has_side_effects = True
primop WaitReadOp "waitRead#" GenPrimOp
Int# -> State# s -> State# s
+ {Block until input is available on specified file descriptor.}
with
needs_wrapper = True
has_side_effects = True
primop WaitWriteOp "waitWrite#" GenPrimOp
Int# -> State# s -> State# s
+ {Block until output is possible on specified file descriptor.}
with
needs_wrapper = True
has_side_effects = True
out_of_line = True
------------------------------------------------------------------------
---- concurrency primitives ---
+section "Concurrency primitives"
+ {(In a non-concurrent implementation, ThreadId\# can be as singleton
+ type, whose (unique) value is returned by myThreadId\#. The
+ other operations can be omitted.)}
------------------------------------------------------------------------
primop ForkOp "fork#" 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
-
-primop ForeignObjToAddrOp "foreignObjToAddr#" GenPrimOp
- ForeignObj# -> Addr#
-
-primop TouchOp "touch#" GenPrimOp
- o -> State# RealWorld -> State# RealWorld
- with
- has_side_effects = True
- strictness = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
-
-------------------------------------------------------------------------
---- Weak pointers ---
+section "Weak pointers"
------------------------------------------------------------------------
-- note that tyvar "o" denotes openAlphaTyVar
out_of_line = True
------------------------------------------------------------------------
---- Stable pointers and names ---
+section "Stable pointers and names"
------------------------------------------------------------------------
primop MakeStablePtrOp "makeStablePtr#" GenPrimOp
usage = { mangle StableNameToIntOp [mkP] mkR }
------------------------------------------------------------------------
---- Unsafe pointer equality (#1 Bad Guy: Alistair Reid :) ---
+section "Unsafe pointer equality"
+-- (#1 Bad Guy: Alistair Reid :)
------------------------------------------------------------------------
primop ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp
usage = { mangle ReallyUnsafePtrEqualityOp [mkZ, mkZ] mkR }
------------------------------------------------------------------------
---- Parallelism ---
+section "Parallelism"
------------------------------------------------------------------------
primop SeqOp "seq#" GenPrimOp
-- 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
+-- `the processor containing the expression v'; it is not evaluated
primop ParGlobalOp "parGlobal#" GenPrimOp
a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
------------------------------------------------------------------------
---- tag to enum stuff ---
+section "Tag to enum stuff"
+ {Convert back and forth between values of enumerated types
+ and small integers.}
------------------------------------------------------------------------
primop DataToTagOp "dataToTag#" GenPrimOp
primop TagToEnumOp "tagToEnum#" GenPrimOp
Int# -> a
+------------------------------------------------------------------------
+section "Bytecode operations"
+ {Support for the bytecode interpreter and linker.}
+------------------------------------------------------------------------
+
-thats_all_folks
+primop AddrToHValueOp "addrToHValue#" GenPrimOp
+ Addr# -> (# a #)
+ {Convert an Addr\# to a followable type.}
+
+primop MkApUpd0_Op "mkApUpd0#" GenPrimOp
+ a -> (# a #)
+ with
+ out_of_line = True
+
+primop NewBCOOp "newBCO#" GenPrimOp
+ ByteArr# -> ByteArr# -> Array# a -> ByteArr# -> State# s -> (# State# s, BCO# #)
+ with
+ has_side_effects = True
+ out_of_line = True
------------------------------------------------------------------------
--- ---
------------------------------------------------------------------------
+thats_all_folks
+
+
+
checkCg check
= getDOptsTc `thenNF_Tc` \ dflags ->
- case check (dopt_HscLang dflags) of
- Nothing -> returnNF_Tc ()
- Just err -> addErrTc (text "Illegal foreign declaration:" <+> err)
+ let hscLang = dopt_HscLang dflags in
+ case hscLang of
+ HscNothing -> returnNF_Tc ()
+ otherwise ->
+ case check hscLang of
+ Nothing -> returnNF_Tc ()
+ Just err -> addErrTc (text "Illegal foreign declaration:" <+> err)
\end{code}
Warnings
/* -----------------------------------------------------------------------------
- * $Id: MachDeps.h,v 1.5 2001/07/19 09:01:40 simonmar Exp $
+ * $Id: MachDeps.h,v 1.6 2001/08/17 17:18:53 apt Exp $
*
* (c) The GRASP/AQUA Project, Glasgow University, 1998
* (c) The GHC Team, 1998-1999
#include "config.h"
+
+
#define CHAR_SIZE_IN_BYTES 1
#define ADDR_SIZE_IN_BYTES SIZEOF_VOID_P
#define INT_SIZE_IN_BYTES SIZEOF_LONG
#define WORD_SIZE_IN_BYTES SIZEOF_LONG
+#ifndef WORD_SIZE_IN_BITS
+#if WORD_SIZE_IN_BYTES == 4
+#define WORD_SIZE_IN_BITS 32
+#else
+#define WORD_SIZE_IN_BITS 64
+#endif
+#endif
+
#define FLOAT_SIZE_IN_BYTES SIZEOF_FLOAT
#define DOUBLE_SIZE_IN_BYTES SIZEOF_DOUBLE
#define ALIGNMENT_WORD16 ALIGNMENT_UNSIGNED_SHORT
#if SIZEOF_UNSIGNED_INT == 4
-#define SIZEOF_INT32 ALIGNMENT_INT
-#define ALIGNMENT_INT32 SIZEOF_INT
-#define SIZEOF_WORD32 ALIGNMENT_UNSIGNED_INT
-#define ALIGNMENT_WORD32 SIZEOF_UNSIGNED_INT
+#define SIZEOF_INT32 SIZEOF_INT
+#define ALIGNMENT_INT32 ALIGNMENT_INT
+#define SIZEOF_WORD32 SIZEOF_UNSIGNED_INT
+#define ALIGNMENT_WORD32 ALIGNMENT_UNSIGNED_INT
#else
#error GHC untested on this architecture: sizeof(unsigned int) != 4
#endif
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.80 2001/08/08 10:50:37 simonmar Exp $
+ * $Id: PrimOps.h,v 1.81 2001/08/17 17:18:53 apt Exp $
*
* (c) The GHC Team, 1998-2000
*
#ifndef PRIMOPS_H
#define PRIMOPS_H
+#include "MachDeps.h"
+
+#if WORD_SIZE_IN_BITS < 32
+#error GHC C backend requires 32+-bit words
+#endif
+
/* -----------------------------------------------------------------------------
Helpers for the bytecode linker.
-------------------------------------------------------------------------- */
Explicitly sized Int# and Word# PrimOps.
-------------------------------------------------------------------------- */
-#define intToInt8zh(r,a) r=(StgInt8)(a)
-#define intToInt16zh(r,a) r=(StgInt16)(a)
-#define intToInt32zh(r,a) r=(StgInt32)(a)
-#define wordToWord8zh(r,a) r=(StgWord8)(a)
-#define wordToWord16zh(r,a) r=(StgWord16)(a)
-#define wordToWord32zh(r,a) r=(StgWord32)(a)
+#define narrow8Intzh(r,a) r=(StgInt8)(a)
+#define narrow16Intzh(r,a) r=(StgInt16)(a)
+#define narrow32Intzh(r,a) r=(StgInt32)(a)
+#define narrow8Wordzh(r,a) r=(StgWord8)(a)
+#define narrow16Wordzh(r,a) r=(StgWord16)(a)
+#define narrow32Wordzh(r,a) r=(StgWord32)(a)
/* -----------------------------------------------------------------------------
Addr# PrimOps.
-------------------------------------------------------------------------- */
+#define nullAddrzh(r,i) r=(A_)(0)
+#define plusAddrzh(r,a,i) r=((void *)(a)) + (i)
+#define minusAddrzh(r,a,b) r=((void *)(a)) - ((void *)(b))
+#define remAddrzh(r,a,i) r=((W_)(a))%(i)
#define int2Addrzh(r,a) r=(A_)(a)
#define addr2Intzh(r,a) r=(I_)(a)
#define readStablePtrOffAddrzh(r,a,i) r=((StgStablePtr *)(a))[i]
#define readInt8OffAddrzh(r,a,i) r=((StgInt8 *)(a))[i]
#define readInt16OffAddrzh(r,a,i) r=((StgInt16 *)(a))[i]
-#define readInt32OffAddrzh(r,a,i) r=((StgInt32 *)(a))[i]
#define readWord8OffAddrzh(r,a,i) r=((StgWord8 *)(a))[i]
#define readWord16OffAddrzh(r,a,i) r=((StgWord16 *)(a))[i]
+#define readInt32OffAddrzh(r,a,i) r=((StgInt32 *)(a))[i]
#define readWord32OffAddrzh(r,a,i) r=((StgWord32 *)(a))[i]
#ifdef SUPPORT_LONG_LONGS
#define readInt64OffAddrzh(r,a,i) r=((LI_ *)(a))[i]
#define readWord64OffAddrzh(r,a,i) r=((LW_ *)(a))[i]
+#else
+#define readInt64OffAddrzh(r,a,i) r=((I_ *)(a))[i]
+#define readWord64OffAddrzh(r,a,i) r=((W_ *)(a))[i]
#endif
#define writeCharOffAddrzh(a,i,v) ((StgWord8 *)(a))[i] = (v)
#ifdef SUPPORT_LONG_LONGS
#define writeInt64OffAddrzh(a,i,v) ((LI_ *)(a))[i] = (v)
#define writeWord64OffAddrzh(a,i,v) ((LW_ *)(a))[i] = (v)
+#else
+#define writeInt64OffAddrzh(a,i,v) ((I_ *)(a))[i] = (v)
+#define writeWord64OffAddrzh(a,i,v) ((W_ *)(a))[i] = (v)
#endif
#define indexCharOffAddrzh(r,a,i) r=((StgWord8 *)(a))[i]
#ifdef SUPPORT_LONG_LONGS
#define indexInt64OffAddrzh(r,a,i) r=((LI_ *)(a))[i]
#define indexWord64OffAddrzh(r,a,i) r=((LW_ *)(a))[i]
+#else
+#define indexInt64OffAddrzh(r,a,i) r=((I_ *)(a))[i]
+#define indexWord64OffAddrzh(r,a,i) r=((W_ *)(a))[i]
#endif
/* -----------------------------------------------------------------------------
LI_ stg_iShiftRA64 (StgInt64, StgInt);
LI_ stg_intToInt64 (StgInt);
-I_ stg_int64ToInt (StgInt64);
+I_ stg_int64ToInt (StgInt64);
LW_ stg_int64ToWord64 (StgInt64);
LW_ stg_wordToWord64 (StgWord);
#define readWord8Arrayzh(r,a,i) indexWord8OffAddrzh(r,BYTE_ARR_CTS(a),i)
#define readWord16Arrayzh(r,a,i) indexWord16OffAddrzh(r,BYTE_ARR_CTS(a),i)
#define readWord32Arrayzh(r,a,i) indexWord32OffAddrzh(r,BYTE_ARR_CTS(a),i)
-#ifdef SUPPORT_LONG_LONGS
#define readInt64Arrayzh(r,a,i) indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i)
#define readWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i)
-#endif
/* result ("r") arg ignored in write macros! */
#define writeArrayzh(a,i,v) ((PP_) PTRS_ARR_CTS(a))[(i)]=(v)
#define writeWord8Arrayzh(a,i,v) writeWord8OffAddrzh(BYTE_ARR_CTS(a),i,v)
#define writeWord16Arrayzh(a,i,v) writeWord16OffAddrzh(BYTE_ARR_CTS(a),i,v)
#define writeWord32Arrayzh(a,i,v) writeWord32OffAddrzh(BYTE_ARR_CTS(a),i,v)
-#ifdef SUPPORT_LONG_LONGS
#define writeInt64Arrayzh(a,i,v) writeInt64OffAddrzh(BYTE_ARR_CTS(a),i,v)
#define writeWord64Arrayzh(a,i,v) writeWord64OffAddrzh(BYTE_ARR_CTS(a),i,v)
-#endif
#define indexArrayzh(r,a,i) r=((PP_) PTRS_ARR_CTS(a))[(i)]
#define indexWord8Arrayzh(r,a,i) indexWord8OffAddrzh(r,BYTE_ARR_CTS(a),i)
#define indexWord16Arrayzh(r,a,i) indexWord16OffAddrzh(r,BYTE_ARR_CTS(a),i)
#define indexWord32Arrayzh(r,a,i) indexWord32OffAddrzh(r,BYTE_ARR_CTS(a),i)
-#ifdef SUPPORT_LONG_LONGS
#define indexInt64Arrayzh(r,a,i) indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i)
#define indexWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i)
-#endif
/* Freezing arrays-of-ptrs requires changing an info table, for the
benefit of the generational collector. It needs to scavenge mutable
#define indexWord8OffForeignObjzh(r,fo,i) indexWord8OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
#define indexWord16OffForeignObjzh(r,fo,i) indexWord16OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
#define indexWord32OffForeignObjzh(r,fo,i) indexWord32OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#ifdef SUPPORT_LONG_LONGS
#define indexInt64OffForeignObjzh(r,fo,i) indexInt64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
#define indexWord64OffForeignObjzh(r,fo,i) indexWord64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#endif
/* -----------------------------------------------------------------------------
Constructor tags
#-----------------------------------------------------------------------------
# Pre-processing (.pp) files
-SRC_CPP_OPTS += -I$(GHC_INCLUDE_DIR)
+SRC_CPP_OPTS += -I$(GHC_INCLUDE_DIR) -traditional
+SRC_CPP_OPTS += ${GhcLibCppOpts}
#-----------------------------------------------------------------------------
# Rules
% -----------------------------------------------------------------------------
-% $Id: PrelBase.lhs,v 1.50 2001/05/03 19:03:27 qrczak Exp $
+% $Id: PrelBase.lhs,v 1.51 2001/08/17 17:18:54 apt Exp $
%
% (c) The University of Glasgow, 1992-2000
%
zeroInt = I# 0#
oneInt = I# 1#
twoInt = I# 2#
-#if WORD_SIZE_IN_BYTES == 4
+
+{- Seems clumsy. Should perhaps put minInt and MaxInt directly into MachDeps.h -}
+#if WORD_SIZE_IN_BITS == 31
+minInt = I# (-0x40000000#)
+maxInt = I# 0x3FFFFFFF#
+#elif WORD_SIZE_IN_BITS == 32
minInt = I# (-0x80000000#)
maxInt = I# 0x7FFFFFFF#
-#else
+#else
minInt = I# (-0x8000000000000000#)
maxInt = I# 0x7FFFFFFFFFFFFFFF#
#endif
"x# <=# x#" forall x#. x# <=# x# = True
#-}
-#if WORD_SIZE_IN_BYTES == 4
+#if WORD_SIZE_IN_BITS == 32
{-# RULES
-"intToInt32#" forall x#. intToInt32# x# = x#
-"wordToWord32#" forall x#. wordToWord32# x# = x#
+"narrow32Int#" forall x#. narrow32Int# x# = x#
+"narrow32Word#" forall x#. narrow32Word# x# = x#
#-}
#endif
| i# >=# 0# = I# (x# `iShiftL#` i#)
| otherwise = I# (x# `iShiftRA#` negateInt# i#)
(I# x#) `rotate` (I# i#) =
-#if WORD_SIZE_IN_BYTES == 4
I# (word2Int# ((x'# `shiftL#` i'#) `or#`
- (x'# `shiftRL#` (32# -# i'#))))
+ (x'# `shiftRL#` (wsib -# i'#))))
where
x'# = int2Word# x#
- i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
-#else
- I# (word2Int# ((x'# `shiftL#` i'#) `or#`
- (x'# `shiftRL#` (64# -# i'#))))
- where
- x'# = int2Word# x#
- i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
-#endif
- bitSize _ = WORD_SIZE_IN_BYTES * 8
+ i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
+ wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
+ bitSize _ = WORD_SIZE_IN_BITS
isSigned _ = True
\end{code}
% -----------------------------------------------------------------------------
-% $Id: PrelEnum.lhs,v 1.14 2001/07/24 06:31:35 ken Exp $
+% $Id: PrelEnum.lhs,v 1.15 2001/08/17 17:18:54 apt Exp $
%
% (c) The University of Glasgow, 1992-2000
%
fromEnum x = x
{-# INLINE enumFrom #-}
- enumFrom (I# x) = case maxInt of I# y -> eftInt x y
+ enumFrom (I# x) = eftInt x maxInt#
+ where I# maxInt# = maxInt
-- Blarg: technically I guess enumFrom isn't strict!
{-# INLINE enumFromTo #-}
--- /dev/null
+---------------------------------------------------------------------------
+-- PrelGHC.hi-boot
+--
+-- This hand-written interface file allows you to bring into scope the
+-- primitive operations and types that GHC knows about.
+---------------------------------------------------------------------------
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+\f
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+__interface "std" PrelGHC 1 0 where
+
+__export PrelGHC
+
+ ZLzmzgZR -- (->)
+
+ CCallable
+ CReturnable
+
+-- Magical assert thingy
+ assert
+
+ -- constructor tags
+ tagToEnumzh
+ getTagzh
+ dataToTagzh
+
+ -- I/O primitives
+ RealWorld
+ realWorldzh
+ Statezh
+
+ -- Concurrency primitives
+ ThreadIdzh
+ myThreadIdzh
+ forkzh
+ yieldzh
+ killThreadzh
+ blockAsyncExceptionszh
+ unblockAsyncExceptionszh
+ delayzh
+ waitReadzh
+ waitWritezh
+
+ -- MVars
+ MVarzh
+ sameMVarzh
+ newMVarzh
+ takeMVarzh
+ putMVarzh
+ tryTakeMVarzh
+ tryPutMVarzh
+ isEmptyMVarzh
+
+ -- Parallel
+ seqzh
+ parzh
+ parGlobalzh
+ parLocalzh
+ parAtzh
+ parAtAbszh
+ parAtRelzh
+ parAtForNowzh
+
+ -- Character Type
+ Charzh
+ gtCharzh
+ geCharzh
+ eqCharzh
+ neCharzh
+ ltCharzh
+ leCharzh
+ ordzh
+ chrzh
+
+ -- Int Type
+ Intzh
+ zgzh
+ zgzezh
+ zezezh
+ zszezh
+ zlzh
+ zlzezh
+ zpzh
+ zmzh
+ ztzh
+ quotIntzh
+ remIntzh
+ gcdIntzh
+ negateIntzh
+ iShiftLzh
+ iShiftRAzh
+ iShiftRLzh
+ addIntCzh
+ subIntCzh
+ mulIntCzh
+
+ Wordzh
+ gtWordzh
+ geWordzh
+ eqWordzh
+ neWordzh
+ ltWordzh
+ leWordzh
+ plusWordzh
+ minusWordzh
+ timesWordzh
+ quotWordzh
+ remWordzh
+ andzh
+ orzh
+ notzh
+ xorzh
+ shiftLzh
+ shiftRLzh
+ int2Wordzh
+ word2Intzh
+
+ narrow8Intzh
+ narrow16Intzh
+ narrow32Intzh
+ narrow8Wordzh
+ narrow16Wordzh
+ narrow32Wordzh
+
+
+
+
+
+
+
+ Int64zh
+ Word64zh
+
+
+ Addrzh
+ nullAddrzh
+ plusAddrzh
+ minusAddrzh
+ remAddrzh
+
+ addr2Intzh
+ int2Addrzh
+
+ gtAddrzh
+ geAddrzh
+ eqAddrzh
+ neAddrzh
+ ltAddrzh
+ leAddrzh
+
+ Floatzh
+ gtFloatzh
+ geFloatzh
+ eqFloatzh
+ neFloatzh
+ ltFloatzh
+ leFloatzh
+ plusFloatzh
+ minusFloatzh
+ timesFloatzh
+ divideFloatzh
+ negateFloatzh
+ float2Intzh
+ int2Floatzh
+ expFloatzh
+ logFloatzh
+ sqrtFloatzh
+ sinFloatzh
+ cosFloatzh
+ tanFloatzh
+ asinFloatzh
+ acosFloatzh
+ atanFloatzh
+ sinhFloatzh
+ coshFloatzh
+ tanhFloatzh
+ powerFloatzh
+ decodeFloatzh
+
+ Doublezh
+ zgzhzh
+ zgzezhzh
+ zezezhzh
+ zszezhzh
+ zlzhzh
+ zlzezhzh
+ zpzhzh
+ zmzhzh
+ ztzhzh
+ zszhzh
+ negateDoublezh
+ double2Intzh
+ int2Doublezh
+ double2Floatzh
+ float2Doublezh
+ expDoublezh
+ logDoublezh
+ sqrtDoublezh
+ sinDoublezh
+ cosDoublezh
+ tanDoublezh
+ asinDoublezh
+ acosDoublezh
+ atanDoublezh
+ sinhDoublezh
+ coshDoublezh
+ tanhDoublezh
+ ztztzhzh
+ decodeDoublezh
+
+ cmpIntegerzh
+ cmpIntegerIntzh
+ plusIntegerzh
+ minusIntegerzh
+ timesIntegerzh
+ gcdIntegerzh
+ quotIntegerzh
+ remIntegerzh
+ gcdIntegerzh
+ gcdIntegerIntzh
+ divExactIntegerzh
+ quotRemIntegerzh
+ divModIntegerzh
+ integer2Intzh
+ integer2Wordzh
+ int2Integerzh
+ word2Integerzh
+
+
+
+
+
+
+
+ integerToInt64zh
+ integerToWord64zh
+ int64ToIntegerzh
+ word64ToIntegerzh
+
+ andIntegerzh
+ orIntegerzh
+ xorIntegerzh
+ complementIntegerzh
+
+ Arrayzh
+ ByteArrayzh
+ MutableArrayzh
+ MutableByteArrayzh
+ sameMutableArrayzh
+ sameMutableByteArrayzh
+ newArrayzh
+ newByteArrayzh
+ newPinnedByteArrayzh
+ byteArrayContentszh
+
+ indexArrayzh
+ indexCharArrayzh
+ indexWideCharArrayzh
+ indexIntArrayzh
+ indexWordArrayzh
+ indexAddrArrayzh
+ indexFloatArrayzh
+ indexDoubleArrayzh
+ indexStablePtrArrayzh
+ indexInt8Arrayzh
+ indexInt16Arrayzh
+ indexInt32Arrayzh
+ indexInt64Arrayzh
+ indexWord8Arrayzh
+ indexWord16Arrayzh
+ indexWord32Arrayzh
+ indexWord64Arrayzh
+
+ readArrayzh
+ readCharArrayzh
+ readWideCharArrayzh
+ readIntArrayzh
+ readWordArrayzh
+ readAddrArrayzh
+ readFloatArrayzh
+ readDoubleArrayzh
+ readStablePtrArrayzh
+ readInt8Arrayzh
+ readInt16Arrayzh
+ readInt32Arrayzh
+ readInt64Arrayzh
+ readWord8Arrayzh
+ readWord16Arrayzh
+ readWord32Arrayzh
+ readWord64Arrayzh
+
+ writeArrayzh
+ writeCharArrayzh
+ writeWideCharArrayzh
+ writeIntArrayzh
+ writeWordArrayzh
+ writeAddrArrayzh
+ writeFloatArrayzh
+ writeDoubleArrayzh
+ writeStablePtrArrayzh
+ writeInt8Arrayzh
+ writeInt16Arrayzh
+ writeInt32Arrayzh
+ writeInt64Arrayzh
+ writeWord8Arrayzh
+ writeWord16Arrayzh
+ writeWord32Arrayzh
+ writeWord64Arrayzh
+
+ indexCharOffAddrzh
+ indexWideCharOffAddrzh
+ indexIntOffAddrzh
+ indexWordOffAddrzh
+ indexAddrOffAddrzh
+ indexFloatOffAddrzh
+ indexDoubleOffAddrzh
+ indexStablePtrOffAddrzh
+ indexInt8OffAddrzh
+ indexInt16OffAddrzh
+ indexInt32OffAddrzh
+ indexInt64OffAddrzh
+ indexWord8OffAddrzh
+ indexWord16OffAddrzh
+ indexWord32OffAddrzh
+ indexWord64OffAddrzh
+
+ readCharOffAddrzh
+ readWideCharOffAddrzh
+ readIntOffAddrzh
+ readWordOffAddrzh
+ readAddrOffAddrzh
+ readFloatOffAddrzh
+ readDoubleOffAddrzh
+ readStablePtrOffAddrzh
+ readInt8OffAddrzh
+ readInt16OffAddrzh
+ readInt32OffAddrzh
+ readInt64OffAddrzh
+ readWord8OffAddrzh
+ readWord16OffAddrzh
+ readWord32OffAddrzh
+ readWord64OffAddrzh
+
+ writeCharOffAddrzh
+ writeWideCharOffAddrzh
+ writeIntOffAddrzh
+ writeWordOffAddrzh
+ writeAddrOffAddrzh
+ writeForeignObjOffAddrzh
+ writeFloatOffAddrzh
+ writeDoubleOffAddrzh
+ writeStablePtrOffAddrzh
+ writeInt8OffAddrzh
+ writeInt16OffAddrzh
+ writeInt32OffAddrzh
+ writeInt64OffAddrzh
+ writeWord8OffAddrzh
+ writeWord16OffAddrzh
+ writeWord32OffAddrzh
+ writeWord64OffAddrzh
+
+ eqForeignObjzh
+ indexCharOffForeignObjzh
+ indexWideCharOffForeignObjzh
+ indexIntOffForeignObjzh
+ indexWordOffForeignObjzh
+ indexAddrOffForeignObjzh
+ indexFloatOffForeignObjzh
+ indexDoubleOffForeignObjzh
+ indexStablePtrOffForeignObjzh
+ indexInt8OffForeignObjzh
+ indexInt16OffForeignObjzh
+ indexInt32OffForeignObjzh
+ indexInt64OffForeignObjzh
+ indexWord8OffForeignObjzh
+ indexWord16OffForeignObjzh
+ indexWord32OffForeignObjzh
+ indexWord64OffForeignObjzh
+
+ unsafeFreezzeArrayzh -- Note zz in the middle
+ unsafeFreezzeByteArrayzh -- Ditto
+
+ unsafeThawArrayzh
+
+ sizzeofByteArrayzh -- Ditto
+ sizzeofMutableByteArrayzh -- Ditto
+
+ MutVarzh
+ newMutVarzh
+ readMutVarzh
+ writeMutVarzh
+ sameMutVarzh
+
+ catchzh
+ raisezh
+
+ Weakzh
+ mkWeakzh
+ deRefWeakzh
+ finalizzeWeakzh
+
+ ForeignObjzh
+ mkForeignObjzh
+ writeForeignObjzh
+ foreignObjToAddrzh
+ touchzh
+
+ StablePtrzh
+ makeStablePtrzh
+ deRefStablePtrzh
+ eqStablePtrzh
+
+ StableNamezh
+ makeStableNamezh
+ eqStableNamezh
+ stableNameToIntzh
+
+ reallyUnsafePtrEqualityzh
+
+ newBCOzh
+ BCOzh
+ mkApUpd0zh
+
+ unsafeCoercezh
+ addrToHValuezh
+;
+
+-- Export PrelErr.error, so that others do not have to import PrelErr
+__export PrelErr error ;
+
+
+--------------------------------------------------
+instance {CCallable Charzh} = zdfCCallableCharzh;
+instance {CCallable Doublezh} = zdfCCallableDoublezh;
+instance {CCallable Floatzh} = zdfCCallableFloatzh;
+instance {CCallable Intzh} = zdfCCallableIntzh;
+instance {CCallable Addrzh} = zdfCCallableAddrzh;
+instance {CCallable Int64zh} = zdfCCallableInt64zh;
+instance {CCallable Word64zh} = zdfCCallableWord64zh;
+instance {CCallable Wordzh} = zdfCCallableWordzh;
+instance {CCallable ByteArrayzh} = zdfCCallableByteArrayzh;
+instance __forall s => {CCallable (MutableByteArrayzh s)} = zdfCCallableMutableByteArrayzh;
+instance {CCallable ForeignObjzh} = zdfCCallableForeignObjzh;
+instance __forall s => {CCallable (StablePtrzh s)} = zdfCCallableStablePtrzh;
+-- CCallable and CReturnable have kind (Type AnyBox) so that
+-- things like Int# can be instances of CCallable.
+1 class CCallable a :: ? ;
+1 class CReturnable a :: ? ;
+
+1 assert :: __forall a => PrelBase.Bool -> a -> a ;
+
+-- These guys do not really exist:
+--
+1 zdfCCallableCharzh :: {CCallable Charzh} ;
+1 zdfCCallableDoublezh :: {CCallable Doublezh} ;
+1 zdfCCallableFloatzh :: {CCallable Floatzh} ;
+1 zdfCCallableIntzh :: {CCallable Intzh} ;
+1 zdfCCallableAddrzh :: {CCallable Addrzh} ;
+1 zdfCCallableInt64zh :: {CCallable Int64zh} ;
+1 zdfCCallableWord64zh :: {CCallable Word64zh} ;
+1 zdfCCallableWordzh :: {CCallable Wordzh} ;
+1 zdfCCallableByteArrayzh :: {CCallable ByteArrayzh} ;
+1 zdfCCallableMutableByteArrayzh :: __forall s => {CCallable (MutableByteArrayzh s)} ;
+1 zdfCCallableForeignObjzh :: {CCallable ForeignObjzh} ;
+1 zdfCCallableStablePtrzh :: __forall a => {CCallable (StablePtrzh a)} ;
-- primitive operations and types that GHC knows about.
---------------------------------------------------------------------------
-#include "config.h"
-#include "Derived.h"
+#include "MachDeps.h"
__interface "std" PrelGHC 1 0 where
int2Wordzh
word2Intzh
+ narrow8Intzh
+ narrow16Intzh
+ narrow32Intzh
+ narrow8Wordzh
+ narrow16Wordzh
+ narrow32Wordzh
+
+#if WORD_SIZE_IN_BITS < 32
+ Int32zh
+ Word32zh
+#endif
+
+#if WORD_SIZE_IN_BITS < 64
Int64zh
Word64zh
-
- intToInt8zh
- intToInt16zh
- intToInt32zh
- wordToWord8zh
- wordToWord16zh
- wordToWord32zh
+#endif
Addrzh
+ nullAddrzh
+ plusAddrzh
+ minusAddrzh
+ remAddrzh
+#if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64)
+ addr2Intzh
+ int2Addrzh
+#endif
gtAddrzh
geAddrzh
eqAddrzh
neAddrzh
ltAddrzh
leAddrzh
- int2Addrzh
- addr2Intzh
Floatzh
gtFloatzh
integer2Wordzh
int2Integerzh
word2Integerzh
-#ifdef SUPPORT_LONG_LONGS
+#if WORD_SIZE_IN_BITS < 32
+ integerToInt32zh
+ integerToWord32zh
+ int32ToIntegerzh
+ word32ToIntegerzh
+#endif
+#if WORD_SIZE_IN_BITS < 64
integerToInt64zh
integerToWord64zh
int64ToIntegerzh
indexInt8Arrayzh
indexInt16Arrayzh
indexInt32Arrayzh
-#ifdef SUPPORT_LONG_LONGS
indexInt64Arrayzh
-#endif
indexWord8Arrayzh
indexWord16Arrayzh
indexWord32Arrayzh
-#ifdef SUPPORT_LONG_LONGS
indexWord64Arrayzh
-#endif
readArrayzh
readCharArrayzh
readInt8Arrayzh
readInt16Arrayzh
readInt32Arrayzh
-#ifdef SUPPORT_LONG_LONGS
readInt64Arrayzh
-#endif
readWord8Arrayzh
readWord16Arrayzh
readWord32Arrayzh
-#ifdef SUPPORT_LONG_LONGS
readWord64Arrayzh
-#endif
writeArrayzh
writeCharArrayzh
writeInt8Arrayzh
writeInt16Arrayzh
writeInt32Arrayzh
-#ifdef SUPPORT_LONG_LONGS
writeInt64Arrayzh
-#endif
writeWord8Arrayzh
writeWord16Arrayzh
writeWord32Arrayzh
-#ifdef SUPPORT_LONG_LONGS
writeWord64Arrayzh
-#endif
indexCharOffAddrzh
indexWideCharOffAddrzh
indexInt8OffAddrzh
indexInt16OffAddrzh
indexInt32OffAddrzh
-#ifdef SUPPORT_LONG_LONGS
indexInt64OffAddrzh
-#endif
indexWord8OffAddrzh
indexWord16OffAddrzh
indexWord32OffAddrzh
-#ifdef SUPPORT_LONG_LONGS
indexWord64OffAddrzh
-#endif
readCharOffAddrzh
readWideCharOffAddrzh
readInt8OffAddrzh
readInt16OffAddrzh
readInt32OffAddrzh
-#ifdef SUPPORT_LONG_LONGS
readInt64OffAddrzh
-#endif
readWord8OffAddrzh
readWord16OffAddrzh
readWord32OffAddrzh
-#ifdef SUPPORT_LONG_LONGS
readWord64OffAddrzh
-#endif
writeCharOffAddrzh
writeWideCharOffAddrzh
writeInt8OffAddrzh
writeInt16OffAddrzh
writeInt32OffAddrzh
-#ifdef SUPPORT_LONG_LONGS
writeInt64OffAddrzh
-#endif
writeWord8OffAddrzh
writeWord16OffAddrzh
writeWord32OffAddrzh
-#ifdef SUPPORT_LONG_LONGS
writeWord64OffAddrzh
-#endif
eqForeignObjzh
indexCharOffForeignObjzh
indexInt8OffForeignObjzh
indexInt16OffForeignObjzh
indexInt32OffForeignObjzh
-#ifdef SUPPORT_LONG_LONGS
indexInt64OffForeignObjzh
-#endif
indexWord8OffForeignObjzh
indexWord16OffForeignObjzh
indexWord32OffForeignObjzh
-#ifdef SUPPORT_LONG_LONGS
indexWord64OffForeignObjzh
-#endif
unsafeFreezzeArrayzh -- Note zz in the middle
unsafeFreezzeByteArrayzh -- Ditto
showsPrec p x = showsPrec p (fromIntegral x :: Int)
instance Num Int8 where
- (I8# x#) + (I8# y#) = I8# (intToInt8# (x# +# y#))
- (I8# x#) - (I8# y#) = I8# (intToInt8# (x# -# y#))
- (I8# x#) * (I8# y#) = I8# (intToInt8# (x# *# y#))
- negate (I8# x#) = I8# (intToInt8# (negateInt# x#))
+ (I8# x#) + (I8# y#) = I8# (narrow8Int# (x# +# y#))
+ (I8# x#) - (I8# y#) = I8# (narrow8Int# (x# -# y#))
+ (I8# x#) * (I8# y#) = I8# (narrow8Int# (x# *# y#))
+ negate (I8# x#) = I8# (narrow8Int# (negateInt# x#))
abs x | x >= 0 = x
| otherwise = negate x
signum x | x > 0 = 1
signum 0 = 0
signum _ = -1
- fromInteger (S# i#) = I8# (intToInt8# i#)
- fromInteger (J# s# d#) = I8# (intToInt8# (integer2Int# s# d#))
+ fromInteger (S# i#) = I8# (narrow8Int# i#)
+ fromInteger (J# s# d#) = I8# (narrow8Int# (integer2Int# s# d#))
instance Real Int8 where
toRational x = toInteger x % 1
instance Integral Int8 where
quot x@(I8# x#) y@(I8# y#)
- | y /= 0 = I8# (intToInt8# (x# `quotInt#` y#))
+ | y /= 0 = I8# (narrow8Int# (x# `quotInt#` y#))
| otherwise = divZeroError "quot{Int8}" x
rem x@(I8# x#) y@(I8# y#)
- | y /= 0 = I8# (intToInt8# (x# `remInt#` y#))
+ | y /= 0 = I8# (narrow8Int# (x# `remInt#` y#))
| otherwise = divZeroError "rem{Int8}" x
div x@(I8# x#) y@(I8# y#)
- | y /= 0 = I8# (intToInt8# (x# `divInt#` y#))
+ | y /= 0 = I8# (narrow8Int# (x# `divInt#` y#))
| otherwise = divZeroError "div{Int8}" x
mod x@(I8# x#) y@(I8# y#)
- | y /= 0 = I8# (intToInt8# (x# `modInt#` y#))
+ | y /= 0 = I8# (narrow8Int# (x# `modInt#` y#))
| otherwise = divZeroError "mod{Int8}" x
quotRem x@(I8# x#) y@(I8# y#)
- | y /= 0 = (I8# (intToInt8# (x# `quotInt#` y#)),
- I8# (intToInt8# (x# `remInt#` y#)))
+ | y /= 0 = (I8# (narrow8Int# (x# `quotInt#` y#)),
+ I8# (narrow8Int# (x# `remInt#` y#)))
| otherwise = divZeroError "quotRem{Int8}" x
divMod x@(I8# x#) y@(I8# y#)
- | y /= 0 = (I8# (intToInt8# (x# `divInt#` y#)),
- I8# (intToInt8# (x# `modInt#` y#)))
+ | y /= 0 = (I8# (narrow8Int# (x# `divInt#` y#)),
+ I8# (narrow8Int# (x# `modInt#` y#)))
| otherwise = divZeroError "divMod{Int8}" x
toInteger (I8# x#) = S# x#
(I8# x#) `xor` (I8# y#) = I8# (word2Int# (int2Word# x# `xor#` int2Word# y#))
complement (I8# x#) = I8# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
(I8# x#) `shift` (I# i#)
- | i# >=# 0# = I8# (intToInt8# (x# `iShiftL#` i#))
+ | i# >=# 0# = I8# (narrow8Int# (x# `iShiftL#` i#))
| otherwise = I8# (x# `iShiftRA#` negateInt# i#)
(I8# x#) `rotate` (I# i#) =
- I8# (intToInt8# (word2Int# ((x'# `shiftL#` i'#) `or#`
+ I8# (narrow8Int# (word2Int# ((x'# `shiftL#` i'#) `or#`
(x'# `shiftRL#` (8# -# i'#)))))
where
- x'# = wordToWord8# (int2Word# x#)
+ x'# = narrow8Word# (int2Word# x#)
i'# = word2Int# (int2Word# i# `and#` int2Word# 7#)
bitSize _ = 8
isSigned _ = True
{-# RULES
"fromIntegral/Int8->Int8" fromIntegral = id :: Int8 -> Int8
-"fromIntegral/a->Int8" fromIntegral = \x -> case fromIntegral x of I# x# -> I8# (intToInt8# x#)
+"fromIntegral/a->Int8" fromIntegral = \x -> case fromIntegral x of I# x# -> I8# (narrow8Int# x#)
"fromIntegral/Int8->a" fromIntegral = \(I8# x#) -> fromIntegral (I# x#)
#-}
showsPrec p x = showsPrec p (fromIntegral x :: Int)
instance Num Int16 where
- (I16# x#) + (I16# y#) = I16# (intToInt16# (x# +# y#))
- (I16# x#) - (I16# y#) = I16# (intToInt16# (x# -# y#))
- (I16# x#) * (I16# y#) = I16# (intToInt16# (x# *# y#))
- negate (I16# x#) = I16# (intToInt16# (negateInt# x#))
+ (I16# x#) + (I16# y#) = I16# (narrow16Int# (x# +# y#))
+ (I16# x#) - (I16# y#) = I16# (narrow16Int# (x# -# y#))
+ (I16# x#) * (I16# y#) = I16# (narrow16Int# (x# *# y#))
+ negate (I16# x#) = I16# (narrow16Int# (negateInt# x#))
abs x | x >= 0 = x
| otherwise = negate x
signum x | x > 0 = 1
signum 0 = 0
signum _ = -1
- fromInteger (S# i#) = I16# (intToInt16# i#)
- fromInteger (J# s# d#) = I16# (intToInt16# (integer2Int# s# d#))
+ fromInteger (S# i#) = I16# (narrow16Int# i#)
+ fromInteger (J# s# d#) = I16# (narrow16Int# (integer2Int# s# d#))
instance Real Int16 where
toRational x = toInteger x % 1
instance Integral Int16 where
quot x@(I16# x#) y@(I16# y#)
- | y /= 0 = I16# (intToInt16# (x# `quotInt#` y#))
+ | y /= 0 = I16# (narrow16Int# (x# `quotInt#` y#))
| otherwise = divZeroError "quot{Int16}" x
rem x@(I16# x#) y@(I16# y#)
- | y /= 0 = I16# (intToInt16# (x# `remInt#` y#))
+ | y /= 0 = I16# (narrow16Int# (x# `remInt#` y#))
| otherwise = divZeroError "rem{Int16}" x
div x@(I16# x#) y@(I16# y#)
- | y /= 0 = I16# (intToInt16# (x# `divInt#` y#))
+ | y /= 0 = I16# (narrow16Int# (x# `divInt#` y#))
| otherwise = divZeroError "div{Int16}" x
mod x@(I16# x#) y@(I16# y#)
- | y /= 0 = I16# (intToInt16# (x# `modInt#` y#))
+ | y /= 0 = I16# (narrow16Int# (x# `modInt#` y#))
| otherwise = divZeroError "mod{Int16}" x
quotRem x@(I16# x#) y@(I16# y#)
- | y /= 0 = (I16# (intToInt16# (x# `quotInt#` y#)),
- I16# (intToInt16# (x# `remInt#` y#)))
+ | y /= 0 = (I16# (narrow16Int# (x# `quotInt#` y#)),
+ I16# (narrow16Int# (x# `remInt#` y#)))
| otherwise = divZeroError "quotRem{Int16}" x
divMod x@(I16# x#) y@(I16# y#)
- | y /= 0 = (I16# (intToInt16# (x# `divInt#` y#)),
- I16# (intToInt16# (x# `modInt#` y#)))
+ | y /= 0 = (I16# (narrow16Int# (x# `divInt#` y#)),
+ I16# (narrow16Int# (x# `modInt#` y#)))
| otherwise = divZeroError "divMod{Int16}" x
toInteger (I16# x#) = S# x#
(I16# x#) `xor` (I16# y#) = I16# (word2Int# (int2Word# x# `xor#` int2Word# y#))
complement (I16# x#) = I16# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
(I16# x#) `shift` (I# i#)
- | i# >=# 0# = I16# (intToInt16# (x# `iShiftL#` i#))
+ | i# >=# 0# = I16# (narrow16Int# (x# `iShiftL#` i#))
| otherwise = I16# (x# `iShiftRA#` negateInt# i#)
(I16# x#) `rotate` (I# i#) =
- I16# (intToInt16# (word2Int# ((x'# `shiftL#` i'#) `or#`
+ I16# (narrow16Int# (word2Int# ((x'# `shiftL#` i'#) `or#`
(x'# `shiftRL#` (16# -# i'#)))))
where
- x'# = wordToWord16# (int2Word# x#)
+ x'# = narrow16Word# (int2Word# x#)
i'# = word2Int# (int2Word# i# `and#` int2Word# 15#)
bitSize _ = 16
isSigned _ = True
"fromIntegral/Word8->Int16" fromIntegral = \(W8# x#) -> I16# (word2Int# x#)
"fromIntegral/Int8->Int16" fromIntegral = \(I8# x#) -> I16# x#
"fromIntegral/Int16->Int16" fromIntegral = id :: Int16 -> Int16
-"fromIntegral/a->Int16" fromIntegral = \x -> case fromIntegral x of I# x# -> I16# (intToInt16# x#)
+"fromIntegral/a->Int16" fromIntegral = \x -> case fromIntegral x of I# x# -> I16# (narrow16Int# x#)
"fromIntegral/Int16->a" fromIntegral = \(I16# x#) -> fromIntegral (I# x#)
#-}
-- type Int32
------------------------------------------------------------------------
+#if WORD_SIZE_IN_BITS < 32
+
+data Int32 = I32# Int32#
+
+instance Eq Int32 where
+ (I32# x#) == (I32# y#) = x# `eqInt32#` y#
+ (I32# x#) /= (I32# y#) = x# `neInt32#` y#
+
+instance Ord Int32 where
+ (I32# x#) < (I32# y#) = x# `ltInt32#` y#
+ (I32# x#) <= (I32# y#) = x# `leInt32#` y#
+ (I32# x#) > (I32# y#) = x# `gtInt32#` y#
+ (I32# x#) >= (I32# y#) = x# `geInt32#` y#
+
+instance Show Int32 where
+ showsPrec p x = showsPrec p (toInteger x)
+
+instance Num Int32 where
+ (I32# x#) + (I32# y#) = I32# (x# `plusInt32#` y#)
+ (I32# x#) - (I32# y#) = I32# (x# `minusInt32#` y#)
+ (I32# x#) * (I32# y#) = I32# (x# `timesInt32#` y#)
+ negate (I32# x#) = I32# (negateInt32# x#)
+ abs x | x >= 0 = x
+ | otherwise = negate x
+ signum x | x > 0 = 1
+ signum 0 = 0
+ signum _ = -1
+ fromInteger (S# i#) = I32# (intToInt32# i#)
+ fromInteger (J# s# d#) = I32# (integerToInt32# s# d#)
+
+instance Enum Int32 where
+ succ x
+ | x /= maxBound = x + 1
+ | otherwise = succError "Int32"
+ pred x
+ | x /= minBound = x - 1
+ | otherwise = predError "Int32"
+ toEnum (I# i#) = I32# (intToInt32# i#)
+ fromEnum x@(I32# x#)
+ | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int)
+ = I# (int32ToInt# x#)
+ | otherwise = fromEnumError "Int32" x
+ enumFrom = integralEnumFrom
+ enumFromThen = integralEnumFromThen
+ enumFromTo = integralEnumFromTo
+ enumFromThenTo = integralEnumFromThenTo
+
+instance Integral Int32 where
+ quot x@(I32# x#) y@(I32# y#)
+ | y /= 0 = I32# (x# `quotInt32#` y#)
+ | otherwise = divZeroError "quot{Int32}" x
+ rem x@(I32# x#) y@(I32# y#)
+ | y /= 0 = I32# (x# `remInt32#` y#)
+ | otherwise = divZeroError "rem{Int32}" x
+ div x@(I32# x#) y@(I32# y#)
+ | y /= 0 = I32# (x# `divInt32#` y#)
+ | otherwise = divZeroError "div{Int32}" x
+ mod x@(I32# x#) y@(I32# y#)
+ | y /= 0 = I32# (x# `modInt32#` y#)
+ | otherwise = divZeroError "mod{Int32}" x
+ quotRem x@(I32# x#) y@(I32# y#)
+ | y /= 0 = (I32# (x# `quotInt32#` y#), I32# (x# `remInt32#` y#))
+ | otherwise = divZeroError "quotRem{Int32}" x
+ divMod x@(I32# x#) y@(I32# y#)
+ | y /= 0 = (I32# (x# `divInt32#` y#), I32# (x# `modInt32#` y#))
+ | otherwise = divZeroError "divMod{Int32}" x
+ toInteger x@(I32# x#)
+ | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int)
+ = S# (int32ToInt# x#)
+ | otherwise = case int32ToInteger# x# of (# s, d #) -> J# s d
+
+divInt32#, modInt32# :: Int32# -> Int32# -> Int32#
+x# `divInt32#` y#
+ | (x# `gtInt32#` intToInt32# 0#) && (y# `ltInt32#` intToInt32# 0#)
+ = ((x# `minusInt32#` y#) `minusInt32#` intToInt32# 1#) `quotInt32#` y#
+ | (x# `ltInt32#` intToInt32# 0#) && (y# `gtInt32#` intToInt32# 0#)
+ = ((x# `minusInt32#` y#) `plusInt32#` intToInt32# 1#) `quotInt32#` y#
+ | otherwise = x# `quotInt32#` y#
+x# `modInt32#` y#
+ | (x# `gtInt32#` intToInt32# 0#) && (y# `ltInt32#` intToInt32# 0#) ||
+ (x# `ltInt32#` intToInt32# 0#) && (y# `gtInt32#` intToInt32# 0#)
+ = if r# `neInt32#` intToInt32# 0# then r# `plusInt32#` y# else intToInt32# 0#
+ | otherwise = r#
+ where
+ r# = x# `remInt32#` y#
+
+instance Read Int32 where
+ readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
+
+instance Bits Int32 where
+ (I32# x#) .&. (I32# y#) = I32# (word32ToInt32# (int32ToWord32# x# `and32#` int32ToWord32# y#))
+ (I32# x#) .|. (I32# y#) = I32# (word32ToInt32# (int32ToWord32# x# `or32#` int32ToWord32# y#))
+ (I32# x#) `xor` (I32# y#) = I32# (word32ToInt32# (int32ToWord32# x# `xor32#` int32ToWord32# y#))
+ complement (I32# x#) = I32# (word32ToInt32# (not32# (int32ToWord32# x#)))
+ (I32# x#) `shift` (I# i#)
+ | i# >=# 0# = I32# (x# `iShiftL32#` i#)
+ | otherwise = I32# (x# `iShiftRA32#` negateInt# i#)
+ (I32# x#) `rotate` (I# i#) =
+ I32# (word32ToInt32# ((x'# `shiftL32#` i'#) `or32#`
+ (x'# `shiftRL32#` (32# -# i'#))))
+ where
+ x'# = int32ToWord32# x#
+ i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
+ bitSize _ = 32
+ isSigned _ = True
+
+foreign import "stg_eqInt32" unsafe eqInt32# :: Int32# -> Int32# -> Bool
+foreign import "stg_neInt32" unsafe neInt32# :: Int32# -> Int32# -> Bool
+foreign import "stg_ltInt32" unsafe ltInt32# :: Int32# -> Int32# -> Bool
+foreign import "stg_leInt32" unsafe leInt32# :: Int32# -> Int32# -> Bool
+foreign import "stg_gtInt32" unsafe gtInt32# :: Int32# -> Int32# -> Bool
+foreign import "stg_geInt32" unsafe geInt32# :: Int32# -> Int32# -> Bool
+foreign import "stg_plusInt32" unsafe plusInt32# :: Int32# -> Int32# -> Int32#
+foreign import "stg_minusInt32" unsafe minusInt32# :: Int32# -> Int32# -> Int32#
+foreign import "stg_timesInt32" unsafe timesInt32# :: Int32# -> Int32# -> Int32#
+foreign import "stg_negateInt32" unsafe negateInt32# :: Int32# -> Int32#
+foreign import "stg_quotInt32" unsafe quotInt32# :: Int32# -> Int32# -> Int32#
+foreign import "stg_remInt32" unsafe remInt32# :: Int32# -> Int32# -> Int32#
+foreign import "stg_intToInt32" unsafe intToInt32# :: Int# -> Int32#
+foreign import "stg_int32ToInt" unsafe int32ToInt# :: Int32# -> Int#
+foreign import "stg_wordToWord32" unsafe wordToWord32# :: Word# -> Word32#
+foreign import "stg_int32ToWord32" unsafe int32ToWord32# :: Int32# -> Word32#
+foreign import "stg_word32ToInt32" unsafe word32ToInt32# :: Word32# -> Int32#
+foreign import "stg_and32" unsafe and32# :: Word32# -> Word32# -> Word32#
+foreign import "stg_or32" unsafe or32# :: Word32# -> Word32# -> Word32#
+foreign import "stg_xor32" unsafe xor32# :: Word32# -> Word32# -> Word32#
+foreign import "stg_not32" unsafe not32# :: Word32# -> Word32#
+foreign import "stg_iShiftL32" unsafe iShiftL32# :: Int32# -> Int# -> Int32#
+foreign import "stg_iShiftRA32" unsafe iShiftRA32# :: Int32# -> Int# -> Int32#
+foreign import "stg_shiftL32" unsafe shiftL32# :: Word32# -> Int# -> Word32#
+foreign import "stg_shiftRL32" unsafe shiftRL32# :: Word32# -> Int# -> Word32#
+
+{-# RULES
+"fromIntegral/Int->Int32" fromIntegral = \(I# x#) -> I32# (intToInt32# x#)
+"fromIntegral/Word->Int32" fromIntegral = \(W# x#) -> I32# (word32ToInt32# (wordToWord32# x#))
+"fromIntegral/Word32->Int32" fromIntegral = \(W32# x#) -> I32# (word32ToInt32# x#)
+"fromIntegral/Int32->Int" fromIntegral = \(I32# x#) -> I# (int32ToInt# x#)
+"fromIntegral/Int32->Word" fromIntegral = \(I32# x#) -> W# (int2Word# (int32ToInt# x#))
+"fromIntegral/Int32->Word32" fromIntegral = \(I32# x#) -> W32# (int32ToWord32# x#)
+"fromIntegral/Int32->Int32" fromIntegral = id :: Int32 -> Int32
+ #-}
+
+#else
+
-- Int32 is represented in the same way as Int.
-#if WORD_SIZE_IN_BYTES == 8
+#if WORD_SIZE_IN_BITS > 32
-- Operations may assume and must ensure that it holds only values
-- from its logical range.
#endif
data Int32 = I32# Int# deriving (Eq, Ord)
-instance CCallable Int32
-instance CReturnable Int32
-
instance Show Int32 where
showsPrec p x = showsPrec p (fromIntegral x :: Int)
instance Num Int32 where
- (I32# x#) + (I32# y#) = I32# (intToInt32# (x# +# y#))
- (I32# x#) - (I32# y#) = I32# (intToInt32# (x# -# y#))
- (I32# x#) * (I32# y#) = I32# (intToInt32# (x# *# y#))
- negate (I32# x#) = I32# (intToInt32# (negateInt# x#))
+ (I32# x#) + (I32# y#) = I32# (narrow32Int# (x# +# y#))
+ (I32# x#) - (I32# y#) = I32# (narrow32Int# (x# -# y#))
+ (I32# x#) * (I32# y#) = I32# (narrow32Int# (x# *# y#))
+ negate (I32# x#) = I32# (narrow32Int# (negateInt# x#))
abs x | x >= 0 = x
| otherwise = negate x
signum x | x > 0 = 1
signum 0 = 0
signum _ = -1
- fromInteger (S# i#) = I32# (intToInt32# i#)
- fromInteger (J# s# d#) = I32# (intToInt32# (integer2Int# s# d#))
-
-instance Real Int32 where
- toRational x = toInteger x % 1
+ fromInteger (S# i#) = I32# (narrow32Int# i#)
+ fromInteger (J# s# d#) = I32# (narrow32Int# (integer2Int# s# d#))
instance Enum Int32 where
succ x
pred x
| x /= minBound = x - 1
| otherwise = predError "Int32"
-#if WORD_SIZE_IN_BYTES == 4
+#if WORD_SIZE_IN_BITS == 32
toEnum (I# i#) = I32# i#
#else
toEnum i@(I# i#)
instance Integral Int32 where
quot x@(I32# x#) y@(I32# y#)
- | y /= 0 = I32# (intToInt32# (x# `quotInt#` y#))
+ | y /= 0 = I32# (narrow32Int# (x# `quotInt#` y#))
| otherwise = divZeroError "quot{Int32}" x
rem x@(I32# x#) y@(I32# y#)
- | y /= 0 = I32# (intToInt32# (x# `remInt#` y#))
+ | y /= 0 = I32# (narrow32Int# (x# `remInt#` y#))
| otherwise = divZeroError "rem{Int32}" x
div x@(I32# x#) y@(I32# y#)
- | y /= 0 = I32# (intToInt32# (x# `divInt#` y#))
+ | y /= 0 = I32# (narrow32Int# (x# `divInt#` y#))
| otherwise = divZeroError "div{Int32}" x
mod x@(I32# x#) y@(I32# y#)
- | y /= 0 = I32# (intToInt32# (x# `modInt#` y#))
+ | y /= 0 = I32# (narrow32Int# (x# `modInt#` y#))
| otherwise = divZeroError "mod{Int32}" x
quotRem x@(I32# x#) y@(I32# y#)
- | y /= 0 = (I32# (intToInt32# (x# `quotInt#` y#)),
- I32# (intToInt32# (x# `remInt#` y#)))
+ | y /= 0 = (I32# (narrow32Int# (x# `quotInt#` y#)),
+ I32# (narrow32Int# (x# `remInt#` y#)))
| otherwise = divZeroError "quotRem{Int32}" x
divMod x@(I32# x#) y@(I32# y#)
- | y /= 0 = (I32# (intToInt32# (x# `divInt#` y#)),
- I32# (intToInt32# (x# `modInt#` y#)))
+ | y /= 0 = (I32# (narrow32Int# (x# `divInt#` y#)),
+ I32# (narrow32Int# (x# `modInt#` y#)))
| otherwise = divZeroError "divMod{Int32}" x
toInteger (I32# x#) = S# x#
-instance Bounded Int32 where
- minBound = -0x80000000
- maxBound = 0x7FFFFFFF
-
-instance Ix Int32 where
- range (m,n) = [m..n]
- index b@(m,_) i
- | inRange b i = fromIntegral (i - m)
- | otherwise = indexError b i "Int32"
- inRange (m,n) i = m <= i && i <= n
-
instance Read Int32 where
readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
(I32# x#) `xor` (I32# y#) = I32# (word2Int# (int2Word# x# `xor#` int2Word# y#))
complement (I32# x#) = I32# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
(I32# x#) `shift` (I# i#)
- | i# >=# 0# = I32# (intToInt32# (x# `iShiftL#` i#))
+ | i# >=# 0# = I32# (narrow32Int# (x# `iShiftL#` i#))
| otherwise = I32# (x# `iShiftRA#` negateInt# i#)
(I32# x#) `rotate` (I# i#) =
- I32# (intToInt32# (word2Int# ((x'# `shiftL#` i'#) `or#`
+ I32# (narrow32Int# (word2Int# ((x'# `shiftL#` i'#) `or#`
(x'# `shiftRL#` (32# -# i'#)))))
where
- x'# = wordToWord32# (int2Word# x#)
+ x'# = narrow32Word# (int2Word# x#)
i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
bitSize _ = 32
isSigned _ = True
"fromIntegral/Int8->Int32" fromIntegral = \(I8# x#) -> I32# x#
"fromIntegral/Int16->Int32" fromIntegral = \(I16# x#) -> I32# x#
"fromIntegral/Int32->Int32" fromIntegral = id :: Int32 -> Int32
-"fromIntegral/a->Int32" fromIntegral = \x -> case fromIntegral x of I# x# -> I32# (intToInt32# x#)
+"fromIntegral/a->Int32" fromIntegral = \x -> case fromIntegral x of I# x# -> I32# (narrow32Int# x#)
"fromIntegral/Int32->a" fromIntegral = \(I32# x#) -> fromIntegral (I# x#)
#-}
+#endif
+
+instance CCallable Int32
+instance CReturnable Int32
+
+instance Real Int32 where
+ toRational x = toInteger x % 1
+
+instance Bounded Int32 where
+ minBound = -0x80000000
+ maxBound = 0x7FFFFFFF
+
+instance Ix Int32 where
+ range (m,n) = [m..n]
+ index b@(m,_) i
+ | inRange b i = fromIntegral (i - m)
+ | otherwise = indexError b i "Int32"
+ inRange (m,n) i = m <= i && i <= n
+
------------------------------------------------------------------------
-- type Int64
------------------------------------------------------------------------
-#if WORD_SIZE_IN_BYTES == 4
+#if WORD_SIZE_IN_BITS < 64
data Int64 = I64# Int64#
| y /= 0 = (I64# (x# `divInt64#` y#), I64# (x# `modInt64#` y#))
| otherwise = divZeroError "divMod{Int64}" x
toInteger x@(I64# x#)
- | x >= -0x80000000 && x <= 0x7FFFFFFF
+ | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int)
= S# (int64ToInt# x#)
| otherwise = case int64ToInteger# x# of (# s, d #) -> J# s d
+
divInt64#, modInt64# :: Int64# -> Int64# -> Int64#
x# `divInt64#` y#
| (x# `gtInt64#` intToInt64# 0#) && (y# `ltInt64#` intToInt64# 0#)
"fromIntegral/Int64->Int64" fromIntegral = id :: Int64 -> Int64
#-}
-#else
+#else
+
+-- Int64 is represented in the same way as Int.
+-- Operations may assume and must ensure that it holds only values
+-- from its logical range.
data Int64 = I64# Int# deriving (Eq, Ord)
-----------------------------------------------------------------------------
--- $Id: PrelPtr.lhs,v 1.2 2001/04/13 21:37:43 panne Exp $
+-- $Id: PrelPtr.lhs,v 1.3 2001/08/17 17:18:54 apt Exp $
--
-- (c) 2000
--
data Ptr a = Ptr Addr# deriving (Eq, Ord)
nullPtr :: Ptr a
-nullPtr = Ptr (int2Addr# 0#)
+nullPtr = Ptr (nullAddr# 0#)
castPtr :: Ptr a -> Ptr b
castPtr (Ptr addr) = Ptr addr
plusPtr :: Ptr a -> Int -> Ptr b
-plusPtr (Ptr addr) (I# d) = Ptr (int2Addr# (addr2Int# addr +# d))
+plusPtr (Ptr addr) (I# d) = Ptr (plusAddr# addr d)
alignPtr :: Ptr a -> Int -> Ptr a
alignPtr addr@(Ptr a) (I# i)
- = case addr2Int# a of { ai ->
- case remInt# ai i of {
+ = case remAddr# a i of {
0# -> addr;
- n -> Ptr (int2Addr# (ai +# (i -# n))) }}
+ n -> Ptr (plusAddr# a (i -# n)) }
minusPtr :: Ptr a -> Ptr b -> Int
-minusPtr (Ptr a1) (Ptr a2) = I# (addr2Int# a1 -# addr2Int# a2)
+minusPtr (Ptr a1) (Ptr a2) = I# (minusAddr# a1 a2)
instance CCallable (Ptr a)
instance CReturnable (Ptr a)
data FunPtr a = FunPtr Addr# deriving (Eq, Ord)
nullFunPtr :: FunPtr a
-nullFunPtr = FunPtr (int2Addr# 0#)
+nullFunPtr = FunPtr (nullAddr# 0#)
castFunPtr :: FunPtr a -> FunPtr b
castFunPtr (FunPtr addr) = FunPtr addr
instance CCallable (FunPtr a)
instance CReturnable (FunPtr a)
\end{code}
+
% -----------------------------------------------------------------------------
-% $Id: PrelStorable.lhs,v 1.8 2001/07/24 06:31:35 ken Exp $
+% $Id: PrelStorable.lhs,v 1.9 2001/08/17 17:18:54 apt Exp $
%
% (c) The FFI task force, 2000
%
= IO $ \s -> case readStablePtrOffAddr# a i s of (# s2, x #) -> (# s2, StablePtr x #)
readInt8OffPtr (Ptr a) (I# i)
= IO $ \s -> case readInt8OffAddr# a i s of (# s2, x #) -> (# s2, I8# x #)
-readInt16OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readInt16OffAddr# a i s of (# s2, x #) -> (# s2, I16# x #)
-readInt32OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readInt32OffAddr# a i s of (# s2, x #) -> (# s2, I32# x #)
-#if WORD_SIZE_IN_BYTES == 4
-readInt64OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readInt64OffAddr# a i s of (# s2, x #) -> (# s2, I64# x #)
-#else
-readInt64OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readIntOffAddr# a i s of (# s2, x #) -> (# s2, I64# x #)
-#endif
readWord8OffPtr (Ptr a) (I# i)
= IO $ \s -> case readWord8OffAddr# a i s of (# s2, x #) -> (# s2, W8# x #)
+readInt16OffPtr (Ptr a) (I# i)
+ = IO $ \s -> case readInt16OffAddr# a i s of (# s2, x #) -> (# s2, I16# x #)
readWord16OffPtr (Ptr a) (I# i)
= IO $ \s -> case readWord16OffAddr# a i s of (# s2, x #) -> (# s2, W16# x #)
+readInt32OffPtr (Ptr a) (I# i)
+ = IO $ \s -> case readInt32OffAddr# a i s of (# s2, x #) -> (# s2, I32# x #)
readWord32OffPtr (Ptr a) (I# i)
= IO $ \s -> case readWord32OffAddr# a i s of (# s2, x #) -> (# s2, W32# x #)
-#if WORD_SIZE_IN_BYTES == 4
+readInt64OffPtr (Ptr a) (I# i)
+ = IO $ \s -> case readInt64OffAddr# a i s of (# s2, x #) -> (# s2, I64# x #)
readWord64OffPtr (Ptr a) (I# i)
= IO $ \s -> case readWord64OffAddr# a i s of (# s2, x #) -> (# s2, W64# x #)
-#else
-readWord64OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readWordOffAddr# a i s of (# s2, x #) -> (# s2, W64# x #)
-#endif
writeWideCharOffPtr :: Ptr Char -> Int -> Char -> IO ()
writeIntOffPtr :: Ptr Int -> Int -> Int -> IO ()
= IO $ \s -> case writeStablePtrOffAddr# a i x s of s2 -> (# s2 , () #)
writeInt8OffPtr (Ptr a) (I# i) (I8# x)
= IO $ \s -> case writeInt8OffAddr# a i x s of s2 -> (# s2, () #)
-writeInt16OffPtr (Ptr a) (I# i) (I16# x)
- = IO $ \s -> case writeInt16OffAddr# a i x s of s2 -> (# s2, () #)
-writeInt32OffPtr (Ptr a) (I# i) (I32# x)
- = IO $ \s -> case writeInt32OffAddr# a i x s of s2 -> (# s2, () #)
-#if WORD_SIZE_IN_BYTES == 4
-writeInt64OffPtr (Ptr a) (I# i) (I64# x)
- = IO $ \s -> case writeInt64OffAddr# a i x s of s2 -> (# s2, () #)
-#else
-writeInt64OffPtr (Ptr a) (I# i) (I64# x)
- = IO $ \s -> case writeIntOffAddr# a i x s of s2 -> (# s2, () #)
-#endif
writeWord8OffPtr (Ptr a) (I# i) (W8# x)
= IO $ \s -> case writeWord8OffAddr# a i x s of s2 -> (# s2, () #)
+writeInt16OffPtr (Ptr a) (I# i) (I16# x)
+ = IO $ \s -> case writeInt16OffAddr# a i x s of s2 -> (# s2, () #)
writeWord16OffPtr (Ptr a) (I# i) (W16# x)
= IO $ \s -> case writeWord16OffAddr# a i x s of s2 -> (# s2, () #)
+writeInt32OffPtr (Ptr a) (I# i) (I32# x)
+ = IO $ \s -> case writeInt32OffAddr# a i x s of s2 -> (# s2, () #)
writeWord32OffPtr (Ptr a) (I# i) (W32# x)
= IO $ \s -> case writeWord32OffAddr# a i x s of s2 -> (# s2, () #)
-#if WORD_SIZE_IN_BYTES == 4
+writeInt64OffPtr (Ptr a) (I# i) (I64# x)
+ = IO $ \s -> case writeInt64OffAddr# a i x s of s2 -> (# s2, () #)
writeWord64OffPtr (Ptr a) (I# i) (W64# x)
= IO $ \s -> case writeWord64OffAddr# a i x s of s2 -> (# s2, () #)
-#else
-writeWord64OffPtr (Ptr a) (I# i) (W64# x)
- = IO $ \s -> case writeWordOffAddr# a i x s of s2 -> (# s2, () #)
-#endif
#endif /* __GLASGOW_HASKELL__ */
\end{code}
instance Bounded Word where
minBound = 0
-#if WORD_SIZE_IN_BYTES == 4
+#if WORD_SIZE_IN_BITS == 31
+ maxBound = 0x7FFFFFFF
+#elif WORD_SIZE_IN_BITS == 32
maxBound = 0xFFFFFFFF
#else
maxBound = 0xFFFFFFFFFFFFFFFF
(W# x#) `shift` (I# i#)
| i# >=# 0# = W# (x# `shiftL#` i#)
| otherwise = W# (x# `shiftRL#` negateInt# i#)
-#if WORD_SIZE_IN_BYTES == 4
- (W# x#) `rotate` (I# i#) = W# ((x# `shiftL#` i'#) `or#` (x# `shiftRL#` (32# -# i'#)))
+ (W# x#) `rotate` (I# i#) = W# ((x# `shiftL#` i'#) `or#` (x# `shiftRL#` (wsib -# i'#)))
where
- i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
-#else
- (W# x#) `rotate` (I# i#) = W# ((x# `shiftL#` i'#) `or#` (x# `shiftRL#` (64# -# i'#)))
- where
- i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
-#endif
- bitSize _ = WORD_SIZE_IN_BYTES * 8
+ i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
+ wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
+ bitSize _ = WORD_SIZE_IN_BITS
isSigned _ = False
{-# RULES
showsPrec p x = showsPrec p (fromIntegral x :: Int)
instance Num Word8 where
- (W8# x#) + (W8# y#) = W8# (wordToWord8# (x# `plusWord#` y#))
- (W8# x#) - (W8# y#) = W8# (wordToWord8# (x# `minusWord#` y#))
- (W8# x#) * (W8# y#) = W8# (wordToWord8# (x# `timesWord#` y#))
- negate (W8# x#) = W8# (wordToWord8# (int2Word# (negateInt# (word2Int# x#))))
+ (W8# x#) + (W8# y#) = W8# (narrow8Word# (x# `plusWord#` y#))
+ (W8# x#) - (W8# y#) = W8# (narrow8Word# (x# `minusWord#` y#))
+ (W8# x#) * (W8# y#) = W8# (narrow8Word# (x# `timesWord#` y#))
+ negate (W8# x#) = W8# (narrow8Word# (int2Word# (negateInt# (word2Int# x#))))
abs x = x
signum 0 = 0
signum _ = 1
- fromInteger (S# i#) = W8# (wordToWord8# (int2Word# i#))
- fromInteger (J# s# d#) = W8# (wordToWord8# (integer2Word# s# d#))
+ fromInteger (S# i#) = W8# (narrow8Word# (int2Word# i#))
+ fromInteger (J# s# d#) = W8# (narrow8Word# (integer2Word# s# d#))
instance Real Word8 where
toRational x = toInteger x % 1
(W8# x#) `xor` (W8# y#) = W8# (x# `xor#` y#)
complement (W8# x#) = W8# (x# `xor#` mb#) where W8# mb# = maxBound
(W8# x#) `shift` (I# i#)
- | i# >=# 0# = W8# (wordToWord8# (x# `shiftL#` i#))
+ | i# >=# 0# = W8# (narrow8Word# (x# `shiftL#` i#))
| otherwise = W8# (x# `shiftRL#` negateInt# i#)
- (W8# x#) `rotate` (I# i#) = W8# (wordToWord8# ((x# `shiftL#` i'#) `or#`
+ (W8# x#) `rotate` (I# i#) = W8# (narrow8Word# ((x# `shiftL#` i'#) `or#`
(x# `shiftRL#` (8# -# i'#))))
where
i'# = word2Int# (int2Word# i# `and#` int2Word# 7#)
{-# RULES
"fromIntegral/Word8->Word8" fromIntegral = id :: Word8 -> Word8
"fromIntegral/Word8->Integer" fromIntegral = toInteger :: Word8 -> Integer
-"fromIntegral/a->Word8" fromIntegral = \x -> case fromIntegral x of W# x# -> W8# (wordToWord8# x#)
+"fromIntegral/a->Word8" fromIntegral = \x -> case fromIntegral x of W# x# -> W8# (narrow8Word# x#)
"fromIntegral/Word8->a" fromIntegral = \(W8# x#) -> fromIntegral (W# x#)
#-}
showsPrec p x = showsPrec p (fromIntegral x :: Int)
instance Num Word16 where
- (W16# x#) + (W16# y#) = W16# (wordToWord16# (x# `plusWord#` y#))
- (W16# x#) - (W16# y#) = W16# (wordToWord16# (x# `minusWord#` y#))
- (W16# x#) * (W16# y#) = W16# (wordToWord16# (x# `timesWord#` y#))
- negate (W16# x#) = W16# (wordToWord16# (int2Word# (negateInt# (word2Int# x#))))
+ (W16# x#) + (W16# y#) = W16# (narrow16Word# (x# `plusWord#` y#))
+ (W16# x#) - (W16# y#) = W16# (narrow16Word# (x# `minusWord#` y#))
+ (W16# x#) * (W16# y#) = W16# (narrow16Word# (x# `timesWord#` y#))
+ negate (W16# x#) = W16# (narrow16Word# (int2Word# (negateInt# (word2Int# x#))))
abs x = x
signum 0 = 0
signum _ = 1
- fromInteger (S# i#) = W16# (wordToWord16# (int2Word# i#))
- fromInteger (J# s# d#) = W16# (wordToWord16# (integer2Word# s# d#))
+ fromInteger (S# i#) = W16# (narrow16Word# (int2Word# i#))
+ fromInteger (J# s# d#) = W16# (narrow16Word# (integer2Word# s# d#))
instance Real Word16 where
toRational x = toInteger x % 1
(W16# x#) `xor` (W16# y#) = W16# (x# `xor#` y#)
complement (W16# x#) = W16# (x# `xor#` mb#) where W16# mb# = maxBound
(W16# x#) `shift` (I# i#)
- | i# >=# 0# = W16# (wordToWord16# (x# `shiftL#` i#))
+ | i# >=# 0# = W16# (narrow16Word# (x# `shiftL#` i#))
| otherwise = W16# (x# `shiftRL#` negateInt# i#)
- (W16# x#) `rotate` (I# i#) = W16# (wordToWord16# ((x# `shiftL#` i'#) `or#`
+ (W16# x#) `rotate` (I# i#) = W16# (narrow16Word# ((x# `shiftL#` i'#) `or#`
(x# `shiftRL#` (16# -# i'#))))
where
i'# = word2Int# (int2Word# i# `and#` int2Word# 15#)
"fromIntegral/Word8->Word16" fromIntegral = \(W8# x#) -> W16# x#
"fromIntegral/Word16->Word16" fromIntegral = id :: Word16 -> Word16
"fromIntegral/Word16->Integer" fromIntegral = toInteger :: Word16 -> Integer
-"fromIntegral/a->Word16" fromIntegral = \x -> case fromIntegral x of W# x# -> W16# (wordToWord16# x#)
+"fromIntegral/a->Word16" fromIntegral = \x -> case fromIntegral x of W# x# -> W16# (narrow16Word# x#)
"fromIntegral/Word16->a" fromIntegral = \(W16# x#) -> fromIntegral (W# x#)
#-}
-- type Word32
------------------------------------------------------------------------
+#if WORD_SIZE_IN_BITS < 32
+
+data Word32 = W32# Word32#
+
+instance Eq Word32 where
+ (W32# x#) == (W32# y#) = x# `eqWord32#` y#
+ (W32# x#) /= (W32# y#) = x# `neWord32#` y#
+
+instance Ord Word32 where
+ (W32# x#) < (W32# y#) = x# `ltWord32#` y#
+ (W32# x#) <= (W32# y#) = x# `leWord32#` y#
+ (W32# x#) > (W32# y#) = x# `gtWord32#` y#
+ (W32# x#) >= (W32# y#) = x# `geWord32#` y#
+
+instance Num Word32 where
+ (W32# x#) + (W32# y#) = W32# (int32ToWord32# (word32ToInt32# x# `plusInt32#` word32ToInt32# y#))
+ (W32# x#) - (W32# y#) = W32# (int32ToWord32# (word32ToInt32# x# `minusInt32#` word32ToInt32# y#))
+ (W32# x#) * (W32# y#) = W32# (int32ToWord32# (word32ToInt32# x# `timesInt32#` word32ToInt32# y#))
+ negate (W32# x#) = W32# (int32ToWord32# (negateInt32# (word32ToInt32# x#)))
+ abs x = x
+ signum 0 = 0
+ signum _ = 1
+ fromInteger (S# i#) = W32# (int32ToWord32# (intToInt32# i#))
+ fromInteger (J# s# d#) = W32# (integerToWord32# s# d#)
+
+instance Enum Word32 where
+ succ x
+ | x /= maxBound = x + 1
+ | otherwise = succError "Word32"
+ pred x
+ | x /= minBound = x - 1
+ | otherwise = predError "Word32"
+ toEnum i@(I# i#)
+ | i >= 0 = W32# (wordToWord32# (int2Word# i#))
+ | otherwise = toEnumError "Word32" i (minBound::Word32, maxBound::Word32)
+ fromEnum x@(W32# x#)
+ | x <= fromIntegral (maxBound::Int)
+ = I# (word2Int# (word32ToWord# x#))
+ | otherwise = fromEnumError "Word32" x
+ enumFrom = integralEnumFrom
+ enumFromThen = integralEnumFromThen
+ enumFromTo = integralEnumFromTo
+ enumFromThenTo = integralEnumFromThenTo
+
+instance Integral Word32 where
+ quot x@(W32# x#) y@(W32# y#)
+ | y /= 0 = W32# (x# `quotWord32#` y#)
+ | otherwise = divZeroError "quot{Word32}" x
+ rem x@(W32# x#) y@(W32# y#)
+ | y /= 0 = W32# (x# `remWord32#` y#)
+ | otherwise = divZeroError "rem{Word32}" x
+ div x@(W32# x#) y@(W32# y#)
+ | y /= 0 = W32# (x# `quotWord32#` y#)
+ | otherwise = divZeroError "div{Word32}" x
+ mod x@(W32# x#) y@(W32# y#)
+ | y /= 0 = W32# (x# `remWord32#` y#)
+ | otherwise = divZeroError "mod{Word32}" x
+ quotRem x@(W32# x#) y@(W32# y#)
+ | y /= 0 = (W32# (x# `quotWord32#` y#), W32# (x# `remWord32#` y#))
+ | otherwise = divZeroError "quotRem{Word32}" x
+ divMod x@(W32# x#) y@(W32# y#)
+ | y /= 0 = (W32# (x# `quotWord32#` y#), W32# (x# `remWord32#` y#))
+ | otherwise = divZeroError "quotRem{Word32}" x
+ toInteger x@(W32# x#)
+ | x <= fromIntegral (maxBound::Int) = S# (word2Int# (word32ToWord# x#))
+ | otherwise = case word32ToInteger# x# of (# s, d #) -> J# s d
+
+instance Bits Word32 where
+ (W32# x#) .&. (W32# y#) = W32# (x# `and32#` y#)
+ (W32# x#) .|. (W32# y#) = W32# (x# `or32#` y#)
+ (W32# x#) `xor` (W32# y#) = W32# (x# `xor32#` y#)
+ complement (W32# x#) = W32# (not32# x#)
+ (W32# x#) `shift` (I# i#)
+ | i# >=# 0# = W32# (x# `shiftL32#` i#)
+ | otherwise = W32# (x# `shiftRL32#` negateInt# i#)
+ (W32# x#) `rotate` (I# i#) = W32# ((x# `shiftL32#` i'#) `or32#`
+ (x# `shiftRL32#` (32# -# i'#)))
+ where
+ i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
+ bitSize _ = 32
+ isSigned _ = False
+
+foreign import "stg_eqWord32" unsafe eqWord32# :: Word32# -> Word32# -> Bool
+foreign import "stg_neWord32" unsafe neWord32# :: Word32# -> Word32# -> Bool
+foreign import "stg_ltWord32" unsafe ltWord32# :: Word32# -> Word32# -> Bool
+foreign import "stg_leWord32" unsafe leWord32# :: Word32# -> Word32# -> Bool
+foreign import "stg_gtWord32" unsafe gtWord32# :: Word32# -> Word32# -> Bool
+foreign import "stg_geWord32" unsafe geWord32# :: Word32# -> Word32# -> Bool
+foreign import "stg_int32ToWord32" unsafe int32ToWord32# :: Int32# -> Word32#
+foreign import "stg_word32ToInt32" unsafe word32ToInt32# :: Word32# -> Int32#
+foreign import "stg_intToInt32" unsafe intToInt32# :: Int# -> Int32#
+foreign import "stg_wordToWord32" unsafe wordToWord32# :: Word# -> Word32#
+foreign import "stg_word32ToWord" unsafe word32ToWord# :: Word32# -> Word#
+foreign import "stg_plusInt32" unsafe plusInt32# :: Int32# -> Int32# -> Int32#
+foreign import "stg_minusInt32" unsafe minusInt32# :: Int32# -> Int32# -> Int32#
+foreign import "stg_timesInt32" unsafe timesInt32# :: Int32# -> Int32# -> Int32#
+foreign import "stg_negateInt32" unsafe negateInt32# :: Int32# -> Int32#
+foreign import "stg_quotWord32" unsafe quotWord32# :: Word32# -> Word32# -> Word32#
+foreign import "stg_remWord32" unsafe remWord32# :: Word32# -> Word32# -> Word32#
+foreign import "stg_and32" unsafe and32# :: Word32# -> Word32# -> Word32#
+foreign import "stg_or32" unsafe or32# :: Word32# -> Word32# -> Word32#
+foreign import "stg_xor32" unsafe xor32# :: Word32# -> Word32# -> Word32#
+foreign import "stg_not32" unsafe not32# :: Word32# -> Word32#
+foreign import "stg_shiftL32" unsafe shiftL32# :: Word32# -> Int# -> Word32#
+foreign import "stg_shiftRL32" unsafe shiftRL32# :: Word32# -> Int# -> Word32#
+
+{-# RULES
+"fromIntegral/Int->Word32" fromIntegral = \(I# x#) -> W32# (int32ToWord32# (intToInt32# x#))
+"fromIntegral/Word->Word32" fromIntegral = \(W# x#) -> W32# (wordToWord32# x#)
+"fromIntegral/Word32->Int" fromIntegral = \(W32# x#) -> I# (word2Int# (word32ToWord# x#))
+"fromIntegral/Word32->Word" fromIntegral = \(W32# x#) -> W# (word32ToWord# x#)
+"fromIntegral/Word32->Word32" fromIntegral = id :: Word32 -> Word32
+ #-}
+
+#else
+
-- Word32 is represented in the same way as Word.
-#if WORD_SIZE_IN_BYTES == 8
+#if WORD_SIZE_IN_BITS > 32
-- Operations may assume and must ensure that it holds only values
-- from its logical range.
#endif
data Word32 = W32# Word# deriving (Eq, Ord)
-instance CCallable Word32
-instance CReturnable Word32
-
-instance Show Word32 where
-#if WORD_SIZE_IN_BYTES == 4
- showsPrec p x = showsPrec p (toInteger x)
-#else
- showsPrec p x = showsPrec p (fromIntegral x :: Int)
-#endif
-
instance Num Word32 where
- (W32# x#) + (W32# y#) = W32# (wordToWord32# (x# `plusWord#` y#))
- (W32# x#) - (W32# y#) = W32# (wordToWord32# (x# `minusWord#` y#))
- (W32# x#) * (W32# y#) = W32# (wordToWord32# (x# `timesWord#` y#))
- negate (W32# x#) = W32# (wordToWord32# (int2Word# (negateInt# (word2Int# x#))))
+ (W32# x#) + (W32# y#) = W32# (narrow32Word# (x# `plusWord#` y#))
+ (W32# x#) - (W32# y#) = W32# (narrow32Word# (x# `minusWord#` y#))
+ (W32# x#) * (W32# y#) = W32# (narrow32Word# (x# `timesWord#` y#))
+ negate (W32# x#) = W32# (narrow32Word# (int2Word# (negateInt# (word2Int# x#))))
abs x = x
signum 0 = 0
signum _ = 1
- fromInteger (S# i#) = W32# (wordToWord32# (int2Word# i#))
- fromInteger (J# s# d#) = W32# (wordToWord32# (integer2Word# s# d#))
-
-instance Real Word32 where
- toRational x = toInteger x % 1
+ fromInteger (S# i#) = W32# (narrow32Word# (int2Word# i#))
+ fromInteger (J# s# d#) = W32# (narrow32Word# (integer2Word# s# d#))
instance Enum Word32 where
succ x
| otherwise = predError "Word32"
toEnum i@(I# i#)
| i >= 0
-#if WORD_SIZE_IN_BYTES == 8
+#if WORD_SIZE_IN_BITS > 32
&& i <= fromIntegral (maxBound::Word32)
#endif
= W32# (int2Word# i#)
| otherwise = toEnumError "Word32" i (minBound::Word32, maxBound::Word32)
-#if WORD_SIZE_IN_BYTES == 4
+#if WORD_SIZE_IN_BITS == 32
fromEnum x@(W32# x#)
| x <= fromIntegral (maxBound::Int)
= I# (word2Int# x#)
| y /= 0 = (W32# (x# `quotWord#` y#), W32# (x# `remWord#` y#))
| otherwise = divZeroError "quotRem{Word32}" x
toInteger (W32# x#)
-#if WORD_SIZE_IN_BYTES == 4
+#if WORD_SIZE_IN_BITS == 32
| i# >=# 0# = S# i#
| otherwise = case word2Integer# x# of (# s, d #) -> J# s d
where
= S# (word2Int# x#)
#endif
-instance Bounded Word32 where
- minBound = 0
- maxBound = 0xFFFFFFFF
-
-instance Ix Word32 where
- range (m,n) = [m..n]
- index b@(m,_) i
- | inRange b i = fromIntegral (i - m)
- | otherwise = indexError b i "Word32"
- inRange (m,n) i = m <= i && i <= n
-
-instance Read Word32 where
-#if WORD_SIZE_IN_BYTES == 4
- readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
-#else
- readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
-#endif
-
instance Bits Word32 where
(W32# x#) .&. (W32# y#) = W32# (x# `and#` y#)
(W32# x#) .|. (W32# y#) = W32# (x# `or#` y#)
(W32# x#) `xor` (W32# y#) = W32# (x# `xor#` y#)
complement (W32# x#) = W32# (x# `xor#` mb#) where W32# mb# = maxBound
(W32# x#) `shift` (I# i#)
- | i# >=# 0# = W32# (wordToWord32# (x# `shiftL#` i#))
+ | i# >=# 0# = W32# (narrow32Word# (x# `shiftL#` i#))
| otherwise = W32# (x# `shiftRL#` negateInt# i#)
- (W32# x#) `rotate` (I# i#) = W32# (wordToWord32# ((x# `shiftL#` i'#) `or#`
+ (W32# x#) `rotate` (I# i#) = W32# (narrow32Word# ((x# `shiftL#` i'#) `or#`
(x# `shiftRL#` (32# -# i'#))))
where
i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
"fromIntegral/Word16->Word32" fromIntegral = \(W16# x#) -> W32# x#
"fromIntegral/Word32->Word32" fromIntegral = id :: Word32 -> Word32
"fromIntegral/Word32->Integer" fromIntegral = toInteger :: Word32 -> Integer
-"fromIntegral/a->Word32" fromIntegral = \x -> case fromIntegral x of W# x# -> W32# (wordToWord32# x#)
+"fromIntegral/a->Word32" fromIntegral = \x -> case fromIntegral x of W# x# -> W32# (narrow32Word# x#)
"fromIntegral/Word32->a" fromIntegral = \(W32# x#) -> fromIntegral (W# x#)
#-}
+#endif
+
+instance CCallable Word32
+instance CReturnable Word32
+
+instance Show Word32 where
+#if WORD_SIZE_IN_BITS < 33
+ showsPrec p x = showsPrec p (toInteger x)
+#else
+ showsPrec p x = showsPrec p (fromIntegral x :: Int)
+#endif
+
+
+instance Real Word32 where
+ toRational x = toInteger x % 1
+
+instance Bounded Word32 where
+ minBound = 0
+ maxBound = 0xFFFFFFFF
+
+instance Ix Word32 where
+ range (m,n) = [m..n]
+ index b@(m,_) i
+ | inRange b i = fromIntegral (i - m)
+ | otherwise = indexError b i "Word32"
+ inRange (m,n) i = m <= i && i <= n
+
+instance Read Word32 where
+#if WORD_SIZE_IN_BITS < 33
+ readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
+#else
+ readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
+#endif
+
------------------------------------------------------------------------
-- type Word64
------------------------------------------------------------------------
-#if WORD_SIZE_IN_BYTES == 4
+#if WORD_SIZE_IN_BITS < 64
data Word64 = W64# Word64#
foreign import "stg_geWord64" unsafe geWord64# :: Word64# -> Word64# -> Bool
foreign import "stg_int64ToWord64" unsafe int64ToWord64# :: Int64# -> Word64#
foreign import "stg_word64ToInt64" unsafe word64ToInt64# :: Word64# -> Int64#
+foreign import "stg_intToInt64" unsafe intToInt64# :: Int# -> Int64#
+foreign import "stg_wordToWord64" unsafe wordToWord64# :: Word# -> Word64#
+foreign import "stg_word64ToWord" unsafe word64ToWord# :: Word64# -> Word#
foreign import "stg_plusInt64" unsafe plusInt64# :: Int64# -> Int64# -> Int64#
foreign import "stg_minusInt64" unsafe minusInt64# :: Int64# -> Int64# -> Int64#
foreign import "stg_timesInt64" unsafe timesInt64# :: Int64# -> Int64# -> Int64#
foreign import "stg_negateInt64" unsafe negateInt64# :: Int64# -> Int64#
-foreign import "stg_intToInt64" unsafe intToInt64# :: Int# -> Int64#
-foreign import "stg_wordToWord64" unsafe wordToWord64# :: Word# -> Word64#
-foreign import "stg_word64ToWord" unsafe word64ToWord# :: Word64# -> Word#
foreign import "stg_quotWord64" unsafe quotWord64# :: Word64# -> Word64# -> Word64#
foreign import "stg_remWord64" unsafe remWord64# :: Word64# -> Word64# -> Word64#
foreign import "stg_and64" unsafe and64# :: Word64# -> Word64# -> Word64#
#else
+-- Word64 is represented in the same way as Word.
+-- Operations may assume and must ensure that it holds only values
+-- from its logical range.
+
data Word64 = W64# Word# deriving (Eq, Ord)
instance Num Word64 where
HC=$(GHC_INPLACE)
# we don't want recompilation checking in here
-SRC_HC_OPTS += -no-recomp
+SRC_HC_OPTS += -no-recomp
# -----------------------------------------------------------------
# Everything after this point
do s <- getContents
let pres = parse pTop "" s
case pres of
- Left err -> do putStr "parse error at "
- print err
+ Left err -> error ("parse error at " ++ (show err))
Right p_o_specs
-> myseq (sanityTop p_o_specs) (
case head args of
"--make-haskell-wrappers"
-> putStr (gen_wrappers p_o_specs)
- "--make-latex-table"
- -> putStr (gen_latex_table p_o_specs)
+ "--make-latex-doc"
+ -> putStr (gen_latex_doc p_o_specs)
)
"--primop-tag",
"--primop-list",
"--make-haskell-wrappers",
- "--make-latex-table"
+ "--make-latex-doc"
]
------------------------------------------------------------------
-- Code generators -----------------------------------------------
------------------------------------------------------------------
-gen_latex_table (Info defaults pos)
- = "\\begin{tabular}{|l|l|}\n"
- ++ "\\hline\nName &\t Type\\\\\n\\hline\n"
- ++ (concat (map f pos))
- ++ "\\end{tabular}"
- where
- f spec = "@" ++ (encode (name spec)) ++ "@ &\t@" ++ (pty (ty spec)) ++ "@\\\\\n"
- encode s = s
- pty (TyF t1 t2) = pbty t1 ++ " -> " ++ pty t2
- pty t = pbty t
- pbty (TyApp tc ts) = (encode tc) ++ (concat (map (' ':) (map paty ts)))
- pbty (TyUTup ts) = (mkUtupnm (length ts)) ++ (concat (map (' ':) (map paty ts)))
- pbty t = paty t
- paty (TyVar tv) = encode tv
- paty t = "(" ++ pty t ++ ")"
- mkUtupnm 1 = "ZL#z32U#ZR"
- mkUtupnm n = "Z" ++ (show (n-1)) ++ "U"
-
-gen_wrappers (Info defaults pos)
+gen_latex_doc (Info defaults entries)
+ = "\\primopdefaults{"
+ ++ mk_options defaults
+ ++ "}\n"
+ ++ (concat (map mk_entry entries))
+ where mk_entry (PrimOpSpec {cons=cons,name=name,ty=ty,cat=cat,desc=desc,opts=opts}) =
+ "\\primopdesc{"
+ ++ latex_encode cons ++ "}{"
+ ++ latex_encode name ++ "}{"
+ ++ latex_encode (zencode name) ++ "}{"
+ ++ latex_encode (show cat) ++ "}{"
+ ++ latex_encode (mk_source_ty ty) ++ "}{"
+ ++ latex_encode (mk_core_ty ty) ++ "}{"
+ ++ desc ++ "}{"
+ ++ mk_options opts
+ ++ "}\n"
+ mk_entry (Section {title=title,desc=desc}) =
+ "\\primopsection{"
+ ++ latex_encode title ++ "}{"
+ ++ desc ++ "}\n"
+ mk_source_ty t = pty t
+ where pty (TyF t1 t2) = pbty t1 ++ " -> " ++ pty t2
+ pty t = pbty t
+ pbty (TyApp tc ts) = tc ++ (concat (map (' ':) (map paty ts)))
+ pbty (TyUTup ts) = "(# " ++ (concat (intersperse "," (map pty ts))) ++ " #)"
+ pbty t = paty t
+ paty (TyVar tv) = tv
+ paty t = "(" ++ pty t ++ ")"
+
+ mk_core_ty t = foralls ++ (pty t)
+ where pty (TyF t1 t2) = pbty t1 ++ " -> " ++ pty t2
+ pty t = pbty t
+ pbty (TyApp tc ts) = (zencode tc) ++ (concat (map (' ':) (map paty ts)))
+ pbty (TyUTup ts) = (zencode (utuplenm (length ts))) ++ (concat ((map (' ':) (map paty ts))))
+ pbty t = paty t
+ paty (TyVar tv) = zencode tv
+ paty (TyApp tc []) = zencode tc
+ paty t = "(" ++ pty t ++ ")"
+ utuplenm 1 = "(# #)"
+ utuplenm n = "(#" ++ (replicate (n-1) ',') ++ "#)"
+ foralls = if tvars == [] then "" else "%forall " ++ (tbinds tvars)
+ tvars = tvars_of t
+ tbinds [] = ". "
+ tbinds ("o":tbs) = "(o::?) " ++ (tbinds tbs)
+ tbinds (tv:tbs) = tv ++ " " ++ (tbinds tbs)
+ tvars_of (TyF t1 t2) = tvars_of t1 `union` tvars_of t2
+ tvars_of (TyApp tc ts) = foldl union [] (map tvars_of ts)
+ tvars_of (TyUTup ts) = foldr union [] (map tvars_of ts)
+ tvars_of (TyVar tv) = [tv]
+
+ mk_options opts =
+ "\\primoptions{"
+ ++ mk_has_side_effects opts ++ "}{"
+ ++ mk_out_of_line opts ++ "}{"
+ ++ mk_commutable opts ++ "}{"
+ ++ mk_needs_wrapper opts ++ "}{"
+ ++ mk_can_fail opts ++ "}{"
+ ++ latex_encode (mk_strictness opts) ++ "}{"
+ ++ latex_encode (mk_usage opts)
+ ++ "}"
+
+ mk_has_side_effects opts = mk_bool_opt opts "has_side_effects" "Has side effects." "Has no side effects."
+ mk_out_of_line opts = mk_bool_opt opts "out_of_line" "Implemented out of line." "Implemented in line."
+ mk_commutable opts = mk_bool_opt opts "commutable" "Commutable." "Not commutable."
+ mk_needs_wrapper opts = mk_bool_opt opts "needs_wrapper" "Needs wrapper." "Needs no wrapper."
+ mk_can_fail opts = mk_bool_opt opts "can_fail" "Can fail." "Cannot fail."
+
+ mk_bool_opt opts opt_name if_true if_false =
+ case lookup_attrib opt_name opts of
+ Just (OptionTrue _) -> if_true
+ Just (OptionFalse _) -> if_false
+ Nothing -> ""
+
+ mk_strictness opts =
+ case lookup_attrib "strictness" opts of
+ Just (OptionString _ s) -> s -- for now
+ Nothing -> ""
+
+ mk_usage opts =
+ case lookup_attrib "usage" opts of
+ Just (OptionString _ s) -> s -- for now
+ Nothing -> ""
+
+ zencode cs =
+ case maybe_tuple cs of
+ Just n -> n -- Tuples go to Z2T etc
+ Nothing -> concat (map encode_ch cs)
+ where
+ maybe_tuple "(# #)" = Just("Z1H")
+ maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of
+ (n, '#' : ')' : cs) -> Just ('Z' : shows (n+1) "H")
+ other -> Nothing
+ maybe_tuple "()" = Just("Z0T")
+ maybe_tuple ('(' : cs) = case count_commas (0::Int) cs of
+ (n, ')' : cs) -> Just ('Z' : shows (n+1) "T")
+ other -> Nothing
+ maybe_tuple other = Nothing
+
+ count_commas :: Int -> String -> (Int, String)
+ count_commas n (',' : cs) = count_commas (n+1) cs
+ count_commas n cs = (n,cs)
+
+ unencodedChar :: Char -> Bool -- True for chars that don't need encoding
+ unencodedChar 'Z' = False
+ unencodedChar 'z' = False
+ unencodedChar c = isAlphaNum c
+
+ encode_ch :: Char -> String
+ encode_ch c | unencodedChar c = [c] -- Common case first
+
+ -- Constructors
+ encode_ch '(' = "ZL" -- Needed for things like (,), and (->)
+ encode_ch ')' = "ZR" -- For symmetry with (
+ encode_ch '[' = "ZM"
+ encode_ch ']' = "ZN"
+ encode_ch ':' = "ZC"
+ encode_ch 'Z' = "ZZ"
+
+ -- Variables
+ encode_ch 'z' = "zz"
+ encode_ch '&' = "za"
+ encode_ch '|' = "zb"
+ encode_ch '^' = "zc"
+ encode_ch '$' = "zd"
+ encode_ch '=' = "ze"
+ encode_ch '>' = "zg"
+ encode_ch '#' = "zh"
+ encode_ch '.' = "zi"
+ encode_ch '<' = "zl"
+ encode_ch '-' = "zm"
+ encode_ch '!' = "zn"
+ encode_ch '+' = "zp"
+ encode_ch '\'' = "zq"
+ encode_ch '\\' = "zr"
+ encode_ch '/' = "zs"
+ encode_ch '*' = "zt"
+ encode_ch '_' = "zu"
+ encode_ch '%' = "zv"
+ encode_ch c = 'z' : shows (ord c) "U"
+
+ latex_encode [] = []
+ latex_encode (c:cs) | c `elem` "#$%&_^{}" = "\\" ++ c:(latex_encode cs)
+ latex_encode ('~':cs) = "\\verb!~!" ++ (latex_encode cs)
+ latex_encode ('\\':cs) = "$\\backslash$" ++ (latex_encode cs)
+ latex_encode (c:cs) = c:(latex_encode cs)
+
+gen_wrappers (Info defaults entries)
= "module PrelPrimopWrappers where\n"
++ "import qualified PrelGHC\n"
- ++ unlines (map f (filter (not.dodgy) pos))
+ ++ unlines (map f (filter (not.dodgy) (filter is_primop entries)))
where
f spec = let args = map (\n -> "a" ++ show n) [1 .. arity (ty spec)]
src_name = wrap (name spec)
]
-gen_primop_list (Info defaults pos)
+gen_primop_list (Info defaults entries)
= unlines (
- [ " [" ++ cons (head pos) ]
+ [ " [" ++ cons first ]
++
- map (\pi -> " , " ++ cons pi) (tail pos)
+ map (\pi -> " , " ++ cons pi) rest
++
[ " ]" ]
- )
+ ) where (first:rest) = filter is_primop entries
-gen_primop_tag (Info defaults pos)
- = unlines (zipWith f pos [1..])
+gen_primop_tag (Info defaults entries)
+ = unlines (zipWith f (filter is_primop entries) [1..])
where
f i n = "tagOf_PrimOp " ++ cons i
++ " = _ILIT(" ++ show n ++ ") :: FastInt"
-gen_data_decl (Info defaults pos)
- = let conss = map cons pos
+gen_data_decl (Info defaults entries)
+ = let conss = map cons (filter is_primop entries)
in "data PrimOp\n = " ++ head conss ++ "\n"
++ unlines (map (" | "++) (tail conss))
gen_switch_from_attribs :: String -> String -> Info -> String
-gen_switch_from_attribs attrib_name fn_name (Info defaults pos)
+gen_switch_from_attribs attrib_name fn_name (Info defaults entries)
= let defv = lookup_attrib attrib_name defaults
- alts = catMaybes (map mkAlt pos)
+ alts = catMaybes (map mkAlt (filter is_primop entries))
getAltRhs (OptionFalse _) = "False"
getAltRhs (OptionTrue _) = "True"
Nothing -> Nothing
Just xx -> Just (fn_name ++ " " ++ cons po ++ " = " ++ getAltRhs xx)
- lookup_attrib nm [] = Nothing
- lookup_attrib nm (a:as)
- = if get_attrib_name a == nm then Just a else lookup_attrib nm as
in
case defv of
Nothing -> error ("gen_switch_from: " ++ attrib_name)
------------------------------------------------------------------
-gen_primop_info (Info defaults pos)
- = unlines (map mkPOItext pos)
+gen_primop_info (Info defaults entries)
+ = unlines (map mkPOItext (filter is_primop entries))
mkPOItext i = mkPOI_LHS_text i ++ mkPOI_RHS_text i
ppType (TyApp "Bool" []) = "boolTy"
ppType (TyApp "Int#" []) = "intPrimTy"
+ppType (TyApp "Int32#" []) = "int32PrimTy"
ppType (TyApp "Int64#" []) = "int64PrimTy"
ppType (TyApp "Char#" []) = "charPrimTy"
ppType (TyApp "Word#" []) = "wordPrimTy"
+ppType (TyApp "Word32#" []) = "word32PrimTy"
ppType (TyApp "Word64#" []) = "word64PrimTy"
ppType (TyApp "Addr#" []) = "addrPrimTy"
ppType (TyApp "Float#" []) = "floatPrimTy"
-- info for all primops; the totality of the info in primops.txt(.pp)
data Info
- = Info [Option] [PrimOpSpec] -- defaults, primops
+ = Info [Option] [Entry] -- defaults, primops
deriving Show
-- info for one primop
-data PrimOpSpec
+data Entry
= PrimOpSpec { cons :: String, -- PrimOp name
name :: String, -- name in prog text
ty :: Ty, -- type
cat :: Category, -- category
+ desc :: String, -- description
opts :: [Option] } -- default overrides
+ | Section { title :: String, -- section title
+ desc :: String } -- description
deriving Show
+is_primop (PrimOpSpec _ _ _ _ _ _) = True
+is_primop _ = False
+
-- a binding of property to value
data Option
= OptionFalse String -- name = False
myseqAll [] x = x
sanityTop :: Info -> ()
-sanityTop (Info defs primops)
+sanityTop (Info defs entries)
= let opt_names = map get_attrib_name defs
+ primops = filter is_primop entries
in
if length opt_names /= length (nub opt_names)
then error ("non-unique default attribute names: " ++ show opt_names ++ "\n")
get_attrib_name (OptionTrue nm) = nm
get_attrib_name (OptionString nm _) = nm
+lookup_attrib nm [] = Nothing
+lookup_attrib nm (a:as)
+ = if get_attrib_name a == nm then Just a else lookup_attrib nm as
+
------------------------------------------------------------------
-- The parser ----------------------------------------------------
------------------------------------------------------------------
-- Due to lack of proper lexing facilities, a hack to zap any
-- leading comments
pTop :: Parser Info
-pTop = then4 (\_ ds ss _ -> Info ds ss)
- pCommentAndWhitespace pDefaults (many pPrimOpSpec)
+pTop = then4 (\_ ds es _ -> Info ds es)
+ pCommentAndWhitespace pDefaults (many pEntry)
(lit "thats_all_folks")
+pEntry :: Parser Entry
+pEntry
+ = alts [pPrimOpSpec, pSection]
+
+pSection :: Parser Entry
+pSection = then3 (\_ n d -> Section {title = n, desc = d})
+ (lit "section") stringLiteral pDesc
+
pDefaults :: Parser [Option]
pDefaults = then2 sel22 (lit "defaults") (many pOption)
pName (lit "=") pStuffBetweenBraces
]
-pPrimOpSpec :: Parser PrimOpSpec
+pPrimOpSpec :: Parser Entry
pPrimOpSpec
- = then6 (\_ c n k t o -> PrimOpSpec { cons = c, name = n, ty = t,
- cat = k, opts = o } )
+ = then7 (\_ c n k t d o -> PrimOpSpec { cons = c, name = n, ty = t,
+ cat = k, desc = d, opts = o } )
(lit "primop") pConstructor stringLiteral
- pCategory pType pOptions
+ pCategory pType pDesc pOptions
pOptions :: Parser [Option]
pOptions = optdef [] (then2 sel22 (lit "with") (many pOption))
apply (const GenPrimOp) (lit "GenPrimOp")
]
+pDesc :: Parser String
+pDesc = optdef "" pStuffBetweenBraces
+
+pStuffBetweenBraces :: Parser String
pStuffBetweenBraces
- = lexeme (then3 sel23
- (char '{') (many (satisfy (not . (== '}'))))
- (char '}'))
+ = lexeme (
+ do char '{'
+ ass <- many pInsides
+ char '}'
+ return (concat ass) )
+
+pInsides :: Parser String
+pInsides
+ = (do char '{'
+ stuff <- many pInsides
+ char '}'
+ return ("{" ++ (concat stuff) ++ "}"))
+ <|>
+ (do c <- satisfy (/= '}')
+ return [c])
+
+
-------------------
-- Parsing types --
apply (\tc -> TyApp tc []) pTycon
]
-pTyvar = sat (`notElem` ["primop","with"]) pName
+pTyvar = sat (`notElem` ["section","primop","with"]) pName
pTycon = pConstructor
pName = lexeme (then2 (:) lower (many isIdChar))
pConstructor = lexeme (then2 (:) upper (many isIdChar))
then6 f p1 p2 p3 p4 p5 p6
= do x1 <- p1 ; x2 <- p2 ; x3 <- p3 ; x4 <- p4 ; x5 <- p5 ; x6 <- p6
return (f x1 x2 x3 x4 x5 x6)
+then7 f p1 p2 p3 p4 p5 p6 p7
+ = do x1 <- p1 ; x2 <- p2 ; x3 <- p3 ; x4 <- p4 ; x5 <- p5 ; x6 <- p6 ; x7 <- p7
+ return (f x1 x2 x3 x4 x5 x6 x7)
opt p
= (do x <- p; return (Just x)) <|> return Nothing
optdef d p
projects / ghc-hetmet.git / commitdiff