summaryrefslogtreecommitdiff
path: root/compiler/prelude
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/prelude')
-rw-r--r--compiler/prelude/ForeignCall.lhs423
-rw-r--r--compiler/prelude/PrelInfo.lhs139
-rw-r--r--compiler/prelude/PrelNames.lhs1063
-rw-r--r--compiler/prelude/PrelRules.lhs447
-rw-r--r--compiler/prelude/PrimOp.lhs461
-rw-r--r--compiler/prelude/TysPrim.lhs392
-rw-r--r--compiler/prelude/TysWiredIn.lhs549
-rw-r--r--compiler/prelude/primops.txt.pp1687
8 files changed, 5161 insertions, 0 deletions
diff --git a/compiler/prelude/ForeignCall.lhs b/compiler/prelude/ForeignCall.lhs
new file mode 100644
index 0000000000..2c90a7dc6e
--- /dev/null
+++ b/compiler/prelude/ForeignCall.lhs
@@ -0,0 +1,423 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+\section[Foreign]{Foreign calls}
+
+\begin{code}
+module ForeignCall (
+ ForeignCall(..),
+ Safety(..), playSafe, playThreadSafe,
+
+ CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,
+ CCallSpec(..),
+ CCallTarget(..), isDynamicTarget,
+ CCallConv(..), defaultCCallConv, ccallConvToInt, ccallConvAttribute,
+
+ DNCallSpec(..), DNKind(..), DNType(..),
+ withDNTypes
+ ) where
+
+#include "HsVersions.h"
+
+import FastString ( FastString, unpackFS )
+import Char ( isAlphaNum )
+import Binary
+import Outputable
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsubsection{Data types}
+%* *
+%************************************************************************
+
+\begin{code}
+data ForeignCall
+ = CCall CCallSpec
+ | DNCall DNCallSpec
+ deriving( Eq ) -- We compare them when seeing if an interface
+ -- has changed (for versioning purposes)
+ {-! derive: Binary !-}
+
+-- We may need more clues to distinguish foreign calls
+-- but this simple printer will do for now
+instance Outputable ForeignCall where
+ ppr (CCall cc) = ppr cc
+ ppr (DNCall dn) = ppr dn
+\end{code}
+
+
+\begin{code}
+data Safety
+ = PlaySafe -- Might invoke Haskell GC, or do a call back, or
+ -- switch threads, etc. So make sure things are
+ -- tidy before the call
+ Bool -- => True, external function is also re-entrant.
+ -- [if supported, RTS arranges for the external call
+ -- to be executed by a separate OS thread, i.e.,
+ -- _concurrently_ to the execution of other Haskell threads.]
+
+ | PlayRisky -- None of the above can happen; the call will return
+ -- without interacting with the runtime system at all
+ deriving( Eq, Show )
+ -- Show used just for Show Lex.Token, I think
+ {-! derive: Binary !-}
+
+instance Outputable Safety where
+ ppr (PlaySafe False) = ptext SLIT("safe")
+ ppr (PlaySafe True) = ptext SLIT("threadsafe")
+ ppr PlayRisky = ptext SLIT("unsafe")
+
+playSafe :: Safety -> Bool
+playSafe PlaySafe{} = True
+playSafe PlayRisky = False
+
+playThreadSafe :: Safety -> Bool
+playThreadSafe (PlaySafe x) = x
+playThreadSafe _ = False
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsubsection{Calling C}
+%* *
+%************************************************************************
+
+\begin{code}
+data CExportSpec
+ = CExportStatic -- foreign export ccall foo :: ty
+ CLabelString -- C Name of exported function
+ CCallConv
+ {-! derive: Binary !-}
+
+data CCallSpec
+ = CCallSpec CCallTarget -- What to call
+ CCallConv -- Calling convention to use.
+ Safety
+ deriving( Eq )
+ {-! derive: Binary !-}
+\end{code}
+
+The call target:
+
+\begin{code}
+data CCallTarget
+ = StaticTarget CLabelString -- An "unboxed" ccall# to `fn'.
+ | DynamicTarget -- First argument (an Addr#) is the function pointer
+ deriving( Eq )
+ {-! derive: Binary !-}
+
+isDynamicTarget :: CCallTarget -> Bool
+isDynamicTarget DynamicTarget = True
+isDynamicTarget other = False
+\end{code}
+
+
+Stuff to do with calling convention:
+
+ccall: Caller allocates parameters, *and* deallocates them.
+
+stdcall: Caller allocates parameters, callee deallocates.
+ Function name has @N after it, where N is number of arg bytes
+ e.g. _Foo@8
+
+ToDo: The stdcall calling convention is x86 (win32) specific,
+so perhaps we should emit a warning if it's being used on other
+platforms.
+
+\begin{code}
+data CCallConv = CCallConv | StdCallConv
+ deriving (Eq)
+ {-! derive: Binary !-}
+
+instance Outputable CCallConv where
+ ppr StdCallConv = ptext SLIT("stdcall")
+ ppr CCallConv = ptext SLIT("ccall")
+
+defaultCCallConv :: CCallConv
+defaultCCallConv = CCallConv
+
+ccallConvToInt :: CCallConv -> Int
+ccallConvToInt StdCallConv = 0
+ccallConvToInt CCallConv = 1
+\end{code}
+
+Generate the gcc attribute corresponding to the given
+calling convention (used by PprAbsC):
+
+\begin{code}
+ccallConvAttribute :: CCallConv -> String
+ccallConvAttribute StdCallConv = "__attribute__((__stdcall__))"
+ccallConvAttribute CCallConv = ""
+\end{code}
+
+\begin{code}
+type CLabelString = FastString -- A C label, completely unencoded
+
+pprCLabelString :: CLabelString -> SDoc
+pprCLabelString lbl = ftext lbl
+
+isCLabelString :: CLabelString -> Bool -- Checks to see if this is a valid C label
+isCLabelString lbl
+ = all ok (unpackFS lbl)
+ where
+ ok c = isAlphaNum c || c == '_' || c == '.'
+ -- The '.' appears in e.g. "foo.so" in the
+ -- module part of a ExtName. Maybe it should be separate
+\end{code}
+
+
+Printing into C files:
+
+\begin{code}
+instance Outputable CExportSpec where
+ ppr (CExportStatic str _) = pprCLabelString str
+
+instance Outputable CCallSpec where
+ ppr (CCallSpec fun cconv safety)
+ = hcat [ ifPprDebug callconv, ppr_fun fun ]
+ where
+ callconv = text "{-" <> ppr cconv <> text "-}"
+
+ gc_suf | playSafe safety = text "_GC"
+ | otherwise = empty
+
+ ppr_fun DynamicTarget = text "__dyn_ccall" <> gc_suf <+> text "\"\""
+ ppr_fun (StaticTarget fn) = text "__ccall" <> gc_suf <+> pprCLabelString fn
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsubsection{.NET interop}
+%* *
+%************************************************************************
+
+\begin{code}
+data DNCallSpec =
+ DNCallSpec Bool -- True => static method/field
+ DNKind -- what type of access
+ String -- assembly
+ String -- fully qualified method/field name.
+ [DNType] -- argument types.
+ DNType -- result type.
+ deriving ( Eq )
+ {-! derive: Binary !-}
+
+data DNKind
+ = DNMethod
+ | DNField
+ | DNConstructor
+ deriving ( Eq )
+ {-! derive: Binary !-}
+
+data DNType
+ = DNByte
+ | DNBool
+ | DNChar
+ | DNDouble
+ | DNFloat
+ | DNInt
+ | DNInt8
+ | DNInt16
+ | DNInt32
+ | DNInt64
+ | DNWord8
+ | DNWord16
+ | DNWord32
+ | DNWord64
+ | DNPtr
+ | DNUnit
+ | DNObject
+ | DNString
+ deriving ( Eq )
+ {-! derive: Binary !-}
+
+withDNTypes :: DNCallSpec -> [DNType] -> DNType -> DNCallSpec
+withDNTypes (DNCallSpec isStatic k assem nm _ _) argTys resTy
+ = DNCallSpec isStatic k assem nm argTys resTy
+
+instance Outputable DNCallSpec where
+ ppr (DNCallSpec isStatic kind ass nm _ _ )
+ = char '"' <>
+ (if isStatic then text "static" else empty) <+>
+ (text (case kind of { DNMethod -> "method" ; DNField -> "field"; DNConstructor -> "ctor" })) <+>
+ (if null ass then char ' ' else char '[' <> text ass <> char ']') <>
+ text nm <>
+ char '"'
+\end{code}
+
+
+
+%************************************************************************
+%* *
+\subsubsection{Misc}
+%* *
+%************************************************************************
+
+\begin{code}
+{-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-}
+instance Binary ForeignCall where
+ put_ bh (CCall aa) = do
+ putByte bh 0
+ put_ bh aa
+ put_ bh (DNCall ab) = do
+ putByte bh 1
+ put_ bh ab
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> do aa <- get bh
+ return (CCall aa)
+ _ -> do ab <- get bh
+ return (DNCall ab)
+
+instance Binary Safety where
+ put_ bh (PlaySafe aa) = do
+ putByte bh 0
+ put_ bh aa
+ put_ bh PlayRisky = do
+ putByte bh 1
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> do aa <- get bh
+ return (PlaySafe aa)
+ _ -> do return PlayRisky
+
+instance Binary CExportSpec where
+ put_ bh (CExportStatic aa ab) = do
+ put_ bh aa
+ put_ bh ab
+ get bh = do
+ aa <- get bh
+ ab <- get bh
+ return (CExportStatic aa ab)
+
+instance Binary CCallSpec where
+ put_ bh (CCallSpec aa ab ac) = do
+ put_ bh aa
+ put_ bh ab
+ put_ bh ac
+ get bh = do
+ aa <- get bh
+ ab <- get bh
+ ac <- get bh
+ return (CCallSpec aa ab ac)
+
+instance Binary CCallTarget where
+ put_ bh (StaticTarget aa) = do
+ putByte bh 0
+ put_ bh aa
+ put_ bh DynamicTarget = do
+ putByte bh 1
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> do aa <- get bh
+ return (StaticTarget aa)
+ _ -> do return DynamicTarget
+
+instance Binary CCallConv where
+ put_ bh CCallConv = do
+ putByte bh 0
+ put_ bh StdCallConv = do
+ putByte bh 1
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> do return CCallConv
+ _ -> do return StdCallConv
+
+instance Binary DNCallSpec where
+ put_ bh (DNCallSpec isStatic kind ass nm _ _) = do
+ put_ bh isStatic
+ put_ bh kind
+ put_ bh ass
+ put_ bh nm
+ get bh = do
+ isStatic <- get bh
+ kind <- get bh
+ ass <- get bh
+ nm <- get bh
+ return (DNCallSpec isStatic kind ass nm [] undefined)
+
+instance Binary DNKind where
+ put_ bh DNMethod = do
+ putByte bh 0
+ put_ bh DNField = do
+ putByte bh 1
+ put_ bh DNConstructor = do
+ putByte bh 2
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> do return DNMethod
+ 1 -> do return DNField
+ _ -> do return DNConstructor
+
+instance Binary DNType where
+ put_ bh DNByte = do
+ putByte bh 0
+ put_ bh DNBool = do
+ putByte bh 1
+ put_ bh DNChar = do
+ putByte bh 2
+ put_ bh DNDouble = do
+ putByte bh 3
+ put_ bh DNFloat = do
+ putByte bh 4
+ put_ bh DNInt = do
+ putByte bh 5
+ put_ bh DNInt8 = do
+ putByte bh 6
+ put_ bh DNInt16 = do
+ putByte bh 7
+ put_ bh DNInt32 = do
+ putByte bh 8
+ put_ bh DNInt64 = do
+ putByte bh 9
+ put_ bh DNWord8 = do
+ putByte bh 10
+ put_ bh DNWord16 = do
+ putByte bh 11
+ put_ bh DNWord32 = do
+ putByte bh 12
+ put_ bh DNWord64 = do
+ putByte bh 13
+ put_ bh DNPtr = do
+ putByte bh 14
+ put_ bh DNUnit = do
+ putByte bh 15
+ put_ bh DNObject = do
+ putByte bh 16
+ put_ bh DNString = do
+ putByte bh 17
+
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> return DNByte
+ 1 -> return DNBool
+ 2 -> return DNChar
+ 3 -> return DNDouble
+ 4 -> return DNFloat
+ 5 -> return DNInt
+ 6 -> return DNInt8
+ 7 -> return DNInt16
+ 8 -> return DNInt32
+ 9 -> return DNInt64
+ 10 -> return DNWord8
+ 11 -> return DNWord16
+ 12 -> return DNWord32
+ 13 -> return DNWord64
+ 14 -> return DNPtr
+ 15 -> return DNUnit
+ 16 -> return DNObject
+ 17 -> return DNString
+
+-- Imported from other files :-
+
+\end{code}
diff --git a/compiler/prelude/PrelInfo.lhs b/compiler/prelude/PrelInfo.lhs
new file mode 100644
index 0000000000..31457b2b63
--- /dev/null
+++ b/compiler/prelude/PrelInfo.lhs
@@ -0,0 +1,139 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+\section[PrelInfo]{The @PrelInfo@ interface to the compiler's prelude knowledge}
+
+\begin{code}
+module PrelInfo (
+ module MkId,
+
+ ghcPrimExports,
+ wiredInThings, basicKnownKeyNames,
+ primOpId,
+
+ -- Random other things
+ maybeCharLikeCon, maybeIntLikeCon,
+
+ -- Class categories
+ isNumericClass, isStandardClass
+
+ ) where
+
+#include "HsVersions.h"
+
+import PrelNames ( basicKnownKeyNames,
+ hasKey, charDataConKey, intDataConKey,
+ numericClassKeys, standardClassKeys )
+
+import PrimOp ( PrimOp, allThePrimOps, primOpOcc, primOpTag, maxPrimOpTag )
+import DataCon ( DataCon )
+import Id ( Id, idName )
+import MkId ( mkPrimOpId, wiredInIds )
+import MkId -- All of it, for re-export
+import Name ( nameOccName )
+import TysPrim ( primTyCons )
+import TysWiredIn ( wiredInTyCons )
+import HscTypes ( TyThing(..), implicitTyThings, GenAvailInfo(..), RdrAvailInfo )
+import Class ( Class, classKey )
+import Type ( funTyCon )
+import TyCon ( tyConName )
+import Util ( isIn )
+
+import Array ( Array, array, (!) )
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[builtinNameInfo]{Lookup built-in names}
+%* *
+%************************************************************************
+
+We have two ``builtin name funs,'' one to look up @TyCons@ and
+@Classes@, the other to look up values.
+
+\begin{code}
+wiredInThings :: [TyThing]
+wiredInThings
+ = concat
+ [ -- Wired in TyCons and their implicit Ids
+ tycon_things
+ , concatMap implicitTyThings tycon_things
+
+ -- Wired in Ids
+ , map AnId wiredInIds
+
+ -- PrimOps
+ , map (AnId . mkPrimOpId) allThePrimOps
+ ]
+ where
+ tycon_things = map ATyCon ([funTyCon] ++ primTyCons ++ wiredInTyCons)
+\end{code}
+
+We let a lot of "non-standard" values be visible, so that we can make
+sense of them in interface pragmas. It's cool, though they all have
+"non-standard" names, so they won't get past the parser in user code.
+
+%************************************************************************
+%* *
+ PrimOpIds
+%* *
+%************************************************************************
+
+\begin{code}
+primOpIds :: Array Int Id -- Indexed by PrimOp tag
+primOpIds = array (1,maxPrimOpTag) [ (primOpTag op, mkPrimOpId op)
+ | op <- allThePrimOps]
+
+primOpId :: PrimOp -> Id
+primOpId op = primOpIds ! primOpTag op
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Export lists for pseudo-modules (GHC.Prim)}
+%* *
+%************************************************************************
+
+GHC.Prim "exports" all the primops and primitive types, some
+wired-in Ids.
+
+\begin{code}
+ghcPrimExports :: [RdrAvailInfo]
+ghcPrimExports
+ = map (Avail . nameOccName . idName) ghcPrimIds ++
+ map (Avail . primOpOcc) allThePrimOps ++
+ [ AvailTC occ [occ] |
+ n <- funTyCon : primTyCons, let occ = nameOccName (tyConName n)
+ ]
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Built-in keys}
+%* *
+%************************************************************************
+
+ToDo: make it do the ``like'' part properly (as in 0.26 and before).
+
+\begin{code}
+maybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool
+maybeCharLikeCon con = con `hasKey` charDataConKey
+maybeIntLikeCon con = con `hasKey` intDataConKey
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Class predicates}
+%* *
+%************************************************************************
+
+\begin{code}
+isNumericClass, isStandardClass :: Class -> Bool
+
+isNumericClass clas = classKey clas `is_elem` numericClassKeys
+isStandardClass clas = classKey clas `is_elem` standardClassKeys
+is_elem = isIn "is_X_Class"
+\end{code}
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
new file mode 100644
index 0000000000..d656fbf18e
--- /dev/null
+++ b/compiler/prelude/PrelNames.lhs
@@ -0,0 +1,1063 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+\section[PrelNames]{Definitions of prelude modules and names}
+
+
+Nota Bene: all Names defined in here should come from the base package
+
+* ModuleNames for prelude modules,
+ e.g. pREL_BASE_Name :: ModuleName
+
+* Modules for prelude modules
+ e.g. pREL_Base :: Module
+
+* Uniques for Ids, DataCons, TyCons and Classes that the compiler
+ "knows about" in some way
+ e.g. intTyConKey :: Unique
+ minusClassOpKey :: Unique
+
+* Names for Ids, DataCons, TyCons and Classes that the compiler
+ "knows about" in some way
+ e.g. intTyConName :: Name
+ minusName :: Name
+ One of these Names contains
+ (a) the module and occurrence name of the thing
+ (b) its Unique
+ The may way the compiler "knows about" one of these things is
+ where the type checker or desugarer needs to look it up. For
+ example, when desugaring list comprehensions the desugarer
+ needs to conjure up 'foldr'. It does this by looking up
+ foldrName in the environment.
+
+* RdrNames for Ids, DataCons etc that the compiler may emit into
+ generated code (e.g. for deriving). It's not necessary to know
+ the uniques for these guys, only their names
+
+
+\begin{code}
+module PrelNames (
+ Unique, Uniquable(..), hasKey, -- Re-exported for convenience
+
+ -----------------------------------------------------------
+ module PrelNames, -- A huge bunch of (a) Names, e.g. intTyConName
+ -- (b) Uniques e.g. intTyConKey
+ -- (c) Groups of classes and types
+ -- (d) miscellaneous things
+ -- So many that we export them all
+ ) where
+
+#include "HsVersions.h"
+
+import Module ( Module, mkModule )
+import OccName ( dataName, tcName, clsName, varName, mkOccNameFS,
+ mkVarOccFS )
+import RdrName ( RdrName, nameRdrName, mkOrig, rdrNameOcc, mkUnqual )
+import Unique ( Unique, Uniquable(..), hasKey,
+ mkPreludeMiscIdUnique, mkPreludeDataConUnique,
+ mkPreludeTyConUnique, mkPreludeClassUnique,
+ mkTupleTyConUnique
+ )
+import BasicTypes ( Boxity(..), Arity )
+import Name ( Name, mkInternalName, mkExternalName, nameModule )
+import SrcLoc ( noSrcLoc )
+import FastString
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Local Names}
+%* *
+%************************************************************************
+
+This *local* name is used by the interactive stuff
+
+\begin{code}
+itName uniq = mkInternalName uniq (mkOccNameFS varName FSLIT("it")) noSrcLoc
+\end{code}
+
+\begin{code}
+-- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
+-- during compiler debugging.
+mkUnboundName :: RdrName -> Name
+mkUnboundName rdr_name = mkInternalName unboundKey (rdrNameOcc rdr_name) noSrcLoc
+
+isUnboundName :: Name -> Bool
+isUnboundName name = name `hasKey` unboundKey
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Known key Names}
+%* *
+%************************************************************************
+
+This section tells what the compiler knows about the assocation of
+names with uniques. These ones are the *non* wired-in ones. The
+wired in ones are defined in TysWiredIn etc.
+
+\begin{code}
+basicKnownKeyNames :: [Name]
+basicKnownKeyNames
+ = genericTyConNames
+ ++ typeableClassNames
+ ++ [ -- Type constructors (synonyms especially)
+ ioTyConName, ioDataConName,
+ runMainIOName,
+ orderingTyConName,
+ rationalTyConName,
+ ratioDataConName,
+ ratioTyConName,
+ byteArrayTyConName,
+ mutableByteArrayTyConName,
+ integerTyConName, smallIntegerDataConName, largeIntegerDataConName,
+
+ -- Classes. *Must* include:
+ -- classes that are grabbed by key (e.g., eqClassKey)
+ -- classes in "Class.standardClassKeys" (quite a few)
+ eqClassName, -- mentioned, derivable
+ ordClassName, -- derivable
+ boundedClassName, -- derivable
+ numClassName, -- mentioned, numeric
+ enumClassName, -- derivable
+ monadClassName,
+ functorClassName,
+ realClassName, -- numeric
+ integralClassName, -- numeric
+ fractionalClassName, -- numeric
+ floatingClassName, -- numeric
+ realFracClassName, -- numeric
+ realFloatClassName, -- numeric
+ dataClassName,
+
+ -- Numeric stuff
+ negateName, minusName,
+ fromRationalName, fromIntegerName,
+ geName, eqName,
+
+ -- Enum stuff
+ enumFromName, enumFromThenName,
+ enumFromThenToName, enumFromToName,
+ enumFromToPName, enumFromThenToPName,
+
+ -- Monad stuff
+ thenIOName, bindIOName, returnIOName, failIOName,
+ failMName, bindMName, thenMName, returnMName,
+
+ -- MonadRec stuff
+ mfixName,
+
+ -- Arrow stuff
+ arrAName, composeAName, firstAName,
+ appAName, choiceAName, loopAName,
+
+ -- Ix stuff
+ ixClassName,
+
+ -- Show stuff
+ showClassName,
+
+ -- Read stuff
+ readClassName,
+
+ -- Stable pointers
+ newStablePtrName,
+
+ -- Strings and lists
+ unpackCStringName, unpackCStringAppendName,
+ unpackCStringFoldrName, unpackCStringUtf8Name,
+
+ -- List operations
+ concatName, filterName,
+ zipName, foldrName, buildName, augmentName, appendName,
+
+ -- Parallel array operations
+ nullPName, lengthPName, replicatePName, mapPName,
+ filterPName, zipPName, crossPName, indexPName,
+ toPName, bpermutePName, bpermuteDftPName, indexOfPName,
+
+ -- FFI primitive types that are not wired-in.
+ stablePtrTyConName, ptrTyConName, funPtrTyConName, addrTyConName,
+ int8TyConName, int16TyConName, int32TyConName, int64TyConName,
+ wordTyConName, word8TyConName, word16TyConName, word32TyConName, word64TyConName,
+
+ -- Others
+ otherwiseIdName,
+ plusIntegerName, timesIntegerName,
+ eqStringName, assertName, breakpointName, assertErrorName,
+ runSTRepName,
+ printName, fstName, sndName,
+
+ -- MonadFix
+ monadFixClassName, mfixName,
+
+ -- Splittable class
+ splittableClassName, splitName,
+
+ -- Other classes
+ randomClassName, randomGenClassName, monadPlusClassName,
+
+ -- Booleans
+ andName, orName
+
+ -- The Either type
+ , eitherTyConName, leftDataConName, rightDataConName
+
+ -- dotnet interop
+ , objectTyConName, marshalObjectName, unmarshalObjectName
+ , marshalStringName, unmarshalStringName, checkDotnetResName
+ ]
+
+genericTyConNames :: [Name]
+genericTyConNames = [crossTyConName, plusTyConName, genUnitTyConName]
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Module names}
+%* *
+%************************************************************************
+
+
+--MetaHaskell Extension Add a new module here
+\begin{code}
+pRELUDE = mkModule "Prelude"
+gHC_PRIM = mkModule "GHC.Prim" -- Primitive types and values
+pREL_BASE = mkModule "GHC.Base"
+pREL_ENUM = mkModule "GHC.Enum"
+pREL_SHOW = mkModule "GHC.Show"
+pREL_READ = mkModule "GHC.Read"
+pREL_NUM = mkModule "GHC.Num"
+pREL_LIST = mkModule "GHC.List"
+pREL_PARR = mkModule "GHC.PArr"
+pREL_TUP = mkModule "Data.Tuple"
+pREL_EITHER = mkModule "Data.Either"
+pREL_PACK = mkModule "GHC.Pack"
+pREL_CONC = mkModule "GHC.Conc"
+pREL_IO_BASE = mkModule "GHC.IOBase"
+pREL_ST = mkModule "GHC.ST"
+pREL_ARR = mkModule "GHC.Arr"
+pREL_BYTEARR = mkModule "PrelByteArr"
+pREL_STABLE = mkModule "GHC.Stable"
+pREL_ADDR = mkModule "GHC.Addr"
+pREL_PTR = mkModule "GHC.Ptr"
+pREL_ERR = mkModule "GHC.Err"
+pREL_REAL = mkModule "GHC.Real"
+pREL_FLOAT = mkModule "GHC.Float"
+pREL_TOP_HANDLER= mkModule "GHC.TopHandler"
+sYSTEM_IO = mkModule "System.IO"
+dYNAMIC = mkModule "Data.Dynamic"
+tYPEABLE = mkModule "Data.Typeable"
+gENERICS = mkModule "Data.Generics.Basics"
+dOTNET = mkModule "GHC.Dotnet"
+
+rEAD_PREC = mkModule "Text.ParserCombinators.ReadPrec"
+lEX = mkModule "Text.Read.Lex"
+
+mAIN = mkModule "Main"
+pREL_INT = mkModule "GHC.Int"
+pREL_WORD = mkModule "GHC.Word"
+mONAD = mkModule "Control.Monad"
+mONAD_FIX = mkModule "Control.Monad.Fix"
+aRROW = mkModule "Control.Arrow"
+aDDR = mkModule "Addr"
+rANDOM = mkModule "System.Random"
+
+gLA_EXTS = mkModule "GHC.Exts"
+rOOT_MAIN = mkModule ":Main" -- Root module for initialisation
+ -- The ':xxx' makes a module name that the user can never
+ -- use himself. The z-encoding for ':' is "ZC", so the z-encoded
+ -- module name still starts with a capital letter, which keeps
+ -- the z-encoded version consistent.
+
+iNTERACTIVE = mkModule ":Interactive"
+thFAKE = mkModule ":THFake"
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Constructing the names of tuples
+%* *
+%************************************************************************
+
+\begin{code}
+mkTupleModule :: Boxity -> Arity -> Module
+mkTupleModule Boxed 0 = pREL_BASE
+mkTupleModule Boxed _ = pREL_TUP
+mkTupleModule Unboxed _ = gHC_PRIM
+\end{code}
+
+
+%************************************************************************
+%* *
+ RdrNames
+%* *
+%************************************************************************
+
+\begin{code}
+main_RDR_Unqual = mkUnqual varName FSLIT("main")
+ -- We definitely don't want an Orig RdrName, because
+ -- main might, in principle, be imported into module Main
+
+eq_RDR = nameRdrName eqName
+ge_RDR = nameRdrName geName
+ne_RDR = varQual_RDR pREL_BASE FSLIT("/=")
+le_RDR = varQual_RDR pREL_BASE FSLIT("<=")
+gt_RDR = varQual_RDR pREL_BASE FSLIT(">")
+compare_RDR = varQual_RDR pREL_BASE FSLIT("compare")
+ltTag_RDR = dataQual_RDR pREL_BASE FSLIT("LT")
+eqTag_RDR = dataQual_RDR pREL_BASE FSLIT("EQ")
+gtTag_RDR = dataQual_RDR pREL_BASE FSLIT("GT")
+
+eqClass_RDR = nameRdrName eqClassName
+numClass_RDR = nameRdrName numClassName
+ordClass_RDR = nameRdrName ordClassName
+enumClass_RDR = nameRdrName enumClassName
+monadClass_RDR = nameRdrName monadClassName
+
+map_RDR = varQual_RDR pREL_BASE FSLIT("map")
+append_RDR = varQual_RDR pREL_BASE FSLIT("++")
+
+foldr_RDR = nameRdrName foldrName
+build_RDR = nameRdrName buildName
+returnM_RDR = nameRdrName returnMName
+bindM_RDR = nameRdrName bindMName
+failM_RDR = nameRdrName failMName
+
+and_RDR = nameRdrName andName
+
+left_RDR = nameRdrName leftDataConName
+right_RDR = nameRdrName rightDataConName
+
+fromEnum_RDR = varQual_RDR pREL_ENUM FSLIT("fromEnum")
+toEnum_RDR = varQual_RDR pREL_ENUM FSLIT("toEnum")
+
+enumFrom_RDR = nameRdrName enumFromName
+enumFromTo_RDR = nameRdrName enumFromToName
+enumFromThen_RDR = nameRdrName enumFromThenName
+enumFromThenTo_RDR = nameRdrName enumFromThenToName
+
+ratioDataCon_RDR = nameRdrName ratioDataConName
+plusInteger_RDR = nameRdrName plusIntegerName
+timesInteger_RDR = nameRdrName timesIntegerName
+
+ioDataCon_RDR = nameRdrName ioDataConName
+
+eqString_RDR = nameRdrName eqStringName
+unpackCString_RDR = nameRdrName unpackCStringName
+unpackCStringFoldr_RDR = nameRdrName unpackCStringFoldrName
+unpackCStringUtf8_RDR = nameRdrName unpackCStringUtf8Name
+
+newStablePtr_RDR = nameRdrName newStablePtrName
+addrDataCon_RDR = dataQual_RDR aDDR FSLIT("A#")
+wordDataCon_RDR = dataQual_RDR pREL_WORD FSLIT("W#")
+
+bindIO_RDR = nameRdrName bindIOName
+returnIO_RDR = nameRdrName returnIOName
+
+fromInteger_RDR = nameRdrName fromIntegerName
+fromRational_RDR = nameRdrName fromRationalName
+minus_RDR = nameRdrName minusName
+times_RDR = varQual_RDR pREL_NUM FSLIT("*")
+plus_RDR = varQual_RDR pREL_NUM FSLIT("+")
+
+compose_RDR = varQual_RDR pREL_BASE FSLIT(".")
+
+not_RDR = varQual_RDR pREL_BASE FSLIT("not")
+getTag_RDR = varQual_RDR pREL_BASE FSLIT("getTag")
+succ_RDR = varQual_RDR pREL_ENUM FSLIT("succ")
+pred_RDR = varQual_RDR pREL_ENUM FSLIT("pred")
+minBound_RDR = varQual_RDR pREL_ENUM FSLIT("minBound")
+maxBound_RDR = varQual_RDR pREL_ENUM FSLIT("maxBound")
+range_RDR = varQual_RDR pREL_ARR FSLIT("range")
+inRange_RDR = varQual_RDR pREL_ARR FSLIT("inRange")
+index_RDR = varQual_RDR pREL_ARR FSLIT("index")
+unsafeIndex_RDR = varQual_RDR pREL_ARR FSLIT("unsafeIndex")
+unsafeRangeSize_RDR = varQual_RDR pREL_ARR FSLIT("unsafeRangeSize")
+
+readList_RDR = varQual_RDR pREL_READ FSLIT("readList")
+readListDefault_RDR = varQual_RDR pREL_READ FSLIT("readListDefault")
+readListPrec_RDR = varQual_RDR pREL_READ FSLIT("readListPrec")
+readListPrecDefault_RDR = varQual_RDR pREL_READ FSLIT("readListPrecDefault")
+readPrec_RDR = varQual_RDR pREL_READ FSLIT("readPrec")
+parens_RDR = varQual_RDR pREL_READ FSLIT("parens")
+choose_RDR = varQual_RDR pREL_READ FSLIT("choose")
+lexP_RDR = varQual_RDR pREL_READ FSLIT("lexP")
+
+punc_RDR = dataQual_RDR lEX FSLIT("Punc")
+ident_RDR = dataQual_RDR lEX FSLIT("Ident")
+symbol_RDR = dataQual_RDR lEX FSLIT("Symbol")
+
+step_RDR = varQual_RDR rEAD_PREC FSLIT("step")
+alt_RDR = varQual_RDR rEAD_PREC FSLIT("+++")
+reset_RDR = varQual_RDR rEAD_PREC FSLIT("reset")
+prec_RDR = varQual_RDR rEAD_PREC FSLIT("prec")
+
+showList_RDR = varQual_RDR pREL_SHOW FSLIT("showList")
+showList___RDR = varQual_RDR pREL_SHOW FSLIT("showList__")
+showsPrec_RDR = varQual_RDR pREL_SHOW FSLIT("showsPrec")
+showString_RDR = varQual_RDR pREL_SHOW FSLIT("showString")
+showSpace_RDR = varQual_RDR pREL_SHOW FSLIT("showSpace")
+showParen_RDR = varQual_RDR pREL_SHOW FSLIT("showParen")
+
+typeOf_RDR = varQual_RDR tYPEABLE FSLIT("typeOf")
+mkTypeRep_RDR = varQual_RDR tYPEABLE FSLIT("mkTyConApp")
+mkTyConRep_RDR = varQual_RDR tYPEABLE FSLIT("mkTyCon")
+
+undefined_RDR = varQual_RDR pREL_ERR FSLIT("undefined")
+
+crossDataCon_RDR = dataQual_RDR pREL_BASE FSLIT(":*:")
+inlDataCon_RDR = dataQual_RDR pREL_BASE FSLIT("Inl")
+inrDataCon_RDR = dataQual_RDR pREL_BASE FSLIT("Inr")
+genUnitDataCon_RDR = dataQual_RDR pREL_BASE FSLIT("Unit")
+
+----------------------
+varQual_RDR mod str = mkOrig mod (mkOccNameFS varName str)
+tcQual_RDR mod str = mkOrig mod (mkOccNameFS tcName str)
+clsQual_RDR mod str = mkOrig mod (mkOccNameFS clsName str)
+dataQual_RDR mod str = mkOrig mod (mkOccNameFS dataName str)
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Known-key names}
+%* *
+%************************************************************************
+
+Many of these Names are not really "built in", but some parts of the
+compiler (notably the deriving mechanism) need to mention their names,
+and it's convenient to write them all down in one place.
+
+--MetaHaskell Extension add the constrs and the lower case case
+-- guys as well (perhaps) e.g. see trueDataConName below
+
+
+\begin{code}
+runMainIOName = varQual pREL_TOP_HANDLER FSLIT("runMainIO") runMainKey
+
+orderingTyConName = tcQual pREL_BASE FSLIT("Ordering") orderingTyConKey
+
+eitherTyConName = tcQual pREL_EITHER FSLIT("Either") eitherTyConKey
+leftDataConName = conName eitherTyConName FSLIT("Left") leftDataConKey
+rightDataConName = conName eitherTyConName FSLIT("Right") rightDataConKey
+
+-- Generics
+crossTyConName = tcQual pREL_BASE FSLIT(":*:") crossTyConKey
+plusTyConName = tcQual pREL_BASE FSLIT(":+:") plusTyConKey
+genUnitTyConName = tcQual pREL_BASE FSLIT("Unit") genUnitTyConKey
+
+-- Base strings Strings
+unpackCStringName = varQual pREL_BASE FSLIT("unpackCString#") unpackCStringIdKey
+unpackCStringAppendName = varQual pREL_BASE FSLIT("unpackAppendCString#") unpackCStringAppendIdKey
+unpackCStringFoldrName = varQual pREL_BASE FSLIT("unpackFoldrCString#") unpackCStringFoldrIdKey
+unpackCStringUtf8Name = varQual pREL_BASE FSLIT("unpackCStringUtf8#") unpackCStringUtf8IdKey
+eqStringName = varQual pREL_BASE FSLIT("eqString") eqStringIdKey
+
+-- Base classes (Eq, Ord, Functor)
+eqClassName = clsQual pREL_BASE FSLIT("Eq") eqClassKey
+eqName = methName eqClassName FSLIT("==") eqClassOpKey
+ordClassName = clsQual pREL_BASE FSLIT("Ord") ordClassKey
+geName = methName ordClassName FSLIT(">=") geClassOpKey
+functorClassName = clsQual pREL_BASE FSLIT("Functor") functorClassKey
+
+-- Class Monad
+monadClassName = clsQual pREL_BASE FSLIT("Monad") monadClassKey
+thenMName = methName monadClassName FSLIT(">>") thenMClassOpKey
+bindMName = methName monadClassName FSLIT(">>=") bindMClassOpKey
+returnMName = methName monadClassName FSLIT("return") returnMClassOpKey
+failMName = methName monadClassName FSLIT("fail") failMClassOpKey
+
+-- Random PrelBase functions
+otherwiseIdName = varQual pREL_BASE FSLIT("otherwise") otherwiseIdKey
+foldrName = varQual pREL_BASE FSLIT("foldr") foldrIdKey
+buildName = varQual pREL_BASE FSLIT("build") buildIdKey
+augmentName = varQual pREL_BASE FSLIT("augment") augmentIdKey
+appendName = varQual pREL_BASE FSLIT("++") appendIdKey
+andName = varQual pREL_BASE FSLIT("&&") andIdKey
+orName = varQual pREL_BASE FSLIT("||") orIdKey
+assertName = varQual pREL_BASE FSLIT("assert") assertIdKey
+breakpointName = varQual pREL_BASE FSLIT("breakpoint") breakpointIdKey
+breakpointJumpName
+ = mkInternalName
+ breakpointJumpIdKey
+ (mkOccNameFS varName FSLIT("breakpointJump"))
+ noSrcLoc
+
+-- PrelTup
+fstName = varQual pREL_TUP FSLIT("fst") fstIdKey
+sndName = varQual pREL_TUP FSLIT("snd") sndIdKey
+
+-- Module PrelNum
+numClassName = clsQual pREL_NUM FSLIT("Num") numClassKey
+fromIntegerName = methName numClassName FSLIT("fromInteger") fromIntegerClassOpKey
+minusName = methName numClassName FSLIT("-") minusClassOpKey
+negateName = methName numClassName FSLIT("negate") negateClassOpKey
+plusIntegerName = varQual pREL_NUM FSLIT("plusInteger") plusIntegerIdKey
+timesIntegerName = varQual pREL_NUM FSLIT("timesInteger") timesIntegerIdKey
+integerTyConName = tcQual pREL_NUM FSLIT("Integer") integerTyConKey
+smallIntegerDataConName = conName integerTyConName FSLIT("S#") smallIntegerDataConKey
+largeIntegerDataConName = conName integerTyConName FSLIT("J#") largeIntegerDataConKey
+
+-- PrelReal types and classes
+rationalTyConName = tcQual pREL_REAL FSLIT("Rational") rationalTyConKey
+ratioTyConName = tcQual pREL_REAL FSLIT("Ratio") ratioTyConKey
+ratioDataConName = conName ratioTyConName FSLIT(":%") ratioDataConKey
+realClassName = clsQual pREL_REAL FSLIT("Real") realClassKey
+integralClassName = clsQual pREL_REAL FSLIT("Integral") integralClassKey
+realFracClassName = clsQual pREL_REAL FSLIT("RealFrac") realFracClassKey
+fractionalClassName = clsQual pREL_REAL FSLIT("Fractional") fractionalClassKey
+fromRationalName = methName fractionalClassName FSLIT("fromRational") fromRationalClassOpKey
+
+-- PrelFloat classes
+floatingClassName = clsQual pREL_FLOAT FSLIT("Floating") floatingClassKey
+realFloatClassName = clsQual pREL_FLOAT FSLIT("RealFloat") realFloatClassKey
+
+-- Class Ix
+ixClassName = clsQual pREL_ARR FSLIT("Ix") ixClassKey
+
+-- Class Typeable
+typeableClassName = clsQual tYPEABLE FSLIT("Typeable") typeableClassKey
+typeable1ClassName = clsQual tYPEABLE FSLIT("Typeable1") typeable1ClassKey
+typeable2ClassName = clsQual tYPEABLE FSLIT("Typeable2") typeable2ClassKey
+typeable3ClassName = clsQual tYPEABLE FSLIT("Typeable3") typeable3ClassKey
+typeable4ClassName = clsQual tYPEABLE FSLIT("Typeable4") typeable4ClassKey
+typeable5ClassName = clsQual tYPEABLE FSLIT("Typeable5") typeable5ClassKey
+typeable6ClassName = clsQual tYPEABLE FSLIT("Typeable6") typeable6ClassKey
+typeable7ClassName = clsQual tYPEABLE FSLIT("Typeable7") typeable7ClassKey
+
+typeableClassNames = [ typeableClassName, typeable1ClassName, typeable2ClassName
+ , typeable3ClassName, typeable4ClassName, typeable5ClassName
+ , typeable6ClassName, typeable7ClassName ]
+
+-- Class Data
+dataClassName = clsQual gENERICS FSLIT("Data") dataClassKey
+
+-- Error module
+assertErrorName = varQual pREL_ERR FSLIT("assertError") assertErrorIdKey
+
+-- Enum module (Enum, Bounded)
+enumClassName = clsQual pREL_ENUM FSLIT("Enum") enumClassKey
+enumFromName = methName enumClassName FSLIT("enumFrom") enumFromClassOpKey
+enumFromToName = methName enumClassName FSLIT("enumFromTo") enumFromToClassOpKey
+enumFromThenName = methName enumClassName FSLIT("enumFromThen") enumFromThenClassOpKey
+enumFromThenToName = methName enumClassName FSLIT("enumFromThenTo") enumFromThenToClassOpKey
+boundedClassName = clsQual pREL_ENUM FSLIT("Bounded") boundedClassKey
+
+-- List functions
+concatName = varQual pREL_LIST FSLIT("concat") concatIdKey
+filterName = varQual pREL_LIST FSLIT("filter") filterIdKey
+zipName = varQual pREL_LIST FSLIT("zip") zipIdKey
+
+-- Class Show
+showClassName = clsQual pREL_SHOW FSLIT("Show") showClassKey
+
+-- Class Read
+readClassName = clsQual pREL_READ FSLIT("Read") readClassKey
+
+-- parallel array types and functions
+enumFromToPName = varQual pREL_PARR FSLIT("enumFromToP") enumFromToPIdKey
+enumFromThenToPName= varQual pREL_PARR FSLIT("enumFromThenToP") enumFromThenToPIdKey
+nullPName = varQual pREL_PARR FSLIT("nullP") nullPIdKey
+lengthPName = varQual pREL_PARR FSLIT("lengthP") lengthPIdKey
+replicatePName = varQual pREL_PARR FSLIT("replicateP") replicatePIdKey
+mapPName = varQual pREL_PARR FSLIT("mapP") mapPIdKey
+filterPName = varQual pREL_PARR FSLIT("filterP") filterPIdKey
+zipPName = varQual pREL_PARR FSLIT("zipP") zipPIdKey
+crossPName = varQual pREL_PARR FSLIT("crossP") crossPIdKey
+indexPName = varQual pREL_PARR FSLIT("!:") indexPIdKey
+toPName = varQual pREL_PARR FSLIT("toP") toPIdKey
+bpermutePName = varQual pREL_PARR FSLIT("bpermuteP") bpermutePIdKey
+bpermuteDftPName = varQual pREL_PARR FSLIT("bpermuteDftP") bpermuteDftPIdKey
+indexOfPName = varQual pREL_PARR FSLIT("indexOfP") indexOfPIdKey
+
+-- IOBase things
+ioTyConName = tcQual pREL_IO_BASE FSLIT("IO") ioTyConKey
+ioDataConName = conName ioTyConName FSLIT("IO") ioDataConKey
+thenIOName = varQual pREL_IO_BASE FSLIT("thenIO") thenIOIdKey
+bindIOName = varQual pREL_IO_BASE FSLIT("bindIO") bindIOIdKey
+returnIOName = varQual pREL_IO_BASE FSLIT("returnIO") returnIOIdKey
+failIOName = varQual pREL_IO_BASE FSLIT("failIO") failIOIdKey
+
+-- IO things
+printName = varQual sYSTEM_IO FSLIT("print") printIdKey
+
+-- Int, Word, and Addr things
+int8TyConName = tcQual pREL_INT FSLIT("Int8") int8TyConKey
+int16TyConName = tcQual pREL_INT FSLIT("Int16") int16TyConKey
+int32TyConName = tcQual pREL_INT FSLIT("Int32") int32TyConKey
+int64TyConName = tcQual pREL_INT FSLIT("Int64") int64TyConKey
+
+-- Word module
+word8TyConName = tcQual pREL_WORD FSLIT("Word8") word8TyConKey
+word16TyConName = tcQual pREL_WORD FSLIT("Word16") word16TyConKey
+word32TyConName = tcQual pREL_WORD FSLIT("Word32") word32TyConKey
+word64TyConName = tcQual pREL_WORD FSLIT("Word64") word64TyConKey
+wordTyConName = tcQual pREL_WORD FSLIT("Word") wordTyConKey
+wordDataConName = conName wordTyConName FSLIT("W#") wordDataConKey
+
+-- Addr module
+addrTyConName = tcQual aDDR FSLIT("Addr") addrTyConKey
+
+-- PrelPtr module
+ptrTyConName = tcQual pREL_PTR FSLIT("Ptr") ptrTyConKey
+funPtrTyConName = tcQual pREL_PTR FSLIT("FunPtr") funPtrTyConKey
+
+-- Byte array types
+byteArrayTyConName = tcQual pREL_BYTEARR FSLIT("ByteArray") byteArrayTyConKey
+mutableByteArrayTyConName = tcQual pREL_BYTEARR FSLIT("MutableByteArray") mutableByteArrayTyConKey
+
+-- Foreign objects and weak pointers
+stablePtrTyConName = tcQual pREL_STABLE FSLIT("StablePtr") stablePtrTyConKey
+newStablePtrName = varQual pREL_STABLE FSLIT("newStablePtr") newStablePtrIdKey
+
+-- PrelST module
+runSTRepName = varQual pREL_ST FSLIT("runSTRep") runSTRepIdKey
+
+-- The "split" Id for splittable implicit parameters
+splittableClassName = clsQual gLA_EXTS FSLIT("Splittable") splittableClassKey
+splitName = methName splittableClassName FSLIT("split") splitIdKey
+
+-- Recursive-do notation
+monadFixClassName = clsQual mONAD_FIX FSLIT("MonadFix") monadFixClassKey
+mfixName = methName monadFixClassName FSLIT("mfix") mfixIdKey
+
+-- Arrow notation
+arrAName = varQual aRROW FSLIT("arr") arrAIdKey
+composeAName = varQual aRROW FSLIT(">>>") composeAIdKey
+firstAName = varQual aRROW FSLIT("first") firstAIdKey
+appAName = varQual aRROW FSLIT("app") appAIdKey
+choiceAName = varQual aRROW FSLIT("|||") choiceAIdKey
+loopAName = varQual aRROW FSLIT("loop") loopAIdKey
+
+-- Other classes, needed for type defaulting
+monadPlusClassName = clsQual mONAD FSLIT("MonadPlus") monadPlusClassKey
+randomClassName = clsQual rANDOM FSLIT("Random") randomClassKey
+randomGenClassName = clsQual rANDOM FSLIT("RandomGen") randomGenClassKey
+
+-- dotnet interop
+objectTyConName = tcQual dOTNET FSLIT("Object") objectTyConKey
+ -- objectTyConName was "wTcQual", but that's gone now, and
+ -- I can't see why it was wired in anyway...
+unmarshalObjectName = varQual dOTNET FSLIT("unmarshalObject") unmarshalObjectIdKey
+marshalObjectName = varQual dOTNET FSLIT("marshalObject") marshalObjectIdKey
+marshalStringName = varQual dOTNET FSLIT("marshalString") marshalStringIdKey
+unmarshalStringName = varQual dOTNET FSLIT("unmarshalString") unmarshalStringIdKey
+checkDotnetResName = varQual dOTNET FSLIT("checkResult") checkDotnetResNameIdKey
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Local helpers}
+%* *
+%************************************************************************
+
+All these are original names; hence mkOrig
+
+\begin{code}
+varQual = mk_known_key_name varName
+tcQual = mk_known_key_name tcName
+clsQual = mk_known_key_name clsName
+
+mk_known_key_name space mod str uniq
+ = mkExternalName uniq mod (mkOccNameFS space str)
+ Nothing noSrcLoc
+
+conName :: Name -> FastString -> Unique -> Name
+conName tycon occ uniq
+ = mkExternalName uniq (nameModule tycon) (mkOccNameFS dataName occ)
+ (Just tycon) noSrcLoc
+
+methName :: Name -> FastString -> Unique -> Name
+methName cls occ uniq
+ = mkExternalName uniq (nameModule cls) (mkVarOccFS occ)
+ (Just cls) noSrcLoc
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@}
+%* *
+%************************************************************************
+--MetaHaskell extension hand allocate keys here
+
+\begin{code}
+boundedClassKey = mkPreludeClassUnique 1
+enumClassKey = mkPreludeClassUnique 2
+eqClassKey = mkPreludeClassUnique 3
+floatingClassKey = mkPreludeClassUnique 5
+fractionalClassKey = mkPreludeClassUnique 6
+integralClassKey = mkPreludeClassUnique 7
+monadClassKey = mkPreludeClassUnique 8
+dataClassKey = mkPreludeClassUnique 9
+functorClassKey = mkPreludeClassUnique 10
+numClassKey = mkPreludeClassUnique 11
+ordClassKey = mkPreludeClassUnique 12
+readClassKey = mkPreludeClassUnique 13
+realClassKey = mkPreludeClassUnique 14
+realFloatClassKey = mkPreludeClassUnique 15
+realFracClassKey = mkPreludeClassUnique 16
+showClassKey = mkPreludeClassUnique 17
+ixClassKey = mkPreludeClassUnique 18
+
+typeableClassKey = mkPreludeClassUnique 20
+typeable1ClassKey = mkPreludeClassUnique 21
+typeable2ClassKey = mkPreludeClassUnique 22
+typeable3ClassKey = mkPreludeClassUnique 23
+typeable4ClassKey = mkPreludeClassUnique 24
+typeable5ClassKey = mkPreludeClassUnique 25
+typeable6ClassKey = mkPreludeClassUnique 26
+typeable7ClassKey = mkPreludeClassUnique 27
+
+monadFixClassKey = mkPreludeClassUnique 28
+splittableClassKey = mkPreludeClassUnique 29
+
+monadPlusClassKey = mkPreludeClassUnique 30
+randomClassKey = mkPreludeClassUnique 31
+randomGenClassKey = mkPreludeClassUnique 32
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@}
+%* *
+%************************************************************************
+
+\begin{code}
+addrPrimTyConKey = mkPreludeTyConUnique 1
+addrTyConKey = mkPreludeTyConUnique 2
+arrayPrimTyConKey = mkPreludeTyConUnique 3
+boolTyConKey = mkPreludeTyConUnique 4
+byteArrayPrimTyConKey = mkPreludeTyConUnique 5
+charPrimTyConKey = mkPreludeTyConUnique 7
+charTyConKey = mkPreludeTyConUnique 8
+doublePrimTyConKey = mkPreludeTyConUnique 9
+doubleTyConKey = mkPreludeTyConUnique 10
+floatPrimTyConKey = mkPreludeTyConUnique 11
+floatTyConKey = mkPreludeTyConUnique 12
+funTyConKey = mkPreludeTyConUnique 13
+intPrimTyConKey = mkPreludeTyConUnique 14
+intTyConKey = mkPreludeTyConUnique 15
+int8TyConKey = mkPreludeTyConUnique 16
+int16TyConKey = mkPreludeTyConUnique 17
+int32PrimTyConKey = mkPreludeTyConUnique 18
+int32TyConKey = mkPreludeTyConUnique 19
+int64PrimTyConKey = mkPreludeTyConUnique 20
+int64TyConKey = mkPreludeTyConUnique 21
+integerTyConKey = mkPreludeTyConUnique 22
+listTyConKey = mkPreludeTyConUnique 23
+foreignObjPrimTyConKey = mkPreludeTyConUnique 24
+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
+tVarPrimTyConKey = mkPreludeTyConUnique 76
+
+-- Generic Type Constructors
+crossTyConKey = mkPreludeTyConUnique 79
+plusTyConKey = mkPreludeTyConUnique 80
+genUnitTyConKey = mkPreludeTyConUnique 81
+
+-- Parallel array type constructor
+parrTyConKey = mkPreludeTyConUnique 82
+
+-- dotnet interop
+objectTyConKey = mkPreludeTyConUnique 83
+
+eitherTyConKey = mkPreludeTyConUnique 84
+
+---------------- Template Haskell -------------------
+-- USES TyConUniques 100-129
+-----------------------------------------------------
+
+unitTyConKey = mkTupleTyConUnique Boxed 0
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@}
+%* *
+%************************************************************************
+
+\begin{code}
+charDataConKey = mkPreludeDataConUnique 1
+consDataConKey = mkPreludeDataConUnique 2
+doubleDataConKey = mkPreludeDataConUnique 3
+falseDataConKey = mkPreludeDataConUnique 4
+floatDataConKey = mkPreludeDataConUnique 5
+intDataConKey = mkPreludeDataConUnique 6
+smallIntegerDataConKey = mkPreludeDataConUnique 7
+largeIntegerDataConKey = mkPreludeDataConUnique 8
+nilDataConKey = mkPreludeDataConUnique 11
+ratioDataConKey = mkPreludeDataConUnique 12
+stableNameDataConKey = mkPreludeDataConUnique 14
+trueDataConKey = mkPreludeDataConUnique 15
+wordDataConKey = mkPreludeDataConUnique 16
+ioDataConKey = mkPreludeDataConUnique 17
+
+-- Generic data constructors
+crossDataConKey = mkPreludeDataConUnique 20
+inlDataConKey = mkPreludeDataConUnique 21
+inrDataConKey = mkPreludeDataConUnique 22
+genUnitDataConKey = mkPreludeDataConUnique 23
+
+-- Data constructor for parallel arrays
+parrDataConKey = mkPreludeDataConUnique 24
+
+leftDataConKey = mkPreludeDataConUnique 25
+rightDataConKey = mkPreludeDataConUnique 26
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)}
+%* *
+%************************************************************************
+
+\begin{code}
+absentErrorIdKey = mkPreludeMiscIdUnique 1
+augmentIdKey = mkPreludeMiscIdUnique 3
+appendIdKey = mkPreludeMiscIdUnique 4
+buildIdKey = mkPreludeMiscIdUnique 5
+errorIdKey = mkPreludeMiscIdUnique 6
+foldlIdKey = mkPreludeMiscIdUnique 7
+foldrIdKey = mkPreludeMiscIdUnique 8
+recSelErrorIdKey = mkPreludeMiscIdUnique 9
+integerMinusOneIdKey = mkPreludeMiscIdUnique 10
+integerPlusOneIdKey = mkPreludeMiscIdUnique 11
+integerPlusTwoIdKey = mkPreludeMiscIdUnique 12
+integerZeroIdKey = mkPreludeMiscIdUnique 13
+int2IntegerIdKey = mkPreludeMiscIdUnique 14
+seqIdKey = mkPreludeMiscIdUnique 15
+irrefutPatErrorIdKey = mkPreludeMiscIdUnique 16
+eqStringIdKey = mkPreludeMiscIdUnique 17
+noMethodBindingErrorIdKey = mkPreludeMiscIdUnique 18
+nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 19
+runtimeErrorIdKey = mkPreludeMiscIdUnique 20
+parErrorIdKey = mkPreludeMiscIdUnique 21
+parIdKey = mkPreludeMiscIdUnique 22
+patErrorIdKey = mkPreludeMiscIdUnique 23
+realWorldPrimIdKey = mkPreludeMiscIdUnique 24
+recConErrorIdKey = mkPreludeMiscIdUnique 25
+recUpdErrorIdKey = mkPreludeMiscIdUnique 26
+traceIdKey = mkPreludeMiscIdUnique 27
+unpackCStringUtf8IdKey = mkPreludeMiscIdUnique 28
+unpackCStringAppendIdKey = mkPreludeMiscIdUnique 29
+unpackCStringFoldrIdKey = mkPreludeMiscIdUnique 30
+unpackCStringIdKey = mkPreludeMiscIdUnique 31
+
+unsafeCoerceIdKey = mkPreludeMiscIdUnique 32
+concatIdKey = mkPreludeMiscIdUnique 33
+filterIdKey = mkPreludeMiscIdUnique 34
+zipIdKey = mkPreludeMiscIdUnique 35
+bindIOIdKey = mkPreludeMiscIdUnique 36
+returnIOIdKey = mkPreludeMiscIdUnique 37
+deRefStablePtrIdKey = mkPreludeMiscIdUnique 38
+newStablePtrIdKey = mkPreludeMiscIdUnique 39
+plusIntegerIdKey = mkPreludeMiscIdUnique 41
+timesIntegerIdKey = mkPreludeMiscIdUnique 42
+printIdKey = mkPreludeMiscIdUnique 43
+failIOIdKey = mkPreludeMiscIdUnique 44
+nullAddrIdKey = mkPreludeMiscIdUnique 46
+voidArgIdKey = mkPreludeMiscIdUnique 47
+splitIdKey = mkPreludeMiscIdUnique 48
+fstIdKey = mkPreludeMiscIdUnique 49
+sndIdKey = mkPreludeMiscIdUnique 50
+otherwiseIdKey = mkPreludeMiscIdUnique 51
+assertIdKey = mkPreludeMiscIdUnique 53
+runSTRepIdKey = mkPreludeMiscIdUnique 54
+
+rootMainKey = mkPreludeMiscIdUnique 55
+runMainKey = mkPreludeMiscIdUnique 56
+
+andIdKey = mkPreludeMiscIdUnique 57
+orIdKey = mkPreludeMiscIdUnique 58
+thenIOIdKey = mkPreludeMiscIdUnique 59
+lazyIdKey = mkPreludeMiscIdUnique 60
+assertErrorIdKey = mkPreludeMiscIdUnique 61
+
+breakpointIdKey = mkPreludeMiscIdUnique 62
+breakpointJumpIdKey = mkPreludeMiscIdUnique 63
+
+-- Parallel array functions
+nullPIdKey = mkPreludeMiscIdUnique 80
+lengthPIdKey = mkPreludeMiscIdUnique 81
+replicatePIdKey = mkPreludeMiscIdUnique 82
+mapPIdKey = mkPreludeMiscIdUnique 83
+filterPIdKey = mkPreludeMiscIdUnique 84
+zipPIdKey = mkPreludeMiscIdUnique 85
+crossPIdKey = mkPreludeMiscIdUnique 86
+indexPIdKey = mkPreludeMiscIdUnique 87
+toPIdKey = mkPreludeMiscIdUnique 88
+enumFromToPIdKey = mkPreludeMiscIdUnique 89
+enumFromThenToPIdKey = mkPreludeMiscIdUnique 90
+bpermutePIdKey = mkPreludeMiscIdUnique 91
+bpermuteDftPIdKey = mkPreludeMiscIdUnique 92
+indexOfPIdKey = mkPreludeMiscIdUnique 93
+
+-- dotnet interop
+unmarshalObjectIdKey = mkPreludeMiscIdUnique 94
+marshalObjectIdKey = mkPreludeMiscIdUnique 95
+marshalStringIdKey = mkPreludeMiscIdUnique 96
+unmarshalStringIdKey = mkPreludeMiscIdUnique 97
+checkDotnetResNameIdKey = mkPreludeMiscIdUnique 98
+
+\end{code}
+
+Certain class operations from Prelude classes. They get their own
+uniques so we can look them up easily when we want to conjure them up
+during type checking.
+
+\begin{code}
+ -- Just a place holder for unbound variables produced by the renamer:
+unboundKey = mkPreludeMiscIdUnique 101
+
+fromIntegerClassOpKey = mkPreludeMiscIdUnique 102
+minusClassOpKey = mkPreludeMiscIdUnique 103
+fromRationalClassOpKey = mkPreludeMiscIdUnique 104
+enumFromClassOpKey = mkPreludeMiscIdUnique 105
+enumFromThenClassOpKey = mkPreludeMiscIdUnique 106
+enumFromToClassOpKey = mkPreludeMiscIdUnique 107
+enumFromThenToClassOpKey = mkPreludeMiscIdUnique 108
+eqClassOpKey = mkPreludeMiscIdUnique 109
+geClassOpKey = mkPreludeMiscIdUnique 110
+negateClassOpKey = mkPreludeMiscIdUnique 111
+failMClassOpKey = mkPreludeMiscIdUnique 112
+bindMClassOpKey = mkPreludeMiscIdUnique 113 -- (>>=)
+thenMClassOpKey = mkPreludeMiscIdUnique 114 -- (>>)
+returnMClassOpKey = mkPreludeMiscIdUnique 117
+
+-- Recursive do notation
+mfixIdKey = mkPreludeMiscIdUnique 118
+
+-- Arrow notation
+arrAIdKey = mkPreludeMiscIdUnique 119
+composeAIdKey = mkPreludeMiscIdUnique 120 -- >>>
+firstAIdKey = mkPreludeMiscIdUnique 121
+appAIdKey = mkPreludeMiscIdUnique 122
+choiceAIdKey = mkPreludeMiscIdUnique 123 -- |||
+loopAIdKey = mkPreludeMiscIdUnique 124
+
+---------------- Template Haskell -------------------
+-- USES IdUniques 200-399
+-----------------------------------------------------
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Standard groups of types}
+%* *
+%************************************************************************
+
+\begin{code}
+numericTyKeys =
+ [ addrTyConKey
+ , wordTyConKey
+ , intTyConKey
+ , integerTyConKey
+ , doubleTyConKey
+ , floatTyConKey
+ ]
+
+ -- Renamer always imports these data decls replete with constructors
+ -- so that desugarer can always see their constructors. Ugh!
+cCallishTyKeys =
+ [ addrTyConKey
+ , wordTyConKey
+ , byteArrayTyConKey
+ , mutableByteArrayTyConKey
+ , stablePtrTyConKey
+ , int8TyConKey
+ , int16TyConKey
+ , int32TyConKey
+ , int64TyConKey
+ , word8TyConKey
+ , word16TyConKey
+ , word32TyConKey
+ , word64TyConKey
+ ]
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection[Class-std-groups]{Standard groups of Prelude classes}
+%* *
+%************************************************************************
+
+NOTE: @Eq@ and @Text@ do need to appear in @standardClasses@
+even though every numeric class has these two as a superclass,
+because the list of ambiguous dictionaries hasn't been simplified.
+
+\begin{code}
+numericClassKeys =
+ [ numClassKey
+ , realClassKey
+ , integralClassKey
+ ]
+ ++ fractionalClassKeys
+
+fractionalClassKeys =
+ [ fractionalClassKey
+ , floatingClassKey
+ , realFracClassKey
+ , realFloatClassKey
+ ]
+
+ -- the strictness analyser needs to know about numeric types
+ -- (see SaAbsInt.lhs)
+needsDataDeclCtxtClassKeys = -- see comments in TcDeriv
+ [ readClassKey
+ ]
+
+-- The "standard classes" are used in defaulting (Haskell 98 report 4.3.4),
+-- and are: "classes defined in the Prelude or a standard library"
+standardClassKeys = derivableClassKeys ++ numericClassKeys
+ ++ [randomClassKey, randomGenClassKey,
+ functorClassKey,
+ monadClassKey, monadPlusClassKey]
+\end{code}
+
+@derivableClassKeys@ is also used in checking \tr{deriving} constructs
+(@TcDeriv@).
+
+\begin{code}
+derivableClassKeys
+ = [ eqClassKey, ordClassKey, enumClassKey, ixClassKey,
+ boundedClassKey, showClassKey, readClassKey ]
+\end{code}
+
diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
new file mode 100644
index 0000000000..9cdddc9065
--- /dev/null
+++ b/compiler/prelude/PrelRules.lhs
@@ -0,0 +1,447 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+\section[ConFold]{Constant Folder}
+
+Conceptually, constant folding should be parameterized with the kind
+of target machine to get identical behaviour during compilation time
+and runtime. We cheat a little bit here...
+
+ToDo:
+ check boundaries before folding, e.g. we can fold the Float addition
+ (i1 + i2) only if it results in a valid Float.
+
+\begin{code}
+
+{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
+
+module PrelRules ( primOpRules, builtinRules ) where
+
+#include "HsVersions.h"
+
+import CoreSyn
+import Id ( mkWildId, isPrimOpId_maybe )
+import Literal ( Literal(..), mkMachInt, mkMachWord
+ , literalType
+ , word2IntLit, int2WordLit
+ , narrow8IntLit, narrow16IntLit, narrow32IntLit
+ , narrow8WordLit, narrow16WordLit, narrow32WordLit
+ , char2IntLit, int2CharLit
+ , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
+ , float2DoubleLit, double2FloatLit
+ )
+import PrimOp ( PrimOp(..), primOpOcc )
+import TysWiredIn ( boolTy, trueDataConId, falseDataConId )
+import TyCon ( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon )
+import DataCon ( dataConTag, dataConTyCon, dataConWorkId, fIRST_TAG )
+import CoreUtils ( cheapEqExpr, exprIsConApp_maybe )
+import Type ( tyConAppTyCon, coreEqType )
+import OccName ( occNameFS )
+import PrelNames ( unpackCStringFoldrName, unpackCStringFoldrIdKey, hasKey,
+ eqStringName, unpackCStringIdKey )
+import Maybes ( orElse )
+import Name ( Name )
+import Outputable
+import FastString
+import StaticFlags ( opt_SimplExcessPrecision )
+
+import DATA_BITS ( Bits(..) )
+#if __GLASGOW_HASKELL__ >= 500
+import DATA_WORD ( Word )
+#else
+import DATA_WORD ( Word64 )
+#endif
+\end{code}
+
+
+\begin{code}
+primOpRules :: PrimOp -> Name -> [CoreRule]
+primOpRules op op_name = primop_rule op
+ where
+ rule_name = occNameFS (primOpOcc op)
+ rule_name_case = rule_name `appendFS` FSLIT("->case")
+
+ -- A useful shorthand
+ one_rule rule_fn = [BuiltinRule { ru_name = rule_name,
+ ru_fn = op_name,
+ ru_try = rule_fn }]
+ case_rule rule_fn = [BuiltinRule { ru_name = rule_name_case,
+ ru_fn = op_name,
+ ru_try = rule_fn }]
+
+ -- ToDo: something for integer-shift ops?
+ -- NotOp
+
+ primop_rule TagToEnumOp = one_rule tagToEnumRule
+ primop_rule DataToTagOp = one_rule dataToTagRule
+
+ -- Int operations
+ primop_rule IntAddOp = one_rule (twoLits (intOp2 (+)))
+ primop_rule IntSubOp = one_rule (twoLits (intOp2 (-)))
+ primop_rule IntMulOp = one_rule (twoLits (intOp2 (*)))
+ primop_rule IntQuotOp = one_rule (twoLits (intOp2Z quot))
+ primop_rule IntRemOp = one_rule (twoLits (intOp2Z rem))
+ primop_rule IntNegOp = one_rule (oneLit negOp)
+
+ -- Word operations
+#if __GLASGOW_HASKELL__ >= 500
+ primop_rule WordAddOp = one_rule (twoLits (wordOp2 (+)))
+ primop_rule WordSubOp = one_rule (twoLits (wordOp2 (-)))
+ primop_rule WordMulOp = one_rule (twoLits (wordOp2 (*)))
+#endif
+ primop_rule WordQuotOp = one_rule (twoLits (wordOp2Z quot))
+ primop_rule WordRemOp = one_rule (twoLits (wordOp2Z rem))
+#if __GLASGOW_HASKELL__ >= 407
+ primop_rule AndOp = one_rule (twoLits (wordBitOp2 (.&.)))
+ primop_rule OrOp = one_rule (twoLits (wordBitOp2 (.|.)))
+ primop_rule XorOp = one_rule (twoLits (wordBitOp2 xor))
+#endif
+
+ -- coercions
+ primop_rule Word2IntOp = one_rule (oneLit (litCoerce word2IntLit))
+ primop_rule Int2WordOp = one_rule (oneLit (litCoerce int2WordLit))
+ primop_rule Narrow8IntOp = one_rule (oneLit (litCoerce narrow8IntLit))
+ primop_rule Narrow16IntOp = one_rule (oneLit (litCoerce narrow16IntLit))
+ primop_rule Narrow32IntOp = one_rule (oneLit (litCoerce narrow32IntLit))
+ primop_rule Narrow8WordOp = one_rule (oneLit (litCoerce narrow8WordLit))
+ primop_rule Narrow16WordOp = one_rule (oneLit (litCoerce narrow16WordLit))
+ primop_rule Narrow32WordOp = one_rule (oneLit (litCoerce narrow32WordLit))
+ primop_rule OrdOp = one_rule (oneLit (litCoerce char2IntLit))
+ primop_rule ChrOp = one_rule (oneLit (litCoerce int2CharLit))
+ primop_rule Float2IntOp = one_rule (oneLit (litCoerce float2IntLit))
+ primop_rule Int2FloatOp = one_rule (oneLit (litCoerce int2FloatLit))
+ primop_rule Double2IntOp = one_rule (oneLit (litCoerce double2IntLit))
+ primop_rule Int2DoubleOp = one_rule (oneLit (litCoerce int2DoubleLit))
+ -- SUP: Not sure what the standard says about precision in the following 2 cases
+ primop_rule Float2DoubleOp = one_rule (oneLit (litCoerce float2DoubleLit))
+ primop_rule Double2FloatOp = one_rule (oneLit (litCoerce double2FloatLit))
+
+ -- Float
+ primop_rule FloatAddOp = one_rule (twoLits (floatOp2 (+)))
+ primop_rule FloatSubOp = one_rule (twoLits (floatOp2 (-)))
+ primop_rule FloatMulOp = one_rule (twoLits (floatOp2 (*)))
+ primop_rule FloatDivOp = one_rule (twoLits (floatOp2Z (/)))
+ primop_rule FloatNegOp = one_rule (oneLit negOp)
+
+ -- Double
+ primop_rule DoubleAddOp = one_rule (twoLits (doubleOp2 (+)))
+ primop_rule DoubleSubOp = one_rule (twoLits (doubleOp2 (-)))
+ primop_rule DoubleMulOp = one_rule (twoLits (doubleOp2 (*)))
+ primop_rule DoubleDivOp = one_rule (twoLits (doubleOp2Z (/)))
+ primop_rule DoubleNegOp = one_rule (oneLit negOp)
+
+ -- Relational operators
+ primop_rule IntEqOp = one_rule (relop (==)) ++ case_rule (litEq True)
+ primop_rule IntNeOp = one_rule (relop (/=)) ++ case_rule (litEq False)
+ primop_rule CharEqOp = one_rule (relop (==)) ++ case_rule (litEq True)
+ primop_rule CharNeOp = one_rule (relop (/=)) ++ case_rule (litEq False)
+
+ primop_rule IntGtOp = one_rule (relop (>))
+ primop_rule IntGeOp = one_rule (relop (>=))
+ primop_rule IntLeOp = one_rule (relop (<=))
+ primop_rule IntLtOp = one_rule (relop (<))
+
+ primop_rule CharGtOp = one_rule (relop (>))
+ primop_rule CharGeOp = one_rule (relop (>=))
+ primop_rule CharLeOp = one_rule (relop (<=))
+ primop_rule CharLtOp = one_rule (relop (<))
+
+ primop_rule FloatGtOp = one_rule (relop (>))
+ primop_rule FloatGeOp = one_rule (relop (>=))
+ primop_rule FloatLeOp = one_rule (relop (<=))
+ primop_rule FloatLtOp = one_rule (relop (<))
+ primop_rule FloatEqOp = one_rule (relop (==))
+ primop_rule FloatNeOp = one_rule (relop (/=))
+
+ primop_rule DoubleGtOp = one_rule (relop (>))
+ primop_rule DoubleGeOp = one_rule (relop (>=))
+ primop_rule DoubleLeOp = one_rule (relop (<=))
+ primop_rule DoubleLtOp = one_rule (relop (<))
+ primop_rule DoubleEqOp = one_rule (relop (==))
+ primop_rule DoubleNeOp = one_rule (relop (/=))
+
+ primop_rule WordGtOp = one_rule (relop (>))
+ primop_rule WordGeOp = one_rule (relop (>=))
+ primop_rule WordLeOp = one_rule (relop (<=))
+ primop_rule WordLtOp = one_rule (relop (<))
+ primop_rule WordEqOp = one_rule (relop (==))
+ primop_rule WordNeOp = one_rule (relop (/=))
+
+ primop_rule other = []
+
+
+ relop cmp = twoLits (cmpOp (\ord -> ord `cmp` EQ))
+ -- Cunning. cmpOp compares the values to give an Ordering.
+ -- It applies its argument to that ordering value to turn
+ -- the ordering into a boolean value. (`cmp` EQ) is just the job.
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Doing the business}
+%* *
+%************************************************************************
+
+ToDo: the reason these all return Nothing is because there used to be
+the possibility of an argument being a litlit. Litlits are now gone,
+so this could be cleaned up.
+
+\begin{code}
+--------------------------
+litCoerce :: (Literal -> Literal) -> Literal -> Maybe CoreExpr
+litCoerce fn lit = Just (Lit (fn lit))
+
+--------------------------
+cmpOp :: (Ordering -> Bool) -> Literal -> Literal -> Maybe CoreExpr
+cmpOp cmp l1 l2
+ = go l1 l2
+ where
+ done res | cmp res = Just trueVal
+ | otherwise = Just falseVal
+
+ -- These compares are at different types
+ go (MachChar i1) (MachChar i2) = done (i1 `compare` i2)
+ go (MachInt i1) (MachInt i2) = done (i1 `compare` i2)
+ go (MachInt64 i1) (MachInt64 i2) = done (i1 `compare` i2)
+ go (MachWord i1) (MachWord i2) = done (i1 `compare` i2)
+ go (MachWord64 i1) (MachWord64 i2) = done (i1 `compare` i2)
+ go (MachFloat i1) (MachFloat i2) = done (i1 `compare` i2)
+ go (MachDouble i1) (MachDouble i2) = done (i1 `compare` i2)
+ go l1 l2 = Nothing
+
+--------------------------
+
+negOp (MachFloat 0.0) = Nothing -- can't represent -0.0 as a Rational
+negOp (MachFloat f) = Just (mkFloatVal (-f))
+negOp (MachDouble 0.0) = Nothing
+negOp (MachDouble d) = Just (mkDoubleVal (-d))
+negOp (MachInt i) = intResult (-i)
+negOp l = Nothing
+
+--------------------------
+intOp2 op (MachInt i1) (MachInt i2) = intResult (i1 `op` i2)
+intOp2 op l1 l2 = Nothing -- Could find LitLit
+
+intOp2Z op (MachInt i1) (MachInt i2)
+ | i2 /= 0 = Just (mkIntVal (i1 `op` i2))
+intOp2Z op l1 l2 = Nothing -- LitLit or zero dividend
+
+--------------------------
+#if __GLASGOW_HASKELL__ >= 500
+wordOp2 op (MachWord w1) (MachWord w2)
+ = wordResult (w1 `op` w2)
+wordOp2 op l1 l2 = Nothing -- Could find LitLit
+#endif
+
+wordOp2Z op (MachWord w1) (MachWord w2)
+ | w2 /= 0 = Just (mkWordVal (w1 `op` w2))
+wordOp2Z op l1 l2 = Nothing -- LitLit or zero dividend
+
+#if __GLASGOW_HASKELL__ >= 500
+wordBitOp2 op l1@(MachWord w1) l2@(MachWord w2)
+ = Just (mkWordVal (w1 `op` w2))
+#else
+-- Integer is not an instance of Bits, so we operate on Word64
+wordBitOp2 op l1@(MachWord w1) l2@(MachWord w2)
+ = Just (mkWordVal ((fromIntegral::Word64->Integer) (fromIntegral w1 `op` fromIntegral w2)))
+#endif
+wordBitOp2 op l1 l2 = Nothing -- Could find LitLit
+
+--------------------------
+floatOp2 op (MachFloat f1) (MachFloat f2)
+ = Just (mkFloatVal (f1 `op` f2))
+floatOp2 op l1 l2 = Nothing
+
+floatOp2Z op (MachFloat f1) (MachFloat f2)
+ | f2 /= 0 = Just (mkFloatVal (f1 `op` f2))
+floatOp2Z op l1 l2 = Nothing
+
+--------------------------
+doubleOp2 op (MachDouble f1) (MachDouble f2)
+ = Just (mkDoubleVal (f1 `op` f2))
+doubleOp2 op l1 l2 = Nothing
+
+doubleOp2Z op (MachDouble f1) (MachDouble f2)
+ | f2 /= 0 = Just (mkDoubleVal (f1 `op` f2))
+doubleOp2Z op l1 l2 = Nothing
+
+
+--------------------------
+ -- This stuff turns
+ -- n ==# 3#
+ -- into
+ -- case n of
+ -- 3# -> True
+ -- m -> False
+ --
+ -- This is a Good Thing, because it allows case-of case things
+ -- to happen, and case-default absorption to happen. For
+ -- example:
+ --
+ -- if (n ==# 3#) || (n ==# 4#) then e1 else e2
+ -- will transform to
+ -- case n of
+ -- 3# -> e1
+ -- 4# -> e1
+ -- m -> e2
+ -- (modulo the usual precautions to avoid duplicating e1)
+
+litEq :: Bool -- True <=> equality, False <=> inequality
+ -> RuleFun
+litEq is_eq [Lit lit, expr] = do_lit_eq is_eq lit expr
+litEq is_eq [expr, Lit lit] = do_lit_eq is_eq lit expr
+litEq is_eq other = Nothing
+
+do_lit_eq is_eq lit expr
+ = Just (Case expr (mkWildId (literalType lit)) boolTy
+ [(DEFAULT, [], val_if_neq),
+ (LitAlt lit, [], val_if_eq)])
+ where
+ val_if_eq | is_eq = trueVal
+ | otherwise = falseVal
+ val_if_neq | is_eq = falseVal
+ | otherwise = trueVal
+
+-- Note that we *don't* warn the user about overflow. It's not done at
+-- runtime either, and compilation of completely harmless things like
+-- ((124076834 :: Word32) + (2147483647 :: Word32))
+-- would yield a warning. Instead we simply squash the value into the
+-- Int range, but not in a way suitable for cross-compiling... :-(
+intResult :: Integer -> Maybe CoreExpr
+intResult result
+ = Just (mkIntVal (toInteger (fromInteger result :: Int)))
+
+#if __GLASGOW_HASKELL__ >= 500
+wordResult :: Integer -> Maybe CoreExpr
+wordResult result
+ = Just (mkWordVal (toInteger (fromInteger result :: Word)))
+#endif
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Vaguely generic functions
+%* *
+%************************************************************************
+
+\begin{code}
+type RuleFun = [CoreExpr] -> Maybe CoreExpr
+
+twoLits :: (Literal -> Literal -> Maybe CoreExpr) -> RuleFun
+twoLits rule [Lit l1, Lit l2] = rule (convFloating l1) (convFloating l2)
+twoLits rule _ = Nothing
+
+oneLit :: (Literal -> Maybe CoreExpr) -> RuleFun
+oneLit rule [Lit l1] = rule (convFloating l1)
+oneLit rule _ = Nothing
+
+-- When excess precision is not requested, cut down the precision of the
+-- Rational value to that of Float/Double. We confuse host architecture
+-- and target architecture here, but it's convenient (and wrong :-).
+convFloating :: Literal -> Literal
+convFloating (MachFloat f) | not opt_SimplExcessPrecision =
+ MachFloat (toRational ((fromRational f) :: Float ))
+convFloating (MachDouble d) | not opt_SimplExcessPrecision =
+ MachDouble (toRational ((fromRational d) :: Double))
+convFloating l = l
+
+
+trueVal = Var trueDataConId
+falseVal = Var falseDataConId
+mkIntVal i = Lit (mkMachInt i)
+mkWordVal w = Lit (mkMachWord w)
+mkFloatVal f = Lit (convFloating (MachFloat f))
+mkDoubleVal d = Lit (convFloating (MachDouble d))
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Special rules for seq, tagToEnum, dataToTag}
+%* *
+%************************************************************************
+
+\begin{code}
+tagToEnumRule [Type ty, Lit (MachInt i)]
+ = ASSERT( isEnumerationTyCon tycon )
+ case filter correct_tag (tyConDataCons_maybe tycon `orElse` []) of
+
+
+ [] -> Nothing -- Abstract type
+ (dc:rest) -> ASSERT( null rest )
+ Just (Var (dataConWorkId dc))
+ where
+ correct_tag dc = (dataConTag dc - fIRST_TAG) == tag
+ tag = fromInteger i
+ tycon = tyConAppTyCon ty
+
+tagToEnumRule other = Nothing
+\end{code}
+
+For dataToTag#, we can reduce if either
+
+ (a) the argument is a constructor
+ (b) the argument is a variable whose unfolding is a known constructor
+
+\begin{code}
+dataToTagRule [Type ty1, Var tag_to_enum `App` Type ty2 `App` tag]
+ | Just TagToEnumOp <- isPrimOpId_maybe tag_to_enum
+ , ty1 `coreEqType` ty2
+ = Just tag -- dataToTag (tagToEnum x) ==> x
+
+dataToTagRule [_, val_arg]
+ | Just (dc,_) <- exprIsConApp_maybe val_arg
+ = ASSERT( not (isNewTyCon (dataConTyCon dc)) )
+ Just (mkIntVal (toInteger (dataConTag dc - fIRST_TAG)))
+
+dataToTagRule other = Nothing
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Built in rules}
+%* *
+%************************************************************************
+
+\begin{code}
+builtinRules :: [CoreRule]
+-- Rules for non-primops that can't be expressed using a RULE pragma
+builtinRules
+ = [ BuiltinRule FSLIT("AppendLitString") unpackCStringFoldrName match_append_lit,
+ BuiltinRule FSLIT("EqString") eqStringName match_eq_string
+ ]
+
+
+-- The rule is this:
+-- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n) = unpackFoldrCString# "foobaz" c n
+
+match_append_lit [Type ty1,
+ Lit (MachStr s1),
+ c1,
+ Var unpk `App` Type ty2
+ `App` Lit (MachStr s2)
+ `App` c2
+ `App` n
+ ]
+ | unpk `hasKey` unpackCStringFoldrIdKey &&
+ c1 `cheapEqExpr` c2
+ = ASSERT( ty1 `coreEqType` ty2 )
+ Just (Var unpk `App` Type ty1
+ `App` Lit (MachStr (s1 `appendFS` s2))
+ `App` c1
+ `App` n)
+
+match_append_lit other = Nothing
+
+-- The rule is this:
+-- eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2
+
+match_eq_string [Var unpk1 `App` Lit (MachStr s1),
+ Var unpk2 `App` Lit (MachStr s2)]
+ | unpk1 `hasKey` unpackCStringIdKey,
+ unpk2 `hasKey` unpackCStringIdKey
+ = Just (if s1 == s2 then trueVal else falseVal)
+
+match_eq_string other = Nothing
+\end{code}
diff --git a/compiler/prelude/PrimOp.lhs b/compiler/prelude/PrimOp.lhs
new file mode 100644
index 0000000000..a650352280
--- /dev/null
+++ b/compiler/prelude/PrimOp.lhs
@@ -0,0 +1,461 @@
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+\section[PrimOp]{Primitive operations (machine-level)}
+
+\begin{code}
+module PrimOp (
+ PrimOp(..), allThePrimOps,
+ primOpType, primOpSig,
+ primOpTag, maxPrimOpTag, primOpOcc,
+
+ primOpOutOfLine, primOpNeedsWrapper,
+ primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,
+
+ getPrimOpResultInfo, PrimOpResultInfo(..)
+ ) where
+
+#include "HsVersions.h"
+
+import TysPrim
+import TysWiredIn
+
+import NewDemand
+import Var ( TyVar )
+import OccName ( OccName, pprOccName, mkVarOccFS )
+import TyCon ( TyCon, isPrimTyCon, tyConPrimRep, PrimRep(..) )
+import Type ( Type, mkForAllTys, mkFunTy, mkFunTys, tyConAppTyCon,
+ typePrimRep )
+import BasicTypes ( Arity, Boxity(..) )
+import Outputable
+import FastTypes
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
+%* *
+%************************************************************************
+
+These are in \tr{state-interface.verb} order.
+
+\begin{code}
+
+-- supplies:
+-- data PrimOp = ...
+#include "primop-data-decl.hs-incl"
+\end{code}
+
+Used for the Ord instance
+
+\begin{code}
+primOpTag :: PrimOp -> Int
+primOpTag op = iBox (tagOf_PrimOp op)
+
+-- supplies
+-- tagOf_PrimOp :: PrimOp -> FastInt
+#include "primop-tag.hs-incl"
+
+
+instance Eq PrimOp where
+ op1 == op2 = tagOf_PrimOp op1 ==# tagOf_PrimOp op2
+
+instance Ord PrimOp where
+ op1 < op2 = tagOf_PrimOp op1 <# tagOf_PrimOp op2
+ op1 <= op2 = tagOf_PrimOp op1 <=# tagOf_PrimOp op2
+ op1 >= op2 = tagOf_PrimOp op1 >=# tagOf_PrimOp op2
+ op1 > op2 = tagOf_PrimOp op1 ># tagOf_PrimOp op2
+ op1 `compare` op2 | op1 < op2 = LT
+ | op1 == op2 = EQ
+ | otherwise = GT
+
+instance Outputable PrimOp where
+ ppr op = pprPrimOp op
+
+instance Show PrimOp where
+ showsPrec p op = showsPrecSDoc p (pprPrimOp op)
+\end{code}
+
+An @Enum@-derived list would be better; meanwhile... (ToDo)
+
+\begin{code}
+allThePrimOps :: [PrimOp]
+allThePrimOps =
+#include "primop-list.hs-incl"
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[PrimOp-info]{The essential info about each @PrimOp@}
+%* *
+%************************************************************************
+
+The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
+refer to the primitive operation. The conventional \tr{#}-for-
+unboxed ops is added on later.
+
+The reason for the funny characters in the names is so we do not
+interfere with the programmer's Haskell name spaces.
+
+We use @PrimKinds@ for the ``type'' information, because they're
+(slightly) more convenient to use than @TyCons@.
+\begin{code}
+data PrimOpInfo
+ = Dyadic OccName -- string :: T -> T -> T
+ Type
+ | Monadic OccName -- string :: T -> T
+ Type
+ | Compare OccName -- string :: T -> T -> Bool
+ Type
+
+ | GenPrimOp OccName -- string :: \/a1..an . T1 -> .. -> Tk -> T
+ [TyVar]
+ [Type]
+ Type
+
+mkDyadic str ty = Dyadic (mkVarOccFS str) ty
+mkMonadic str ty = Monadic (mkVarOccFS str) ty
+mkCompare str ty = Compare (mkVarOccFS str) ty
+mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOccFS str) tvs tys ty
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection{Strictness}
+%* *
+%************************************************************************
+
+Not all primops are strict!
+
+\begin{code}
+primOpStrictness :: PrimOp -> Arity -> StrictSig
+ -- See Demand.StrictnessInfo for discussion of what the results
+ -- The arity should be the arity of the primop; that's why
+ -- this function isn't exported.
+#include "primop-strictness.hs-incl"
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
+%* *
+%************************************************************************
+
+@primOpInfo@ gives all essential information (from which everything
+else, notably a type, can be constructed) for each @PrimOp@.
+
+\begin{code}
+primOpInfo :: PrimOp -> PrimOpInfo
+#include "primop-primop-info.hs-incl"
+\end{code}
+
+Here are a load of comments from the old primOp info:
+
+A @Word#@ is an unsigned @Int#@.
+
+@decodeFloat#@ is given w/ Integer-stuff (it's similar).
+
+@decodeDouble#@ is given w/ Integer-stuff (it's similar).
+
+Decoding of floating-point numbers is sorta Integer-related. Encoding
+is done with plain ccalls now (see PrelNumExtra.lhs).
+
+A @Weak@ Pointer is created by the @mkWeak#@ primitive:
+
+ mkWeak# :: k -> v -> f -> State# RealWorld
+ -> (# State# RealWorld, Weak# v #)
+
+In practice, you'll use the higher-level
+
+ data Weak v = Weak# v
+ mkWeak :: k -> v -> IO () -> IO (Weak v)
+
+The following operation dereferences a weak pointer. The weak pointer
+may have been finalized, so the operation returns a result code which
+must be inspected before looking at the dereferenced value.
+
+ deRefWeak# :: Weak# v -> State# RealWorld ->
+ (# State# RealWorld, v, Int# #)
+
+Only look at v if the Int# returned is /= 0 !!
+
+The higher-level op is
+
+ deRefWeak :: Weak v -> IO (Maybe v)
+
+Weak pointers can be finalized early by using the finalize# operation:
+
+ finalizeWeak# :: Weak# v -> State# RealWorld ->
+ (# State# RealWorld, Int#, IO () #)
+
+The Int# returned is either
+
+ 0 if the weak pointer has already been finalized, or it has no
+ finalizer (the third component is then invalid).
+
+ 1 if the weak pointer is still alive, with the finalizer returned
+ as the third component.
+
+A {\em stable name/pointer} is an index into a table of stable name
+entries. Since the garbage collector is told about stable pointers,
+it is safe to pass a stable pointer to external systems such as C
+routines.
+
+\begin{verbatim}
+makeStablePtr# :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
+freeStablePtr :: StablePtr# a -> State# RealWorld -> State# RealWorld
+deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
+eqStablePtr# :: StablePtr# a -> StablePtr# a -> Int#
+\end{verbatim}
+
+It may seem a bit surprising that @makeStablePtr#@ is a @IO@
+operation since it doesn't (directly) involve IO operations. The
+reason is that if some optimisation pass decided to duplicate calls to
+@makeStablePtr#@ and we only pass one of the stable pointers over, a
+massive space leak can result. Putting it into the IO monad
+prevents this. (Another reason for putting them in a monad is to
+ensure correct sequencing wrt the side-effecting @freeStablePtr@
+operation.)
+
+An important property of stable pointers is that if you call
+makeStablePtr# twice on the same object you get the same stable
+pointer back.
+
+Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
+besides, it's not likely to be used from Haskell) so it's not a
+primop.
+
+Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
+
+Stable Names
+~~~~~~~~~~~~
+
+A stable name is like a stable pointer, but with three important differences:
+
+ (a) You can't deRef one to get back to the original object.
+ (b) You can convert one to an Int.
+ (c) You don't need to 'freeStableName'
+
+The existence of a stable name doesn't guarantee to keep the object it
+points to alive (unlike a stable pointer), hence (a).
+
+Invariants:
+
+ (a) makeStableName always returns the same value for a given
+ object (same as stable pointers).
+
+ (b) if two stable names are equal, it implies that the objects
+ from which they were created were the same.
+
+ (c) stableNameToInt always returns the same Int for a given
+ stable name.
+
+
+-- 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
+
+These primops are pretty wierd.
+
+ dataToTag# :: a -> Int (arg must be an evaluated data type)
+ tagToEnum# :: Int -> a (result type must be an enumerated type)
+
+The constraints aren't currently checked by the front end, but the
+code generator will fall over if they aren't satisfied.
+
+\begin{code}
+#ifdef DEBUG
+primOpInfo op = pprPanic "primOpInfo:" (ppr op)
+#endif
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-ool]{Which PrimOps are out-of-line}
+%* *
+%************************************************************************
+
+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}
+
+
+primOpOkForSpeculation
+~~~~~~~~~~~~~~~~~~~~~~
+Sometimes we may choose to execute a PrimOp even though it isn't
+certain that its result will be required; ie execute them
+``speculatively''. The same thing as ``cheap eagerness.'' Usually
+this is OK, because PrimOps are usually cheap, but it isn't OK for
+(a)~expensive PrimOps and (b)~PrimOps which can fail.
+
+PrimOps that have side effects also should not be executed speculatively.
+
+Ok-for-speculation also means that it's ok *not* to execute the
+primop. For example
+ case op a b of
+ r -> 3
+Here the result is not used, so we can discard the primop. Anything
+that has side effects mustn't be dicarded in this way, of course!
+
+See also @primOpIsCheap@ (below).
+
+
+\begin{code}
+primOpOkForSpeculation :: PrimOp -> Bool
+ -- See comments with CoreUtils.exprOkForSpeculation
+primOpOkForSpeculation op
+ = not (primOpHasSideEffects op || primOpOutOfLine op || primOpCanFail op)
+\end{code}
+
+
+primOpIsCheap
+~~~~~~~~~~~~~
+@primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
+WARNING), we just borrow some other predicates for a
+what-should-be-good-enough test. "Cheap" means willing to call it more
+than once, and/or push it inside a lambda. The latter could change the
+behaviour of 'seq' for primops that can fail, so we don't treat them as cheap.
+
+\begin{code}
+primOpIsCheap :: PrimOp -> Bool
+primOpIsCheap op = primOpOkForSpeculation op
+-- In March 2001, we changed this to
+-- primOpIsCheap op = False
+-- thereby making *no* primops seem cheap. But this killed eta
+-- expansion on case (x ==# y) of True -> \s -> ...
+-- which is bad. In particular a loop like
+-- doLoop n = loop 0
+-- where
+-- loop i | i == n = return ()
+-- | otherwise = bar i >> loop (i+1)
+-- allocated a closure every time round because it doesn't eta expand.
+--
+-- The problem that originally gave rise to the change was
+-- let x = a +# b *# c in x +# x
+-- were we don't want to inline x. But primopIsCheap doesn't control
+-- that (it's exprIsDupable that does) so the problem doesn't occur
+-- even if primOpIsCheap sometimes says 'True'.
+\end{code}
+
+primOpIsDupable
+~~~~~~~~~~~~~~~
+primOpIsDupable means that the use of the primop is small enough to
+duplicate into different case branches. See CoreUtils.exprIsDupable.
+
+\begin{code}
+primOpIsDupable :: PrimOp -> Bool
+ -- See comments with CoreUtils.exprIsDupable
+ -- We say it's dupable it isn't implemented by a C call with a wrapper
+primOpIsDupable op = not (primOpNeedsWrapper op)
+\end{code}
+
+
+\begin{code}
+primOpCanFail :: PrimOp -> Bool
+#include "primop-can-fail.hs-incl"
+\end{code}
+
+And some primops have side-effects and so, for example, must not be
+duplicated.
+
+\begin{code}
+primOpHasSideEffects :: PrimOp -> Bool
+#include "primop-has-side-effects.hs-incl"
+\end{code}
+
+Inline primitive operations that perform calls need wrappers to save
+any live variables that are stored in caller-saves registers.
+
+\begin{code}
+primOpNeedsWrapper :: PrimOp -> Bool
+#include "primop-needs-wrapper.hs-incl"
+\end{code}
+
+\begin{code}
+primOpType :: PrimOp -> Type -- you may want to use primOpSig instead
+primOpType op
+ = case (primOpInfo op) of
+ Dyadic occ ty -> dyadic_fun_ty ty
+ Monadic occ ty -> monadic_fun_ty ty
+ Compare occ ty -> compare_fun_ty ty
+
+ GenPrimOp occ tyvars arg_tys res_ty ->
+ mkForAllTys tyvars (mkFunTys arg_tys res_ty)
+
+primOpOcc :: PrimOp -> OccName
+primOpOcc op = case (primOpInfo op) of
+ Dyadic occ _ -> occ
+ Monadic occ _ -> occ
+ Compare occ _ -> occ
+ GenPrimOp occ _ _ _ -> occ
+
+-- primOpSig is like primOpType but gives the result split apart:
+-- (type variables, argument types, result type)
+-- It also gives arity, strictness info
+
+primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictSig)
+primOpSig op
+ = (tyvars, arg_tys, res_ty, arity, primOpStrictness op arity)
+ where
+ arity = length arg_tys
+ (tyvars, arg_tys, res_ty)
+ = case (primOpInfo op) of
+ Monadic occ ty -> ([], [ty], ty )
+ Dyadic occ ty -> ([], [ty,ty], ty )
+ Compare occ ty -> ([], [ty,ty], boolTy)
+ GenPrimOp occ tyvars arg_tys res_ty
+ -> (tyvars, arg_tys, res_ty)
+\end{code}
+
+\begin{code}
+data PrimOpResultInfo
+ = ReturnsPrim PrimRep
+ | ReturnsAlg TyCon
+
+-- Some PrimOps need not return a manifest primitive or algebraic value
+-- (i.e. they might return a polymorphic value). These PrimOps *must*
+-- be out of line, or the code generator won't work.
+
+getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
+getPrimOpResultInfo op
+ = case (primOpInfo op) of
+ Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
+ Monadic _ ty -> ReturnsPrim (typePrimRep ty)
+ Compare _ ty -> ReturnsAlg boolTyCon
+ GenPrimOp _ _ _ ty | isPrimTyCon tc -> ReturnsPrim (tyConPrimRep tc)
+ | otherwise -> ReturnsAlg tc
+ where
+ tc = tyConAppTyCon ty
+ -- All primops return a tycon-app result
+ -- The tycon can be an unboxed tuple, though, which
+ -- gives rise to a ReturnAlg
+\end{code}
+
+The commutable ops are those for which we will try to move constants
+to the right hand side for strength reduction.
+
+\begin{code}
+commutableOp :: PrimOp -> Bool
+#include "primop-commutable.hs-incl"
+\end{code}
+
+Utils:
+\begin{code}
+dyadic_fun_ty ty = mkFunTys [ty, ty] ty
+monadic_fun_ty ty = mkFunTy ty ty
+compare_fun_ty ty = mkFunTys [ty, ty] boolTy
+\end{code}
+
+Output stuff:
+\begin{code}
+pprPrimOp :: PrimOp -> SDoc
+pprPrimOp other_op = pprOccName (primOpOcc other_op)
+\end{code}
+
diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs
new file mode 100644
index 0000000000..2f6168bafb
--- /dev/null
+++ b/compiler/prelude/TysPrim.lhs
@@ -0,0 +1,392 @@
+%
+% (c) The AQUA Project, Glasgow University, 1994-1998
+%
+\section[TysPrim]{Wired-in knowledge about primitive types}
+
+\begin{code}
+module TysPrim(
+ alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
+ alphaTy, betaTy, gammaTy, deltaTy,
+ openAlphaTy, openAlphaTyVar, openAlphaTyVars,
+
+ primTyCons,
+
+ charPrimTyCon, charPrimTy,
+ intPrimTyCon, intPrimTy,
+ wordPrimTyCon, wordPrimTy,
+ addrPrimTyCon, addrPrimTy,
+ floatPrimTyCon, floatPrimTy,
+ doublePrimTyCon, doublePrimTy,
+
+ statePrimTyCon, mkStatePrimTy,
+ realWorldTyCon, realWorldTy, realWorldStatePrimTy,
+
+ arrayPrimTyCon, mkArrayPrimTy,
+ byteArrayPrimTyCon, byteArrayPrimTy,
+ mutableArrayPrimTyCon, mkMutableArrayPrimTy,
+ mutableByteArrayPrimTyCon, mkMutableByteArrayPrimTy,
+ mutVarPrimTyCon, mkMutVarPrimTy,
+
+ mVarPrimTyCon, mkMVarPrimTy,
+ tVarPrimTyCon, mkTVarPrimTy,
+ stablePtrPrimTyCon, mkStablePtrPrimTy,
+ stableNamePrimTyCon, mkStableNamePrimTy,
+ bcoPrimTyCon, bcoPrimTy,
+ weakPrimTyCon, mkWeakPrimTy,
+ threadIdPrimTyCon, threadIdPrimTy,
+
+ int32PrimTyCon, int32PrimTy,
+ word32PrimTyCon, word32PrimTy,
+
+ int64PrimTyCon, int64PrimTy,
+ word64PrimTyCon, word64PrimTy
+ ) where
+
+#include "HsVersions.h"
+
+import Var ( TyVar, mkTyVar )
+import Name ( Name, BuiltInSyntax(..), mkInternalName, mkWiredInName )
+import OccName ( mkOccNameFS, tcName, mkTyVarOcc )
+import TyCon ( TyCon, ArgVrcs, mkPrimTyCon, mkLiftedPrimTyCon,
+ PrimRep(..) )
+import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
+ unliftedTypeKind, liftedTypeKind, openTypeKind,
+ Kind, mkArrowKinds,
+ TyThing(..)
+ )
+import SrcLoc ( noSrcLoc )
+import Unique ( mkAlphaTyVarUnique )
+import PrelNames
+import FastString ( FastString, mkFastString )
+import Outputable
+
+import Char ( ord, chr )
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Primitive type constructors}
+%* *
+%************************************************************************
+
+\begin{code}
+primTyCons :: [TyCon]
+primTyCons
+ = [ addrPrimTyCon
+ , arrayPrimTyCon
+ , byteArrayPrimTyCon
+ , charPrimTyCon
+ , doublePrimTyCon
+ , floatPrimTyCon
+ , intPrimTyCon
+ , int32PrimTyCon
+ , int64PrimTyCon
+ , bcoPrimTyCon
+ , weakPrimTyCon
+ , mutableArrayPrimTyCon
+ , mutableByteArrayPrimTyCon
+ , mVarPrimTyCon
+ , tVarPrimTyCon
+ , mutVarPrimTyCon
+ , realWorldTyCon
+ , stablePtrPrimTyCon
+ , stableNamePrimTyCon
+ , statePrimTyCon
+ , threadIdPrimTyCon
+ , wordPrimTyCon
+ , word32PrimTyCon
+ , word64PrimTyCon
+ ]
+
+mkPrimTc :: FastString -> Unique -> TyCon -> Name
+mkPrimTc fs uniq tycon
+ = mkWiredInName gHC_PRIM (mkOccNameFS tcName fs)
+ uniq
+ Nothing -- No parent object
+ (ATyCon tycon) -- Relevant TyCon
+ UserSyntax -- None are built-in syntax
+
+charPrimTyConName = mkPrimTc FSLIT("Char#") charPrimTyConKey charPrimTyCon
+intPrimTyConName = mkPrimTc FSLIT("Int#") intPrimTyConKey intPrimTyCon
+int32PrimTyConName = mkPrimTc FSLIT("Int32#") int32PrimTyConKey int32PrimTyCon
+int64PrimTyConName = mkPrimTc FSLIT("Int64#") int64PrimTyConKey int64PrimTyCon
+wordPrimTyConName = mkPrimTc FSLIT("Word#") wordPrimTyConKey wordPrimTyCon
+word32PrimTyConName = mkPrimTc FSLIT("Word32#") word32PrimTyConKey word32PrimTyCon
+word64PrimTyConName = mkPrimTc FSLIT("Word64#") word64PrimTyConKey word64PrimTyCon
+addrPrimTyConName = mkPrimTc FSLIT("Addr#") addrPrimTyConKey addrPrimTyCon
+floatPrimTyConName = mkPrimTc FSLIT("Float#") floatPrimTyConKey floatPrimTyCon
+doublePrimTyConName = mkPrimTc FSLIT("Double#") doublePrimTyConKey doublePrimTyCon
+statePrimTyConName = mkPrimTc FSLIT("State#") statePrimTyConKey statePrimTyCon
+realWorldTyConName = mkPrimTc FSLIT("RealWorld") realWorldTyConKey realWorldTyCon
+arrayPrimTyConName = mkPrimTc FSLIT("Array#") arrayPrimTyConKey arrayPrimTyCon
+byteArrayPrimTyConName = mkPrimTc FSLIT("ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon
+mutableArrayPrimTyConName = mkPrimTc FSLIT("MutableArray#") mutableArrayPrimTyConKey mutableArrayPrimTyCon
+mutableByteArrayPrimTyConName = mkPrimTc FSLIT("MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon
+mutVarPrimTyConName = mkPrimTc FSLIT("MutVar#") mutVarPrimTyConKey mutVarPrimTyCon
+mVarPrimTyConName = mkPrimTc FSLIT("MVar#") mVarPrimTyConKey mVarPrimTyCon
+tVarPrimTyConName = mkPrimTc FSLIT("TVar#") tVarPrimTyConKey tVarPrimTyCon
+stablePtrPrimTyConName = mkPrimTc FSLIT("StablePtr#") stablePtrPrimTyConKey stablePtrPrimTyCon
+stableNamePrimTyConName = mkPrimTc FSLIT("StableName#") stableNamePrimTyConKey stableNamePrimTyCon
+bcoPrimTyConName = mkPrimTc FSLIT("BCO#") bcoPrimTyConKey bcoPrimTyCon
+weakPrimTyConName = mkPrimTc FSLIT("Weak#") weakPrimTyConKey weakPrimTyCon
+threadIdPrimTyConName = mkPrimTc FSLIT("ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Support code}
+%* *
+%************************************************************************
+
+alphaTyVars is a list of type variables for use in templates:
+ ["a", "b", ..., "z", "t1", "t2", ... ]
+
+\begin{code}
+tyVarList :: Kind -> [TyVar]
+tyVarList kind = [ mkTyVar (mkInternalName (mkAlphaTyVarUnique u)
+ (mkTyVarOcc (mkFastString name))
+ noSrcLoc) kind
+ | u <- [2..],
+ let name | c <= 'z' = [c]
+ | otherwise = 't':show u
+ where c = chr (u-2 + ord 'a')
+ ]
+
+alphaTyVars :: [TyVar]
+alphaTyVars = tyVarList liftedTypeKind
+
+betaTyVars = tail alphaTyVars
+
+alphaTyVar, betaTyVar, gammaTyVar :: TyVar
+(alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
+
+alphaTys = mkTyVarTys alphaTyVars
+(alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys
+
+ -- openAlphaTyVar is prepared to be instantiated
+ -- to a lifted or unlifted type variable. It's used for the
+ -- result type for "error", so that we can have (error Int# "Help")
+openAlphaTyVars :: [TyVar]
+openAlphaTyVars@(openAlphaTyVar:_) = tyVarList openTypeKind
+
+openAlphaTy = mkTyVarTy openAlphaTyVar
+
+vrcPos,vrcZero :: (Bool,Bool)
+vrcPos = (True,False)
+vrcZero = (False,False)
+
+vrcsP,vrcsZ,vrcsZP :: ArgVrcs
+vrcsP = [vrcPos]
+vrcsZ = [vrcZero]
+vrcsZP = [vrcZero,vrcPos]
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection[TysPrim-basic]{Basic primitive types (@Char#@, @Int#@, etc.)}
+%* *
+%************************************************************************
+
+\begin{code}
+-- only used herein
+pcPrimTyCon :: Name -> ArgVrcs -> PrimRep -> TyCon
+pcPrimTyCon name arg_vrcs rep
+ = mkPrimTyCon name kind arity arg_vrcs rep
+ where
+ arity = length arg_vrcs
+ kind = mkArrowKinds (replicate arity liftedTypeKind) result_kind
+ result_kind = unliftedTypeKind -- all primitive types are unlifted
+
+pcPrimTyCon0 :: Name -> PrimRep -> TyCon
+pcPrimTyCon0 name rep
+ = mkPrimTyCon name result_kind 0 [] rep
+ where
+ result_kind = unliftedTypeKind -- all primitive types are unlifted
+
+charPrimTy = mkTyConTy charPrimTyCon
+charPrimTyCon = pcPrimTyCon0 charPrimTyConName WordRep
+
+intPrimTy = mkTyConTy intPrimTyCon
+intPrimTyCon = pcPrimTyCon0 intPrimTyConName IntRep
+
+int32PrimTy = mkTyConTy int32PrimTyCon
+int32PrimTyCon = pcPrimTyCon0 int32PrimTyConName IntRep
+
+int64PrimTy = mkTyConTy int64PrimTyCon
+int64PrimTyCon = pcPrimTyCon0 int64PrimTyConName Int64Rep
+
+wordPrimTy = mkTyConTy wordPrimTyCon
+wordPrimTyCon = pcPrimTyCon0 wordPrimTyConName WordRep
+
+word32PrimTy = mkTyConTy word32PrimTyCon
+word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName WordRep
+
+word64PrimTy = mkTyConTy word64PrimTyCon
+word64PrimTyCon = pcPrimTyCon0 word64PrimTyConName Word64Rep
+
+addrPrimTy = mkTyConTy addrPrimTyCon
+addrPrimTyCon = pcPrimTyCon0 addrPrimTyConName AddrRep
+
+floatPrimTy = mkTyConTy floatPrimTyCon
+floatPrimTyCon = pcPrimTyCon0 floatPrimTyConName FloatRep
+
+doublePrimTy = mkTyConTy doublePrimTyCon
+doublePrimTyCon = pcPrimTyCon0 doublePrimTyConName DoubleRep
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection[TysPrim-state]{The @State#@ type (and @_RealWorld@ types)}
+%* *
+%************************************************************************
+
+State# is the primitive, unlifted type of states. It has one type parameter,
+thus
+ State# RealWorld
+or
+ State# s
+
+where s is a type variable. The only purpose of the type parameter is to
+keep different state threads separate. It is represented by nothing at all.
+
+\begin{code}
+mkStatePrimTy ty = mkTyConApp statePrimTyCon [ty]
+statePrimTyCon = pcPrimTyCon statePrimTyConName vrcsZ VoidRep
+\end{code}
+
+RealWorld is deeply magical. It is *primitive*, but it is not
+*unlifted* (hence ptrArg). We never manipulate values of type
+RealWorld; it's only used in the type system, to parameterise State#.
+
+\begin{code}
+realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName liftedTypeKind 0 [] PtrRep
+realWorldTy = mkTyConTy realWorldTyCon
+realWorldStatePrimTy = mkStatePrimTy realWorldTy -- State# RealWorld
+\end{code}
+
+Note: the ``state-pairing'' types are not truly primitive, so they are
+defined in \tr{TysWiredIn.lhs}, not here.
+
+
+%************************************************************************
+%* *
+\subsection[TysPrim-arrays]{The primitive array types}
+%* *
+%************************************************************************
+
+\begin{code}
+arrayPrimTyCon = pcPrimTyCon arrayPrimTyConName vrcsP PtrRep
+mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConName vrcsZP PtrRep
+mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConName vrcsZ PtrRep
+byteArrayPrimTyCon = pcPrimTyCon0 byteArrayPrimTyConName PtrRep
+
+mkArrayPrimTy elt = mkTyConApp arrayPrimTyCon [elt]
+byteArrayPrimTy = mkTyConTy byteArrayPrimTyCon
+mkMutableArrayPrimTy s elt = mkTyConApp mutableArrayPrimTyCon [s, elt]
+mkMutableByteArrayPrimTy s = mkTyConApp mutableByteArrayPrimTyCon [s]
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[TysPrim-mut-var]{The mutable variable type}
+%* *
+%************************************************************************
+
+\begin{code}
+mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName vrcsZP PtrRep
+
+mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt]
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[TysPrim-synch-var]{The synchronizing variable type}
+%* *
+%************************************************************************
+
+\begin{code}
+mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName vrcsZP PtrRep
+
+mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt]
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[TysPrim-stm-var]{The transactional variable type}
+%* *
+%************************************************************************
+
+\begin{code}
+tVarPrimTyCon = pcPrimTyCon tVarPrimTyConName vrcsZP PtrRep
+
+mkTVarPrimTy s elt = mkTyConApp tVarPrimTyCon [s, elt]
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[TysPrim-stable-ptrs]{The stable-pointer type}
+%* *
+%************************************************************************
+
+\begin{code}
+stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName vrcsP AddrRep
+
+mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty]
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[TysPrim-stable-names]{The stable-name type}
+%* *
+%************************************************************************
+
+\begin{code}
+stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName vrcsP PtrRep
+
+mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty]
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[TysPrim-BCOs]{The ``bytecode object'' type}
+%* *
+%************************************************************************
+
+\begin{code}
+bcoPrimTy = mkTyConTy bcoPrimTyCon
+bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName PtrRep
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[TysPrim-Weak]{The ``weak pointer'' type}
+%* *
+%************************************************************************
+
+\begin{code}
+weakPrimTyCon = pcPrimTyCon weakPrimTyConName vrcsP PtrRep
+
+mkWeakPrimTy v = mkTyConApp weakPrimTyCon [v]
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[TysPrim-thread-ids]{The ``thread id'' type}
+%* *
+%************************************************************************
+
+A thread id is represented by a pointer to the TSO itself, to ensure
+that they are always unique and we can always find the TSO for a given
+thread id. However, this has the unfortunate consequence that a
+ThreadId# for a given thread is treated as a root by the garbage
+collector and can keep TSOs around for too long.
+
+Hence the programmer API for thread manipulation uses a weak pointer
+to the thread id internally.
+
+\begin{code}
+threadIdPrimTy = mkTyConTy threadIdPrimTyCon
+threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName PtrRep
+\end{code}
diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
new file mode 100644
index 0000000000..ceb4df550a
--- /dev/null
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -0,0 +1,549 @@
+%
+% (c) The GRASP Project, Glasgow University, 1994-1998
+%
+\section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types}
+
+This module is about types that can be defined in Haskell, but which
+must be wired into the compiler nonetheless.
+
+This module tracks the ``state interface'' document, ``GHC prelude:
+types and operations.''
+
+\begin{code}
+module TysWiredIn (
+ wiredInTyCons,
+
+ boolTy, boolTyCon, boolTyCon_RDR, boolTyConName,
+ trueDataCon, trueDataConId, true_RDR,
+ falseDataCon, falseDataConId, false_RDR,
+
+ charTyCon, charDataCon, charTyCon_RDR,
+ charTy, stringTy, charTyConName,
+
+
+ doubleTyCon, doubleDataCon, doubleTy, doubleTyConName,
+
+ floatTyCon, floatDataCon, floatTy, floatTyConName,
+
+ intTyCon, intDataCon, intTyCon_RDR, intDataCon_RDR, intTyConName,
+ intTy,
+
+ listTyCon, nilDataCon, consDataCon,
+ listTyCon_RDR, consDataCon_RDR, listTyConName,
+ mkListTy,
+
+ -- tuples
+ mkTupleTy,
+ tupleTyCon, tupleCon,
+ unitTyCon, unitDataCon, unitDataConId, pairTyCon,
+ unboxedSingletonTyCon, unboxedSingletonDataCon,
+ unboxedPairTyCon, unboxedPairDataCon,
+
+ unitTy,
+ voidTy,
+
+ -- parallel arrays
+ mkPArrTy,
+ parrTyCon, parrFakeCon, isPArrTyCon, isPArrFakeCon,
+ parrTyCon_RDR, parrTyConName
+ ) where
+
+#include "HsVersions.h"
+
+import {-# SOURCE #-} MkId( mkDataConIds )
+
+-- friends:
+import PrelNames
+import TysPrim
+
+-- others:
+import Constants ( mAX_TUPLE_SIZE )
+import Module ( Module )
+import RdrName ( nameRdrName )
+import Name ( Name, BuiltInSyntax(..), nameUnique, nameOccName,
+ nameModule, mkWiredInName )
+import OccName ( mkOccNameFS, tcName, dataName, mkTupleOcc,
+ mkDataConWorkerOcc )
+import DataCon ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity )
+import Var ( TyVar, tyVarKind )
+import TyCon ( TyCon, AlgTyConRhs(DataTyCon), tyConDataCons,
+ mkTupleTyCon, mkAlgTyCon, tyConName )
+
+import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed,
+ StrictnessMark(..) )
+
+import Type ( Type, mkTyConTy, mkTyConApp, mkTyVarTy, mkTyVarTys,
+ TyThing(..) )
+import Kind ( mkArrowKinds, liftedTypeKind, ubxTupleKind )
+import Unique ( incrUnique, mkTupleTyConUnique,
+ mkTupleDataConUnique, mkPArrDataConUnique )
+import Array
+import FastString
+import Outputable
+
+alpha_tyvar = [alphaTyVar]
+alpha_ty = [alphaTy]
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Wired in type constructors}
+%* *
+%************************************************************************
+
+If you change which things are wired in, make sure you change their
+names in PrelNames, so they use wTcQual, wDataQual, etc
+
+\begin{code}
+wiredInTyCons :: [TyCon] -- Excludes tuples
+wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because
+ -- it's defined in GHC.Base, and there's only
+ -- one of it. We put it in wiredInTyCons so
+ -- that it'll pre-populate the name cache, so
+ -- the special case in lookupOrigNameCache
+ -- doesn't need to look out for it
+ , boolTyCon
+ , charTyCon
+ , doubleTyCon
+ , floatTyCon
+ , intTyCon
+ , listTyCon
+ , parrTyCon
+ ]
+\end{code}
+
+\begin{code}
+mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
+mkWiredInTyConName built_in mod fs uniq tycon
+ = mkWiredInName mod (mkOccNameFS tcName fs) uniq
+ Nothing -- No parent object
+ (ATyCon tycon) -- Relevant TyCon
+ built_in
+
+mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name -> Name
+mkWiredInDataConName built_in mod fs uniq datacon parent
+ = mkWiredInName mod (mkOccNameFS dataName fs) uniq
+ (Just parent) -- Name of parent TyCon
+ (ADataCon datacon) -- Relevant DataCon
+ built_in
+
+charTyConName = mkWiredInTyConName UserSyntax pREL_BASE FSLIT("Char") charTyConKey charTyCon
+charDataConName = mkWiredInDataConName UserSyntax pREL_BASE FSLIT("C#") charDataConKey charDataCon charTyConName
+intTyConName = mkWiredInTyConName UserSyntax pREL_BASE FSLIT("Int") intTyConKey intTyCon
+intDataConName = mkWiredInDataConName UserSyntax pREL_BASE FSLIT("I#") intDataConKey intDataCon intTyConName
+
+boolTyConName = mkWiredInTyConName UserSyntax pREL_BASE FSLIT("Bool") boolTyConKey boolTyCon
+falseDataConName = mkWiredInDataConName UserSyntax pREL_BASE FSLIT("False") falseDataConKey falseDataCon boolTyConName
+trueDataConName = mkWiredInDataConName UserSyntax pREL_BASE FSLIT("True") trueDataConKey trueDataCon boolTyConName
+listTyConName = mkWiredInTyConName BuiltInSyntax pREL_BASE FSLIT("[]") listTyConKey listTyCon
+nilDataConName = mkWiredInDataConName BuiltInSyntax pREL_BASE FSLIT("[]") nilDataConKey nilDataCon listTyConName
+consDataConName = mkWiredInDataConName BuiltInSyntax pREL_BASE FSLIT(":") consDataConKey consDataCon listTyConName
+
+floatTyConName = mkWiredInTyConName UserSyntax pREL_FLOAT FSLIT("Float") floatTyConKey floatTyCon
+floatDataConName = mkWiredInDataConName UserSyntax pREL_FLOAT FSLIT("F#") floatDataConKey floatDataCon floatTyConName
+doubleTyConName = mkWiredInTyConName UserSyntax pREL_FLOAT FSLIT("Double") doubleTyConKey doubleTyCon
+doubleDataConName = mkWiredInDataConName UserSyntax pREL_FLOAT FSLIT("D#") doubleDataConKey doubleDataCon doubleTyConName
+
+parrTyConName = mkWiredInTyConName BuiltInSyntax pREL_PARR FSLIT("[::]") parrTyConKey parrTyCon
+parrDataConName = mkWiredInDataConName UserSyntax pREL_PARR FSLIT("PArr") parrDataConKey parrDataCon parrTyConName
+
+boolTyCon_RDR = nameRdrName boolTyConName
+false_RDR = nameRdrName falseDataConName
+true_RDR = nameRdrName trueDataConName
+intTyCon_RDR = nameRdrName intTyConName
+charTyCon_RDR = nameRdrName charTyConName
+intDataCon_RDR = nameRdrName intDataConName
+listTyCon_RDR = nameRdrName listTyConName
+consDataCon_RDR = nameRdrName consDataConName
+parrTyCon_RDR = nameRdrName parrTyConName
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{mkWiredInTyCon}
+%* *
+%************************************************************************
+
+\begin{code}
+pcNonRecDataTyCon = pcTyCon False NonRecursive
+pcRecDataTyCon = pcTyCon False Recursive
+
+pcTyCon is_enum is_rec name tyvars argvrcs cons
+ = tycon
+ where
+ tycon = mkAlgTyCon name
+ (mkArrowKinds (map tyVarKind tyvars) liftedTypeKind)
+ tyvars
+ argvrcs
+ [] -- No stupid theta
+ (DataTyCon cons is_enum)
+ [] -- No record selectors
+ is_rec
+ True -- All the wired-in tycons have generics
+
+pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
+pcDataCon = pcDataConWithFixity False
+
+pcDataConWithFixity :: Bool -> Name -> [TyVar] -> [Type] -> TyCon -> DataCon
+-- The Name should be in the DataName name space; it's the name
+-- of the DataCon itself.
+--
+-- The unique is the first of two free uniques;
+-- the first is used for the datacon itself,
+-- the second is used for the "worker name"
+
+pcDataConWithFixity declared_infix dc_name tyvars arg_tys tycon
+ = data_con
+ where
+ data_con = mkDataCon dc_name declared_infix True {- Vanilla -}
+ (map (const NotMarkedStrict) arg_tys)
+ [{- No labelled fields -}]
+ tyvars [] [] arg_tys tycon (mkTyVarTys tyvars)
+ (mkDataConIds bogus_wrap_name wrk_name data_con)
+
+
+ mod = nameModule dc_name
+ wrk_occ = mkDataConWorkerOcc (nameOccName dc_name)
+ wrk_key = incrUnique (nameUnique dc_name)
+ wrk_name = mkWiredInName mod wrk_occ wrk_key
+ (Just (tyConName tycon))
+ (AnId (dataConWorkId data_con)) UserSyntax
+ bogus_wrap_name = pprPanic "Wired-in data wrapper id" (ppr dc_name)
+ -- Wired-in types are too simple to need wrappers
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection[TysWiredIn-tuples]{The tuple types}
+%* *
+%************************************************************************
+
+\begin{code}
+tupleTyCon :: Boxity -> Arity -> TyCon
+tupleTyCon boxity i | i > mAX_TUPLE_SIZE = fst (mk_tuple boxity i) -- Build one specially
+tupleTyCon Boxed i = fst (boxedTupleArr ! i)
+tupleTyCon Unboxed i = fst (unboxedTupleArr ! i)
+
+tupleCon :: Boxity -> Arity -> DataCon
+tupleCon boxity i | i > mAX_TUPLE_SIZE = snd (mk_tuple boxity i) -- Build one specially
+tupleCon Boxed i = snd (boxedTupleArr ! i)
+tupleCon Unboxed i = snd (unboxedTupleArr ! i)
+
+boxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon)
+boxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Boxed i | i <- [0..mAX_TUPLE_SIZE]]
+unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mAX_TUPLE_SIZE]]
+
+mk_tuple :: Boxity -> Int -> (TyCon,DataCon)
+mk_tuple boxity arity = (tycon, tuple_con)
+ where
+ tycon = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con boxity gen_info
+ mod = mkTupleModule boxity arity
+ tc_name = mkWiredInName mod (mkTupleOcc tcName boxity arity) tc_uniq
+ Nothing (ATyCon tycon) BuiltInSyntax
+ tc_kind = mkArrowKinds (map tyVarKind tyvars) res_kind
+ res_kind | isBoxed boxity = liftedTypeKind
+ | otherwise = ubxTupleKind
+
+ tyvars | isBoxed boxity = take arity alphaTyVars
+ | otherwise = take arity openAlphaTyVars
+
+ tuple_con = pcDataCon dc_name tyvars tyvar_tys tycon
+ tyvar_tys = mkTyVarTys tyvars
+ dc_name = mkWiredInName mod (mkTupleOcc dataName boxity arity) dc_uniq
+ (Just tc_name) (ADataCon tuple_con) BuiltInSyntax
+ tc_uniq = mkTupleTyConUnique boxity arity
+ dc_uniq = mkTupleDataConUnique boxity arity
+ gen_info = True -- Tuples all have generics..
+ -- hmm: that's a *lot* of code
+
+unitTyCon = tupleTyCon Boxed 0
+unitDataCon = head (tyConDataCons unitTyCon)
+unitDataConId = dataConWorkId unitDataCon
+
+pairTyCon = tupleTyCon Boxed 2
+
+unboxedSingletonTyCon = tupleTyCon Unboxed 1
+unboxedSingletonDataCon = tupleCon Unboxed 1
+
+unboxedPairTyCon = tupleTyCon Unboxed 2
+unboxedPairDataCon = tupleCon Unboxed 2
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)}
+%* *
+%************************************************************************
+
+\begin{code}
+-- The Void type is represented as a data type with no constructors
+-- It's a built in type (i.e. there's no way to define it in Haskell;
+-- the nearest would be
+--
+-- data Void = -- No constructors!
+--
+-- ) It's lifted; there is only one value of this
+-- type, namely "void", whose semantics is just bottom.
+--
+-- Haskell 98 drops the definition of a Void type, so we just 'simulate'
+-- voidTy using ().
+voidTy = unitTy
+\end{code}
+
+
+\begin{code}
+charTy = mkTyConTy charTyCon
+
+charTyCon = pcNonRecDataTyCon charTyConName [] [] [charDataCon]
+charDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon
+
+stringTy = mkListTy charTy -- convenience only
+\end{code}
+
+\begin{code}
+intTy = mkTyConTy intTyCon
+
+intTyCon = pcNonRecDataTyCon intTyConName [] [] [intDataCon]
+intDataCon = pcDataCon intDataConName [] [intPrimTy] intTyCon
+\end{code}
+
+\begin{code}
+floatTy = mkTyConTy floatTyCon
+
+floatTyCon = pcNonRecDataTyCon floatTyConName [] [] [floatDataCon]
+floatDataCon = pcDataCon floatDataConName [] [floatPrimTy] floatTyCon
+\end{code}
+
+\begin{code}
+doubleTy = mkTyConTy doubleTyCon
+
+doubleTyCon = pcNonRecDataTyCon doubleTyConName [] [] [doubleDataCon]
+doubleDataCon = pcDataCon doubleDataConName [] [doublePrimTy] doubleTyCon
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection[TysWiredIn-Bool]{The @Bool@ type}
+%* *
+%************************************************************************
+
+An ordinary enumeration type, but deeply wired in. There are no
+magical operations on @Bool@ (just the regular Prelude code).
+
+{\em BEGIN IDLE SPECULATION BY SIMON}
+
+This is not the only way to encode @Bool@. A more obvious coding makes
+@Bool@ just a boxed up version of @Bool#@, like this:
+\begin{verbatim}
+type Bool# = Int#
+data Bool = MkBool Bool#
+\end{verbatim}
+
+Unfortunately, this doesn't correspond to what the Report says @Bool@
+looks like! Furthermore, we get slightly less efficient code (I
+think) with this coding. @gtInt@ would look like this:
+
+\begin{verbatim}
+gtInt :: Int -> Int -> Bool
+gtInt x y = case x of I# x# ->
+ case y of I# y# ->
+ case (gtIntPrim x# y#) of
+ b# -> MkBool b#
+\end{verbatim}
+
+Notice that the result of the @gtIntPrim@ comparison has to be turned
+into an integer (here called @b#@), and returned in a @MkBool@ box.
+
+The @if@ expression would compile to this:
+\begin{verbatim}
+case (gtInt x y) of
+ MkBool b# -> case b# of { 1# -> e1; 0# -> e2 }
+\end{verbatim}
+
+I think this code is a little less efficient than the previous code,
+but I'm not certain. At all events, corresponding with the Report is
+important. The interesting thing is that the language is expressive
+enough to describe more than one alternative; and that a type doesn't
+necessarily need to be a straightforwardly boxed version of its
+primitive counterpart.
+
+{\em END IDLE SPECULATION BY SIMON}
+
+\begin{code}
+boolTy = mkTyConTy boolTyCon
+
+boolTyCon = pcTyCon True NonRecursive boolTyConName
+ [] [] [falseDataCon, trueDataCon]
+
+falseDataCon = pcDataCon falseDataConName [] [] boolTyCon
+trueDataCon = pcDataCon trueDataConName [] [] boolTyCon
+
+falseDataConId = dataConWorkId falseDataCon
+trueDataConId = dataConWorkId trueDataCon
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[TysWiredIn-List]{The @List@ type (incl ``build'' magic)}
+%* *
+%************************************************************************
+
+Special syntax, deeply wired in, but otherwise an ordinary algebraic
+data types:
+\begin{verbatim}
+data [] a = [] | a : (List a)
+data () = ()
+data (,) a b = (,,) a b
+...
+\end{verbatim}
+
+\begin{code}
+mkListTy :: Type -> Type
+mkListTy ty = mkTyConApp listTyCon [ty]
+
+listTyCon = pcRecDataTyCon listTyConName
+ alpha_tyvar [(True,False)] [nilDataCon, consDataCon]
+
+nilDataCon = pcDataCon nilDataConName alpha_tyvar [] listTyCon
+consDataCon = pcDataConWithFixity True {- Declared infix -}
+ consDataConName
+ alpha_tyvar [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon
+-- Interesting: polymorphic recursion would help here.
+-- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy
+-- gets the over-specific type (Type -> Type)
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[TysWiredIn-Tuples]{The @Tuple@ types}
+%* *
+%************************************************************************
+
+The tuple types are definitely magic, because they form an infinite
+family.
+
+\begin{itemize}
+\item
+They have a special family of type constructors, of type @TyCon@
+These contain the tycon arity, but don't require a Unique.
+
+\item
+They have a special family of constructors, of type
+@Id@. Again these contain their arity but don't need a Unique.
+
+\item
+There should be a magic way of generating the info tables and
+entry code for all tuples.
+
+But at the moment we just compile a Haskell source
+file\srcloc{lib/prelude/...} containing declarations like:
+\begin{verbatim}
+data Tuple0 = Tup0
+data Tuple2 a b = Tup2 a b
+data Tuple3 a b c = Tup3 a b c
+data Tuple4 a b c d = Tup4 a b c d
+...
+\end{verbatim}
+The print-names associated with the magic @Id@s for tuple constructors
+``just happen'' to be the same as those generated by these
+declarations.
+
+\item
+The instance environment should have a magic way to know
+that each tuple type is an instances of classes @Eq@, @Ix@, @Ord@ and
+so on. \ToDo{Not implemented yet.}
+
+\item
+There should also be a way to generate the appropriate code for each
+of these instances, but (like the info tables and entry code) it is
+done by enumeration\srcloc{lib/prelude/InTup?.hs}.
+\end{itemize}
+
+\begin{code}
+mkTupleTy :: Boxity -> Int -> [Type] -> Type
+mkTupleTy boxity arity tys = mkTyConApp (tupleTyCon boxity arity) tys
+
+unitTy = mkTupleTy Boxed 0 []
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[TysWiredIn-PArr]{The @[::]@ type}
+%* *
+%************************************************************************
+
+Special syntax for parallel arrays needs some wired in definitions.
+
+\begin{code}
+-- construct a type representing the application of the parallel array
+-- constructor
+--
+mkPArrTy :: Type -> Type
+mkPArrTy ty = mkTyConApp parrTyCon [ty]
+
+-- represents the type constructor of parallel arrays
+--
+-- * this must match the definition in `PrelPArr'
+--
+-- NB: Although the constructor is given here, it will not be accessible in
+-- user code as it is not in the environment of any compiled module except
+-- `PrelPArr'.
+--
+parrTyCon :: TyCon
+parrTyCon = pcNonRecDataTyCon parrTyConName alpha_tyvar [(True, False)] [parrDataCon]
+
+parrDataCon :: DataCon
+parrDataCon = pcDataCon
+ parrDataConName
+ alpha_tyvar -- forall'ed type variables
+ [intPrimTy, -- 1st argument: Int#
+ mkTyConApp -- 2nd argument: Array# a
+ arrayPrimTyCon
+ alpha_ty]
+ parrTyCon
+
+-- check whether a type constructor is the constructor for parallel arrays
+--
+isPArrTyCon :: TyCon -> Bool
+isPArrTyCon tc = tyConName tc == parrTyConName
+
+-- fake array constructors
+--
+-- * these constructors are never really used to represent array values;
+-- however, they are very convenient during desugaring (and, in particular,
+-- in the pattern matching compiler) to treat array pattern just like
+-- yet another constructor pattern
+--
+parrFakeCon :: Arity -> DataCon
+parrFakeCon i | i > mAX_TUPLE_SIZE = mkPArrFakeCon i -- build one specially
+parrFakeCon i = parrFakeConArr!i
+
+-- pre-defined set of constructors
+--
+parrFakeConArr :: Array Int DataCon
+parrFakeConArr = array (0, mAX_TUPLE_SIZE) [(i, mkPArrFakeCon i)
+ | i <- [0..mAX_TUPLE_SIZE]]
+
+-- build a fake parallel array constructor for the given arity
+--
+mkPArrFakeCon :: Int -> DataCon
+mkPArrFakeCon arity = data_con
+ where
+ data_con = pcDataCon name [tyvar] tyvarTys parrTyCon
+ tyvar = head alphaTyVars
+ tyvarTys = replicate arity $ mkTyVarTy tyvar
+ nameStr = mkFastString ("MkPArr" ++ show arity)
+ name = mkWiredInName pREL_PARR (mkOccNameFS dataName nameStr) uniq
+ Nothing (ADataCon data_con) UserSyntax
+ uniq = mkPArrDataConUnique arity
+
+-- checks whether a data constructor is a fake constructor for parallel arrays
+--
+isPArrFakeCon :: DataCon -> Bool
+isPArrFakeCon dcon = dcon == parrFakeCon (dataConSourceArity dcon)
+\end{code}
+
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
new file mode 100644
index 0000000000..13b4b6c97d
--- /dev/null
+++ b/compiler/prelude/primops.txt.pp
@@ -0,0 +1,1687 @@
+-----------------------------------------------------------------------
+-- $Id: primops.txt.pp,v 1.37 2005/11/25 09:46:19 simonmar 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
+-- 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.)
+--
+-- - if the primop is inline (i.e. a macro), then:
+-- ghc/compiler/AbsCUtils.lhs (dscCOpStmt)
+-- defines the translation of the primop into simpler
+-- abstract C operations.
+--
+-- - or, for an out-of-line primop:
+-- ghc/includes/StgMiscClosures.h (just add the declaration)
+-- ghc/rts/PrimOps.cmm (define it here)
+-- ghc/rts/Linker.c (declare the symbol for GHCi)
+--
+-- - 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 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 -> mkStrictSig (mkTopDmdType (replicate arity lazyDmd) TopRes) }
+ 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"
+
+-- We need platform defines (tests for mingw32 below). However, we only
+-- test the TARGET platform, which doesn't vary between stages, so the
+-- stage1 platform defines are fine:
+#include "../stage1/ghc_boot_platform.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\_HSWORD}, 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.
+
+ 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
+
+------------------------------------------------------------------------
+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#
+ {Low word of signed integer multiply.}
+ with commutable = True
+
+primop IntMulMayOfloOp "mulIntMayOflo#"
+ Dyadic Int# -> Int# -> Int#
+ {Return non-zero if there is any possibility that the upper word of a
+ signed integer multiply might contain useful information. Return
+ zero only if you are completely sure that no overflow can occur.
+ On a 32-bit platform, the recommmended implementation is to do a
+ 32 x 32 -> 64 signed multiply, and subtract result[63:32] from
+ (result[31] >>signed 31). If this is zero, meaning that the
+ upper word is merely a sign extension of the lower one, no
+ overflow can occur.
+
+ On a 64-bit platform it is not always possible to
+ acquire the top 64 bits of the result. Therefore, a recommended
+ implementation is to take the absolute value of both operands, and
+ return 0 iff bits[63:31] of them are zero, since that means that their
+ magnitudes fit within 31 bits, so the magnitude of the product must fit
+ into 62 bits.
+
+ If in doubt, return non-zero, but do make an effort to create the
+ correct answer for small args, since otherwise the performance of
+ (*) :: Integer -> Integer -> Integer will be poor.
+ }
+ 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#
+ with out_of_line = True
+
+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 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 "uncheckedIShiftL#" GenPrimOp Int# -> Int# -> Int#
+ {Shift left. Result undefined if shift amount is not
+ in the range 0 to word size - 1 inclusive.}
+primop ISraOp "uncheckedIShiftRA#" GenPrimOp Int# -> Int# -> Int#
+ {Shift right arithmetic. Result undefined if shift amount is not
+ in the range 0 to word size - 1 inclusive.}
+primop ISrlOp "uncheckedIShiftRL#" GenPrimOp Int# -> Int# -> Int#
+ {Shift right logical. Result undefined if shift amount is not
+ in the range 0 to word size - 1 inclusive.}
+
+------------------------------------------------------------------------
+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 "uncheckedShiftL#" GenPrimOp Word# -> Int# -> Word#
+ {Shift left logical. Result undefined if shift amount is not
+ in the range 0 to word size - 1 inclusive.}
+primop SrlOp "uncheckedShiftRL#" GenPrimOp Word# -> Int# -> Word#
+ {Shift right logical. Result undefined if shift amount is not
+ in the range 0 to word size - 1 inclusive.}
+
+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.
+
+For .NET these operations are implemented by foreign imports, so the
+primops are omitted.}
+------------------------------------------------------------------------
+
+#ifndef ILX
+
+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 out_of_line = True
+
+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
+ out_of_line = 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
+ out_of_line = 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
+ out_of_line = True
+
+primop Integer2WordOp "integer2Word#" GenPrimOp
+ Int# -> ByteArr# -> Word#
+ with needs_wrapper = True
+ out_of_line = True
+
+#if WORD_SIZE_IN_BITS < 32
+primop IntegerToInt32Op "integerToInt32#" GenPrimOp
+ Int# -> ByteArr# -> Int32#
+
+primop IntegerToWord32Op "integerToWord32#" GenPrimOp
+ Int# -> ByteArr# -> Word32#
+#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
+
+#endif /* ndef ILX */
+
+------------------------------------------------------------------------
+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
+ 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 }
+ 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# -> INT32
+
+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# -> WORD32
+
+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, INT32 #)
+
+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, WORD32 #)
+
+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# -> INT32 -> 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# -> WORD32 -> 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.
+
+ NB: {\tt nullAddr\#::Addr\#} is not a primop, but is defined in MkId.lhs.
+ It is the null address.}
+------------------------------------------------------------------------
+
+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#
+
+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# -> INT32
+
+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# -> WORD32
+
+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, INT32 #)
+
+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, WORD32 #)
+
+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_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# -> INT32 -> 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# -> WORD32 -> 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 "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 }
+ 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
+ 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 }
+
+-- not really the right type, but we don't know about pairs here. The
+-- correct type is
+--
+-- MutVar# s a -> (a -> (a,b)) -> State# s -> (# State# s, b #)
+--
+primop AtomicModifyMutVarOp "atomicModifyMutVar#" GenPrimOp
+ MutVar# s a -> (a -> b) -> State# s -> (# State# s, c #)
+ with
+ usage = { mangle AtomicModifyMutVarOp [mkP, mkM, mkP] mkM }
+ has_side_effects = True
+ out_of_line = True
+
+------------------------------------------------------------------------
+section "Exceptions"
+------------------------------------------------------------------------
+
+primop CatchOp "catch#" GenPrimOp
+ (State# RealWorld -> (# State# RealWorld, a #) )
+ -> (b -> State# RealWorld -> (# State# RealWorld, a #) )
+ -> State# RealWorld
+ -> (# State# RealWorld, a #)
+ with
+ -- 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 -> mkStrictSig (mkTopDmdType [lazyDmd] BotRes) }
+ -- NB: result is bottom
+ usage = { mangle RaiseOp [mkM] mkM }
+ out_of_line = True
+
+-- raiseIO# needs to be a primop, because exceptions in the IO monad
+-- must be *precise* - we don't want the strictness analyser turning
+-- one kind of bottom into another, as it is allowed to do in pure code.
+
+primop RaiseIOOp "raiseIO#" GenPrimOp
+ a -> State# RealWorld -> (# State# RealWorld, b #)
+ with
+ out_of_line = True
+
+primop BlockAsyncExceptionsOp "blockAsyncExceptions#" GenPrimOp
+ (State# RealWorld -> (# State# RealWorld, a #))
+ -> (State# RealWorld -> (# State# RealWorld, a #))
+ with
+ out_of_line = True
+
+primop UnblockAsyncExceptionsOp "unblockAsyncExceptions#" GenPrimOp
+ (State# RealWorld -> (# State# RealWorld, a #))
+ -> (State# RealWorld -> (# State# RealWorld, a #))
+ with
+ out_of_line = True
+
+------------------------------------------------------------------------
+section "STM-accessible Mutable Variables"
+------------------------------------------------------------------------
+
+primop AtomicallyOp "atomically#" GenPrimOp
+ (State# RealWorld -> (# State# RealWorld, a #) )
+ -> State# RealWorld -> (# State# RealWorld, a #)
+ with
+ out_of_line = True
+ has_side_effects = True
+
+primop RetryOp "retry#" GenPrimOp
+ State# RealWorld -> (# State# RealWorld, a #)
+ with
+ out_of_line = True
+ has_side_effects = True
+
+primop CatchRetryOp "catchRetry#" GenPrimOp
+ (State# RealWorld -> (# State# RealWorld, a #) )
+ -> (State# RealWorld -> (# State# RealWorld, a #) )
+ -> (State# RealWorld -> (# State# RealWorld, a #) )
+ with
+ out_of_line = True
+ has_side_effects = True
+
+primop CatchSTMOp "catchSTM#" GenPrimOp
+ (State# RealWorld -> (# State# RealWorld, a #) )
+ -> (b -> State# RealWorld -> (# State# RealWorld, a #) )
+ -> (State# RealWorld -> (# State# RealWorld, a #) )
+ with
+ out_of_line = True
+ has_side_effects = True
+
+primop NewTVarOp "newTVar#" GenPrimOp
+ a
+ -> State# s -> (# State# s, TVar# s a #)
+ {Create a new Tar\# holding a specified initial value.}
+ with
+ out_of_line = True
+
+primop ReadTVarOp "readTVar#" GenPrimOp
+ TVar# s a
+ -> State# s -> (# State# s, a #)
+ {Read contents of TVar\#. Result is not yet evaluated.}
+ with
+ out_of_line = True
+
+primop WriteTVarOp "writeTVar#" GenPrimOp
+ TVar# s a
+ -> a
+ -> State# s -> State# s
+ {Write contents of TVar\#.}
+ with
+ out_of_line = True
+ has_side_effects = True
+
+primop SameTVarOp "sameTVar#" GenPrimOp
+ TVar# s a -> TVar# s a -> Bool
+
+
+------------------------------------------------------------------------
+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
+ 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
+ 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 }
+ out_of_line = True
+
+------------------------------------------------------------------------
+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
+
+#ifdef mingw32_TARGET_OS
+primop AsyncReadOp "asyncRead#" GenPrimOp
+ Int# -> Int# -> Int# -> Addr# -> State# RealWorld-> (# State# RealWorld, Int#, Int# #)
+ {Asynchronously read bytes from specified file descriptor.}
+ with
+ needs_wrapper = True
+ has_side_effects = True
+ out_of_line = True
+
+primop AsyncWriteOp "asyncWrite#" GenPrimOp
+ Int# -> Int# -> Int# -> Addr# -> State# RealWorld-> (# State# RealWorld, Int#, Int# #)
+ {Asynchronously write bytes from specified file descriptor.}
+ with
+ needs_wrapper = True
+ has_side_effects = True
+ out_of_line = True
+
+primop AsyncDoProcOp "asyncDoProc#" GenPrimOp
+ Addr# -> Addr# -> State# RealWorld-> (# State# RealWorld, Int#, Int# #)
+ {Asynchronously perform procedure (first arg), passing it 2nd arg.}
+ with
+ needs_wrapper = True
+ has_side_effects = True
+ out_of_line = True
+
+#endif
+
+------------------------------------------------------------------------
+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 }
+ has_side_effects = True
+ out_of_line = True
+
+primop ForkOnOp "forkOn#" GenPrimOp
+ Int# -> a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
+ with
+ usage = { mangle ForkOnOp [mkO, mkP] mkR }
+ 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# #)
+ with
+ out_of_line = True
+
+primop LabelThreadOp "labelThread#" GenPrimOp
+ ThreadId# -> Addr# -> State# RealWorld -> State# RealWorld
+ with
+ has_side_effects = True
+ out_of_line = True
+
+primop IsCurrentThreadBoundOp "isCurrentThreadBound#" GenPrimOp
+ State# RealWorld -> (# State# RealWorld, Int# #)
+ with
+ out_of_line = True
+
+------------------------------------------------------------------------
+section "Weak pointers"
+------------------------------------------------------------------------
+
+-- note that tyvar "o" denotes openAlphaTyVar
+
+primop MkWeakOp "mkWeak#" GenPrimOp
+ o -> b -> c -> State# RealWorld -> (# State# RealWorld, Weak# b #)
+ with
+ 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
+ out_of_line = True
+
+primop FinalizeWeakOp "finalizeWeak#" GenPrimOp
+ Weak# a -> State# RealWorld -> (# State# RealWorld, Int#,
+ (State# RealWorld -> (# State# RealWorld, () #)) #)
+ with
+ usage = { mangle FinalizeWeakOp [mkM, mkP]
+ (mkR . (inUB FinalizeWeakOp
+ [id,id,inFun FinalizeWeakOp mkR mkM])) }
+ has_side_effects = True
+ out_of_line = True
+
+primop TouchOp "touch#" GenPrimOp
+ o -> State# RealWorld -> State# RealWorld
+ with
+ has_side_effects = True
+
+------------------------------------------------------------------------
+section "Stable pointers and names"
+------------------------------------------------------------------------
+
+primop MakeStablePtrOp "makeStablePtr#" GenPrimOp
+ a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
+ with
+ usage = { mangle MakeStablePtrOp [mkM, mkP] mkM }
+ has_side_effects = True
+ out_of_line = 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
+ out_of_line = 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 }
+ 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 ParOp "par#" GenPrimOp
+ a -> Int#
+ with
+ usage = { mangle ParOp [mkO] mkR }
+ -- 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 -> mkStrictSig (mkTopDmdType [seqDmd] TopRes) }
+ -- dataToTag# must have an evaluated argument
+
+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
+ BCO# -> (# a #)
+ with
+ out_of_line = True
+
+primop NewBCOOp "newBCO#" GenPrimOp
+ ByteArr# -> ByteArr# -> Array# a -> ByteArr# -> Int# -> ByteArr# -> State# s -> (# State# s, BCO# #)
+ with
+ has_side_effects = True
+ out_of_line = True
+
+------------------------------------------------------------------------
+section "Coercion"
+ {{\tt unsafeCoerce\# :: a -> b} is not a primop, but is defined in MkId.lhs.}
+
+------------------------------------------------------------------------
+
+
+------------------------------------------------------------------------
+--- ---
+------------------------------------------------------------------------
+
+thats_all_folks
+
+
+
View Lorry Controller Status