diff options
Diffstat (limited to 'compiler/GHC/Builtin')
-rw-r--r-- | compiler/GHC/Builtin/Names.hs | 2490 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Names.hs-boot | 7 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Names/TH.hs | 1093 | ||||
-rw-r--r-- | compiler/GHC/Builtin/PrimOps.hs | 698 | ||||
-rw-r--r-- | compiler/GHC/Builtin/PrimOps.hs-boot | 5 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Types.hs | 1690 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Types.hs-boot | 47 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Types/Literals.hs | 993 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Types/Prim.hs | 1110 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Uniques.hs | 180 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Uniques.hs-boot | 18 | ||||
-rw-r--r-- | compiler/GHC/Builtin/Utils.hs | 287 | ||||
-rw-r--r-- | compiler/GHC/Builtin/primops.txt.pp | 3841 |
13 files changed, 12459 insertions, 0 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs new file mode 100644 index 0000000000..1b1bfdf7fe --- /dev/null +++ b/compiler/GHC/Builtin/Names.hs @@ -0,0 +1,2490 @@ +{- +(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 + +\section[GHC.Builtin.Names]{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 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 + + +Note [Known-key names] +~~~~~~~~~~~~~~~~~~~~~~ +It is *very* important that the compiler gives wired-in things and +things with "known-key" names the correct Uniques wherever they +occur. We have to be careful about this in exactly two places: + + 1. When we parse some source code, renaming the AST better yield an + AST whose Names have the correct uniques + + 2. When we read an interface file, the read-in gubbins better have + the right uniques + +This is accomplished through a combination of mechanisms: + + 1. When parsing source code, the RdrName-decorated AST has some + RdrNames which are Exact. These are wired-in RdrNames where the + we could directly tell from the parsed syntax what Name to + use. For example, when we parse a [] in a type we can just insert + an Exact RdrName Name with the listTyConKey. + + Currently, I believe this is just an optimisation: it would be + equally valid to just output Orig RdrNames that correctly record + the module etc we expect the final Name to come from. However, + were we to eliminate isBuiltInOcc_maybe it would become essential + (see point 3). + + 2. The knownKeyNames (which consist of the basicKnownKeyNames from + the module, and those names reachable via the wired-in stuff from + GHC.Builtin.Types) are used to initialise the "OrigNameCache" in + GHC.Iface.Env. This initialization ensures that when the type checker + or renamer (both of which use GHC.Iface.Env) look up an original name + (i.e. a pair of a Module and an OccName) for a known-key name + they get the correct Unique. + + This is the most important mechanism for ensuring that known-key + stuff gets the right Unique, and is why it is so important to + place your known-key names in the appropriate lists. + + 3. For "infinite families" of known-key names (i.e. tuples and sums), we + have to be extra careful. Because there are an infinite number of + these things, we cannot add them to the list of known-key names + used to initialise the OrigNameCache. Instead, we have to + rely on never having to look them up in that cache. See + Note [Infinite families of known-key names] for details. + + +Note [Infinite families of known-key names] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Infinite families of known-key things (e.g. tuples and sums) pose a tricky +problem: we can't add them to the knownKeyNames finite map which we use to +ensure that, e.g., a reference to (,) gets assigned the right unique (if this +doesn't sound familiar see Note [Known-key names] above). + +We instead handle tuples and sums separately from the "vanilla" known-key +things, + + a) The parser recognises them specially and generates an Exact Name (hence not + looked up in the orig-name cache) + + b) The known infinite families of names are specially serialised by + GHC.Iface.Binary.putName, with that special treatment detected when we read + back to ensure that we get back to the correct uniques. See Note [Symbol + table representation of names] in GHC.Iface.Binary and Note [How tuples + work] in GHC.Builtin.Types. + +Most of the infinite families cannot occur in source code, so mechanisms (a) and (b) +suffice to ensure that they always have the right Unique. In particular, +implicit param TyCon names, constraint tuples and Any TyCons cannot be mentioned +by the user. For those things that *can* appear in source programs, + + c) GHC.Iface.Env.lookupOrigNameCache uses isBuiltInOcc_maybe to map built-in syntax + directly onto the corresponding name, rather than trying to find it in the + original-name cache. + + See also Note [Built-in syntax and the OrigNameCache] + + +Note [The integer library] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Clearly, we need to know the names of various definitions of the integer +library, e.g. the type itself, `mkInteger` etc. But there are two possible +implementations of the integer library: + + * integer-gmp (fast, but uses libgmp, which may not be available on all + targets and is GPL licensed) + * integer-simple (slow, but pure Haskell and BSD-licensed) + +We want the compiler to work with either one. The way we achieve this is: + + * When compiling the integer-{gmp,simple} library, we pass + -this-unit-id integer-wired-in + to GHC (see the cabal file libraries/integer-{gmp,simple}. + * This way, GHC can use just this UnitID (see Module.integerUnitId) when + generating code, and the linker will succeed. + +Unfortuately, the abstraction is not complete: When using integer-gmp, we +really want to use the S# constructor directly. This is controlled by +the `integerLibrary` field of `DynFlags`: If it is IntegerGMP, we use +this constructor directly (see CorePrep.lookupIntegerSDataConName) + +When GHC reads the package data base, it (internally only) pretends it has UnitId +`integer-wired-in` instead of the actual UnitId (which includes the version +number); just like for `base` and other packages, as described in +Note [Wired-in packages] in GHC.Types.Module. This is done in Packages.findWiredInPackages. +-} + +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module GHC.Builtin.Names + ( Unique, Uniquable(..), hasKey, -- Re-exported for convenience + + ----------------------------------------------------------- + module GHC.Builtin.Names, -- 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 GhcPrelude + +import GHC.Types.Module +import GHC.Types.Name.Occurrence +import GHC.Types.Name.Reader +import GHC.Types.Unique +import GHC.Types.Name +import GHC.Types.SrcLoc +import FastString + +{- +************************************************************************ +* * + allNameStrings +* * +************************************************************************ +-} + +allNameStrings :: [String] +-- Infinite list of a,b,c...z, aa, ab, ac, ... etc +allNameStrings = [ c:cs | cs <- "" : allNameStrings, c <- ['a'..'z'] ] + +{- +************************************************************************ +* * +\subsection{Local Names} +* * +************************************************************************ + +This *local* name is used by the interactive stuff +-} + +itName :: Unique -> SrcSpan -> Name +itName uniq loc = mkInternalName uniq (mkOccNameFS varName (fsLit "it")) loc + +-- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly +-- during compiler debugging. +mkUnboundName :: OccName -> Name +mkUnboundName occ = mkInternalName unboundKey occ noSrcSpan + +isUnboundName :: Name -> Bool +isUnboundName name = name `hasKey` unboundKey + +{- +************************************************************************ +* * +\subsection{Known key Names} +* * +************************************************************************ + +This section tells what the compiler knows about the association of +names with uniques. These ones are the *non* wired-in ones. The +wired in ones are defined in GHC.Builtin.Types etc. +-} + +basicKnownKeyNames :: [Name] -- See Note [Known-key names] +basicKnownKeyNames + = genericTyConNames + ++ [ -- 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, + isStringClassName, + applicativeClassName, + alternativeClassName, + foldableClassName, + traversableClassName, + semigroupClassName, sappendName, + monoidClassName, memptyName, mappendName, mconcatName, + + -- The IO type + -- See Note [TyConRepNames for non-wired-in TyCons] + ioTyConName, ioDataConName, + runMainIOName, + runRWName, + + -- Type representation types + trModuleTyConName, trModuleDataConName, + trNameTyConName, trNameSDataConName, trNameDDataConName, + trTyConTyConName, trTyConDataConName, + + -- Typeable + typeableClassName, + typeRepTyConName, + someTypeRepTyConName, + someTypeRepDataConName, + kindRepTyConName, + kindRepTyConAppDataConName, + kindRepVarDataConName, + kindRepAppDataConName, + kindRepFunDataConName, + kindRepTYPEDataConName, + kindRepTypeLitSDataConName, + kindRepTypeLitDDataConName, + typeLitSortTyConName, + typeLitSymbolDataConName, + typeLitNatDataConName, + typeRepIdName, + mkTrTypeName, + mkTrConName, + mkTrAppName, + mkTrFunName, + typeSymbolTypeRepName, typeNatTypeRepName, + trGhcPrimModuleName, + + -- KindReps for common cases + starKindRepName, + starArrStarKindRepName, + starArrStarArrStarKindRepName, + + -- Dynamic + toDynName, + + -- Numeric stuff + negateName, minusName, geName, eqName, + + -- Conversion functions + rationalTyConName, + ratioTyConName, ratioDataConName, + fromRationalName, fromIntegerName, + toIntegerName, toRationalName, + fromIntegralName, realToFracName, + + -- Int# stuff + divIntName, modIntName, + + -- String stuff + fromStringName, + + -- Enum stuff + enumFromName, enumFromThenName, + enumFromThenToName, enumFromToName, + + -- Applicative stuff + pureAName, apAName, thenAName, + + -- Functor stuff + fmapName, + + -- Monad stuff + thenIOName, bindIOName, returnIOName, failIOName, bindMName, thenMName, + returnMName, joinMName, + + -- MonadFail + monadFailClassName, failMName, + + -- MonadFix + monadFixClassName, mfixName, + + -- Arrow stuff + arrAName, composeAName, firstAName, + appAName, choiceAName, loopAName, + + -- Ix stuff + ixClassName, + + -- Show stuff + showClassName, + + -- Read stuff + readClassName, + + -- Stable pointers + newStablePtrName, + + -- GHC Extensions + groupWithName, + + -- Strings and lists + unpackCStringName, + unpackCStringFoldrName, unpackCStringUtf8Name, + + -- Overloaded lists + isListClassName, + fromListName, + fromListNName, + toListName, + + -- List operations + concatName, filterName, mapName, + zipName, foldrName, buildName, augmentName, appendName, + + -- FFI primitive types that are not wired-in. + stablePtrTyConName, ptrTyConName, funPtrTyConName, + int8TyConName, int16TyConName, int32TyConName, int64TyConName, + word16TyConName, word32TyConName, word64TyConName, + + -- Others + otherwiseIdName, inlineIdName, + eqStringName, assertName, breakpointName, breakpointCondName, + opaqueTyConName, + assertErrorName, traceName, + printName, fstName, sndName, + dollarName, + + -- Integer + integerTyConName, mkIntegerName, + integerToWord64Name, integerToInt64Name, + word64ToIntegerName, int64ToIntegerName, + plusIntegerName, timesIntegerName, smallIntegerName, + wordToIntegerName, + integerToWordName, integerToIntName, minusIntegerName, + negateIntegerName, eqIntegerPrimName, neqIntegerPrimName, + absIntegerName, signumIntegerName, + leIntegerPrimName, gtIntegerPrimName, ltIntegerPrimName, geIntegerPrimName, + compareIntegerName, quotRemIntegerName, divModIntegerName, + quotIntegerName, remIntegerName, divIntegerName, modIntegerName, + floatFromIntegerName, doubleFromIntegerName, + encodeFloatIntegerName, encodeDoubleIntegerName, + decodeDoubleIntegerName, + gcdIntegerName, lcmIntegerName, + andIntegerName, orIntegerName, xorIntegerName, complementIntegerName, + shiftLIntegerName, shiftRIntegerName, bitIntegerName, + integerSDataConName,naturalSDataConName, + + -- Natural + naturalTyConName, + naturalFromIntegerName, naturalToIntegerName, + plusNaturalName, minusNaturalName, timesNaturalName, mkNaturalName, + wordToNaturalName, + + -- Float/Double + rationalToFloatName, + rationalToDoubleName, + + -- Other classes + randomClassName, randomGenClassName, monadPlusClassName, + + -- Type-level naturals + knownNatClassName, knownSymbolClassName, + + -- Overloaded labels + isLabelClassName, + + -- Implicit Parameters + ipClassName, + + -- Overloaded record fields + hasFieldClassName, + + -- Call Stacks + callStackTyConName, + emptyCallStackName, pushCallStackName, + + -- Source Locations + srcLocDataConName, + + -- Annotation type checking + toAnnotationWrapperName + + -- The Ordering type + , orderingTyConName + , ordLTDataConName, ordEQDataConName, ordGTDataConName + + -- The SPEC type for SpecConstr + , specTyConName + + -- The Either type + , eitherTyConName, leftDataConName, rightDataConName + + -- Plugins + , pluginTyConName + , frontendPluginTyConName + + -- Generics + , genClassName, gen1ClassName + , datatypeClassName, constructorClassName, selectorClassName + + -- Monad comprehensions + , guardMName + , liftMName + , mzipName + + -- GHCi Sandbox + , ghciIoClassName, ghciStepIoMName + + -- StaticPtr + , makeStaticName + , staticPtrTyConName + , staticPtrDataConName, staticPtrInfoDataConName + , fromStaticPtrName + + -- Fingerprint + , fingerprintDataConName + + -- Custom type errors + , errorMessageTypeErrorFamName + , typeErrorTextDataConName + , typeErrorAppendDataConName + , typeErrorVAppendDataConName + , typeErrorShowTypeDataConName + + -- Unsafe coercion proofs + , unsafeEqualityProofName + , unsafeEqualityTyConName + , unsafeReflDataConName + , unsafeCoercePrimName + , unsafeCoerceName + ] + +genericTyConNames :: [Name] +genericTyConNames = [ + v1TyConName, u1TyConName, par1TyConName, rec1TyConName, + k1TyConName, m1TyConName, sumTyConName, prodTyConName, + compTyConName, rTyConName, dTyConName, + cTyConName, sTyConName, rec0TyConName, + d1TyConName, c1TyConName, s1TyConName, noSelTyConName, + repTyConName, rep1TyConName, uRecTyConName, + uAddrTyConName, uCharTyConName, uDoubleTyConName, + uFloatTyConName, uIntTyConName, uWordTyConName, + prefixIDataConName, infixIDataConName, leftAssociativeDataConName, + rightAssociativeDataConName, notAssociativeDataConName, + sourceUnpackDataConName, sourceNoUnpackDataConName, + noSourceUnpackednessDataConName, sourceLazyDataConName, + sourceStrictDataConName, noSourceStrictnessDataConName, + decidedLazyDataConName, decidedStrictDataConName, decidedUnpackDataConName, + metaDataDataConName, metaConsDataConName, metaSelDataConName + ] + +{- +************************************************************************ +* * +\subsection{Module names} +* * +************************************************************************ + + +--MetaHaskell Extension Add a new module here +-} + +pRELUDE :: Module +pRELUDE = mkBaseModule_ pRELUDE_NAME + +gHC_PRIM, gHC_TYPES, gHC_GENERICS, gHC_MAGIC, + gHC_CLASSES, gHC_PRIMOPWRAPPERS, gHC_BASE, gHC_ENUM, + gHC_GHCI, gHC_GHCI_HELPERS, gHC_CSTRING, + gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE, gHC_INTEGER_TYPE, gHC_NATURAL, + gHC_LIST, gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_LIST, dATA_STRING, + dATA_FOLDABLE, dATA_TRAVERSABLE, + gHC_CONC, gHC_IO, gHC_IO_Exception, + gHC_ST, gHC_IX, gHC_STABLE, gHC_PTR, gHC_ERR, gHC_REAL, + gHC_FLOAT, gHC_TOP_HANDLER, sYSTEM_IO, dYNAMIC, + tYPEABLE, tYPEABLE_INTERNAL, gENERICS, + rEAD_PREC, lEX, gHC_INT, gHC_WORD, mONAD, mONAD_FIX, mONAD_ZIP, mONAD_FAIL, + aRROW, cONTROL_APPLICATIVE, gHC_DESUGAR, rANDOM, gHC_EXTS, + cONTROL_EXCEPTION_BASE, gHC_TYPELITS, gHC_TYPENATS, dATA_TYPE_EQUALITY, + dATA_COERCE, dEBUG_TRACE, uNSAFE_COERCE :: Module + +gHC_PRIM = mkPrimModule (fsLit "GHC.Prim") -- Primitive types and values +gHC_TYPES = mkPrimModule (fsLit "GHC.Types") +gHC_MAGIC = mkPrimModule (fsLit "GHC.Magic") +gHC_CSTRING = mkPrimModule (fsLit "GHC.CString") +gHC_CLASSES = mkPrimModule (fsLit "GHC.Classes") +gHC_PRIMOPWRAPPERS = mkPrimModule (fsLit "GHC.PrimopWrappers") + +gHC_BASE = mkBaseModule (fsLit "GHC.Base") +gHC_ENUM = mkBaseModule (fsLit "GHC.Enum") +gHC_GHCI = mkBaseModule (fsLit "GHC.GHCi") +gHC_GHCI_HELPERS= mkBaseModule (fsLit "GHC.GHCi.Helpers") +gHC_SHOW = mkBaseModule (fsLit "GHC.Show") +gHC_READ = mkBaseModule (fsLit "GHC.Read") +gHC_NUM = mkBaseModule (fsLit "GHC.Num") +gHC_MAYBE = mkBaseModule (fsLit "GHC.Maybe") +gHC_INTEGER_TYPE= mkIntegerModule (fsLit "GHC.Integer.Type") +gHC_NATURAL = mkBaseModule (fsLit "GHC.Natural") +gHC_LIST = mkBaseModule (fsLit "GHC.List") +gHC_TUPLE = mkPrimModule (fsLit "GHC.Tuple") +dATA_TUPLE = mkBaseModule (fsLit "Data.Tuple") +dATA_EITHER = mkBaseModule (fsLit "Data.Either") +dATA_LIST = mkBaseModule (fsLit "Data.List") +dATA_STRING = mkBaseModule (fsLit "Data.String") +dATA_FOLDABLE = mkBaseModule (fsLit "Data.Foldable") +dATA_TRAVERSABLE= mkBaseModule (fsLit "Data.Traversable") +gHC_CONC = mkBaseModule (fsLit "GHC.Conc") +gHC_IO = mkBaseModule (fsLit "GHC.IO") +gHC_IO_Exception = mkBaseModule (fsLit "GHC.IO.Exception") +gHC_ST = mkBaseModule (fsLit "GHC.ST") +gHC_IX = mkBaseModule (fsLit "GHC.Ix") +gHC_STABLE = mkBaseModule (fsLit "GHC.Stable") +gHC_PTR = mkBaseModule (fsLit "GHC.Ptr") +gHC_ERR = mkBaseModule (fsLit "GHC.Err") +gHC_REAL = mkBaseModule (fsLit "GHC.Real") +gHC_FLOAT = mkBaseModule (fsLit "GHC.Float") +gHC_TOP_HANDLER = mkBaseModule (fsLit "GHC.TopHandler") +sYSTEM_IO = mkBaseModule (fsLit "System.IO") +dYNAMIC = mkBaseModule (fsLit "Data.Dynamic") +tYPEABLE = mkBaseModule (fsLit "Data.Typeable") +tYPEABLE_INTERNAL = mkBaseModule (fsLit "Data.Typeable.Internal") +gENERICS = mkBaseModule (fsLit "Data.Data") +rEAD_PREC = mkBaseModule (fsLit "Text.ParserCombinators.ReadPrec") +lEX = mkBaseModule (fsLit "Text.Read.Lex") +gHC_INT = mkBaseModule (fsLit "GHC.Int") +gHC_WORD = mkBaseModule (fsLit "GHC.Word") +mONAD = mkBaseModule (fsLit "Control.Monad") +mONAD_FIX = mkBaseModule (fsLit "Control.Monad.Fix") +mONAD_ZIP = mkBaseModule (fsLit "Control.Monad.Zip") +mONAD_FAIL = mkBaseModule (fsLit "Control.Monad.Fail") +aRROW = mkBaseModule (fsLit "Control.Arrow") +cONTROL_APPLICATIVE = mkBaseModule (fsLit "Control.Applicative") +gHC_DESUGAR = mkBaseModule (fsLit "GHC.Desugar") +rANDOM = mkBaseModule (fsLit "System.Random") +gHC_EXTS = mkBaseModule (fsLit "GHC.Exts") +cONTROL_EXCEPTION_BASE = mkBaseModule (fsLit "Control.Exception.Base") +gHC_GENERICS = mkBaseModule (fsLit "GHC.Generics") +gHC_TYPELITS = mkBaseModule (fsLit "GHC.TypeLits") +gHC_TYPENATS = mkBaseModule (fsLit "GHC.TypeNats") +dATA_TYPE_EQUALITY = mkBaseModule (fsLit "Data.Type.Equality") +dATA_COERCE = mkBaseModule (fsLit "Data.Coerce") +dEBUG_TRACE = mkBaseModule (fsLit "Debug.Trace") +uNSAFE_COERCE = mkBaseModule (fsLit "Unsafe.Coerce") + +gHC_SRCLOC :: Module +gHC_SRCLOC = mkBaseModule (fsLit "GHC.SrcLoc") + +gHC_STACK, gHC_STACK_TYPES :: Module +gHC_STACK = mkBaseModule (fsLit "GHC.Stack") +gHC_STACK_TYPES = mkBaseModule (fsLit "GHC.Stack.Types") + +gHC_STATICPTR :: Module +gHC_STATICPTR = mkBaseModule (fsLit "GHC.StaticPtr") + +gHC_STATICPTR_INTERNAL :: Module +gHC_STATICPTR_INTERNAL = mkBaseModule (fsLit "GHC.StaticPtr.Internal") + +gHC_FINGERPRINT_TYPE :: Module +gHC_FINGERPRINT_TYPE = mkBaseModule (fsLit "GHC.Fingerprint.Type") + +gHC_OVER_LABELS :: Module +gHC_OVER_LABELS = mkBaseModule (fsLit "GHC.OverloadedLabels") + +gHC_RECORDS :: Module +gHC_RECORDS = mkBaseModule (fsLit "GHC.Records") + +mAIN, rOOT_MAIN :: Module +mAIN = mkMainModule_ mAIN_NAME +rOOT_MAIN = mkMainModule (fsLit ":Main") -- Root module for initialisation + +mkInteractiveModule :: Int -> Module +-- (mkInteractiveMoudule 9) makes module 'interactive:M9' +mkInteractiveModule n = mkModule interactiveUnitId (mkModuleName ("Ghci" ++ show n)) + +pRELUDE_NAME, mAIN_NAME :: ModuleName +pRELUDE_NAME = mkModuleNameFS (fsLit "Prelude") +mAIN_NAME = mkModuleNameFS (fsLit "Main") + +dATA_ARRAY_PARALLEL_NAME, dATA_ARRAY_PARALLEL_PRIM_NAME :: ModuleName +dATA_ARRAY_PARALLEL_NAME = mkModuleNameFS (fsLit "Data.Array.Parallel") +dATA_ARRAY_PARALLEL_PRIM_NAME = mkModuleNameFS (fsLit "Data.Array.Parallel.Prim") + +mkPrimModule :: FastString -> Module +mkPrimModule m = mkModule primUnitId (mkModuleNameFS m) + +mkIntegerModule :: FastString -> Module +mkIntegerModule m = mkModule integerUnitId (mkModuleNameFS m) + +mkBaseModule :: FastString -> Module +mkBaseModule m = mkModule baseUnitId (mkModuleNameFS m) + +mkBaseModule_ :: ModuleName -> Module +mkBaseModule_ m = mkModule baseUnitId m + +mkThisGhcModule :: FastString -> Module +mkThisGhcModule m = mkModule thisGhcUnitId (mkModuleNameFS m) + +mkThisGhcModule_ :: ModuleName -> Module +mkThisGhcModule_ m = mkModule thisGhcUnitId m + +mkMainModule :: FastString -> Module +mkMainModule m = mkModule mainUnitId (mkModuleNameFS m) + +mkMainModule_ :: ModuleName -> Module +mkMainModule_ m = mkModule mainUnitId m + +{- +************************************************************************ +* * + RdrNames +* * +************************************************************************ +-} + +main_RDR_Unqual :: RdrName +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, ge_RDR, le_RDR, lt_RDR, gt_RDR, compare_RDR, + ltTag_RDR, eqTag_RDR, gtTag_RDR :: RdrName +eq_RDR = nameRdrName eqName +ge_RDR = nameRdrName geName +le_RDR = varQual_RDR gHC_CLASSES (fsLit "<=") +lt_RDR = varQual_RDR gHC_CLASSES (fsLit "<") +gt_RDR = varQual_RDR gHC_CLASSES (fsLit ">") +compare_RDR = varQual_RDR gHC_CLASSES (fsLit "compare") +ltTag_RDR = nameRdrName ordLTDataConName +eqTag_RDR = nameRdrName ordEQDataConName +gtTag_RDR = nameRdrName ordGTDataConName + +eqClass_RDR, numClass_RDR, ordClass_RDR, enumClass_RDR, monadClass_RDR + :: RdrName +eqClass_RDR = nameRdrName eqClassName +numClass_RDR = nameRdrName numClassName +ordClass_RDR = nameRdrName ordClassName +enumClass_RDR = nameRdrName enumClassName +monadClass_RDR = nameRdrName monadClassName + +map_RDR, append_RDR :: RdrName +map_RDR = nameRdrName mapName +append_RDR = nameRdrName appendName + +foldr_RDR, build_RDR, returnM_RDR, bindM_RDR, failM_RDR + :: RdrName +foldr_RDR = nameRdrName foldrName +build_RDR = nameRdrName buildName +returnM_RDR = nameRdrName returnMName +bindM_RDR = nameRdrName bindMName +failM_RDR = nameRdrName failMName + +left_RDR, right_RDR :: RdrName +left_RDR = nameRdrName leftDataConName +right_RDR = nameRdrName rightDataConName + +fromEnum_RDR, toEnum_RDR :: RdrName +fromEnum_RDR = varQual_RDR gHC_ENUM (fsLit "fromEnum") +toEnum_RDR = varQual_RDR gHC_ENUM (fsLit "toEnum") + +enumFrom_RDR, enumFromTo_RDR, enumFromThen_RDR, enumFromThenTo_RDR :: RdrName +enumFrom_RDR = nameRdrName enumFromName +enumFromTo_RDR = nameRdrName enumFromToName +enumFromThen_RDR = nameRdrName enumFromThenName +enumFromThenTo_RDR = nameRdrName enumFromThenToName + +ratioDataCon_RDR, plusInteger_RDR, timesInteger_RDR :: RdrName +ratioDataCon_RDR = nameRdrName ratioDataConName +plusInteger_RDR = nameRdrName plusIntegerName +timesInteger_RDR = nameRdrName timesIntegerName + +ioDataCon_RDR :: RdrName +ioDataCon_RDR = nameRdrName ioDataConName + +eqString_RDR, unpackCString_RDR, unpackCStringFoldr_RDR, + unpackCStringUtf8_RDR :: RdrName +eqString_RDR = nameRdrName eqStringName +unpackCString_RDR = nameRdrName unpackCStringName +unpackCStringFoldr_RDR = nameRdrName unpackCStringFoldrName +unpackCStringUtf8_RDR = nameRdrName unpackCStringUtf8Name + +newStablePtr_RDR :: RdrName +newStablePtr_RDR = nameRdrName newStablePtrName + +bindIO_RDR, returnIO_RDR :: RdrName +bindIO_RDR = nameRdrName bindIOName +returnIO_RDR = nameRdrName returnIOName + +fromInteger_RDR, fromRational_RDR, minus_RDR, times_RDR, plus_RDR :: RdrName +fromInteger_RDR = nameRdrName fromIntegerName +fromRational_RDR = nameRdrName fromRationalName +minus_RDR = nameRdrName minusName +times_RDR = varQual_RDR gHC_NUM (fsLit "*") +plus_RDR = varQual_RDR gHC_NUM (fsLit "+") + +toInteger_RDR, toRational_RDR, fromIntegral_RDR :: RdrName +toInteger_RDR = nameRdrName toIntegerName +toRational_RDR = nameRdrName toRationalName +fromIntegral_RDR = nameRdrName fromIntegralName + +stringTy_RDR, fromString_RDR :: RdrName +stringTy_RDR = tcQual_RDR gHC_BASE (fsLit "String") +fromString_RDR = nameRdrName fromStringName + +fromList_RDR, fromListN_RDR, toList_RDR :: RdrName +fromList_RDR = nameRdrName fromListName +fromListN_RDR = nameRdrName fromListNName +toList_RDR = nameRdrName toListName + +compose_RDR :: RdrName +compose_RDR = varQual_RDR gHC_BASE (fsLit ".") + +not_RDR, getTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR, + and_RDR, range_RDR, inRange_RDR, index_RDR, + unsafeIndex_RDR, unsafeRangeSize_RDR :: RdrName +and_RDR = varQual_RDR gHC_CLASSES (fsLit "&&") +not_RDR = varQual_RDR gHC_CLASSES (fsLit "not") +getTag_RDR = varQual_RDR gHC_BASE (fsLit "getTag") +succ_RDR = varQual_RDR gHC_ENUM (fsLit "succ") +pred_RDR = varQual_RDR gHC_ENUM (fsLit "pred") +minBound_RDR = varQual_RDR gHC_ENUM (fsLit "minBound") +maxBound_RDR = varQual_RDR gHC_ENUM (fsLit "maxBound") +range_RDR = varQual_RDR gHC_IX (fsLit "range") +inRange_RDR = varQual_RDR gHC_IX (fsLit "inRange") +index_RDR = varQual_RDR gHC_IX (fsLit "index") +unsafeIndex_RDR = varQual_RDR gHC_IX (fsLit "unsafeIndex") +unsafeRangeSize_RDR = varQual_RDR gHC_IX (fsLit "unsafeRangeSize") + +readList_RDR, readListDefault_RDR, readListPrec_RDR, readListPrecDefault_RDR, + readPrec_RDR, parens_RDR, choose_RDR, lexP_RDR, expectP_RDR :: RdrName +readList_RDR = varQual_RDR gHC_READ (fsLit "readList") +readListDefault_RDR = varQual_RDR gHC_READ (fsLit "readListDefault") +readListPrec_RDR = varQual_RDR gHC_READ (fsLit "readListPrec") +readListPrecDefault_RDR = varQual_RDR gHC_READ (fsLit "readListPrecDefault") +readPrec_RDR = varQual_RDR gHC_READ (fsLit "readPrec") +parens_RDR = varQual_RDR gHC_READ (fsLit "parens") +choose_RDR = varQual_RDR gHC_READ (fsLit "choose") +lexP_RDR = varQual_RDR gHC_READ (fsLit "lexP") +expectP_RDR = varQual_RDR gHC_READ (fsLit "expectP") + +readField_RDR, readFieldHash_RDR, readSymField_RDR :: RdrName +readField_RDR = varQual_RDR gHC_READ (fsLit "readField") +readFieldHash_RDR = varQual_RDR gHC_READ (fsLit "readFieldHash") +readSymField_RDR = varQual_RDR gHC_READ (fsLit "readSymField") + +punc_RDR, ident_RDR, symbol_RDR :: RdrName +punc_RDR = dataQual_RDR lEX (fsLit "Punc") +ident_RDR = dataQual_RDR lEX (fsLit "Ident") +symbol_RDR = dataQual_RDR lEX (fsLit "Symbol") + +step_RDR, alt_RDR, reset_RDR, prec_RDR, pfail_RDR :: RdrName +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") +pfail_RDR = varQual_RDR rEAD_PREC (fsLit "pfail") + +showsPrec_RDR, shows_RDR, showString_RDR, + showSpace_RDR, showCommaSpace_RDR, showParen_RDR :: RdrName +showsPrec_RDR = varQual_RDR gHC_SHOW (fsLit "showsPrec") +shows_RDR = varQual_RDR gHC_SHOW (fsLit "shows") +showString_RDR = varQual_RDR gHC_SHOW (fsLit "showString") +showSpace_RDR = varQual_RDR gHC_SHOW (fsLit "showSpace") +showCommaSpace_RDR = varQual_RDR gHC_SHOW (fsLit "showCommaSpace") +showParen_RDR = varQual_RDR gHC_SHOW (fsLit "showParen") + +error_RDR :: RdrName +error_RDR = varQual_RDR gHC_ERR (fsLit "error") + +-- Generics (constructors and functions) +u1DataCon_RDR, par1DataCon_RDR, rec1DataCon_RDR, + k1DataCon_RDR, m1DataCon_RDR, l1DataCon_RDR, r1DataCon_RDR, + prodDataCon_RDR, comp1DataCon_RDR, + unPar1_RDR, unRec1_RDR, unK1_RDR, unComp1_RDR, + from_RDR, from1_RDR, to_RDR, to1_RDR, + datatypeName_RDR, moduleName_RDR, packageName_RDR, isNewtypeName_RDR, + conName_RDR, conFixity_RDR, conIsRecord_RDR, selName_RDR, + prefixDataCon_RDR, infixDataCon_RDR, leftAssocDataCon_RDR, + rightAssocDataCon_RDR, notAssocDataCon_RDR, + uAddrDataCon_RDR, uCharDataCon_RDR, uDoubleDataCon_RDR, + uFloatDataCon_RDR, uIntDataCon_RDR, uWordDataCon_RDR, + uAddrHash_RDR, uCharHash_RDR, uDoubleHash_RDR, + uFloatHash_RDR, uIntHash_RDR, uWordHash_RDR :: RdrName + +u1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "U1") +par1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Par1") +rec1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Rec1") +k1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "K1") +m1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "M1") + +l1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "L1") +r1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "R1") + +prodDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit ":*:") +comp1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Comp1") + +unPar1_RDR = varQual_RDR gHC_GENERICS (fsLit "unPar1") +unRec1_RDR = varQual_RDR gHC_GENERICS (fsLit "unRec1") +unK1_RDR = varQual_RDR gHC_GENERICS (fsLit "unK1") +unComp1_RDR = varQual_RDR gHC_GENERICS (fsLit "unComp1") + +from_RDR = varQual_RDR gHC_GENERICS (fsLit "from") +from1_RDR = varQual_RDR gHC_GENERICS (fsLit "from1") +to_RDR = varQual_RDR gHC_GENERICS (fsLit "to") +to1_RDR = varQual_RDR gHC_GENERICS (fsLit "to1") + +datatypeName_RDR = varQual_RDR gHC_GENERICS (fsLit "datatypeName") +moduleName_RDR = varQual_RDR gHC_GENERICS (fsLit "moduleName") +packageName_RDR = varQual_RDR gHC_GENERICS (fsLit "packageName") +isNewtypeName_RDR = varQual_RDR gHC_GENERICS (fsLit "isNewtype") +selName_RDR = varQual_RDR gHC_GENERICS (fsLit "selName") +conName_RDR = varQual_RDR gHC_GENERICS (fsLit "conName") +conFixity_RDR = varQual_RDR gHC_GENERICS (fsLit "conFixity") +conIsRecord_RDR = varQual_RDR gHC_GENERICS (fsLit "conIsRecord") + +prefixDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Prefix") +infixDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Infix") +leftAssocDataCon_RDR = nameRdrName leftAssociativeDataConName +rightAssocDataCon_RDR = nameRdrName rightAssociativeDataConName +notAssocDataCon_RDR = nameRdrName notAssociativeDataConName + +uAddrDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UAddr") +uCharDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UChar") +uDoubleDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UDouble") +uFloatDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UFloat") +uIntDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UInt") +uWordDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UWord") + +uAddrHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uAddr#") +uCharHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uChar#") +uDoubleHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uDouble#") +uFloatHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uFloat#") +uIntHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uInt#") +uWordHash_RDR = varQual_RDR gHC_GENERICS (fsLit "uWord#") + +fmap_RDR, replace_RDR, pure_RDR, ap_RDR, liftA2_RDR, foldable_foldr_RDR, + foldMap_RDR, null_RDR, all_RDR, traverse_RDR, mempty_RDR, + mappend_RDR :: RdrName +fmap_RDR = nameRdrName fmapName +replace_RDR = varQual_RDR gHC_BASE (fsLit "<$") +pure_RDR = nameRdrName pureAName +ap_RDR = nameRdrName apAName +liftA2_RDR = varQual_RDR gHC_BASE (fsLit "liftA2") +foldable_foldr_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldr") +foldMap_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldMap") +null_RDR = varQual_RDR dATA_FOLDABLE (fsLit "null") +all_RDR = varQual_RDR dATA_FOLDABLE (fsLit "all") +traverse_RDR = varQual_RDR dATA_TRAVERSABLE (fsLit "traverse") +mempty_RDR = nameRdrName memptyName +mappend_RDR = nameRdrName mappendName + +---------------------- +varQual_RDR, tcQual_RDR, clsQual_RDR, dataQual_RDR + :: Module -> FastString -> RdrName +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) + +{- +************************************************************************ +* * +\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. +-} + +wildCardName :: Name +wildCardName = mkSystemVarName wildCardKey (fsLit "wild") + +runMainIOName, runRWName :: Name +runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey +runRWName = varQual gHC_MAGIC (fsLit "runRW#") runRWKey + +orderingTyConName, ordLTDataConName, ordEQDataConName, ordGTDataConName :: Name +orderingTyConName = tcQual gHC_TYPES (fsLit "Ordering") orderingTyConKey +ordLTDataConName = dcQual gHC_TYPES (fsLit "LT") ordLTDataConKey +ordEQDataConName = dcQual gHC_TYPES (fsLit "EQ") ordEQDataConKey +ordGTDataConName = dcQual gHC_TYPES (fsLit "GT") ordGTDataConKey + +specTyConName :: Name +specTyConName = tcQual gHC_TYPES (fsLit "SPEC") specTyConKey + +eitherTyConName, leftDataConName, rightDataConName :: Name +eitherTyConName = tcQual dATA_EITHER (fsLit "Either") eitherTyConKey +leftDataConName = dcQual dATA_EITHER (fsLit "Left") leftDataConKey +rightDataConName = dcQual dATA_EITHER (fsLit "Right") rightDataConKey + +-- Generics (types) +v1TyConName, u1TyConName, par1TyConName, rec1TyConName, + k1TyConName, m1TyConName, sumTyConName, prodTyConName, + compTyConName, rTyConName, dTyConName, + cTyConName, sTyConName, rec0TyConName, + d1TyConName, c1TyConName, s1TyConName, noSelTyConName, + repTyConName, rep1TyConName, uRecTyConName, + uAddrTyConName, uCharTyConName, uDoubleTyConName, + uFloatTyConName, uIntTyConName, uWordTyConName, + prefixIDataConName, infixIDataConName, leftAssociativeDataConName, + rightAssociativeDataConName, notAssociativeDataConName, + sourceUnpackDataConName, sourceNoUnpackDataConName, + noSourceUnpackednessDataConName, sourceLazyDataConName, + sourceStrictDataConName, noSourceStrictnessDataConName, + decidedLazyDataConName, decidedStrictDataConName, decidedUnpackDataConName, + metaDataDataConName, metaConsDataConName, metaSelDataConName :: Name + +v1TyConName = tcQual gHC_GENERICS (fsLit "V1") v1TyConKey +u1TyConName = tcQual gHC_GENERICS (fsLit "U1") u1TyConKey +par1TyConName = tcQual gHC_GENERICS (fsLit "Par1") par1TyConKey +rec1TyConName = tcQual gHC_GENERICS (fsLit "Rec1") rec1TyConKey +k1TyConName = tcQual gHC_GENERICS (fsLit "K1") k1TyConKey +m1TyConName = tcQual gHC_GENERICS (fsLit "M1") m1TyConKey + +sumTyConName = tcQual gHC_GENERICS (fsLit ":+:") sumTyConKey +prodTyConName = tcQual gHC_GENERICS (fsLit ":*:") prodTyConKey +compTyConName = tcQual gHC_GENERICS (fsLit ":.:") compTyConKey + +rTyConName = tcQual gHC_GENERICS (fsLit "R") rTyConKey +dTyConName = tcQual gHC_GENERICS (fsLit "D") dTyConKey +cTyConName = tcQual gHC_GENERICS (fsLit "C") cTyConKey +sTyConName = tcQual gHC_GENERICS (fsLit "S") sTyConKey + +rec0TyConName = tcQual gHC_GENERICS (fsLit "Rec0") rec0TyConKey +d1TyConName = tcQual gHC_GENERICS (fsLit "D1") d1TyConKey +c1TyConName = tcQual gHC_GENERICS (fsLit "C1") c1TyConKey +s1TyConName = tcQual gHC_GENERICS (fsLit "S1") s1TyConKey +noSelTyConName = tcQual gHC_GENERICS (fsLit "NoSelector") noSelTyConKey + +repTyConName = tcQual gHC_GENERICS (fsLit "Rep") repTyConKey +rep1TyConName = tcQual gHC_GENERICS (fsLit "Rep1") rep1TyConKey + +uRecTyConName = tcQual gHC_GENERICS (fsLit "URec") uRecTyConKey +uAddrTyConName = tcQual gHC_GENERICS (fsLit "UAddr") uAddrTyConKey +uCharTyConName = tcQual gHC_GENERICS (fsLit "UChar") uCharTyConKey +uDoubleTyConName = tcQual gHC_GENERICS (fsLit "UDouble") uDoubleTyConKey +uFloatTyConName = tcQual gHC_GENERICS (fsLit "UFloat") uFloatTyConKey +uIntTyConName = tcQual gHC_GENERICS (fsLit "UInt") uIntTyConKey +uWordTyConName = tcQual gHC_GENERICS (fsLit "UWord") uWordTyConKey + +prefixIDataConName = dcQual gHC_GENERICS (fsLit "PrefixI") prefixIDataConKey +infixIDataConName = dcQual gHC_GENERICS (fsLit "InfixI") infixIDataConKey +leftAssociativeDataConName = dcQual gHC_GENERICS (fsLit "LeftAssociative") leftAssociativeDataConKey +rightAssociativeDataConName = dcQual gHC_GENERICS (fsLit "RightAssociative") rightAssociativeDataConKey +notAssociativeDataConName = dcQual gHC_GENERICS (fsLit "NotAssociative") notAssociativeDataConKey + +sourceUnpackDataConName = dcQual gHC_GENERICS (fsLit "SourceUnpack") sourceUnpackDataConKey +sourceNoUnpackDataConName = dcQual gHC_GENERICS (fsLit "SourceNoUnpack") sourceNoUnpackDataConKey +noSourceUnpackednessDataConName = dcQual gHC_GENERICS (fsLit "NoSourceUnpackedness") noSourceUnpackednessDataConKey +sourceLazyDataConName = dcQual gHC_GENERICS (fsLit "SourceLazy") sourceLazyDataConKey +sourceStrictDataConName = dcQual gHC_GENERICS (fsLit "SourceStrict") sourceStrictDataConKey +noSourceStrictnessDataConName = dcQual gHC_GENERICS (fsLit "NoSourceStrictness") noSourceStrictnessDataConKey +decidedLazyDataConName = dcQual gHC_GENERICS (fsLit "DecidedLazy") decidedLazyDataConKey +decidedStrictDataConName = dcQual gHC_GENERICS (fsLit "DecidedStrict") decidedStrictDataConKey +decidedUnpackDataConName = dcQual gHC_GENERICS (fsLit "DecidedUnpack") decidedUnpackDataConKey + +metaDataDataConName = dcQual gHC_GENERICS (fsLit "MetaData") metaDataDataConKey +metaConsDataConName = dcQual gHC_GENERICS (fsLit "MetaCons") metaConsDataConKey +metaSelDataConName = dcQual gHC_GENERICS (fsLit "MetaSel") metaSelDataConKey + +-- Primitive Int +divIntName, modIntName :: Name +divIntName = varQual gHC_CLASSES (fsLit "divInt#") divIntIdKey +modIntName = varQual gHC_CLASSES (fsLit "modInt#") modIntIdKey + +-- Base strings Strings +unpackCStringName, unpackCStringFoldrName, + unpackCStringUtf8Name, eqStringName :: Name +unpackCStringName = varQual gHC_CSTRING (fsLit "unpackCString#") unpackCStringIdKey +unpackCStringFoldrName = varQual gHC_CSTRING (fsLit "unpackFoldrCString#") unpackCStringFoldrIdKey +unpackCStringUtf8Name = varQual gHC_CSTRING (fsLit "unpackCStringUtf8#") unpackCStringUtf8IdKey +eqStringName = varQual gHC_BASE (fsLit "eqString") eqStringIdKey + +-- The 'inline' function +inlineIdName :: Name +inlineIdName = varQual gHC_MAGIC (fsLit "inline") inlineIdKey + +-- Base classes (Eq, Ord, Functor) +fmapName, eqClassName, eqName, ordClassName, geName, functorClassName :: Name +eqClassName = clsQual gHC_CLASSES (fsLit "Eq") eqClassKey +eqName = varQual gHC_CLASSES (fsLit "==") eqClassOpKey +ordClassName = clsQual gHC_CLASSES (fsLit "Ord") ordClassKey +geName = varQual gHC_CLASSES (fsLit ">=") geClassOpKey +functorClassName = clsQual gHC_BASE (fsLit "Functor") functorClassKey +fmapName = varQual gHC_BASE (fsLit "fmap") fmapClassOpKey + +-- Class Monad +monadClassName, thenMName, bindMName, returnMName :: Name +monadClassName = clsQual gHC_BASE (fsLit "Monad") monadClassKey +thenMName = varQual gHC_BASE (fsLit ">>") thenMClassOpKey +bindMName = varQual gHC_BASE (fsLit ">>=") bindMClassOpKey +returnMName = varQual gHC_BASE (fsLit "return") returnMClassOpKey + +-- Class MonadFail +monadFailClassName, failMName :: Name +monadFailClassName = clsQual mONAD_FAIL (fsLit "MonadFail") monadFailClassKey +failMName = varQual mONAD_FAIL (fsLit "fail") failMClassOpKey + +-- Class Applicative +applicativeClassName, pureAName, apAName, thenAName :: Name +applicativeClassName = clsQual gHC_BASE (fsLit "Applicative") applicativeClassKey +apAName = varQual gHC_BASE (fsLit "<*>") apAClassOpKey +pureAName = varQual gHC_BASE (fsLit "pure") pureAClassOpKey +thenAName = varQual gHC_BASE (fsLit "*>") thenAClassOpKey + +-- Classes (Foldable, Traversable) +foldableClassName, traversableClassName :: Name +foldableClassName = clsQual dATA_FOLDABLE (fsLit "Foldable") foldableClassKey +traversableClassName = clsQual dATA_TRAVERSABLE (fsLit "Traversable") traversableClassKey + +-- Classes (Semigroup, Monoid) +semigroupClassName, sappendName :: Name +semigroupClassName = clsQual gHC_BASE (fsLit "Semigroup") semigroupClassKey +sappendName = varQual gHC_BASE (fsLit "<>") sappendClassOpKey +monoidClassName, memptyName, mappendName, mconcatName :: Name +monoidClassName = clsQual gHC_BASE (fsLit "Monoid") monoidClassKey +memptyName = varQual gHC_BASE (fsLit "mempty") memptyClassOpKey +mappendName = varQual gHC_BASE (fsLit "mappend") mappendClassOpKey +mconcatName = varQual gHC_BASE (fsLit "mconcat") mconcatClassOpKey + + + +-- AMP additions + +joinMName, alternativeClassName :: Name +joinMName = varQual gHC_BASE (fsLit "join") joinMIdKey +alternativeClassName = clsQual mONAD (fsLit "Alternative") alternativeClassKey + +-- +joinMIdKey, apAClassOpKey, pureAClassOpKey, thenAClassOpKey, + alternativeClassKey :: Unique +joinMIdKey = mkPreludeMiscIdUnique 750 +apAClassOpKey = mkPreludeMiscIdUnique 751 -- <*> +pureAClassOpKey = mkPreludeMiscIdUnique 752 +thenAClassOpKey = mkPreludeMiscIdUnique 753 +alternativeClassKey = mkPreludeMiscIdUnique 754 + + +-- Functions for GHC extensions +groupWithName :: Name +groupWithName = varQual gHC_EXTS (fsLit "groupWith") groupWithIdKey + +-- Random PrelBase functions +fromStringName, otherwiseIdName, foldrName, buildName, augmentName, + mapName, appendName, assertName, + breakpointName, breakpointCondName, + opaqueTyConName, dollarName :: Name +dollarName = varQual gHC_BASE (fsLit "$") dollarIdKey +otherwiseIdName = varQual gHC_BASE (fsLit "otherwise") otherwiseIdKey +foldrName = varQual gHC_BASE (fsLit "foldr") foldrIdKey +buildName = varQual gHC_BASE (fsLit "build") buildIdKey +augmentName = varQual gHC_BASE (fsLit "augment") augmentIdKey +mapName = varQual gHC_BASE (fsLit "map") mapIdKey +appendName = varQual gHC_BASE (fsLit "++") appendIdKey +assertName = varQual gHC_BASE (fsLit "assert") assertIdKey +breakpointName = varQual gHC_BASE (fsLit "breakpoint") breakpointIdKey +breakpointCondName= varQual gHC_BASE (fsLit "breakpointCond") breakpointCondIdKey +opaqueTyConName = tcQual gHC_BASE (fsLit "Opaque") opaqueTyConKey +fromStringName = varQual dATA_STRING (fsLit "fromString") fromStringClassOpKey + +-- PrelTup +fstName, sndName :: Name +fstName = varQual dATA_TUPLE (fsLit "fst") fstIdKey +sndName = varQual dATA_TUPLE (fsLit "snd") sndIdKey + +-- Module GHC.Num +numClassName, fromIntegerName, minusName, negateName :: Name +numClassName = clsQual gHC_NUM (fsLit "Num") numClassKey +fromIntegerName = varQual gHC_NUM (fsLit "fromInteger") fromIntegerClassOpKey +minusName = varQual gHC_NUM (fsLit "-") minusClassOpKey +negateName = varQual gHC_NUM (fsLit "negate") negateClassOpKey + +integerTyConName, mkIntegerName, integerSDataConName, + integerToWord64Name, integerToInt64Name, + word64ToIntegerName, int64ToIntegerName, + plusIntegerName, timesIntegerName, smallIntegerName, + wordToIntegerName, + integerToWordName, integerToIntName, minusIntegerName, + negateIntegerName, eqIntegerPrimName, neqIntegerPrimName, + absIntegerName, signumIntegerName, + leIntegerPrimName, gtIntegerPrimName, ltIntegerPrimName, geIntegerPrimName, + compareIntegerName, quotRemIntegerName, divModIntegerName, + quotIntegerName, remIntegerName, divIntegerName, modIntegerName, + floatFromIntegerName, doubleFromIntegerName, + encodeFloatIntegerName, encodeDoubleIntegerName, + decodeDoubleIntegerName, + gcdIntegerName, lcmIntegerName, + andIntegerName, orIntegerName, xorIntegerName, complementIntegerName, + shiftLIntegerName, shiftRIntegerName, bitIntegerName :: Name +integerTyConName = tcQual gHC_INTEGER_TYPE (fsLit "Integer") integerTyConKey +integerSDataConName = dcQual gHC_INTEGER_TYPE (fsLit "S#") integerSDataConKey +mkIntegerName = varQual gHC_INTEGER_TYPE (fsLit "mkInteger") mkIntegerIdKey +integerToWord64Name = varQual gHC_INTEGER_TYPE (fsLit "integerToWord64") integerToWord64IdKey +integerToInt64Name = varQual gHC_INTEGER_TYPE (fsLit "integerToInt64") integerToInt64IdKey +word64ToIntegerName = varQual gHC_INTEGER_TYPE (fsLit "word64ToInteger") word64ToIntegerIdKey +int64ToIntegerName = varQual gHC_INTEGER_TYPE (fsLit "int64ToInteger") int64ToIntegerIdKey +plusIntegerName = varQual gHC_INTEGER_TYPE (fsLit "plusInteger") plusIntegerIdKey +timesIntegerName = varQual gHC_INTEGER_TYPE (fsLit "timesInteger") timesIntegerIdKey +smallIntegerName = varQual gHC_INTEGER_TYPE (fsLit "smallInteger") smallIntegerIdKey +wordToIntegerName = varQual gHC_INTEGER_TYPE (fsLit "wordToInteger") wordToIntegerIdKey +integerToWordName = varQual gHC_INTEGER_TYPE (fsLit "integerToWord") integerToWordIdKey +integerToIntName = varQual gHC_INTEGER_TYPE (fsLit "integerToInt") integerToIntIdKey +minusIntegerName = varQual gHC_INTEGER_TYPE (fsLit "minusInteger") minusIntegerIdKey +negateIntegerName = varQual gHC_INTEGER_TYPE (fsLit "negateInteger") negateIntegerIdKey +eqIntegerPrimName = varQual gHC_INTEGER_TYPE (fsLit "eqInteger#") eqIntegerPrimIdKey +neqIntegerPrimName = varQual gHC_INTEGER_TYPE (fsLit "neqInteger#") neqIntegerPrimIdKey +absIntegerName = varQual gHC_INTEGER_TYPE (fsLit "absInteger") absIntegerIdKey +signumIntegerName = varQual gHC_INTEGER_TYPE (fsLit "signumInteger") signumIntegerIdKey +leIntegerPrimName = varQual gHC_INTEGER_TYPE (fsLit "leInteger#") leIntegerPrimIdKey +gtIntegerPrimName = varQual gHC_INTEGER_TYPE (fsLit "gtInteger#") gtIntegerPrimIdKey +ltIntegerPrimName = varQual gHC_INTEGER_TYPE (fsLit "ltInteger#") ltIntegerPrimIdKey +geIntegerPrimName = varQual gHC_INTEGER_TYPE (fsLit "geInteger#") geIntegerPrimIdKey +compareIntegerName = varQual gHC_INTEGER_TYPE (fsLit "compareInteger") compareIntegerIdKey +quotRemIntegerName = varQual gHC_INTEGER_TYPE (fsLit "quotRemInteger") quotRemIntegerIdKey +divModIntegerName = varQual gHC_INTEGER_TYPE (fsLit "divModInteger") divModIntegerIdKey +quotIntegerName = varQual gHC_INTEGER_TYPE (fsLit "quotInteger") quotIntegerIdKey +remIntegerName = varQual gHC_INTEGER_TYPE (fsLit "remInteger") remIntegerIdKey +divIntegerName = varQual gHC_INTEGER_TYPE (fsLit "divInteger") divIntegerIdKey +modIntegerName = varQual gHC_INTEGER_TYPE (fsLit "modInteger") modIntegerIdKey +floatFromIntegerName = varQual gHC_INTEGER_TYPE (fsLit "floatFromInteger") floatFromIntegerIdKey +doubleFromIntegerName = varQual gHC_INTEGER_TYPE (fsLit "doubleFromInteger") doubleFromIntegerIdKey +encodeFloatIntegerName = varQual gHC_INTEGER_TYPE (fsLit "encodeFloatInteger") encodeFloatIntegerIdKey +encodeDoubleIntegerName = varQual gHC_INTEGER_TYPE (fsLit "encodeDoubleInteger") encodeDoubleIntegerIdKey +decodeDoubleIntegerName = varQual gHC_INTEGER_TYPE (fsLit "decodeDoubleInteger") decodeDoubleIntegerIdKey +gcdIntegerName = varQual gHC_INTEGER_TYPE (fsLit "gcdInteger") gcdIntegerIdKey +lcmIntegerName = varQual gHC_INTEGER_TYPE (fsLit "lcmInteger") lcmIntegerIdKey +andIntegerName = varQual gHC_INTEGER_TYPE (fsLit "andInteger") andIntegerIdKey +orIntegerName = varQual gHC_INTEGER_TYPE (fsLit "orInteger") orIntegerIdKey +xorIntegerName = varQual gHC_INTEGER_TYPE (fsLit "xorInteger") xorIntegerIdKey +complementIntegerName = varQual gHC_INTEGER_TYPE (fsLit "complementInteger") complementIntegerIdKey +shiftLIntegerName = varQual gHC_INTEGER_TYPE (fsLit "shiftLInteger") shiftLIntegerIdKey +shiftRIntegerName = varQual gHC_INTEGER_TYPE (fsLit "shiftRInteger") shiftRIntegerIdKey +bitIntegerName = varQual gHC_INTEGER_TYPE (fsLit "bitInteger") bitIntegerIdKey + +-- GHC.Natural types +naturalTyConName, naturalSDataConName :: Name +naturalTyConName = tcQual gHC_NATURAL (fsLit "Natural") naturalTyConKey +naturalSDataConName = dcQual gHC_NATURAL (fsLit "NatS#") naturalSDataConKey + +naturalFromIntegerName :: Name +naturalFromIntegerName = varQual gHC_NATURAL (fsLit "naturalFromInteger") naturalFromIntegerIdKey + +naturalToIntegerName, plusNaturalName, minusNaturalName, timesNaturalName, + mkNaturalName, wordToNaturalName :: Name +naturalToIntegerName = varQual gHC_NATURAL (fsLit "naturalToInteger") naturalToIntegerIdKey +plusNaturalName = varQual gHC_NATURAL (fsLit "plusNatural") plusNaturalIdKey +minusNaturalName = varQual gHC_NATURAL (fsLit "minusNatural") minusNaturalIdKey +timesNaturalName = varQual gHC_NATURAL (fsLit "timesNatural") timesNaturalIdKey +mkNaturalName = varQual gHC_NATURAL (fsLit "mkNatural") mkNaturalIdKey +wordToNaturalName = varQual gHC_NATURAL (fsLit "wordToNatural#") wordToNaturalIdKey + +-- GHC.Real types and classes +rationalTyConName, ratioTyConName, ratioDataConName, realClassName, + integralClassName, realFracClassName, fractionalClassName, + fromRationalName, toIntegerName, toRationalName, fromIntegralName, + realToFracName :: Name +rationalTyConName = tcQual gHC_REAL (fsLit "Rational") rationalTyConKey +ratioTyConName = tcQual gHC_REAL (fsLit "Ratio") ratioTyConKey +ratioDataConName = dcQual gHC_REAL (fsLit ":%") ratioDataConKey +realClassName = clsQual gHC_REAL (fsLit "Real") realClassKey +integralClassName = clsQual gHC_REAL (fsLit "Integral") integralClassKey +realFracClassName = clsQual gHC_REAL (fsLit "RealFrac") realFracClassKey +fractionalClassName = clsQual gHC_REAL (fsLit "Fractional") fractionalClassKey +fromRationalName = varQual gHC_REAL (fsLit "fromRational") fromRationalClassOpKey +toIntegerName = varQual gHC_REAL (fsLit "toInteger") toIntegerClassOpKey +toRationalName = varQual gHC_REAL (fsLit "toRational") toRationalClassOpKey +fromIntegralName = varQual gHC_REAL (fsLit "fromIntegral")fromIntegralIdKey +realToFracName = varQual gHC_REAL (fsLit "realToFrac") realToFracIdKey + +-- PrelFloat classes +floatingClassName, realFloatClassName :: Name +floatingClassName = clsQual gHC_FLOAT (fsLit "Floating") floatingClassKey +realFloatClassName = clsQual gHC_FLOAT (fsLit "RealFloat") realFloatClassKey + +-- other GHC.Float functions +rationalToFloatName, rationalToDoubleName :: Name +rationalToFloatName = varQual gHC_FLOAT (fsLit "rationalToFloat") rationalToFloatIdKey +rationalToDoubleName = varQual gHC_FLOAT (fsLit "rationalToDouble") rationalToDoubleIdKey + +-- Class Ix +ixClassName :: Name +ixClassName = clsQual gHC_IX (fsLit "Ix") ixClassKey + +-- Typeable representation types +trModuleTyConName + , trModuleDataConName + , trNameTyConName + , trNameSDataConName + , trNameDDataConName + , trTyConTyConName + , trTyConDataConName + :: Name +trModuleTyConName = tcQual gHC_TYPES (fsLit "Module") trModuleTyConKey +trModuleDataConName = dcQual gHC_TYPES (fsLit "Module") trModuleDataConKey +trNameTyConName = tcQual gHC_TYPES (fsLit "TrName") trNameTyConKey +trNameSDataConName = dcQual gHC_TYPES (fsLit "TrNameS") trNameSDataConKey +trNameDDataConName = dcQual gHC_TYPES (fsLit "TrNameD") trNameDDataConKey +trTyConTyConName = tcQual gHC_TYPES (fsLit "TyCon") trTyConTyConKey +trTyConDataConName = dcQual gHC_TYPES (fsLit "TyCon") trTyConDataConKey + +kindRepTyConName + , kindRepTyConAppDataConName + , kindRepVarDataConName + , kindRepAppDataConName + , kindRepFunDataConName + , kindRepTYPEDataConName + , kindRepTypeLitSDataConName + , kindRepTypeLitDDataConName + :: Name +kindRepTyConName = tcQual gHC_TYPES (fsLit "KindRep") kindRepTyConKey +kindRepTyConAppDataConName = dcQual gHC_TYPES (fsLit "KindRepTyConApp") kindRepTyConAppDataConKey +kindRepVarDataConName = dcQual gHC_TYPES (fsLit "KindRepVar") kindRepVarDataConKey +kindRepAppDataConName = dcQual gHC_TYPES (fsLit "KindRepApp") kindRepAppDataConKey +kindRepFunDataConName = dcQual gHC_TYPES (fsLit "KindRepFun") kindRepFunDataConKey +kindRepTYPEDataConName = dcQual gHC_TYPES (fsLit "KindRepTYPE") kindRepTYPEDataConKey +kindRepTypeLitSDataConName = dcQual gHC_TYPES (fsLit "KindRepTypeLitS") kindRepTypeLitSDataConKey +kindRepTypeLitDDataConName = dcQual gHC_TYPES (fsLit "KindRepTypeLitD") kindRepTypeLitDDataConKey + +typeLitSortTyConName + , typeLitSymbolDataConName + , typeLitNatDataConName + :: Name +typeLitSortTyConName = tcQual gHC_TYPES (fsLit "TypeLitSort") typeLitSortTyConKey +typeLitSymbolDataConName = dcQual gHC_TYPES (fsLit "TypeLitSymbol") typeLitSymbolDataConKey +typeLitNatDataConName = dcQual gHC_TYPES (fsLit "TypeLitNat") typeLitNatDataConKey + +-- Class Typeable, and functions for constructing `Typeable` dictionaries +typeableClassName + , typeRepTyConName + , someTypeRepTyConName + , someTypeRepDataConName + , mkTrTypeName + , mkTrConName + , mkTrAppName + , mkTrFunName + , typeRepIdName + , typeNatTypeRepName + , typeSymbolTypeRepName + , trGhcPrimModuleName + :: Name +typeableClassName = clsQual tYPEABLE_INTERNAL (fsLit "Typeable") typeableClassKey +typeRepTyConName = tcQual tYPEABLE_INTERNAL (fsLit "TypeRep") typeRepTyConKey +someTypeRepTyConName = tcQual tYPEABLE_INTERNAL (fsLit "SomeTypeRep") someTypeRepTyConKey +someTypeRepDataConName = dcQual tYPEABLE_INTERNAL (fsLit "SomeTypeRep") someTypeRepDataConKey +typeRepIdName = varQual tYPEABLE_INTERNAL (fsLit "typeRep#") typeRepIdKey +mkTrTypeName = varQual tYPEABLE_INTERNAL (fsLit "mkTrType") mkTrTypeKey +mkTrConName = varQual tYPEABLE_INTERNAL (fsLit "mkTrCon") mkTrConKey +mkTrAppName = varQual tYPEABLE_INTERNAL (fsLit "mkTrApp") mkTrAppKey +mkTrFunName = varQual tYPEABLE_INTERNAL (fsLit "mkTrFun") mkTrFunKey +typeNatTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeNatTypeRep") typeNatTypeRepKey +typeSymbolTypeRepName = varQual tYPEABLE_INTERNAL (fsLit "typeSymbolTypeRep") typeSymbolTypeRepKey +-- this is the Typeable 'Module' for GHC.Prim (which has no code, so we place in GHC.Types) +-- See Note [Grand plan for Typeable] in GHC.Tc.Instance.Typeable. +trGhcPrimModuleName = varQual gHC_TYPES (fsLit "tr$ModuleGHCPrim") trGhcPrimModuleKey + +-- Typeable KindReps for some common cases +starKindRepName, starArrStarKindRepName, starArrStarArrStarKindRepName :: Name +starKindRepName = varQual gHC_TYPES (fsLit "krep$*") starKindRepKey +starArrStarKindRepName = varQual gHC_TYPES (fsLit "krep$*Arr*") starArrStarKindRepKey +starArrStarArrStarKindRepName = varQual gHC_TYPES (fsLit "krep$*->*->*") starArrStarArrStarKindRepKey + +-- Custom type errors +errorMessageTypeErrorFamName + , typeErrorTextDataConName + , typeErrorAppendDataConName + , typeErrorVAppendDataConName + , typeErrorShowTypeDataConName + :: Name + +errorMessageTypeErrorFamName = + tcQual gHC_TYPELITS (fsLit "TypeError") errorMessageTypeErrorFamKey + +typeErrorTextDataConName = + dcQual gHC_TYPELITS (fsLit "Text") typeErrorTextDataConKey + +typeErrorAppendDataConName = + dcQual gHC_TYPELITS (fsLit ":<>:") typeErrorAppendDataConKey + +typeErrorVAppendDataConName = + dcQual gHC_TYPELITS (fsLit ":$$:") typeErrorVAppendDataConKey + +typeErrorShowTypeDataConName = + dcQual gHC_TYPELITS (fsLit "ShowType") typeErrorShowTypeDataConKey + +-- Unsafe coercion proofs +unsafeEqualityProofName, unsafeEqualityTyConName, unsafeCoercePrimName, + unsafeCoerceName, unsafeReflDataConName :: Name +unsafeEqualityProofName = varQual uNSAFE_COERCE (fsLit "unsafeEqualityProof") unsafeEqualityProofIdKey +unsafeEqualityTyConName = tcQual uNSAFE_COERCE (fsLit "UnsafeEquality") unsafeEqualityTyConKey +unsafeReflDataConName = dcQual uNSAFE_COERCE (fsLit "UnsafeRefl") unsafeReflDataConKey +unsafeCoercePrimName = varQual uNSAFE_COERCE (fsLit "unsafeCoerce#") unsafeCoercePrimIdKey +unsafeCoerceName = varQual uNSAFE_COERCE (fsLit "unsafeCoerce") unsafeCoerceIdKey + +-- Dynamic +toDynName :: Name +toDynName = varQual dYNAMIC (fsLit "toDyn") toDynIdKey + +-- Class Data +dataClassName :: Name +dataClassName = clsQual gENERICS (fsLit "Data") dataClassKey + +-- Error module +assertErrorName :: Name +assertErrorName = varQual gHC_IO_Exception (fsLit "assertError") assertErrorIdKey + +-- Debug.Trace +traceName :: Name +traceName = varQual dEBUG_TRACE (fsLit "trace") traceKey + +-- Enum module (Enum, Bounded) +enumClassName, enumFromName, enumFromToName, enumFromThenName, + enumFromThenToName, boundedClassName :: Name +enumClassName = clsQual gHC_ENUM (fsLit "Enum") enumClassKey +enumFromName = varQual gHC_ENUM (fsLit "enumFrom") enumFromClassOpKey +enumFromToName = varQual gHC_ENUM (fsLit "enumFromTo") enumFromToClassOpKey +enumFromThenName = varQual gHC_ENUM (fsLit "enumFromThen") enumFromThenClassOpKey +enumFromThenToName = varQual gHC_ENUM (fsLit "enumFromThenTo") enumFromThenToClassOpKey +boundedClassName = clsQual gHC_ENUM (fsLit "Bounded") boundedClassKey + +-- List functions +concatName, filterName, zipName :: Name +concatName = varQual gHC_LIST (fsLit "concat") concatIdKey +filterName = varQual gHC_LIST (fsLit "filter") filterIdKey +zipName = varQual gHC_LIST (fsLit "zip") zipIdKey + +-- Overloaded lists +isListClassName, fromListName, fromListNName, toListName :: Name +isListClassName = clsQual gHC_EXTS (fsLit "IsList") isListClassKey +fromListName = varQual gHC_EXTS (fsLit "fromList") fromListClassOpKey +fromListNName = varQual gHC_EXTS (fsLit "fromListN") fromListNClassOpKey +toListName = varQual gHC_EXTS (fsLit "toList") toListClassOpKey + +-- Class Show +showClassName :: Name +showClassName = clsQual gHC_SHOW (fsLit "Show") showClassKey + +-- Class Read +readClassName :: Name +readClassName = clsQual gHC_READ (fsLit "Read") readClassKey + +-- Classes Generic and Generic1, Datatype, Constructor and Selector +genClassName, gen1ClassName, datatypeClassName, constructorClassName, + selectorClassName :: Name +genClassName = clsQual gHC_GENERICS (fsLit "Generic") genClassKey +gen1ClassName = clsQual gHC_GENERICS (fsLit "Generic1") gen1ClassKey + +datatypeClassName = clsQual gHC_GENERICS (fsLit "Datatype") datatypeClassKey +constructorClassName = clsQual gHC_GENERICS (fsLit "Constructor") constructorClassKey +selectorClassName = clsQual gHC_GENERICS (fsLit "Selector") selectorClassKey + +genericClassNames :: [Name] +genericClassNames = [genClassName, gen1ClassName] + +-- GHCi things +ghciIoClassName, ghciStepIoMName :: Name +ghciIoClassName = clsQual gHC_GHCI (fsLit "GHCiSandboxIO") ghciIoClassKey +ghciStepIoMName = varQual gHC_GHCI (fsLit "ghciStepIO") ghciStepIoMClassOpKey + +-- IO things +ioTyConName, ioDataConName, + thenIOName, bindIOName, returnIOName, failIOName :: Name +ioTyConName = tcQual gHC_TYPES (fsLit "IO") ioTyConKey +ioDataConName = dcQual gHC_TYPES (fsLit "IO") ioDataConKey +thenIOName = varQual gHC_BASE (fsLit "thenIO") thenIOIdKey +bindIOName = varQual gHC_BASE (fsLit "bindIO") bindIOIdKey +returnIOName = varQual gHC_BASE (fsLit "returnIO") returnIOIdKey +failIOName = varQual gHC_IO (fsLit "failIO") failIOIdKey + +-- IO things +printName :: Name +printName = varQual sYSTEM_IO (fsLit "print") printIdKey + +-- Int, Word, and Addr things +int8TyConName, int16TyConName, int32TyConName, int64TyConName :: Name +int8TyConName = tcQual gHC_INT (fsLit "Int8") int8TyConKey +int16TyConName = tcQual gHC_INT (fsLit "Int16") int16TyConKey +int32TyConName = tcQual gHC_INT (fsLit "Int32") int32TyConKey +int64TyConName = tcQual gHC_INT (fsLit "Int64") int64TyConKey + +-- Word module +word16TyConName, word32TyConName, word64TyConName :: Name +word16TyConName = tcQual gHC_WORD (fsLit "Word16") word16TyConKey +word32TyConName = tcQual gHC_WORD (fsLit "Word32") word32TyConKey +word64TyConName = tcQual gHC_WORD (fsLit "Word64") word64TyConKey + +-- PrelPtr module +ptrTyConName, funPtrTyConName :: Name +ptrTyConName = tcQual gHC_PTR (fsLit "Ptr") ptrTyConKey +funPtrTyConName = tcQual gHC_PTR (fsLit "FunPtr") funPtrTyConKey + +-- Foreign objects and weak pointers +stablePtrTyConName, newStablePtrName :: Name +stablePtrTyConName = tcQual gHC_STABLE (fsLit "StablePtr") stablePtrTyConKey +newStablePtrName = varQual gHC_STABLE (fsLit "newStablePtr") newStablePtrIdKey + +-- Recursive-do notation +monadFixClassName, mfixName :: Name +monadFixClassName = clsQual mONAD_FIX (fsLit "MonadFix") monadFixClassKey +mfixName = varQual mONAD_FIX (fsLit "mfix") mfixIdKey + +-- Arrow notation +arrAName, composeAName, firstAName, appAName, choiceAName, loopAName :: Name +arrAName = varQual aRROW (fsLit "arr") arrAIdKey +composeAName = varQual gHC_DESUGAR (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 + +-- Monad comprehensions +guardMName, liftMName, mzipName :: Name +guardMName = varQual mONAD (fsLit "guard") guardMIdKey +liftMName = varQual mONAD (fsLit "liftM") liftMIdKey +mzipName = varQual mONAD_ZIP (fsLit "mzip") mzipIdKey + + +-- Annotation type checking +toAnnotationWrapperName :: Name +toAnnotationWrapperName = varQual gHC_DESUGAR (fsLit "toAnnotationWrapper") toAnnotationWrapperIdKey + +-- Other classes, needed for type defaulting +monadPlusClassName, randomClassName, randomGenClassName, + isStringClassName :: Name +monadPlusClassName = clsQual mONAD (fsLit "MonadPlus") monadPlusClassKey +randomClassName = clsQual rANDOM (fsLit "Random") randomClassKey +randomGenClassName = clsQual rANDOM (fsLit "RandomGen") randomGenClassKey +isStringClassName = clsQual dATA_STRING (fsLit "IsString") isStringClassKey + +-- Type-level naturals +knownNatClassName :: Name +knownNatClassName = clsQual gHC_TYPENATS (fsLit "KnownNat") knownNatClassNameKey +knownSymbolClassName :: Name +knownSymbolClassName = clsQual gHC_TYPELITS (fsLit "KnownSymbol") knownSymbolClassNameKey + +-- Overloaded labels +isLabelClassName :: Name +isLabelClassName + = clsQual gHC_OVER_LABELS (fsLit "IsLabel") isLabelClassNameKey + +-- Implicit Parameters +ipClassName :: Name +ipClassName + = clsQual gHC_CLASSES (fsLit "IP") ipClassKey + +-- Overloaded record fields +hasFieldClassName :: Name +hasFieldClassName + = clsQual gHC_RECORDS (fsLit "HasField") hasFieldClassNameKey + +-- Source Locations +callStackTyConName, emptyCallStackName, pushCallStackName, + srcLocDataConName :: Name +callStackTyConName + = tcQual gHC_STACK_TYPES (fsLit "CallStack") callStackTyConKey +emptyCallStackName + = varQual gHC_STACK_TYPES (fsLit "emptyCallStack") emptyCallStackKey +pushCallStackName + = varQual gHC_STACK_TYPES (fsLit "pushCallStack") pushCallStackKey +srcLocDataConName + = dcQual gHC_STACK_TYPES (fsLit "SrcLoc") srcLocDataConKey + +-- plugins +pLUGINS :: Module +pLUGINS = mkThisGhcModule (fsLit "GHC.Driver.Plugins") +pluginTyConName :: Name +pluginTyConName = tcQual pLUGINS (fsLit "Plugin") pluginTyConKey +frontendPluginTyConName :: Name +frontendPluginTyConName = tcQual pLUGINS (fsLit "FrontendPlugin") frontendPluginTyConKey + +-- Static pointers +makeStaticName :: Name +makeStaticName = + varQual gHC_STATICPTR_INTERNAL (fsLit "makeStatic") makeStaticKey + +staticPtrInfoTyConName :: Name +staticPtrInfoTyConName = + tcQual gHC_STATICPTR (fsLit "StaticPtrInfo") staticPtrInfoTyConKey + +staticPtrInfoDataConName :: Name +staticPtrInfoDataConName = + dcQual gHC_STATICPTR (fsLit "StaticPtrInfo") staticPtrInfoDataConKey + +staticPtrTyConName :: Name +staticPtrTyConName = + tcQual gHC_STATICPTR (fsLit "StaticPtr") staticPtrTyConKey + +staticPtrDataConName :: Name +staticPtrDataConName = + dcQual gHC_STATICPTR (fsLit "StaticPtr") staticPtrDataConKey + +fromStaticPtrName :: Name +fromStaticPtrName = + varQual gHC_STATICPTR (fsLit "fromStaticPtr") fromStaticPtrClassOpKey + +fingerprintDataConName :: Name +fingerprintDataConName = + dcQual gHC_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey + +{- +************************************************************************ +* * +\subsection{Local helpers} +* * +************************************************************************ + +All these are original names; hence mkOrig +-} + +varQual, tcQual, clsQual, dcQual :: Module -> FastString -> Unique -> Name +varQual = mk_known_key_name varName +tcQual = mk_known_key_name tcName +clsQual = mk_known_key_name clsName +dcQual = mk_known_key_name dataName + +mk_known_key_name :: NameSpace -> Module -> FastString -> Unique -> Name +mk_known_key_name space modu str unique + = mkExternalName unique modu (mkOccNameFS space str) noSrcSpan + + +{- +************************************************************************ +* * +\subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@} +* * +************************************************************************ +--MetaHaskell extension hand allocate keys here +-} + +boundedClassKey, enumClassKey, eqClassKey, floatingClassKey, + fractionalClassKey, integralClassKey, monadClassKey, dataClassKey, + functorClassKey, numClassKey, ordClassKey, readClassKey, realClassKey, + realFloatClassKey, realFracClassKey, showClassKey, ixClassKey :: Unique +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 :: Unique +typeableClassKey = mkPreludeClassUnique 20 + +monadFixClassKey :: Unique +monadFixClassKey = mkPreludeClassUnique 28 + +monadFailClassKey :: Unique +monadFailClassKey = mkPreludeClassUnique 29 + +monadPlusClassKey, randomClassKey, randomGenClassKey :: Unique +monadPlusClassKey = mkPreludeClassUnique 30 +randomClassKey = mkPreludeClassUnique 31 +randomGenClassKey = mkPreludeClassUnique 32 + +isStringClassKey :: Unique +isStringClassKey = mkPreludeClassUnique 33 + +applicativeClassKey, foldableClassKey, traversableClassKey :: Unique +applicativeClassKey = mkPreludeClassUnique 34 +foldableClassKey = mkPreludeClassUnique 35 +traversableClassKey = mkPreludeClassUnique 36 + +genClassKey, gen1ClassKey, datatypeClassKey, constructorClassKey, + selectorClassKey :: Unique +genClassKey = mkPreludeClassUnique 37 +gen1ClassKey = mkPreludeClassUnique 38 + +datatypeClassKey = mkPreludeClassUnique 39 +constructorClassKey = mkPreludeClassUnique 40 +selectorClassKey = mkPreludeClassUnique 41 + +-- KnownNat: see Note [KnowNat & KnownSymbol and EvLit] in GHC.Tc.Types.Evidence +knownNatClassNameKey :: Unique +knownNatClassNameKey = mkPreludeClassUnique 42 + +-- KnownSymbol: see Note [KnownNat & KnownSymbol and EvLit] in GHC.Tc.Types.Evidence +knownSymbolClassNameKey :: Unique +knownSymbolClassNameKey = mkPreludeClassUnique 43 + +ghciIoClassKey :: Unique +ghciIoClassKey = mkPreludeClassUnique 44 + +isLabelClassNameKey :: Unique +isLabelClassNameKey = mkPreludeClassUnique 45 + +semigroupClassKey, monoidClassKey :: Unique +semigroupClassKey = mkPreludeClassUnique 46 +monoidClassKey = mkPreludeClassUnique 47 + +-- Implicit Parameters +ipClassKey :: Unique +ipClassKey = mkPreludeClassUnique 48 + +-- Overloaded record fields +hasFieldClassNameKey :: Unique +hasFieldClassNameKey = mkPreludeClassUnique 49 + + +---------------- Template Haskell ------------------- +-- GHC.Builtin.Names.TH: USES ClassUniques 200-299 +----------------------------------------------------- + +{- +************************************************************************ +* * +\subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@} +* * +************************************************************************ +-} + +addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey, + byteArrayPrimTyConKey, charPrimTyConKey, charTyConKey, doublePrimTyConKey, + doubleTyConKey, floatPrimTyConKey, floatTyConKey, funTyConKey, + intPrimTyConKey, intTyConKey, int8TyConKey, int16TyConKey, + int8PrimTyConKey, int16PrimTyConKey, int32PrimTyConKey, int32TyConKey, + int64PrimTyConKey, int64TyConKey, + integerTyConKey, naturalTyConKey, + listTyConKey, foreignObjPrimTyConKey, maybeTyConKey, + weakPrimTyConKey, mutableArrayPrimTyConKey, mutableArrayArrayPrimTyConKey, + mutableByteArrayPrimTyConKey, orderingTyConKey, mVarPrimTyConKey, + ratioTyConKey, rationalTyConKey, realWorldTyConKey, stablePtrPrimTyConKey, + stablePtrTyConKey, eqTyConKey, heqTyConKey, + smallArrayPrimTyConKey, smallMutableArrayPrimTyConKey :: Unique +addrPrimTyConKey = mkPreludeTyConUnique 1 +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 +int8PrimTyConKey = mkPreludeTyConUnique 16 +int8TyConKey = mkPreludeTyConUnique 17 +int16PrimTyConKey = mkPreludeTyConUnique 18 +int16TyConKey = mkPreludeTyConUnique 19 +int32PrimTyConKey = mkPreludeTyConUnique 20 +int32TyConKey = mkPreludeTyConUnique 21 +int64PrimTyConKey = mkPreludeTyConUnique 22 +int64TyConKey = mkPreludeTyConUnique 23 +integerTyConKey = mkPreludeTyConUnique 24 +naturalTyConKey = mkPreludeTyConUnique 25 + +listTyConKey = mkPreludeTyConUnique 26 +foreignObjPrimTyConKey = mkPreludeTyConUnique 27 +maybeTyConKey = mkPreludeTyConUnique 28 +weakPrimTyConKey = mkPreludeTyConUnique 29 +mutableArrayPrimTyConKey = mkPreludeTyConUnique 30 +mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 31 +orderingTyConKey = mkPreludeTyConUnique 32 +mVarPrimTyConKey = mkPreludeTyConUnique 33 +ratioTyConKey = mkPreludeTyConUnique 34 +rationalTyConKey = mkPreludeTyConUnique 35 +realWorldTyConKey = mkPreludeTyConUnique 36 +stablePtrPrimTyConKey = mkPreludeTyConUnique 37 +stablePtrTyConKey = mkPreludeTyConUnique 38 +eqTyConKey = mkPreludeTyConUnique 40 +heqTyConKey = mkPreludeTyConUnique 41 +arrayArrayPrimTyConKey = mkPreludeTyConUnique 42 +mutableArrayArrayPrimTyConKey = mkPreludeTyConUnique 43 + +statePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey, + mutVarPrimTyConKey, ioTyConKey, + wordPrimTyConKey, wordTyConKey, word8PrimTyConKey, word8TyConKey, + word16PrimTyConKey, word16TyConKey, word32PrimTyConKey, word32TyConKey, + word64PrimTyConKey, word64TyConKey, + liftedConKey, unliftedConKey, anyBoxConKey, kindConKey, boxityConKey, + typeConKey, threadIdPrimTyConKey, bcoPrimTyConKey, ptrTyConKey, + funPtrTyConKey, tVarPrimTyConKey, eqPrimTyConKey, + eqReprPrimTyConKey, eqPhantPrimTyConKey, voidPrimTyConKey, + compactPrimTyConKey :: Unique +statePrimTyConKey = mkPreludeTyConUnique 50 +stableNamePrimTyConKey = mkPreludeTyConUnique 51 +stableNameTyConKey = mkPreludeTyConUnique 52 +eqPrimTyConKey = mkPreludeTyConUnique 53 +eqReprPrimTyConKey = mkPreludeTyConUnique 54 +eqPhantPrimTyConKey = mkPreludeTyConUnique 55 +mutVarPrimTyConKey = mkPreludeTyConUnique 56 +ioTyConKey = mkPreludeTyConUnique 57 +voidPrimTyConKey = mkPreludeTyConUnique 58 +wordPrimTyConKey = mkPreludeTyConUnique 59 +wordTyConKey = mkPreludeTyConUnique 60 +word8PrimTyConKey = mkPreludeTyConUnique 61 +word8TyConKey = mkPreludeTyConUnique 62 +word16PrimTyConKey = mkPreludeTyConUnique 63 +word16TyConKey = mkPreludeTyConUnique 64 +word32PrimTyConKey = mkPreludeTyConUnique 65 +word32TyConKey = mkPreludeTyConUnique 66 +word64PrimTyConKey = mkPreludeTyConUnique 67 +word64TyConKey = mkPreludeTyConUnique 68 +liftedConKey = mkPreludeTyConUnique 69 +unliftedConKey = mkPreludeTyConUnique 70 +anyBoxConKey = mkPreludeTyConUnique 71 +kindConKey = mkPreludeTyConUnique 72 +boxityConKey = mkPreludeTyConUnique 73 +typeConKey = mkPreludeTyConUnique 74 +threadIdPrimTyConKey = mkPreludeTyConUnique 75 +bcoPrimTyConKey = mkPreludeTyConUnique 76 +ptrTyConKey = mkPreludeTyConUnique 77 +funPtrTyConKey = mkPreludeTyConUnique 78 +tVarPrimTyConKey = mkPreludeTyConUnique 79 +compactPrimTyConKey = mkPreludeTyConUnique 80 + +eitherTyConKey :: Unique +eitherTyConKey = mkPreludeTyConUnique 84 + +-- Kind constructors +liftedTypeKindTyConKey, tYPETyConKey, + constraintKindTyConKey, runtimeRepTyConKey, + vecCountTyConKey, vecElemTyConKey :: Unique +liftedTypeKindTyConKey = mkPreludeTyConUnique 87 +tYPETyConKey = mkPreludeTyConUnique 88 +constraintKindTyConKey = mkPreludeTyConUnique 92 +runtimeRepTyConKey = mkPreludeTyConUnique 95 +vecCountTyConKey = mkPreludeTyConUnique 96 +vecElemTyConKey = mkPreludeTyConUnique 97 + +pluginTyConKey, frontendPluginTyConKey :: Unique +pluginTyConKey = mkPreludeTyConUnique 102 +frontendPluginTyConKey = mkPreludeTyConUnique 103 + +unknownTyConKey, unknown1TyConKey, unknown2TyConKey, unknown3TyConKey, + opaqueTyConKey :: Unique +unknownTyConKey = mkPreludeTyConUnique 129 +unknown1TyConKey = mkPreludeTyConUnique 130 +unknown2TyConKey = mkPreludeTyConUnique 131 +unknown3TyConKey = mkPreludeTyConUnique 132 +opaqueTyConKey = mkPreludeTyConUnique 133 + +-- Generics (Unique keys) +v1TyConKey, u1TyConKey, par1TyConKey, rec1TyConKey, + k1TyConKey, m1TyConKey, sumTyConKey, prodTyConKey, + compTyConKey, rTyConKey, dTyConKey, + cTyConKey, sTyConKey, rec0TyConKey, + d1TyConKey, c1TyConKey, s1TyConKey, noSelTyConKey, + repTyConKey, rep1TyConKey, uRecTyConKey, + uAddrTyConKey, uCharTyConKey, uDoubleTyConKey, + uFloatTyConKey, uIntTyConKey, uWordTyConKey :: Unique + +v1TyConKey = mkPreludeTyConUnique 135 +u1TyConKey = mkPreludeTyConUnique 136 +par1TyConKey = mkPreludeTyConUnique 137 +rec1TyConKey = mkPreludeTyConUnique 138 +k1TyConKey = mkPreludeTyConUnique 139 +m1TyConKey = mkPreludeTyConUnique 140 + +sumTyConKey = mkPreludeTyConUnique 141 +prodTyConKey = mkPreludeTyConUnique 142 +compTyConKey = mkPreludeTyConUnique 143 + +rTyConKey = mkPreludeTyConUnique 144 +dTyConKey = mkPreludeTyConUnique 146 +cTyConKey = mkPreludeTyConUnique 147 +sTyConKey = mkPreludeTyConUnique 148 + +rec0TyConKey = mkPreludeTyConUnique 149 +d1TyConKey = mkPreludeTyConUnique 151 +c1TyConKey = mkPreludeTyConUnique 152 +s1TyConKey = mkPreludeTyConUnique 153 +noSelTyConKey = mkPreludeTyConUnique 154 + +repTyConKey = mkPreludeTyConUnique 155 +rep1TyConKey = mkPreludeTyConUnique 156 + +uRecTyConKey = mkPreludeTyConUnique 157 +uAddrTyConKey = mkPreludeTyConUnique 158 +uCharTyConKey = mkPreludeTyConUnique 159 +uDoubleTyConKey = mkPreludeTyConUnique 160 +uFloatTyConKey = mkPreludeTyConUnique 161 +uIntTyConKey = mkPreludeTyConUnique 162 +uWordTyConKey = mkPreludeTyConUnique 163 + +-- Type-level naturals +typeNatKindConNameKey, typeSymbolKindConNameKey, + typeNatAddTyFamNameKey, typeNatMulTyFamNameKey, typeNatExpTyFamNameKey, + typeNatLeqTyFamNameKey, typeNatSubTyFamNameKey + , typeSymbolCmpTyFamNameKey, typeNatCmpTyFamNameKey + , typeNatDivTyFamNameKey + , typeNatModTyFamNameKey + , typeNatLogTyFamNameKey + :: Unique +typeNatKindConNameKey = mkPreludeTyConUnique 164 +typeSymbolKindConNameKey = mkPreludeTyConUnique 165 +typeNatAddTyFamNameKey = mkPreludeTyConUnique 166 +typeNatMulTyFamNameKey = mkPreludeTyConUnique 167 +typeNatExpTyFamNameKey = mkPreludeTyConUnique 168 +typeNatLeqTyFamNameKey = mkPreludeTyConUnique 169 +typeNatSubTyFamNameKey = mkPreludeTyConUnique 170 +typeSymbolCmpTyFamNameKey = mkPreludeTyConUnique 171 +typeNatCmpTyFamNameKey = mkPreludeTyConUnique 172 +typeNatDivTyFamNameKey = mkPreludeTyConUnique 173 +typeNatModTyFamNameKey = mkPreludeTyConUnique 174 +typeNatLogTyFamNameKey = mkPreludeTyConUnique 175 + +-- Custom user type-errors +errorMessageTypeErrorFamKey :: Unique +errorMessageTypeErrorFamKey = mkPreludeTyConUnique 176 + + + +ntTyConKey:: Unique +ntTyConKey = mkPreludeTyConUnique 177 +coercibleTyConKey :: Unique +coercibleTyConKey = mkPreludeTyConUnique 178 + +proxyPrimTyConKey :: Unique +proxyPrimTyConKey = mkPreludeTyConUnique 179 + +specTyConKey :: Unique +specTyConKey = mkPreludeTyConUnique 180 + +anyTyConKey :: Unique +anyTyConKey = mkPreludeTyConUnique 181 + +smallArrayPrimTyConKey = mkPreludeTyConUnique 182 +smallMutableArrayPrimTyConKey = mkPreludeTyConUnique 183 + +staticPtrTyConKey :: Unique +staticPtrTyConKey = mkPreludeTyConUnique 184 + +staticPtrInfoTyConKey :: Unique +staticPtrInfoTyConKey = mkPreludeTyConUnique 185 + +callStackTyConKey :: Unique +callStackTyConKey = mkPreludeTyConUnique 186 + +-- Typeables +typeRepTyConKey, someTypeRepTyConKey, someTypeRepDataConKey :: Unique +typeRepTyConKey = mkPreludeTyConUnique 187 +someTypeRepTyConKey = mkPreludeTyConUnique 188 +someTypeRepDataConKey = mkPreludeTyConUnique 189 + + +typeSymbolAppendFamNameKey :: Unique +typeSymbolAppendFamNameKey = mkPreludeTyConUnique 190 + +-- Unsafe equality +unsafeEqualityTyConKey :: Unique +unsafeEqualityTyConKey = mkPreludeTyConUnique 191 + + +---------------- Template Haskell ------------------- +-- GHC.Builtin.Names.TH: USES TyConUniques 200-299 +----------------------------------------------------- + +----------------------- SIMD ------------------------ +-- USES TyConUniques 300-399 +----------------------------------------------------- + +#include "primop-vector-uniques.hs-incl" + +{- +************************************************************************ +* * +\subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@} +* * +************************************************************************ +-} + +charDataConKey, consDataConKey, doubleDataConKey, falseDataConKey, + floatDataConKey, intDataConKey, integerSDataConKey, nilDataConKey, + ratioDataConKey, stableNameDataConKey, trueDataConKey, wordDataConKey, + word8DataConKey, ioDataConKey, integerDataConKey, heqDataConKey, + coercibleDataConKey, eqDataConKey, nothingDataConKey, justDataConKey :: Unique + +charDataConKey = mkPreludeDataConUnique 1 +consDataConKey = mkPreludeDataConUnique 2 +doubleDataConKey = mkPreludeDataConUnique 3 +falseDataConKey = mkPreludeDataConUnique 4 +floatDataConKey = mkPreludeDataConUnique 5 +intDataConKey = mkPreludeDataConUnique 6 +integerSDataConKey = mkPreludeDataConUnique 7 +nothingDataConKey = mkPreludeDataConUnique 8 +justDataConKey = mkPreludeDataConUnique 9 +eqDataConKey = mkPreludeDataConUnique 10 +nilDataConKey = mkPreludeDataConUnique 11 +ratioDataConKey = mkPreludeDataConUnique 12 +word8DataConKey = mkPreludeDataConUnique 13 +stableNameDataConKey = mkPreludeDataConUnique 14 +trueDataConKey = mkPreludeDataConUnique 15 +wordDataConKey = mkPreludeDataConUnique 16 +ioDataConKey = mkPreludeDataConUnique 17 +integerDataConKey = mkPreludeDataConUnique 18 +heqDataConKey = mkPreludeDataConUnique 19 + +-- Generic data constructors +crossDataConKey, inlDataConKey, inrDataConKey, genUnitDataConKey :: Unique +crossDataConKey = mkPreludeDataConUnique 20 +inlDataConKey = mkPreludeDataConUnique 21 +inrDataConKey = mkPreludeDataConUnique 22 +genUnitDataConKey = mkPreludeDataConUnique 23 + +leftDataConKey, rightDataConKey :: Unique +leftDataConKey = mkPreludeDataConUnique 25 +rightDataConKey = mkPreludeDataConUnique 26 + +ordLTDataConKey, ordEQDataConKey, ordGTDataConKey :: Unique +ordLTDataConKey = mkPreludeDataConUnique 27 +ordEQDataConKey = mkPreludeDataConUnique 28 +ordGTDataConKey = mkPreludeDataConUnique 29 + + +coercibleDataConKey = mkPreludeDataConUnique 32 + +staticPtrDataConKey :: Unique +staticPtrDataConKey = mkPreludeDataConUnique 33 + +staticPtrInfoDataConKey :: Unique +staticPtrInfoDataConKey = mkPreludeDataConUnique 34 + +fingerprintDataConKey :: Unique +fingerprintDataConKey = mkPreludeDataConUnique 35 + +srcLocDataConKey :: Unique +srcLocDataConKey = mkPreludeDataConUnique 37 + +trTyConTyConKey, trTyConDataConKey, + trModuleTyConKey, trModuleDataConKey, + trNameTyConKey, trNameSDataConKey, trNameDDataConKey, + trGhcPrimModuleKey, kindRepTyConKey, + typeLitSortTyConKey :: Unique +trTyConTyConKey = mkPreludeDataConUnique 40 +trTyConDataConKey = mkPreludeDataConUnique 41 +trModuleTyConKey = mkPreludeDataConUnique 42 +trModuleDataConKey = mkPreludeDataConUnique 43 +trNameTyConKey = mkPreludeDataConUnique 44 +trNameSDataConKey = mkPreludeDataConUnique 45 +trNameDDataConKey = mkPreludeDataConUnique 46 +trGhcPrimModuleKey = mkPreludeDataConUnique 47 +kindRepTyConKey = mkPreludeDataConUnique 48 +typeLitSortTyConKey = mkPreludeDataConUnique 49 + +typeErrorTextDataConKey, + typeErrorAppendDataConKey, + typeErrorVAppendDataConKey, + typeErrorShowTypeDataConKey + :: Unique +typeErrorTextDataConKey = mkPreludeDataConUnique 50 +typeErrorAppendDataConKey = mkPreludeDataConUnique 51 +typeErrorVAppendDataConKey = mkPreludeDataConUnique 52 +typeErrorShowTypeDataConKey = mkPreludeDataConUnique 53 + +prefixIDataConKey, infixIDataConKey, leftAssociativeDataConKey, + rightAssociativeDataConKey, notAssociativeDataConKey, + sourceUnpackDataConKey, sourceNoUnpackDataConKey, + noSourceUnpackednessDataConKey, sourceLazyDataConKey, + sourceStrictDataConKey, noSourceStrictnessDataConKey, + decidedLazyDataConKey, decidedStrictDataConKey, decidedUnpackDataConKey, + metaDataDataConKey, metaConsDataConKey, metaSelDataConKey :: Unique +prefixIDataConKey = mkPreludeDataConUnique 54 +infixIDataConKey = mkPreludeDataConUnique 55 +leftAssociativeDataConKey = mkPreludeDataConUnique 56 +rightAssociativeDataConKey = mkPreludeDataConUnique 57 +notAssociativeDataConKey = mkPreludeDataConUnique 58 +sourceUnpackDataConKey = mkPreludeDataConUnique 59 +sourceNoUnpackDataConKey = mkPreludeDataConUnique 60 +noSourceUnpackednessDataConKey = mkPreludeDataConUnique 61 +sourceLazyDataConKey = mkPreludeDataConUnique 62 +sourceStrictDataConKey = mkPreludeDataConUnique 63 +noSourceStrictnessDataConKey = mkPreludeDataConUnique 64 +decidedLazyDataConKey = mkPreludeDataConUnique 65 +decidedStrictDataConKey = mkPreludeDataConUnique 66 +decidedUnpackDataConKey = mkPreludeDataConUnique 67 +metaDataDataConKey = mkPreludeDataConUnique 68 +metaConsDataConKey = mkPreludeDataConUnique 69 +metaSelDataConKey = mkPreludeDataConUnique 70 + +vecRepDataConKey, tupleRepDataConKey, sumRepDataConKey :: Unique +vecRepDataConKey = mkPreludeDataConUnique 71 +tupleRepDataConKey = mkPreludeDataConUnique 72 +sumRepDataConKey = mkPreludeDataConUnique 73 + +-- See Note [Wiring in RuntimeRep] in GHC.Builtin.Types +runtimeRepSimpleDataConKeys, unliftedSimpleRepDataConKeys, unliftedRepDataConKeys :: [Unique] +liftedRepDataConKey :: Unique +runtimeRepSimpleDataConKeys@(liftedRepDataConKey : unliftedSimpleRepDataConKeys) + = map mkPreludeDataConUnique [74..88] + +unliftedRepDataConKeys = vecRepDataConKey : + tupleRepDataConKey : + sumRepDataConKey : + unliftedSimpleRepDataConKeys + +-- See Note [Wiring in RuntimeRep] in GHC.Builtin.Types +-- VecCount +vecCountDataConKeys :: [Unique] +vecCountDataConKeys = map mkPreludeDataConUnique [89..94] + +-- See Note [Wiring in RuntimeRep] in GHC.Builtin.Types +-- VecElem +vecElemDataConKeys :: [Unique] +vecElemDataConKeys = map mkPreludeDataConUnique [95..104] + +-- Typeable things +kindRepTyConAppDataConKey, kindRepVarDataConKey, kindRepAppDataConKey, + kindRepFunDataConKey, kindRepTYPEDataConKey, + kindRepTypeLitSDataConKey, kindRepTypeLitDDataConKey + :: Unique +kindRepTyConAppDataConKey = mkPreludeDataConUnique 105 +kindRepVarDataConKey = mkPreludeDataConUnique 106 +kindRepAppDataConKey = mkPreludeDataConUnique 107 +kindRepFunDataConKey = mkPreludeDataConUnique 108 +kindRepTYPEDataConKey = mkPreludeDataConUnique 109 +kindRepTypeLitSDataConKey = mkPreludeDataConUnique 110 +kindRepTypeLitDDataConKey = mkPreludeDataConUnique 111 + +typeLitSymbolDataConKey, typeLitNatDataConKey :: Unique +typeLitSymbolDataConKey = mkPreludeDataConUnique 112 +typeLitNatDataConKey = mkPreludeDataConUnique 113 + +-- Unsafe equality +unsafeReflDataConKey :: Unique +unsafeReflDataConKey = mkPreludeDataConUnique 114 + +---------------- Template Haskell ------------------- +-- GHC.Builtin.Names.TH: USES DataUniques 200-250 +----------------------------------------------------- + + +{- +************************************************************************ +* * +\subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)} +* * +************************************************************************ +-} + +wildCardKey, absentErrorIdKey, augmentIdKey, appendIdKey, + buildIdKey, errorIdKey, foldrIdKey, recSelErrorIdKey, + seqIdKey, eqStringIdKey, + noMethodBindingErrorIdKey, nonExhaustiveGuardsErrorIdKey, + runtimeErrorIdKey, patErrorIdKey, voidPrimIdKey, + realWorldPrimIdKey, recConErrorIdKey, + unpackCStringUtf8IdKey, unpackCStringAppendIdKey, + unpackCStringFoldrIdKey, unpackCStringIdKey, + typeErrorIdKey, divIntIdKey, modIntIdKey, + absentSumFieldErrorIdKey :: Unique + +wildCardKey = mkPreludeMiscIdUnique 0 -- See Note [WildCard binders] +absentErrorIdKey = mkPreludeMiscIdUnique 1 +augmentIdKey = mkPreludeMiscIdUnique 2 +appendIdKey = mkPreludeMiscIdUnique 3 +buildIdKey = mkPreludeMiscIdUnique 4 +errorIdKey = mkPreludeMiscIdUnique 5 +foldrIdKey = mkPreludeMiscIdUnique 6 +recSelErrorIdKey = mkPreludeMiscIdUnique 7 +seqIdKey = mkPreludeMiscIdUnique 8 +absentSumFieldErrorIdKey = mkPreludeMiscIdUnique 9 +eqStringIdKey = mkPreludeMiscIdUnique 10 +noMethodBindingErrorIdKey = mkPreludeMiscIdUnique 11 +nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 12 +runtimeErrorIdKey = mkPreludeMiscIdUnique 13 +patErrorIdKey = mkPreludeMiscIdUnique 14 +realWorldPrimIdKey = mkPreludeMiscIdUnique 15 +recConErrorIdKey = mkPreludeMiscIdUnique 16 +unpackCStringUtf8IdKey = mkPreludeMiscIdUnique 17 +unpackCStringAppendIdKey = mkPreludeMiscIdUnique 18 +unpackCStringFoldrIdKey = mkPreludeMiscIdUnique 19 +unpackCStringIdKey = mkPreludeMiscIdUnique 20 +voidPrimIdKey = mkPreludeMiscIdUnique 21 +typeErrorIdKey = mkPreludeMiscIdUnique 22 +divIntIdKey = mkPreludeMiscIdUnique 23 +modIntIdKey = mkPreludeMiscIdUnique 24 + +concatIdKey, filterIdKey, zipIdKey, + bindIOIdKey, returnIOIdKey, newStablePtrIdKey, + printIdKey, failIOIdKey, nullAddrIdKey, voidArgIdKey, + fstIdKey, sndIdKey, otherwiseIdKey, assertIdKey :: Unique +concatIdKey = mkPreludeMiscIdUnique 31 +filterIdKey = mkPreludeMiscIdUnique 32 +zipIdKey = mkPreludeMiscIdUnique 33 +bindIOIdKey = mkPreludeMiscIdUnique 34 +returnIOIdKey = mkPreludeMiscIdUnique 35 +newStablePtrIdKey = mkPreludeMiscIdUnique 36 +printIdKey = mkPreludeMiscIdUnique 37 +failIOIdKey = mkPreludeMiscIdUnique 38 +nullAddrIdKey = mkPreludeMiscIdUnique 39 +voidArgIdKey = mkPreludeMiscIdUnique 40 +fstIdKey = mkPreludeMiscIdUnique 41 +sndIdKey = mkPreludeMiscIdUnique 42 +otherwiseIdKey = mkPreludeMiscIdUnique 43 +assertIdKey = mkPreludeMiscIdUnique 44 + +mkIntegerIdKey, smallIntegerIdKey, wordToIntegerIdKey, + integerToWordIdKey, integerToIntIdKey, + integerToWord64IdKey, integerToInt64IdKey, + word64ToIntegerIdKey, int64ToIntegerIdKey, + plusIntegerIdKey, timesIntegerIdKey, minusIntegerIdKey, + negateIntegerIdKey, + eqIntegerPrimIdKey, neqIntegerPrimIdKey, absIntegerIdKey, signumIntegerIdKey, + leIntegerPrimIdKey, gtIntegerPrimIdKey, ltIntegerPrimIdKey, geIntegerPrimIdKey, + compareIntegerIdKey, quotRemIntegerIdKey, divModIntegerIdKey, + quotIntegerIdKey, remIntegerIdKey, divIntegerIdKey, modIntegerIdKey, + floatFromIntegerIdKey, doubleFromIntegerIdKey, + encodeFloatIntegerIdKey, encodeDoubleIntegerIdKey, + decodeDoubleIntegerIdKey, + gcdIntegerIdKey, lcmIntegerIdKey, + andIntegerIdKey, orIntegerIdKey, xorIntegerIdKey, complementIntegerIdKey, + shiftLIntegerIdKey, shiftRIntegerIdKey :: Unique +mkIntegerIdKey = mkPreludeMiscIdUnique 60 +smallIntegerIdKey = mkPreludeMiscIdUnique 61 +integerToWordIdKey = mkPreludeMiscIdUnique 62 +integerToIntIdKey = mkPreludeMiscIdUnique 63 +integerToWord64IdKey = mkPreludeMiscIdUnique 64 +integerToInt64IdKey = mkPreludeMiscIdUnique 65 +plusIntegerIdKey = mkPreludeMiscIdUnique 66 +timesIntegerIdKey = mkPreludeMiscIdUnique 67 +minusIntegerIdKey = mkPreludeMiscIdUnique 68 +negateIntegerIdKey = mkPreludeMiscIdUnique 69 +eqIntegerPrimIdKey = mkPreludeMiscIdUnique 70 +neqIntegerPrimIdKey = mkPreludeMiscIdUnique 71 +absIntegerIdKey = mkPreludeMiscIdUnique 72 +signumIntegerIdKey = mkPreludeMiscIdUnique 73 +leIntegerPrimIdKey = mkPreludeMiscIdUnique 74 +gtIntegerPrimIdKey = mkPreludeMiscIdUnique 75 +ltIntegerPrimIdKey = mkPreludeMiscIdUnique 76 +geIntegerPrimIdKey = mkPreludeMiscIdUnique 77 +compareIntegerIdKey = mkPreludeMiscIdUnique 78 +quotIntegerIdKey = mkPreludeMiscIdUnique 79 +remIntegerIdKey = mkPreludeMiscIdUnique 80 +divIntegerIdKey = mkPreludeMiscIdUnique 81 +modIntegerIdKey = mkPreludeMiscIdUnique 82 +divModIntegerIdKey = mkPreludeMiscIdUnique 83 +quotRemIntegerIdKey = mkPreludeMiscIdUnique 84 +floatFromIntegerIdKey = mkPreludeMiscIdUnique 85 +doubleFromIntegerIdKey = mkPreludeMiscIdUnique 86 +encodeFloatIntegerIdKey = mkPreludeMiscIdUnique 87 +encodeDoubleIntegerIdKey = mkPreludeMiscIdUnique 88 +gcdIntegerIdKey = mkPreludeMiscIdUnique 89 +lcmIntegerIdKey = mkPreludeMiscIdUnique 90 +andIntegerIdKey = mkPreludeMiscIdUnique 91 +orIntegerIdKey = mkPreludeMiscIdUnique 92 +xorIntegerIdKey = mkPreludeMiscIdUnique 93 +complementIntegerIdKey = mkPreludeMiscIdUnique 94 +shiftLIntegerIdKey = mkPreludeMiscIdUnique 95 +shiftRIntegerIdKey = mkPreludeMiscIdUnique 96 +wordToIntegerIdKey = mkPreludeMiscIdUnique 97 +word64ToIntegerIdKey = mkPreludeMiscIdUnique 98 +int64ToIntegerIdKey = mkPreludeMiscIdUnique 99 +decodeDoubleIntegerIdKey = mkPreludeMiscIdUnique 100 + +rootMainKey, runMainKey :: Unique +rootMainKey = mkPreludeMiscIdUnique 101 +runMainKey = mkPreludeMiscIdUnique 102 + +thenIOIdKey, lazyIdKey, assertErrorIdKey, oneShotKey, runRWKey :: Unique +thenIOIdKey = mkPreludeMiscIdUnique 103 +lazyIdKey = mkPreludeMiscIdUnique 104 +assertErrorIdKey = mkPreludeMiscIdUnique 105 +oneShotKey = mkPreludeMiscIdUnique 106 +runRWKey = mkPreludeMiscIdUnique 107 + +traceKey :: Unique +traceKey = mkPreludeMiscIdUnique 108 + +breakpointIdKey, breakpointCondIdKey :: Unique +breakpointIdKey = mkPreludeMiscIdUnique 110 +breakpointCondIdKey = mkPreludeMiscIdUnique 111 + +inlineIdKey, noinlineIdKey :: Unique +inlineIdKey = mkPreludeMiscIdUnique 120 +-- see below + +mapIdKey, groupWithIdKey, dollarIdKey :: Unique +mapIdKey = mkPreludeMiscIdUnique 121 +groupWithIdKey = mkPreludeMiscIdUnique 122 +dollarIdKey = mkPreludeMiscIdUnique 123 + +coercionTokenIdKey :: Unique +coercionTokenIdKey = mkPreludeMiscIdUnique 124 + +noinlineIdKey = mkPreludeMiscIdUnique 125 + +rationalToFloatIdKey, rationalToDoubleIdKey :: Unique +rationalToFloatIdKey = mkPreludeMiscIdUnique 130 +rationalToDoubleIdKey = mkPreludeMiscIdUnique 131 + +magicDictKey :: Unique +magicDictKey = mkPreludeMiscIdUnique 156 + +coerceKey :: Unique +coerceKey = mkPreludeMiscIdUnique 157 + +{- +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. +-} + +-- Just a placeholder for unbound variables produced by the renamer: +unboundKey :: Unique +unboundKey = mkPreludeMiscIdUnique 158 + +fromIntegerClassOpKey, minusClassOpKey, fromRationalClassOpKey, + enumFromClassOpKey, enumFromThenClassOpKey, enumFromToClassOpKey, + enumFromThenToClassOpKey, eqClassOpKey, geClassOpKey, negateClassOpKey, + bindMClassOpKey, thenMClassOpKey, returnMClassOpKey, fmapClassOpKey + :: Unique +fromIntegerClassOpKey = mkPreludeMiscIdUnique 160 +minusClassOpKey = mkPreludeMiscIdUnique 161 +fromRationalClassOpKey = mkPreludeMiscIdUnique 162 +enumFromClassOpKey = mkPreludeMiscIdUnique 163 +enumFromThenClassOpKey = mkPreludeMiscIdUnique 164 +enumFromToClassOpKey = mkPreludeMiscIdUnique 165 +enumFromThenToClassOpKey = mkPreludeMiscIdUnique 166 +eqClassOpKey = mkPreludeMiscIdUnique 167 +geClassOpKey = mkPreludeMiscIdUnique 168 +negateClassOpKey = mkPreludeMiscIdUnique 169 +bindMClassOpKey = mkPreludeMiscIdUnique 171 -- (>>=) +thenMClassOpKey = mkPreludeMiscIdUnique 172 -- (>>) +fmapClassOpKey = mkPreludeMiscIdUnique 173 +returnMClassOpKey = mkPreludeMiscIdUnique 174 + +-- Recursive do notation +mfixIdKey :: Unique +mfixIdKey = mkPreludeMiscIdUnique 175 + +-- MonadFail operations +failMClassOpKey :: Unique +failMClassOpKey = mkPreludeMiscIdUnique 176 + +-- Arrow notation +arrAIdKey, composeAIdKey, firstAIdKey, appAIdKey, choiceAIdKey, + loopAIdKey :: Unique +arrAIdKey = mkPreludeMiscIdUnique 180 +composeAIdKey = mkPreludeMiscIdUnique 181 -- >>> +firstAIdKey = mkPreludeMiscIdUnique 182 +appAIdKey = mkPreludeMiscIdUnique 183 +choiceAIdKey = mkPreludeMiscIdUnique 184 -- ||| +loopAIdKey = mkPreludeMiscIdUnique 185 + +fromStringClassOpKey :: Unique +fromStringClassOpKey = mkPreludeMiscIdUnique 186 + +-- Annotation type checking +toAnnotationWrapperIdKey :: Unique +toAnnotationWrapperIdKey = mkPreludeMiscIdUnique 187 + +-- Conversion functions +fromIntegralIdKey, realToFracIdKey, toIntegerClassOpKey, toRationalClassOpKey :: Unique +fromIntegralIdKey = mkPreludeMiscIdUnique 190 +realToFracIdKey = mkPreludeMiscIdUnique 191 +toIntegerClassOpKey = mkPreludeMiscIdUnique 192 +toRationalClassOpKey = mkPreludeMiscIdUnique 193 + +-- Monad comprehensions +guardMIdKey, liftMIdKey, mzipIdKey :: Unique +guardMIdKey = mkPreludeMiscIdUnique 194 +liftMIdKey = mkPreludeMiscIdUnique 195 +mzipIdKey = mkPreludeMiscIdUnique 196 + +-- GHCi +ghciStepIoMClassOpKey :: Unique +ghciStepIoMClassOpKey = mkPreludeMiscIdUnique 197 + +-- Overloaded lists +isListClassKey, fromListClassOpKey, fromListNClassOpKey, toListClassOpKey :: Unique +isListClassKey = mkPreludeMiscIdUnique 198 +fromListClassOpKey = mkPreludeMiscIdUnique 199 +fromListNClassOpKey = mkPreludeMiscIdUnique 500 +toListClassOpKey = mkPreludeMiscIdUnique 501 + +proxyHashKey :: Unique +proxyHashKey = mkPreludeMiscIdUnique 502 + +---------------- Template Haskell ------------------- +-- GHC.Builtin.Names.TH: USES IdUniques 200-499 +----------------------------------------------------- + +-- Used to make `Typeable` dictionaries +mkTyConKey + , mkTrTypeKey + , mkTrConKey + , mkTrAppKey + , mkTrFunKey + , typeNatTypeRepKey + , typeSymbolTypeRepKey + , typeRepIdKey + :: Unique +mkTyConKey = mkPreludeMiscIdUnique 503 +mkTrTypeKey = mkPreludeMiscIdUnique 504 +mkTrConKey = mkPreludeMiscIdUnique 505 +mkTrAppKey = mkPreludeMiscIdUnique 506 +typeNatTypeRepKey = mkPreludeMiscIdUnique 507 +typeSymbolTypeRepKey = mkPreludeMiscIdUnique 508 +typeRepIdKey = mkPreludeMiscIdUnique 509 +mkTrFunKey = mkPreludeMiscIdUnique 510 + +-- Representations for primitive types +trTYPEKey + ,trTYPE'PtrRepLiftedKey + , trRuntimeRepKey + , tr'PtrRepLiftedKey + :: Unique +trTYPEKey = mkPreludeMiscIdUnique 511 +trTYPE'PtrRepLiftedKey = mkPreludeMiscIdUnique 512 +trRuntimeRepKey = mkPreludeMiscIdUnique 513 +tr'PtrRepLiftedKey = mkPreludeMiscIdUnique 514 + +-- KindReps for common cases +starKindRepKey, starArrStarKindRepKey, starArrStarArrStarKindRepKey :: Unique +starKindRepKey = mkPreludeMiscIdUnique 520 +starArrStarKindRepKey = mkPreludeMiscIdUnique 521 +starArrStarArrStarKindRepKey = mkPreludeMiscIdUnique 522 + +-- Dynamic +toDynIdKey :: Unique +toDynIdKey = mkPreludeMiscIdUnique 523 + + +bitIntegerIdKey :: Unique +bitIntegerIdKey = mkPreludeMiscIdUnique 550 + +heqSCSelIdKey, eqSCSelIdKey, coercibleSCSelIdKey :: Unique +eqSCSelIdKey = mkPreludeMiscIdUnique 551 +heqSCSelIdKey = mkPreludeMiscIdUnique 552 +coercibleSCSelIdKey = mkPreludeMiscIdUnique 553 + +sappendClassOpKey :: Unique +sappendClassOpKey = mkPreludeMiscIdUnique 554 + +memptyClassOpKey, mappendClassOpKey, mconcatClassOpKey :: Unique +memptyClassOpKey = mkPreludeMiscIdUnique 555 +mappendClassOpKey = mkPreludeMiscIdUnique 556 +mconcatClassOpKey = mkPreludeMiscIdUnique 557 + +emptyCallStackKey, pushCallStackKey :: Unique +emptyCallStackKey = mkPreludeMiscIdUnique 558 +pushCallStackKey = mkPreludeMiscIdUnique 559 + +fromStaticPtrClassOpKey :: Unique +fromStaticPtrClassOpKey = mkPreludeMiscIdUnique 560 + +makeStaticKey :: Unique +makeStaticKey = mkPreludeMiscIdUnique 561 + +-- Natural +naturalFromIntegerIdKey, naturalToIntegerIdKey, plusNaturalIdKey, + minusNaturalIdKey, timesNaturalIdKey, mkNaturalIdKey, + naturalSDataConKey, wordToNaturalIdKey :: Unique +naturalFromIntegerIdKey = mkPreludeMiscIdUnique 562 +naturalToIntegerIdKey = mkPreludeMiscIdUnique 563 +plusNaturalIdKey = mkPreludeMiscIdUnique 564 +minusNaturalIdKey = mkPreludeMiscIdUnique 565 +timesNaturalIdKey = mkPreludeMiscIdUnique 566 +mkNaturalIdKey = mkPreludeMiscIdUnique 567 +naturalSDataConKey = mkPreludeMiscIdUnique 568 +wordToNaturalIdKey = mkPreludeMiscIdUnique 569 + +-- Unsafe coercion proofs +unsafeEqualityProofIdKey, unsafeCoercePrimIdKey, unsafeCoerceIdKey :: Unique +unsafeEqualityProofIdKey = mkPreludeMiscIdUnique 570 +unsafeCoercePrimIdKey = mkPreludeMiscIdUnique 571 +unsafeCoerceIdKey = mkPreludeMiscIdUnique 572 + +{- +************************************************************************ +* * +\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. +-} + +numericClassKeys :: [Unique] +numericClassKeys = + [ numClassKey + , realClassKey + , integralClassKey + ] + ++ fractionalClassKeys + +fractionalClassKeys :: [Unique] +fractionalClassKeys = + [ fractionalClassKey + , floatingClassKey + , realFracClassKey + , realFloatClassKey + ] + +-- 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 :: [Unique] +standardClassKeys = derivableClassKeys ++ numericClassKeys + ++ [randomClassKey, randomGenClassKey, + functorClassKey, + monadClassKey, monadPlusClassKey, monadFailClassKey, + semigroupClassKey, monoidClassKey, + isStringClassKey, + applicativeClassKey, foldableClassKey, + traversableClassKey, alternativeClassKey + ] + +{- +@derivableClassKeys@ is also used in checking \tr{deriving} constructs +(@GHC.Tc.Deriv@). +-} + +derivableClassKeys :: [Unique] +derivableClassKeys + = [ eqClassKey, ordClassKey, enumClassKey, ixClassKey, + boundedClassKey, showClassKey, readClassKey ] + + +-- These are the "interactive classes" that are consulted when doing +-- defaulting. Does not include Num or IsString, which have special +-- handling. +interactiveClassNames :: [Name] +interactiveClassNames + = [ showClassName, eqClassName, ordClassName, foldableClassName + , traversableClassName ] + +interactiveClassKeys :: [Unique] +interactiveClassKeys = map getUnique interactiveClassNames + +{- +************************************************************************ +* * + Semi-builtin names +* * +************************************************************************ + +The following names should be considered by GHCi to be in scope always. + +-} + +pretendNameIsInScope :: Name -> Bool +pretendNameIsInScope n + = any (n `hasKey`) + [ liftedTypeKindTyConKey, tYPETyConKey + , runtimeRepTyConKey, liftedRepDataConKey ] diff --git a/compiler/GHC/Builtin/Names.hs-boot b/compiler/GHC/Builtin/Names.hs-boot new file mode 100644 index 0000000000..8dcd62e716 --- /dev/null +++ b/compiler/GHC/Builtin/Names.hs-boot @@ -0,0 +1,7 @@ +module GHC.Builtin.Names where + +import GHC.Types.Module +import GHC.Types.Unique + +mAIN :: Module +liftedTypeKindTyConKey :: Unique diff --git a/compiler/GHC/Builtin/Names/TH.hs b/compiler/GHC/Builtin/Names/TH.hs new file mode 100644 index 0000000000..7f83cd7521 --- /dev/null +++ b/compiler/GHC/Builtin/Names/TH.hs @@ -0,0 +1,1093 @@ +-- %************************************************************************ +-- %* * +-- The known-key names for Template Haskell +-- %* * +-- %************************************************************************ + +module GHC.Builtin.Names.TH where + +import GhcPrelude () + +import GHC.Builtin.Names( mk_known_key_name ) +import GHC.Types.Module( Module, mkModuleNameFS, mkModule, thUnitId ) +import GHC.Types.Name( Name ) +import GHC.Types.Name.Occurrence( tcName, clsName, dataName, varName ) +import GHC.Types.Name.Reader( RdrName, nameRdrName ) +import GHC.Types.Unique +import FastString + +-- To add a name, do three things +-- +-- 1) Allocate a key +-- 2) Make a "Name" +-- 3) Add the name to templateHaskellNames + +templateHaskellNames :: [Name] +-- The names that are implicitly mentioned by ``bracket'' +-- Should stay in sync with the import list of GHC.HsToCore.Quote + +templateHaskellNames = [ + returnQName, bindQName, sequenceQName, newNameName, liftName, liftTypedName, + mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName, + mkNameSName, + liftStringName, + unTypeName, + unTypeQName, + unsafeTExpCoerceName, + + -- Lit + charLName, stringLName, integerLName, intPrimLName, wordPrimLName, + floatPrimLName, doublePrimLName, rationalLName, stringPrimLName, + charPrimLName, + -- Pat + litPName, varPName, tupPName, unboxedTupPName, unboxedSumPName, + conPName, tildePName, bangPName, infixPName, + asPName, wildPName, recPName, listPName, sigPName, viewPName, + -- FieldPat + fieldPatName, + -- Match + matchName, + -- Clause + clauseName, + -- Exp + varEName, conEName, litEName, appEName, appTypeEName, infixEName, + infixAppName, sectionLName, sectionRName, lamEName, lamCaseEName, + tupEName, unboxedTupEName, unboxedSumEName, + condEName, multiIfEName, letEName, caseEName, doEName, mdoEName, compEName, + fromEName, fromThenEName, fromToEName, fromThenToEName, + listEName, sigEName, recConEName, recUpdEName, staticEName, unboundVarEName, + labelEName, implicitParamVarEName, + -- FieldExp + fieldExpName, + -- Body + guardedBName, normalBName, + -- Guard + normalGEName, patGEName, + -- Stmt + bindSName, letSName, noBindSName, parSName, recSName, + -- Dec + funDName, valDName, dataDName, newtypeDName, tySynDName, + classDName, instanceWithOverlapDName, + standaloneDerivWithStrategyDName, sigDName, kiSigDName, forImpDName, + pragInlDName, pragSpecDName, pragSpecInlDName, pragSpecInstDName, + pragRuleDName, pragCompleteDName, pragAnnDName, defaultSigDName, + dataFamilyDName, openTypeFamilyDName, closedTypeFamilyDName, + dataInstDName, newtypeInstDName, tySynInstDName, + infixLDName, infixRDName, infixNDName, + roleAnnotDName, patSynDName, patSynSigDName, + implicitParamBindDName, + -- Cxt + cxtName, + + -- SourceUnpackedness + noSourceUnpackednessName, sourceNoUnpackName, sourceUnpackName, + -- SourceStrictness + noSourceStrictnessName, sourceLazyName, sourceStrictName, + -- Con + normalCName, recCName, infixCName, forallCName, gadtCName, recGadtCName, + -- Bang + bangName, + -- BangType + bangTypeName, + -- VarBangType + varBangTypeName, + -- PatSynDir (for pattern synonyms) + unidirPatSynName, implBidirPatSynName, explBidirPatSynName, + -- PatSynArgs (for pattern synonyms) + prefixPatSynName, infixPatSynName, recordPatSynName, + -- Type + forallTName, forallVisTName, varTName, conTName, infixTName, appTName, + appKindTName, equalityTName, tupleTName, unboxedTupleTName, + unboxedSumTName, arrowTName, listTName, sigTName, litTName, + promotedTName, promotedTupleTName, promotedNilTName, promotedConsTName, + wildCardTName, implicitParamTName, + -- TyLit + numTyLitName, strTyLitName, + -- TyVarBndr + plainTVName, kindedTVName, + -- Role + nominalRName, representationalRName, phantomRName, inferRName, + -- Kind + starKName, constraintKName, + -- FamilyResultSig + noSigName, kindSigName, tyVarSigName, + -- InjectivityAnn + injectivityAnnName, + -- Callconv + cCallName, stdCallName, cApiCallName, primCallName, javaScriptCallName, + -- Safety + unsafeName, + safeName, + interruptibleName, + -- Inline + noInlineDataConName, inlineDataConName, inlinableDataConName, + -- RuleMatch + conLikeDataConName, funLikeDataConName, + -- Phases + allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName, + -- Overlap + overlappableDataConName, overlappingDataConName, overlapsDataConName, + incoherentDataConName, + -- DerivStrategy + stockStrategyName, anyclassStrategyName, + newtypeStrategyName, viaStrategyName, + -- TExp + tExpDataConName, + -- RuleBndr + ruleVarName, typedRuleVarName, + -- FunDep + funDepName, + -- TySynEqn + tySynEqnName, + -- AnnTarget + valueAnnotationName, typeAnnotationName, moduleAnnotationName, + -- DerivClause + derivClauseName, + + -- The type classes + liftClassName, quoteClassName, + + -- And the tycons + qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchTyConName, + expQTyConName, fieldExpTyConName, predTyConName, + stmtTyConName, decsTyConName, conTyConName, bangTypeTyConName, + varBangTypeTyConName, typeQTyConName, expTyConName, decTyConName, + typeTyConName, tyVarBndrTyConName, clauseTyConName, + patQTyConName, funDepTyConName, decsQTyConName, + ruleBndrTyConName, tySynEqnTyConName, + roleTyConName, tExpTyConName, injAnnTyConName, kindTyConName, + overlapTyConName, derivClauseTyConName, derivStrategyTyConName, + + -- Quasiquoting + quoteDecName, quoteTypeName, quoteExpName, quotePatName] + +thSyn, thLib, qqLib :: Module +thSyn = mkTHModule (fsLit "Language.Haskell.TH.Syntax") +thLib = mkTHModule (fsLit "Language.Haskell.TH.Lib.Internal") +qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote") + +mkTHModule :: FastString -> Module +mkTHModule m = mkModule thUnitId (mkModuleNameFS m) + +libFun, libTc, thFun, thTc, thCls, thCon, qqFun :: FastString -> Unique -> Name +libFun = mk_known_key_name varName thLib +libTc = mk_known_key_name tcName thLib +thFun = mk_known_key_name varName thSyn +thTc = mk_known_key_name tcName thSyn +thCls = mk_known_key_name clsName thSyn +thCon = mk_known_key_name dataName thSyn +qqFun = mk_known_key_name varName qqLib + +-------------------- TH.Syntax ----------------------- +liftClassName :: Name +liftClassName = thCls (fsLit "Lift") liftClassKey + +quoteClassName :: Name +quoteClassName = thCls (fsLit "Quote") quoteClassKey + +qTyConName, nameTyConName, fieldExpTyConName, patTyConName, + fieldPatTyConName, expTyConName, decTyConName, typeTyConName, + matchTyConName, clauseTyConName, funDepTyConName, predTyConName, + tExpTyConName, injAnnTyConName, overlapTyConName, decsTyConName :: Name +qTyConName = thTc (fsLit "Q") qTyConKey +nameTyConName = thTc (fsLit "Name") nameTyConKey +fieldExpTyConName = thTc (fsLit "FieldExp") fieldExpTyConKey +patTyConName = thTc (fsLit "Pat") patTyConKey +fieldPatTyConName = thTc (fsLit "FieldPat") fieldPatTyConKey +expTyConName = thTc (fsLit "Exp") expTyConKey +decTyConName = thTc (fsLit "Dec") decTyConKey +decsTyConName = libTc (fsLit "Decs") decsTyConKey +typeTyConName = thTc (fsLit "Type") typeTyConKey +matchTyConName = thTc (fsLit "Match") matchTyConKey +clauseTyConName = thTc (fsLit "Clause") clauseTyConKey +funDepTyConName = thTc (fsLit "FunDep") funDepTyConKey +predTyConName = thTc (fsLit "Pred") predTyConKey +tExpTyConName = thTc (fsLit "TExp") tExpTyConKey +injAnnTyConName = thTc (fsLit "InjectivityAnn") injAnnTyConKey +overlapTyConName = thTc (fsLit "Overlap") overlapTyConKey + +returnQName, bindQName, sequenceQName, newNameName, liftName, + mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, + mkNameLName, mkNameSName, liftStringName, unTypeName, unTypeQName, + unsafeTExpCoerceName, liftTypedName :: Name +returnQName = thFun (fsLit "returnQ") returnQIdKey +bindQName = thFun (fsLit "bindQ") bindQIdKey +sequenceQName = thFun (fsLit "sequenceQ") sequenceQIdKey +newNameName = thFun (fsLit "newName") newNameIdKey +liftName = thFun (fsLit "lift") liftIdKey +liftStringName = thFun (fsLit "liftString") liftStringIdKey +mkNameName = thFun (fsLit "mkName") mkNameIdKey +mkNameG_vName = thFun (fsLit "mkNameG_v") mkNameG_vIdKey +mkNameG_dName = thFun (fsLit "mkNameG_d") mkNameG_dIdKey +mkNameG_tcName = thFun (fsLit "mkNameG_tc") mkNameG_tcIdKey +mkNameLName = thFun (fsLit "mkNameL") mkNameLIdKey +mkNameSName = thFun (fsLit "mkNameS") mkNameSIdKey +unTypeName = thFun (fsLit "unType") unTypeIdKey +unTypeQName = thFun (fsLit "unTypeQ") unTypeQIdKey +unsafeTExpCoerceName = thFun (fsLit "unsafeTExpCoerce") unsafeTExpCoerceIdKey +liftTypedName = thFun (fsLit "liftTyped") liftTypedIdKey + + +-------------------- TH.Lib ----------------------- +-- data Lit = ... +charLName, stringLName, integerLName, intPrimLName, wordPrimLName, + floatPrimLName, doublePrimLName, rationalLName, stringPrimLName, + charPrimLName :: Name +charLName = libFun (fsLit "charL") charLIdKey +stringLName = libFun (fsLit "stringL") stringLIdKey +integerLName = libFun (fsLit "integerL") integerLIdKey +intPrimLName = libFun (fsLit "intPrimL") intPrimLIdKey +wordPrimLName = libFun (fsLit "wordPrimL") wordPrimLIdKey +floatPrimLName = libFun (fsLit "floatPrimL") floatPrimLIdKey +doublePrimLName = libFun (fsLit "doublePrimL") doublePrimLIdKey +rationalLName = libFun (fsLit "rationalL") rationalLIdKey +stringPrimLName = libFun (fsLit "stringPrimL") stringPrimLIdKey +charPrimLName = libFun (fsLit "charPrimL") charPrimLIdKey + +-- data Pat = ... +litPName, varPName, tupPName, unboxedTupPName, unboxedSumPName, conPName, + infixPName, tildePName, bangPName, asPName, wildPName, recPName, listPName, + sigPName, viewPName :: Name +litPName = libFun (fsLit "litP") litPIdKey +varPName = libFun (fsLit "varP") varPIdKey +tupPName = libFun (fsLit "tupP") tupPIdKey +unboxedTupPName = libFun (fsLit "unboxedTupP") unboxedTupPIdKey +unboxedSumPName = libFun (fsLit "unboxedSumP") unboxedSumPIdKey +conPName = libFun (fsLit "conP") conPIdKey +infixPName = libFun (fsLit "infixP") infixPIdKey +tildePName = libFun (fsLit "tildeP") tildePIdKey +bangPName = libFun (fsLit "bangP") bangPIdKey +asPName = libFun (fsLit "asP") asPIdKey +wildPName = libFun (fsLit "wildP") wildPIdKey +recPName = libFun (fsLit "recP") recPIdKey +listPName = libFun (fsLit "listP") listPIdKey +sigPName = libFun (fsLit "sigP") sigPIdKey +viewPName = libFun (fsLit "viewP") viewPIdKey + +-- type FieldPat = ... +fieldPatName :: Name +fieldPatName = libFun (fsLit "fieldPat") fieldPatIdKey + +-- data Match = ... +matchName :: Name +matchName = libFun (fsLit "match") matchIdKey + +-- data Clause = ... +clauseName :: Name +clauseName = libFun (fsLit "clause") clauseIdKey + +-- data Exp = ... +varEName, conEName, litEName, appEName, appTypeEName, infixEName, infixAppName, + sectionLName, sectionRName, lamEName, lamCaseEName, tupEName, + unboxedTupEName, unboxedSumEName, condEName, multiIfEName, letEName, + caseEName, doEName, mdoEName, compEName, staticEName, unboundVarEName, + labelEName, implicitParamVarEName :: Name +varEName = libFun (fsLit "varE") varEIdKey +conEName = libFun (fsLit "conE") conEIdKey +litEName = libFun (fsLit "litE") litEIdKey +appEName = libFun (fsLit "appE") appEIdKey +appTypeEName = libFun (fsLit "appTypeE") appTypeEIdKey +infixEName = libFun (fsLit "infixE") infixEIdKey +infixAppName = libFun (fsLit "infixApp") infixAppIdKey +sectionLName = libFun (fsLit "sectionL") sectionLIdKey +sectionRName = libFun (fsLit "sectionR") sectionRIdKey +lamEName = libFun (fsLit "lamE") lamEIdKey +lamCaseEName = libFun (fsLit "lamCaseE") lamCaseEIdKey +tupEName = libFun (fsLit "tupE") tupEIdKey +unboxedTupEName = libFun (fsLit "unboxedTupE") unboxedTupEIdKey +unboxedSumEName = libFun (fsLit "unboxedSumE") unboxedSumEIdKey +condEName = libFun (fsLit "condE") condEIdKey +multiIfEName = libFun (fsLit "multiIfE") multiIfEIdKey +letEName = libFun (fsLit "letE") letEIdKey +caseEName = libFun (fsLit "caseE") caseEIdKey +doEName = libFun (fsLit "doE") doEIdKey +mdoEName = libFun (fsLit "mdoE") mdoEIdKey +compEName = libFun (fsLit "compE") compEIdKey +-- ArithSeq skips a level +fromEName, fromThenEName, fromToEName, fromThenToEName :: Name +fromEName = libFun (fsLit "fromE") fromEIdKey +fromThenEName = libFun (fsLit "fromThenE") fromThenEIdKey +fromToEName = libFun (fsLit "fromToE") fromToEIdKey +fromThenToEName = libFun (fsLit "fromThenToE") fromThenToEIdKey +-- end ArithSeq +listEName, sigEName, recConEName, recUpdEName :: Name +listEName = libFun (fsLit "listE") listEIdKey +sigEName = libFun (fsLit "sigE") sigEIdKey +recConEName = libFun (fsLit "recConE") recConEIdKey +recUpdEName = libFun (fsLit "recUpdE") recUpdEIdKey +staticEName = libFun (fsLit "staticE") staticEIdKey +unboundVarEName = libFun (fsLit "unboundVarE") unboundVarEIdKey +labelEName = libFun (fsLit "labelE") labelEIdKey +implicitParamVarEName = libFun (fsLit "implicitParamVarE") implicitParamVarEIdKey + +-- type FieldExp = ... +fieldExpName :: Name +fieldExpName = libFun (fsLit "fieldExp") fieldExpIdKey + +-- data Body = ... +guardedBName, normalBName :: Name +guardedBName = libFun (fsLit "guardedB") guardedBIdKey +normalBName = libFun (fsLit "normalB") normalBIdKey + +-- data Guard = ... +normalGEName, patGEName :: Name +normalGEName = libFun (fsLit "normalGE") normalGEIdKey +patGEName = libFun (fsLit "patGE") patGEIdKey + +-- data Stmt = ... +bindSName, letSName, noBindSName, parSName, recSName :: Name +bindSName = libFun (fsLit "bindS") bindSIdKey +letSName = libFun (fsLit "letS") letSIdKey +noBindSName = libFun (fsLit "noBindS") noBindSIdKey +parSName = libFun (fsLit "parS") parSIdKey +recSName = libFun (fsLit "recS") recSIdKey + +-- data Dec = ... +funDName, valDName, dataDName, newtypeDName, tySynDName, classDName, + instanceWithOverlapDName, sigDName, kiSigDName, forImpDName, pragInlDName, + pragSpecDName, pragSpecInlDName, pragSpecInstDName, pragRuleDName, + pragAnnDName, standaloneDerivWithStrategyDName, defaultSigDName, + dataInstDName, newtypeInstDName, tySynInstDName, dataFamilyDName, + openTypeFamilyDName, closedTypeFamilyDName, infixLDName, infixRDName, + infixNDName, roleAnnotDName, patSynDName, patSynSigDName, + pragCompleteDName, implicitParamBindDName :: Name +funDName = libFun (fsLit "funD") funDIdKey +valDName = libFun (fsLit "valD") valDIdKey +dataDName = libFun (fsLit "dataD") dataDIdKey +newtypeDName = libFun (fsLit "newtypeD") newtypeDIdKey +tySynDName = libFun (fsLit "tySynD") tySynDIdKey +classDName = libFun (fsLit "classD") classDIdKey +instanceWithOverlapDName = libFun (fsLit "instanceWithOverlapD") instanceWithOverlapDIdKey +standaloneDerivWithStrategyDName = libFun (fsLit "standaloneDerivWithStrategyD") standaloneDerivWithStrategyDIdKey +sigDName = libFun (fsLit "sigD") sigDIdKey +kiSigDName = libFun (fsLit "kiSigD") kiSigDIdKey +defaultSigDName = libFun (fsLit "defaultSigD") defaultSigDIdKey +forImpDName = libFun (fsLit "forImpD") forImpDIdKey +pragInlDName = libFun (fsLit "pragInlD") pragInlDIdKey +pragSpecDName = libFun (fsLit "pragSpecD") pragSpecDIdKey +pragSpecInlDName = libFun (fsLit "pragSpecInlD") pragSpecInlDIdKey +pragSpecInstDName = libFun (fsLit "pragSpecInstD") pragSpecInstDIdKey +pragRuleDName = libFun (fsLit "pragRuleD") pragRuleDIdKey +pragCompleteDName = libFun (fsLit "pragCompleteD") pragCompleteDIdKey +pragAnnDName = libFun (fsLit "pragAnnD") pragAnnDIdKey +dataInstDName = libFun (fsLit "dataInstD") dataInstDIdKey +newtypeInstDName = libFun (fsLit "newtypeInstD") newtypeInstDIdKey +tySynInstDName = libFun (fsLit "tySynInstD") tySynInstDIdKey +openTypeFamilyDName = libFun (fsLit "openTypeFamilyD") openTypeFamilyDIdKey +closedTypeFamilyDName = libFun (fsLit "closedTypeFamilyD") closedTypeFamilyDIdKey +dataFamilyDName = libFun (fsLit "dataFamilyD") dataFamilyDIdKey +infixLDName = libFun (fsLit "infixLD") infixLDIdKey +infixRDName = libFun (fsLit "infixRD") infixRDIdKey +infixNDName = libFun (fsLit "infixND") infixNDIdKey +roleAnnotDName = libFun (fsLit "roleAnnotD") roleAnnotDIdKey +patSynDName = libFun (fsLit "patSynD") patSynDIdKey +patSynSigDName = libFun (fsLit "patSynSigD") patSynSigDIdKey +implicitParamBindDName = libFun (fsLit "implicitParamBindD") implicitParamBindDIdKey + +-- type Ctxt = ... +cxtName :: Name +cxtName = libFun (fsLit "cxt") cxtIdKey + +-- data SourceUnpackedness = ... +noSourceUnpackednessName, sourceNoUnpackName, sourceUnpackName :: Name +noSourceUnpackednessName = libFun (fsLit "noSourceUnpackedness") noSourceUnpackednessKey +sourceNoUnpackName = libFun (fsLit "sourceNoUnpack") sourceNoUnpackKey +sourceUnpackName = libFun (fsLit "sourceUnpack") sourceUnpackKey + +-- data SourceStrictness = ... +noSourceStrictnessName, sourceLazyName, sourceStrictName :: Name +noSourceStrictnessName = libFun (fsLit "noSourceStrictness") noSourceStrictnessKey +sourceLazyName = libFun (fsLit "sourceLazy") sourceLazyKey +sourceStrictName = libFun (fsLit "sourceStrict") sourceStrictKey + +-- data Con = ... +normalCName, recCName, infixCName, forallCName, gadtCName, recGadtCName :: Name +normalCName = libFun (fsLit "normalC" ) normalCIdKey +recCName = libFun (fsLit "recC" ) recCIdKey +infixCName = libFun (fsLit "infixC" ) infixCIdKey +forallCName = libFun (fsLit "forallC" ) forallCIdKey +gadtCName = libFun (fsLit "gadtC" ) gadtCIdKey +recGadtCName = libFun (fsLit "recGadtC") recGadtCIdKey + +-- data Bang = ... +bangName :: Name +bangName = libFun (fsLit "bang") bangIdKey + +-- type BangType = ... +bangTypeName :: Name +bangTypeName = libFun (fsLit "bangType") bangTKey + +-- type VarBangType = ... +varBangTypeName :: Name +varBangTypeName = libFun (fsLit "varBangType") varBangTKey + +-- data PatSynDir = ... +unidirPatSynName, implBidirPatSynName, explBidirPatSynName :: Name +unidirPatSynName = libFun (fsLit "unidir") unidirPatSynIdKey +implBidirPatSynName = libFun (fsLit "implBidir") implBidirPatSynIdKey +explBidirPatSynName = libFun (fsLit "explBidir") explBidirPatSynIdKey + +-- data PatSynArgs = ... +prefixPatSynName, infixPatSynName, recordPatSynName :: Name +prefixPatSynName = libFun (fsLit "prefixPatSyn") prefixPatSynIdKey +infixPatSynName = libFun (fsLit "infixPatSyn") infixPatSynIdKey +recordPatSynName = libFun (fsLit "recordPatSyn") recordPatSynIdKey + +-- data Type = ... +forallTName, forallVisTName, varTName, conTName, infixTName, tupleTName, + unboxedTupleTName, unboxedSumTName, arrowTName, listTName, appTName, + appKindTName, sigTName, equalityTName, litTName, promotedTName, + promotedTupleTName, promotedNilTName, promotedConsTName, + wildCardTName, implicitParamTName :: Name +forallTName = libFun (fsLit "forallT") forallTIdKey +forallVisTName = libFun (fsLit "forallVisT") forallVisTIdKey +varTName = libFun (fsLit "varT") varTIdKey +conTName = libFun (fsLit "conT") conTIdKey +tupleTName = libFun (fsLit "tupleT") tupleTIdKey +unboxedTupleTName = libFun (fsLit "unboxedTupleT") unboxedTupleTIdKey +unboxedSumTName = libFun (fsLit "unboxedSumT") unboxedSumTIdKey +arrowTName = libFun (fsLit "arrowT") arrowTIdKey +listTName = libFun (fsLit "listT") listTIdKey +appTName = libFun (fsLit "appT") appTIdKey +appKindTName = libFun (fsLit "appKindT") appKindTIdKey +sigTName = libFun (fsLit "sigT") sigTIdKey +equalityTName = libFun (fsLit "equalityT") equalityTIdKey +litTName = libFun (fsLit "litT") litTIdKey +promotedTName = libFun (fsLit "promotedT") promotedTIdKey +promotedTupleTName = libFun (fsLit "promotedTupleT") promotedTupleTIdKey +promotedNilTName = libFun (fsLit "promotedNilT") promotedNilTIdKey +promotedConsTName = libFun (fsLit "promotedConsT") promotedConsTIdKey +wildCardTName = libFun (fsLit "wildCardT") wildCardTIdKey +infixTName = libFun (fsLit "infixT") infixTIdKey +implicitParamTName = libFun (fsLit "implicitParamT") implicitParamTIdKey + +-- data TyLit = ... +numTyLitName, strTyLitName :: Name +numTyLitName = libFun (fsLit "numTyLit") numTyLitIdKey +strTyLitName = libFun (fsLit "strTyLit") strTyLitIdKey + +-- data TyVarBndr = ... +plainTVName, kindedTVName :: Name +plainTVName = libFun (fsLit "plainTV") plainTVIdKey +kindedTVName = libFun (fsLit "kindedTV") kindedTVIdKey + +-- data Role = ... +nominalRName, representationalRName, phantomRName, inferRName :: Name +nominalRName = libFun (fsLit "nominalR") nominalRIdKey +representationalRName = libFun (fsLit "representationalR") representationalRIdKey +phantomRName = libFun (fsLit "phantomR") phantomRIdKey +inferRName = libFun (fsLit "inferR") inferRIdKey + +-- data Kind = ... +starKName, constraintKName :: Name +starKName = libFun (fsLit "starK") starKIdKey +constraintKName = libFun (fsLit "constraintK") constraintKIdKey + +-- data FamilyResultSig = ... +noSigName, kindSigName, tyVarSigName :: Name +noSigName = libFun (fsLit "noSig") noSigIdKey +kindSigName = libFun (fsLit "kindSig") kindSigIdKey +tyVarSigName = libFun (fsLit "tyVarSig") tyVarSigIdKey + +-- data InjectivityAnn = ... +injectivityAnnName :: Name +injectivityAnnName = libFun (fsLit "injectivityAnn") injectivityAnnIdKey + +-- data Callconv = ... +cCallName, stdCallName, cApiCallName, primCallName, javaScriptCallName :: Name +cCallName = libFun (fsLit "cCall") cCallIdKey +stdCallName = libFun (fsLit "stdCall") stdCallIdKey +cApiCallName = libFun (fsLit "cApi") cApiCallIdKey +primCallName = libFun (fsLit "prim") primCallIdKey +javaScriptCallName = libFun (fsLit "javaScript") javaScriptCallIdKey + +-- data Safety = ... +unsafeName, safeName, interruptibleName :: Name +unsafeName = libFun (fsLit "unsafe") unsafeIdKey +safeName = libFun (fsLit "safe") safeIdKey +interruptibleName = libFun (fsLit "interruptible") interruptibleIdKey + +-- newtype TExp a = ... +tExpDataConName :: Name +tExpDataConName = thCon (fsLit "TExp") tExpDataConKey + +-- data RuleBndr = ... +ruleVarName, typedRuleVarName :: Name +ruleVarName = libFun (fsLit ("ruleVar")) ruleVarIdKey +typedRuleVarName = libFun (fsLit ("typedRuleVar")) typedRuleVarIdKey + +-- data FunDep = ... +funDepName :: Name +funDepName = libFun (fsLit "funDep") funDepIdKey + +-- data TySynEqn = ... +tySynEqnName :: Name +tySynEqnName = libFun (fsLit "tySynEqn") tySynEqnIdKey + +-- data AnnTarget = ... +valueAnnotationName, typeAnnotationName, moduleAnnotationName :: Name +valueAnnotationName = libFun (fsLit "valueAnnotation") valueAnnotationIdKey +typeAnnotationName = libFun (fsLit "typeAnnotation") typeAnnotationIdKey +moduleAnnotationName = libFun (fsLit "moduleAnnotation") moduleAnnotationIdKey + +-- type DerivClause = ... +derivClauseName :: Name +derivClauseName = libFun (fsLit "derivClause") derivClauseIdKey + +-- data DerivStrategy = ... +stockStrategyName, anyclassStrategyName, newtypeStrategyName, + viaStrategyName :: Name +stockStrategyName = libFun (fsLit "stockStrategy") stockStrategyIdKey +anyclassStrategyName = libFun (fsLit "anyclassStrategy") anyclassStrategyIdKey +newtypeStrategyName = libFun (fsLit "newtypeStrategy") newtypeStrategyIdKey +viaStrategyName = libFun (fsLit "viaStrategy") viaStrategyIdKey + +patQTyConName, expQTyConName, stmtTyConName, + conTyConName, bangTypeTyConName, + varBangTypeTyConName, typeQTyConName, + decsQTyConName, ruleBndrTyConName, tySynEqnTyConName, roleTyConName, + derivClauseTyConName, kindTyConName, tyVarBndrTyConName, + derivStrategyTyConName :: Name +-- These are only used for the types of top-level splices +expQTyConName = libTc (fsLit "ExpQ") expQTyConKey +decsQTyConName = libTc (fsLit "DecsQ") decsQTyConKey -- Q [Dec] +typeQTyConName = libTc (fsLit "TypeQ") typeQTyConKey +patQTyConName = libTc (fsLit "PatQ") patQTyConKey + +-- These are used in GHC.HsToCore.Quote but always wrapped in a type variable +stmtTyConName = thTc (fsLit "Stmt") stmtTyConKey +conTyConName = thTc (fsLit "Con") conTyConKey +bangTypeTyConName = thTc (fsLit "BangType") bangTypeTyConKey +varBangTypeTyConName = thTc (fsLit "VarBangType") varBangTypeTyConKey +ruleBndrTyConName = thTc (fsLit "RuleBndr") ruleBndrTyConKey +tySynEqnTyConName = thTc (fsLit "TySynEqn") tySynEqnTyConKey +roleTyConName = libTc (fsLit "Role") roleTyConKey +derivClauseTyConName = thTc (fsLit "DerivClause") derivClauseTyConKey +kindTyConName = thTc (fsLit "Kind") kindTyConKey +tyVarBndrTyConName = thTc (fsLit "TyVarBndr") tyVarBndrTyConKey +derivStrategyTyConName = thTc (fsLit "DerivStrategy") derivStrategyTyConKey + +-- quasiquoting +quoteExpName, quotePatName, quoteDecName, quoteTypeName :: Name +quoteExpName = qqFun (fsLit "quoteExp") quoteExpKey +quotePatName = qqFun (fsLit "quotePat") quotePatKey +quoteDecName = qqFun (fsLit "quoteDec") quoteDecKey +quoteTypeName = qqFun (fsLit "quoteType") quoteTypeKey + +-- data Inline = ... +noInlineDataConName, inlineDataConName, inlinableDataConName :: Name +noInlineDataConName = thCon (fsLit "NoInline") noInlineDataConKey +inlineDataConName = thCon (fsLit "Inline") inlineDataConKey +inlinableDataConName = thCon (fsLit "Inlinable") inlinableDataConKey + +-- data RuleMatch = ... +conLikeDataConName, funLikeDataConName :: Name +conLikeDataConName = thCon (fsLit "ConLike") conLikeDataConKey +funLikeDataConName = thCon (fsLit "FunLike") funLikeDataConKey + +-- data Phases = ... +allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName :: Name +allPhasesDataConName = thCon (fsLit "AllPhases") allPhasesDataConKey +fromPhaseDataConName = thCon (fsLit "FromPhase") fromPhaseDataConKey +beforePhaseDataConName = thCon (fsLit "BeforePhase") beforePhaseDataConKey + +-- data Overlap = ... +overlappableDataConName, + overlappingDataConName, + overlapsDataConName, + incoherentDataConName :: Name +overlappableDataConName = thCon (fsLit "Overlappable") overlappableDataConKey +overlappingDataConName = thCon (fsLit "Overlapping") overlappingDataConKey +overlapsDataConName = thCon (fsLit "Overlaps") overlapsDataConKey +incoherentDataConName = thCon (fsLit "Incoherent") incoherentDataConKey + +{- ********************************************************************* +* * + Class keys +* * +********************************************************************* -} + +-- ClassUniques available: 200-299 +-- Check in GHC.Builtin.Names if you want to change this + +liftClassKey :: Unique +liftClassKey = mkPreludeClassUnique 200 + +quoteClassKey :: Unique +quoteClassKey = mkPreludeClassUnique 201 + +{- ********************************************************************* +* * + TyCon keys +* * +********************************************************************* -} + +-- TyConUniques available: 200-299 +-- Check in GHC.Builtin.Names if you want to change this + +expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey, + patTyConKey, + stmtTyConKey, conTyConKey, typeQTyConKey, typeTyConKey, + tyVarBndrTyConKey, decTyConKey, bangTypeTyConKey, varBangTypeTyConKey, + fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey, + funDepTyConKey, predTyConKey, + predQTyConKey, decsQTyConKey, ruleBndrTyConKey, tySynEqnTyConKey, + roleTyConKey, tExpTyConKey, injAnnTyConKey, kindTyConKey, + overlapTyConKey, derivClauseTyConKey, derivStrategyTyConKey, decsTyConKey + :: Unique +expTyConKey = mkPreludeTyConUnique 200 +matchTyConKey = mkPreludeTyConUnique 201 +clauseTyConKey = mkPreludeTyConUnique 202 +qTyConKey = mkPreludeTyConUnique 203 +expQTyConKey = mkPreludeTyConUnique 204 +patTyConKey = mkPreludeTyConUnique 206 +stmtTyConKey = mkPreludeTyConUnique 209 +conTyConKey = mkPreludeTyConUnique 210 +typeQTyConKey = mkPreludeTyConUnique 211 +typeTyConKey = mkPreludeTyConUnique 212 +decTyConKey = mkPreludeTyConUnique 213 +bangTypeTyConKey = mkPreludeTyConUnique 214 +varBangTypeTyConKey = mkPreludeTyConUnique 215 +fieldExpTyConKey = mkPreludeTyConUnique 216 +fieldPatTyConKey = mkPreludeTyConUnique 217 +nameTyConKey = mkPreludeTyConUnique 218 +patQTyConKey = mkPreludeTyConUnique 219 +funDepTyConKey = mkPreludeTyConUnique 222 +predTyConKey = mkPreludeTyConUnique 223 +predQTyConKey = mkPreludeTyConUnique 224 +tyVarBndrTyConKey = mkPreludeTyConUnique 225 +decsQTyConKey = mkPreludeTyConUnique 226 +ruleBndrTyConKey = mkPreludeTyConUnique 227 +tySynEqnTyConKey = mkPreludeTyConUnique 228 +roleTyConKey = mkPreludeTyConUnique 229 +tExpTyConKey = mkPreludeTyConUnique 230 +injAnnTyConKey = mkPreludeTyConUnique 231 +kindTyConKey = mkPreludeTyConUnique 232 +overlapTyConKey = mkPreludeTyConUnique 233 +derivClauseTyConKey = mkPreludeTyConUnique 234 +derivStrategyTyConKey = mkPreludeTyConUnique 235 +decsTyConKey = mkPreludeTyConUnique 236 + +{- ********************************************************************* +* * + DataCon keys +* * +********************************************************************* -} + +-- DataConUniques available: 100-150 +-- If you want to change this, make sure you check in GHC.Builtin.Names + +-- data Inline = ... +noInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique +noInlineDataConKey = mkPreludeDataConUnique 200 +inlineDataConKey = mkPreludeDataConUnique 201 +inlinableDataConKey = mkPreludeDataConUnique 202 + +-- data RuleMatch = ... +conLikeDataConKey, funLikeDataConKey :: Unique +conLikeDataConKey = mkPreludeDataConUnique 203 +funLikeDataConKey = mkPreludeDataConUnique 204 + +-- data Phases = ... +allPhasesDataConKey, fromPhaseDataConKey, beforePhaseDataConKey :: Unique +allPhasesDataConKey = mkPreludeDataConUnique 205 +fromPhaseDataConKey = mkPreludeDataConUnique 206 +beforePhaseDataConKey = mkPreludeDataConUnique 207 + +-- newtype TExp a = ... +tExpDataConKey :: Unique +tExpDataConKey = mkPreludeDataConUnique 208 + +-- data Overlap = .. +overlappableDataConKey, + overlappingDataConKey, + overlapsDataConKey, + incoherentDataConKey :: Unique +overlappableDataConKey = mkPreludeDataConUnique 209 +overlappingDataConKey = mkPreludeDataConUnique 210 +overlapsDataConKey = mkPreludeDataConUnique 211 +incoherentDataConKey = mkPreludeDataConUnique 212 + +{- ********************************************************************* +* * + Id keys +* * +********************************************************************* -} + +-- IdUniques available: 200-499 +-- If you want to change this, make sure you check in GHC.Builtin.Names + +returnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey, + mkNameIdKey, mkNameG_vIdKey, mkNameG_dIdKey, mkNameG_tcIdKey, + mkNameLIdKey, mkNameSIdKey, unTypeIdKey, unTypeQIdKey, + unsafeTExpCoerceIdKey, liftTypedIdKey :: Unique +returnQIdKey = mkPreludeMiscIdUnique 200 +bindQIdKey = mkPreludeMiscIdUnique 201 +sequenceQIdKey = mkPreludeMiscIdUnique 202 +liftIdKey = mkPreludeMiscIdUnique 203 +newNameIdKey = mkPreludeMiscIdUnique 204 +mkNameIdKey = mkPreludeMiscIdUnique 205 +mkNameG_vIdKey = mkPreludeMiscIdUnique 206 +mkNameG_dIdKey = mkPreludeMiscIdUnique 207 +mkNameG_tcIdKey = mkPreludeMiscIdUnique 208 +mkNameLIdKey = mkPreludeMiscIdUnique 209 +mkNameSIdKey = mkPreludeMiscIdUnique 210 +unTypeIdKey = mkPreludeMiscIdUnique 211 +unTypeQIdKey = mkPreludeMiscIdUnique 212 +unsafeTExpCoerceIdKey = mkPreludeMiscIdUnique 213 +liftTypedIdKey = mkPreludeMiscIdUnique 214 + + +-- data Lit = ... +charLIdKey, stringLIdKey, integerLIdKey, intPrimLIdKey, wordPrimLIdKey, + floatPrimLIdKey, doublePrimLIdKey, rationalLIdKey, stringPrimLIdKey, + charPrimLIdKey:: Unique +charLIdKey = mkPreludeMiscIdUnique 220 +stringLIdKey = mkPreludeMiscIdUnique 221 +integerLIdKey = mkPreludeMiscIdUnique 222 +intPrimLIdKey = mkPreludeMiscIdUnique 223 +wordPrimLIdKey = mkPreludeMiscIdUnique 224 +floatPrimLIdKey = mkPreludeMiscIdUnique 225 +doublePrimLIdKey = mkPreludeMiscIdUnique 226 +rationalLIdKey = mkPreludeMiscIdUnique 227 +stringPrimLIdKey = mkPreludeMiscIdUnique 228 +charPrimLIdKey = mkPreludeMiscIdUnique 229 + +liftStringIdKey :: Unique +liftStringIdKey = mkPreludeMiscIdUnique 230 + +-- data Pat = ... +litPIdKey, varPIdKey, tupPIdKey, unboxedTupPIdKey, unboxedSumPIdKey, conPIdKey, + infixPIdKey, tildePIdKey, bangPIdKey, asPIdKey, wildPIdKey, recPIdKey, + listPIdKey, sigPIdKey, viewPIdKey :: Unique +litPIdKey = mkPreludeMiscIdUnique 240 +varPIdKey = mkPreludeMiscIdUnique 241 +tupPIdKey = mkPreludeMiscIdUnique 242 +unboxedTupPIdKey = mkPreludeMiscIdUnique 243 +unboxedSumPIdKey = mkPreludeMiscIdUnique 244 +conPIdKey = mkPreludeMiscIdUnique 245 +infixPIdKey = mkPreludeMiscIdUnique 246 +tildePIdKey = mkPreludeMiscIdUnique 247 +bangPIdKey = mkPreludeMiscIdUnique 248 +asPIdKey = mkPreludeMiscIdUnique 249 +wildPIdKey = mkPreludeMiscIdUnique 250 +recPIdKey = mkPreludeMiscIdUnique 251 +listPIdKey = mkPreludeMiscIdUnique 252 +sigPIdKey = mkPreludeMiscIdUnique 253 +viewPIdKey = mkPreludeMiscIdUnique 254 + +-- type FieldPat = ... +fieldPatIdKey :: Unique +fieldPatIdKey = mkPreludeMiscIdUnique 260 + +-- data Match = ... +matchIdKey :: Unique +matchIdKey = mkPreludeMiscIdUnique 261 + +-- data Clause = ... +clauseIdKey :: Unique +clauseIdKey = mkPreludeMiscIdUnique 262 + + +-- data Exp = ... +varEIdKey, conEIdKey, litEIdKey, appEIdKey, appTypeEIdKey, infixEIdKey, + infixAppIdKey, sectionLIdKey, sectionRIdKey, lamEIdKey, lamCaseEIdKey, + tupEIdKey, unboxedTupEIdKey, unboxedSumEIdKey, condEIdKey, multiIfEIdKey, + letEIdKey, caseEIdKey, doEIdKey, compEIdKey, + fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey, + listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey, staticEIdKey, + unboundVarEIdKey, labelEIdKey, implicitParamVarEIdKey, mdoEIdKey :: Unique +varEIdKey = mkPreludeMiscIdUnique 270 +conEIdKey = mkPreludeMiscIdUnique 271 +litEIdKey = mkPreludeMiscIdUnique 272 +appEIdKey = mkPreludeMiscIdUnique 273 +appTypeEIdKey = mkPreludeMiscIdUnique 274 +infixEIdKey = mkPreludeMiscIdUnique 275 +infixAppIdKey = mkPreludeMiscIdUnique 276 +sectionLIdKey = mkPreludeMiscIdUnique 277 +sectionRIdKey = mkPreludeMiscIdUnique 278 +lamEIdKey = mkPreludeMiscIdUnique 279 +lamCaseEIdKey = mkPreludeMiscIdUnique 280 +tupEIdKey = mkPreludeMiscIdUnique 281 +unboxedTupEIdKey = mkPreludeMiscIdUnique 282 +unboxedSumEIdKey = mkPreludeMiscIdUnique 283 +condEIdKey = mkPreludeMiscIdUnique 284 +multiIfEIdKey = mkPreludeMiscIdUnique 285 +letEIdKey = mkPreludeMiscIdUnique 286 +caseEIdKey = mkPreludeMiscIdUnique 287 +doEIdKey = mkPreludeMiscIdUnique 288 +compEIdKey = mkPreludeMiscIdUnique 289 +fromEIdKey = mkPreludeMiscIdUnique 290 +fromThenEIdKey = mkPreludeMiscIdUnique 291 +fromToEIdKey = mkPreludeMiscIdUnique 292 +fromThenToEIdKey = mkPreludeMiscIdUnique 293 +listEIdKey = mkPreludeMiscIdUnique 294 +sigEIdKey = mkPreludeMiscIdUnique 295 +recConEIdKey = mkPreludeMiscIdUnique 296 +recUpdEIdKey = mkPreludeMiscIdUnique 297 +staticEIdKey = mkPreludeMiscIdUnique 298 +unboundVarEIdKey = mkPreludeMiscIdUnique 299 +labelEIdKey = mkPreludeMiscIdUnique 300 +implicitParamVarEIdKey = mkPreludeMiscIdUnique 301 +mdoEIdKey = mkPreludeMiscIdUnique 302 + +-- type FieldExp = ... +fieldExpIdKey :: Unique +fieldExpIdKey = mkPreludeMiscIdUnique 305 + +-- data Body = ... +guardedBIdKey, normalBIdKey :: Unique +guardedBIdKey = mkPreludeMiscIdUnique 306 +normalBIdKey = mkPreludeMiscIdUnique 307 + +-- data Guard = ... +normalGEIdKey, patGEIdKey :: Unique +normalGEIdKey = mkPreludeMiscIdUnique 308 +patGEIdKey = mkPreludeMiscIdUnique 309 + +-- data Stmt = ... +bindSIdKey, letSIdKey, noBindSIdKey, parSIdKey, recSIdKey :: Unique +bindSIdKey = mkPreludeMiscIdUnique 310 +letSIdKey = mkPreludeMiscIdUnique 311 +noBindSIdKey = mkPreludeMiscIdUnique 312 +parSIdKey = mkPreludeMiscIdUnique 313 +recSIdKey = mkPreludeMiscIdUnique 314 + +-- data Dec = ... +funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey, classDIdKey, + instanceWithOverlapDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey, + pragInlDIdKey, pragSpecDIdKey, pragSpecInlDIdKey, pragSpecInstDIdKey, + pragRuleDIdKey, pragAnnDIdKey, defaultSigDIdKey, dataFamilyDIdKey, + openTypeFamilyDIdKey, closedTypeFamilyDIdKey, dataInstDIdKey, + newtypeInstDIdKey, tySynInstDIdKey, standaloneDerivWithStrategyDIdKey, + infixLDIdKey, infixRDIdKey, infixNDIdKey, roleAnnotDIdKey, patSynDIdKey, + patSynSigDIdKey, pragCompleteDIdKey, implicitParamBindDIdKey, + kiSigDIdKey :: Unique +funDIdKey = mkPreludeMiscIdUnique 320 +valDIdKey = mkPreludeMiscIdUnique 321 +dataDIdKey = mkPreludeMiscIdUnique 322 +newtypeDIdKey = mkPreludeMiscIdUnique 323 +tySynDIdKey = mkPreludeMiscIdUnique 324 +classDIdKey = mkPreludeMiscIdUnique 325 +instanceWithOverlapDIdKey = mkPreludeMiscIdUnique 326 +instanceDIdKey = mkPreludeMiscIdUnique 327 +sigDIdKey = mkPreludeMiscIdUnique 328 +forImpDIdKey = mkPreludeMiscIdUnique 329 +pragInlDIdKey = mkPreludeMiscIdUnique 330 +pragSpecDIdKey = mkPreludeMiscIdUnique 331 +pragSpecInlDIdKey = mkPreludeMiscIdUnique 332 +pragSpecInstDIdKey = mkPreludeMiscIdUnique 333 +pragRuleDIdKey = mkPreludeMiscIdUnique 334 +pragAnnDIdKey = mkPreludeMiscIdUnique 335 +dataFamilyDIdKey = mkPreludeMiscIdUnique 336 +openTypeFamilyDIdKey = mkPreludeMiscIdUnique 337 +dataInstDIdKey = mkPreludeMiscIdUnique 338 +newtypeInstDIdKey = mkPreludeMiscIdUnique 339 +tySynInstDIdKey = mkPreludeMiscIdUnique 340 +closedTypeFamilyDIdKey = mkPreludeMiscIdUnique 341 +infixLDIdKey = mkPreludeMiscIdUnique 342 +infixRDIdKey = mkPreludeMiscIdUnique 343 +infixNDIdKey = mkPreludeMiscIdUnique 344 +roleAnnotDIdKey = mkPreludeMiscIdUnique 345 +standaloneDerivWithStrategyDIdKey = mkPreludeMiscIdUnique 346 +defaultSigDIdKey = mkPreludeMiscIdUnique 347 +patSynDIdKey = mkPreludeMiscIdUnique 348 +patSynSigDIdKey = mkPreludeMiscIdUnique 349 +pragCompleteDIdKey = mkPreludeMiscIdUnique 350 +implicitParamBindDIdKey = mkPreludeMiscIdUnique 351 +kiSigDIdKey = mkPreludeMiscIdUnique 352 + +-- type Cxt = ... +cxtIdKey :: Unique +cxtIdKey = mkPreludeMiscIdUnique 361 + +-- data SourceUnpackedness = ... +noSourceUnpackednessKey, sourceNoUnpackKey, sourceUnpackKey :: Unique +noSourceUnpackednessKey = mkPreludeMiscIdUnique 362 +sourceNoUnpackKey = mkPreludeMiscIdUnique 363 +sourceUnpackKey = mkPreludeMiscIdUnique 364 + +-- data SourceStrictness = ... +noSourceStrictnessKey, sourceLazyKey, sourceStrictKey :: Unique +noSourceStrictnessKey = mkPreludeMiscIdUnique 365 +sourceLazyKey = mkPreludeMiscIdUnique 366 +sourceStrictKey = mkPreludeMiscIdUnique 367 + +-- data Con = ... +normalCIdKey, recCIdKey, infixCIdKey, forallCIdKey, gadtCIdKey, + recGadtCIdKey :: Unique +normalCIdKey = mkPreludeMiscIdUnique 368 +recCIdKey = mkPreludeMiscIdUnique 369 +infixCIdKey = mkPreludeMiscIdUnique 370 +forallCIdKey = mkPreludeMiscIdUnique 371 +gadtCIdKey = mkPreludeMiscIdUnique 372 +recGadtCIdKey = mkPreludeMiscIdUnique 373 + +-- data Bang = ... +bangIdKey :: Unique +bangIdKey = mkPreludeMiscIdUnique 374 + +-- type BangType = ... +bangTKey :: Unique +bangTKey = mkPreludeMiscIdUnique 375 + +-- type VarBangType = ... +varBangTKey :: Unique +varBangTKey = mkPreludeMiscIdUnique 376 + +-- data PatSynDir = ... +unidirPatSynIdKey, implBidirPatSynIdKey, explBidirPatSynIdKey :: Unique +unidirPatSynIdKey = mkPreludeMiscIdUnique 377 +implBidirPatSynIdKey = mkPreludeMiscIdUnique 378 +explBidirPatSynIdKey = mkPreludeMiscIdUnique 379 + +-- data PatSynArgs = ... +prefixPatSynIdKey, infixPatSynIdKey, recordPatSynIdKey :: Unique +prefixPatSynIdKey = mkPreludeMiscIdUnique 380 +infixPatSynIdKey = mkPreludeMiscIdUnique 381 +recordPatSynIdKey = mkPreludeMiscIdUnique 382 + +-- data Type = ... +forallTIdKey, forallVisTIdKey, varTIdKey, conTIdKey, tupleTIdKey, + unboxedTupleTIdKey, unboxedSumTIdKey, arrowTIdKey, listTIdKey, appTIdKey, + appKindTIdKey, sigTIdKey, equalityTIdKey, litTIdKey, promotedTIdKey, + promotedTupleTIdKey, promotedNilTIdKey, promotedConsTIdKey, + wildCardTIdKey, implicitParamTIdKey, infixTIdKey :: Unique +forallTIdKey = mkPreludeMiscIdUnique 390 +forallVisTIdKey = mkPreludeMiscIdUnique 391 +varTIdKey = mkPreludeMiscIdUnique 392 +conTIdKey = mkPreludeMiscIdUnique 393 +tupleTIdKey = mkPreludeMiscIdUnique 394 +unboxedTupleTIdKey = mkPreludeMiscIdUnique 395 +unboxedSumTIdKey = mkPreludeMiscIdUnique 396 +arrowTIdKey = mkPreludeMiscIdUnique 397 +listTIdKey = mkPreludeMiscIdUnique 398 +appTIdKey = mkPreludeMiscIdUnique 399 +appKindTIdKey = mkPreludeMiscIdUnique 400 +sigTIdKey = mkPreludeMiscIdUnique 401 +equalityTIdKey = mkPreludeMiscIdUnique 402 +litTIdKey = mkPreludeMiscIdUnique 403 +promotedTIdKey = mkPreludeMiscIdUnique 404 +promotedTupleTIdKey = mkPreludeMiscIdUnique 405 +promotedNilTIdKey = mkPreludeMiscIdUnique 406 +promotedConsTIdKey = mkPreludeMiscIdUnique 407 +wildCardTIdKey = mkPreludeMiscIdUnique 408 +implicitParamTIdKey = mkPreludeMiscIdUnique 409 +infixTIdKey = mkPreludeMiscIdUnique 410 + +-- data TyLit = ... +numTyLitIdKey, strTyLitIdKey :: Unique +numTyLitIdKey = mkPreludeMiscIdUnique 411 +strTyLitIdKey = mkPreludeMiscIdUnique 412 + +-- data TyVarBndr = ... +plainTVIdKey, kindedTVIdKey :: Unique +plainTVIdKey = mkPreludeMiscIdUnique 413 +kindedTVIdKey = mkPreludeMiscIdUnique 414 + +-- data Role = ... +nominalRIdKey, representationalRIdKey, phantomRIdKey, inferRIdKey :: Unique +nominalRIdKey = mkPreludeMiscIdUnique 415 +representationalRIdKey = mkPreludeMiscIdUnique 416 +phantomRIdKey = mkPreludeMiscIdUnique 417 +inferRIdKey = mkPreludeMiscIdUnique 418 + +-- data Kind = ... +starKIdKey, constraintKIdKey :: Unique +starKIdKey = mkPreludeMiscIdUnique 425 +constraintKIdKey = mkPreludeMiscIdUnique 426 + +-- data FamilyResultSig = ... +noSigIdKey, kindSigIdKey, tyVarSigIdKey :: Unique +noSigIdKey = mkPreludeMiscIdUnique 427 +kindSigIdKey = mkPreludeMiscIdUnique 428 +tyVarSigIdKey = mkPreludeMiscIdUnique 429 + +-- data InjectivityAnn = ... +injectivityAnnIdKey :: Unique +injectivityAnnIdKey = mkPreludeMiscIdUnique 430 + +-- data Callconv = ... +cCallIdKey, stdCallIdKey, cApiCallIdKey, primCallIdKey, + javaScriptCallIdKey :: Unique +cCallIdKey = mkPreludeMiscIdUnique 431 +stdCallIdKey = mkPreludeMiscIdUnique 432 +cApiCallIdKey = mkPreludeMiscIdUnique 433 +primCallIdKey = mkPreludeMiscIdUnique 434 +javaScriptCallIdKey = mkPreludeMiscIdUnique 435 + +-- data Safety = ... +unsafeIdKey, safeIdKey, interruptibleIdKey :: Unique +unsafeIdKey = mkPreludeMiscIdUnique 440 +safeIdKey = mkPreludeMiscIdUnique 441 +interruptibleIdKey = mkPreludeMiscIdUnique 442 + +-- data FunDep = ... +funDepIdKey :: Unique +funDepIdKey = mkPreludeMiscIdUnique 445 + +-- data TySynEqn = ... +tySynEqnIdKey :: Unique +tySynEqnIdKey = mkPreludeMiscIdUnique 460 + +-- quasiquoting +quoteExpKey, quotePatKey, quoteDecKey, quoteTypeKey :: Unique +quoteExpKey = mkPreludeMiscIdUnique 470 +quotePatKey = mkPreludeMiscIdUnique 471 +quoteDecKey = mkPreludeMiscIdUnique 472 +quoteTypeKey = mkPreludeMiscIdUnique 473 + +-- data RuleBndr = ... +ruleVarIdKey, typedRuleVarIdKey :: Unique +ruleVarIdKey = mkPreludeMiscIdUnique 480 +typedRuleVarIdKey = mkPreludeMiscIdUnique 481 + +-- data AnnTarget = ... +valueAnnotationIdKey, typeAnnotationIdKey, moduleAnnotationIdKey :: Unique +valueAnnotationIdKey = mkPreludeMiscIdUnique 490 +typeAnnotationIdKey = mkPreludeMiscIdUnique 491 +moduleAnnotationIdKey = mkPreludeMiscIdUnique 492 + +-- type DerivPred = ... +derivClauseIdKey :: Unique +derivClauseIdKey = mkPreludeMiscIdUnique 493 + +-- data DerivStrategy = ... +stockStrategyIdKey, anyclassStrategyIdKey, newtypeStrategyIdKey, + viaStrategyIdKey :: Unique +stockStrategyIdKey = mkPreludeDataConUnique 494 +anyclassStrategyIdKey = mkPreludeDataConUnique 495 +newtypeStrategyIdKey = mkPreludeDataConUnique 496 +viaStrategyIdKey = mkPreludeDataConUnique 497 + +{- +************************************************************************ +* * + RdrNames +* * +************************************************************************ +-} + +lift_RDR, liftTyped_RDR, mkNameG_dRDR, mkNameG_vRDR :: RdrName +lift_RDR = nameRdrName liftName +liftTyped_RDR = nameRdrName liftTypedName +mkNameG_dRDR = nameRdrName mkNameG_dName +mkNameG_vRDR = nameRdrName mkNameG_vName + +-- data Exp = ... +conE_RDR, litE_RDR, appE_RDR, infixApp_RDR :: RdrName +conE_RDR = nameRdrName conEName +litE_RDR = nameRdrName litEName +appE_RDR = nameRdrName appEName +infixApp_RDR = nameRdrName infixAppName + +-- data Lit = ... +stringL_RDR, intPrimL_RDR, wordPrimL_RDR, floatPrimL_RDR, + doublePrimL_RDR, stringPrimL_RDR, charPrimL_RDR :: RdrName +stringL_RDR = nameRdrName stringLName +intPrimL_RDR = nameRdrName intPrimLName +wordPrimL_RDR = nameRdrName wordPrimLName +floatPrimL_RDR = nameRdrName floatPrimLName +doublePrimL_RDR = nameRdrName doublePrimLName +stringPrimL_RDR = nameRdrName stringPrimLName +charPrimL_RDR = nameRdrName charPrimLName diff --git a/compiler/GHC/Builtin/PrimOps.hs b/compiler/GHC/Builtin/PrimOps.hs new file mode 100644 index 0000000000..e85c12a55d --- /dev/null +++ b/compiler/GHC/Builtin/PrimOps.hs @@ -0,0 +1,698 @@ +{- +(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 + +\section[PrimOp]{Primitive operations (machine-level)} +-} + +{-# LANGUAGE CPP #-} + +module GHC.Builtin.PrimOps ( + PrimOp(..), PrimOpVecCat(..), allThePrimOps, + primOpType, primOpSig, + primOpTag, maxPrimOpTag, primOpOcc, + primOpWrapperId, + + tagToEnumKey, + + primOpOutOfLine, primOpCodeSize, + primOpOkForSpeculation, primOpOkForSideEffects, + primOpIsCheap, primOpFixity, + + getPrimOpResultInfo, isComparisonPrimOp, PrimOpResultInfo(..), + + PrimCall(..) + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import GHC.Builtin.Types.Prim +import GHC.Builtin.Types + +import GHC.Cmm.Type +import GHC.Types.Demand +import GHC.Types.Id ( Id, mkVanillaGlobalWithInfo ) +import GHC.Types.Id.Info ( vanillaIdInfo, setCafInfo, CafInfo(NoCafRefs) ) +import GHC.Types.Name +import GHC.Builtin.Names ( gHC_PRIMOPWRAPPERS ) +import GHC.Core.TyCon ( TyCon, isPrimTyCon, PrimRep(..) ) +import GHC.Core.Type +import GHC.Types.RepType ( typePrimRep1, tyConPrimRep1 ) +import GHC.Types.Basic ( Arity, Fixity(..), FixityDirection(..), Boxity(..), + SourceText(..) ) +import GHC.Types.SrcLoc ( wiredInSrcSpan ) +import GHC.Types.ForeignCall ( CLabelString ) +import GHC.Types.Unique ( Unique, mkPrimOpIdUnique, mkPrimOpWrapperUnique ) +import GHC.Types.Module ( UnitId ) +import Outputable +import FastString + +{- +************************************************************************ +* * +\subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)} +* * +************************************************************************ + +These are in \tr{state-interface.verb} order. +-} + +-- supplies: +-- data PrimOp = ... +#include "primop-data-decl.hs-incl" + +-- supplies +-- primOpTag :: PrimOp -> Int +#include "primop-tag.hs-incl" +primOpTag _ = error "primOpTag: unknown primop" + + +instance Eq PrimOp where + op1 == op2 = primOpTag op1 == primOpTag op2 + +instance Ord PrimOp where + op1 < op2 = primOpTag op1 < primOpTag op2 + op1 <= op2 = primOpTag op1 <= primOpTag op2 + op1 >= op2 = primOpTag op1 >= primOpTag op2 + op1 > op2 = primOpTag op1 > primOpTag op2 + op1 `compare` op2 | op1 < op2 = LT + | op1 == op2 = EQ + | otherwise = GT + +instance Outputable PrimOp where + ppr op = pprPrimOp op + +data PrimOpVecCat = IntVec + | WordVec + | FloatVec + +-- An @Enum@-derived list would be better; meanwhile... (ToDo) + +allThePrimOps :: [PrimOp] +allThePrimOps = +#include "primop-list.hs-incl" + +tagToEnumKey :: Unique +tagToEnumKey = mkPrimOpIdUnique (primOpTag TagToEnumOp) + +{- +************************************************************************ +* * +\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@. +-} + +data PrimOpInfo + = Dyadic OccName -- string :: T -> T -> T + Type + | Monadic OccName -- string :: T -> T + Type + | Compare OccName -- string :: T -> T -> Int# + Type + | GenPrimOp OccName -- string :: \/a1..an . T1 -> .. -> Tk -> T + [TyVar] + [Type] + Type + +mkDyadic, mkMonadic, mkCompare :: FastString -> Type -> PrimOpInfo +mkDyadic str ty = Dyadic (mkVarOccFS str) ty +mkMonadic str ty = Monadic (mkVarOccFS str) ty +mkCompare str ty = Compare (mkVarOccFS str) ty + +mkGenPrimOp :: FastString -> [TyVar] -> [Type] -> Type -> PrimOpInfo +mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOccFS str) tvs tys ty + +{- +************************************************************************ +* * +\subsubsection{Strictness} +* * +************************************************************************ + +Not all primops are strict! +-} + +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" + +{- +************************************************************************ +* * +\subsubsection{Fixity} +* * +************************************************************************ +-} + +primOpFixity :: PrimOp -> Maybe Fixity +#include "primop-fixity.hs-incl" + +{- +************************************************************************ +* * +\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@. +-} + +primOpInfo :: PrimOp -> PrimOpInfo +#include "primop-primop-info.hs-incl" +primOpInfo _ = error "primOpInfo: unknown primop" + +{- +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.hs). + +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. + + +These primops are pretty weird. + + 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. + +************************************************************************ +* * + 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. +-} + +primOpOutOfLine :: PrimOp -> Bool +#include "primop-out-of-line.hs-incl" + +{- +************************************************************************ +* * + Failure and side effects +* * +************************************************************************ + +Note [Checking versus non-checking primops] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + In GHC primops break down into two classes: + + a. Checking primops behave, for instance, like division. In this + case the primop may throw an exception (e.g. division-by-zero) + and is consequently is marked with the can_fail flag described below. + The ability to fail comes at the expense of precluding some optimizations. + + b. Non-checking primops behavior, for instance, like addition. While + addition can overflow it does not produce an exception. So can_fail is + set to False, and we get more optimisation opportunities. But we must + never throw an exception, so we cannot rewrite to a call to error. + + It is important that a non-checking primop never be transformed in a way that + would cause it to bottom. Doing so would violate Core's let/app invariant + (see Note [Core let/app invariant] in GHC.Core) which is critical to + the simplifier's ability to float without fear of changing program meaning. + + +Note [PrimOp can_fail and has_side_effects] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Both can_fail and has_side_effects mean that the primop has +some effect that is not captured entirely by its result value. + +---------- has_side_effects --------------------- +A primop "has_side_effects" if it has some *write* effect, visible +elsewhere + - writing to the world (I/O) + - writing to a mutable data structure (writeIORef) + - throwing a synchronous Haskell exception + +Often such primops have a type like + State -> input -> (State, output) +so the state token guarantees ordering. In general we rely *only* on +data dependencies of the state token to enforce write-effect ordering + + * NB1: if you inline unsafePerformIO, you may end up with + side-effecting ops whose 'state' output is discarded. + And programmers may do that by hand; see #9390. + That is why we (conservatively) do not discard write-effecting + primops even if both their state and result is discarded. + + * NB2: We consider primops, such as raiseIO#, that can raise a + (Haskell) synchronous exception to "have_side_effects" but not + "can_fail". We must be careful about not discarding such things; + see the paper "A semantics for imprecise exceptions". + + * NB3: *Read* effects (like reading an IORef) don't count here, + because it doesn't matter if we don't do them, or do them more than + once. *Sequencing* is maintained by the data dependency of the state + token. + +---------- can_fail ---------------------------- +A primop "can_fail" if it can fail with an *unchecked* exception on +some elements of its input domain. Main examples: + division (fails on zero denominator) + array indexing (fails if the index is out of bounds) + +An "unchecked exception" is one that is an outright error, (not +turned into a Haskell exception,) such as seg-fault or +divide-by-zero error. Such can_fail primops are ALWAYS surrounded +with a test that checks for the bad cases, but we need to be +very careful about code motion that might move it out of +the scope of the test. + +Note [Transformations affected by can_fail and has_side_effects] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The can_fail and has_side_effects properties have the following effect +on program transformations. Summary table is followed by details. + + can_fail has_side_effects +Discard YES NO +Float in YES YES +Float out NO NO +Duplicate YES NO + +* Discarding. case (a `op` b) of _ -> rhs ===> rhs + You should not discard a has_side_effects primop; e.g. + case (writeIntArray# a i v s of (# _, _ #) -> True + Arguably you should be able to discard this, since the + returned stat token is not used, but that relies on NEVER + inlining unsafePerformIO, and programmers sometimes write + this kind of stuff by hand (#9390). So we (conservatively) + never discard a has_side_effects primop. + + However, it's fine to discard a can_fail primop. For example + case (indexIntArray# a i) of _ -> True + We can discard indexIntArray#; it has can_fail, but not + has_side_effects; see #5658 which was all about this. + Notice that indexIntArray# is (in a more general handling of + effects) read effect, but we don't care about that here, and + treat read effects as *not* has_side_effects. + + Similarly (a `/#` b) can be discarded. It can seg-fault or + cause a hardware exception, but not a synchronous Haskell + exception. + + + + Synchronous Haskell exceptions, e.g. from raiseIO#, are treated + as has_side_effects and hence are not discarded. + +* Float in. You can float a can_fail or has_side_effects primop + *inwards*, but not inside a lambda (see Duplication below). + +* Float out. You must not float a can_fail primop *outwards* lest + you escape the dynamic scope of the test. Example: + case d ># 0# of + True -> case x /# d of r -> r +# 1 + False -> 0 + Here we must not float the case outwards to give + case x/# d of r -> + case d ># 0# of + True -> r +# 1 + False -> 0 + + Nor can you float out a has_side_effects primop. For example: + if blah then case writeMutVar# v True s0 of (# s1 #) -> s1 + else s0 + Notice that s0 is mentioned in both branches of the 'if', but + only one of these two will actually be consumed. But if we + float out to + case writeMutVar# v True s0 of (# s1 #) -> + if blah then s1 else s0 + the writeMutVar will be performed in both branches, which is + utterly wrong. + +* Duplication. You cannot duplicate a has_side_effect primop. You + might wonder how this can occur given the state token threading, but + just look at Control.Monad.ST.Lazy.Imp.strictToLazy! We get + something like this + p = case readMutVar# s v of + (# s', r #) -> (S# s', r) + s' = case p of (s', r) -> s' + r = case p of (s', r) -> r + + (All these bindings are boxed.) If we inline p at its two call + sites, we get a catastrophe: because the read is performed once when + s' is demanded, and once when 'r' is demanded, which may be much + later. Utterly wrong. #3207 is real example of this happening. + + However, it's fine to duplicate a can_fail primop. That is really + the only difference between can_fail and has_side_effects. + +Note [Implementation: how can_fail/has_side_effects affect transformations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +How do we ensure that that floating/duplication/discarding are done right +in the simplifier? + +Two main predicates on primpops test these flags: + primOpOkForSideEffects <=> not has_side_effects + primOpOkForSpeculation <=> not (has_side_effects || can_fail) + + * The "no-float-out" thing is achieved by ensuring that we never + let-bind a can_fail or has_side_effects primop. The RHS of a + let-binding (which can float in and out freely) satisfies + exprOkForSpeculation; this is the let/app invariant. And + exprOkForSpeculation is false of can_fail and has_side_effects. + + * So can_fail and has_side_effects primops will appear only as the + scrutinees of cases, and that's why the FloatIn pass is capable + of floating case bindings inwards. + + * The no-duplicate thing is done via primOpIsCheap, by making + has_side_effects things (very very very) not-cheap! +-} + +primOpHasSideEffects :: PrimOp -> Bool +#include "primop-has-side-effects.hs-incl" + +primOpCanFail :: PrimOp -> Bool +#include "primop-can-fail.hs-incl" + +primOpOkForSpeculation :: PrimOp -> Bool + -- See Note [PrimOp can_fail and has_side_effects] + -- See comments with GHC.Core.Utils.exprOkForSpeculation + -- primOpOkForSpeculation => primOpOkForSideEffects +primOpOkForSpeculation op + = primOpOkForSideEffects op + && not (primOpOutOfLine op || primOpCanFail op) + -- I think the "out of line" test is because out of line things can + -- be expensive (eg sine, cosine), and so we may not want to speculate them + +primOpOkForSideEffects :: PrimOp -> Bool +primOpOkForSideEffects op + = not (primOpHasSideEffects op) + +{- +Note [primOpIsCheap] +~~~~~~~~~~~~~~~~~~~~ + +@primOpIsCheap@, as used in GHC.Core.Opt.Simplify.Utils. 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. +-} + +primOpIsCheap :: PrimOp -> Bool +-- See Note [PrimOp can_fail and has_side_effects] +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'. + +{- +************************************************************************ +* * + PrimOp code size +* * +************************************************************************ + +primOpCodeSize +~~~~~~~~~~~~~~ +Gives an indication of the code size of a primop, for the purposes of +calculating unfolding sizes; see GHC.Core.Unfold.sizeExpr. +-} + +primOpCodeSize :: PrimOp -> Int +#include "primop-code-size.hs-incl" + +primOpCodeSizeDefault :: Int +primOpCodeSizeDefault = 1 + -- GHC.Core.Unfold.primOpSize already takes into account primOpOutOfLine + -- and adds some further costs for the args in that case. + +primOpCodeSizeForeignCall :: Int +primOpCodeSizeForeignCall = 4 + +{- +************************************************************************ +* * + PrimOp types +* * +************************************************************************ +-} + +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 -> + mkSpecForAllTys tyvars (mkVisFunTys 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 + +{- Note [Primop wrappers] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Previously hasNoBinding would claim that PrimOpIds didn't have a curried +function definition. This caused quite some trouble as we would be forced to +eta expand unsaturated primop applications very late in the Core pipeline. Not +only would this produce unnecessary thunks, but it would also result in nasty +inconsistencies in CAFfy-ness determinations (see #16846 and +Note [CAFfyness inconsistencies due to late eta expansion] in GHC.Iface.Tidy). + +However, it was quite unnecessary for hasNoBinding to claim this; primops in +fact *do* have curried definitions which are found in GHC.PrimopWrappers, which +is auto-generated by utils/genprimops from prelude/primops.txt.pp. These wrappers +are standard Haskell functions mirroring the types of the primops they wrap. +For instance, in the case of plusInt# we would have: + + module GHC.PrimopWrappers where + import GHC.Prim as P + plusInt# a b = P.plusInt# a b + +We now take advantage of these curried definitions by letting hasNoBinding +claim that PrimOpIds have a curried definition and then rewrite any unsaturated +PrimOpId applications that we find during CoreToStg as applications of the +associated wrapper (e.g. `GHC.Prim.plusInt# 3#` will get rewritten to +`GHC.PrimopWrappers.plusInt# 3#`).` The Id of the wrapper for a primop can be +found using 'PrimOp.primOpWrapperId'. + +Nota Bene: GHC.PrimopWrappers is needed *regardless*, because it's +used by GHCi, which does not implement primops direct at all. + +-} + +-- | Returns the 'Id' of the wrapper associated with the given 'PrimOp'. +-- See Note [Primop wrappers]. +primOpWrapperId :: PrimOp -> Id +primOpWrapperId op = mkVanillaGlobalWithInfo name ty info + where + info = setCafInfo vanillaIdInfo NoCafRefs + name = mkExternalName uniq gHC_PRIMOPWRAPPERS (primOpOcc op) wiredInSrcSpan + uniq = mkPrimOpWrapperUnique (primOpTag op) + ty = primOpType op + +isComparisonPrimOp :: PrimOp -> Bool +isComparisonPrimOp op = case primOpInfo op of + Compare {} -> True + _ -> False + +-- 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], intPrimTy) + GenPrimOp _occ tyvars arg_tys res_ty -> (tyvars, arg_tys, res_ty ) + +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 (typePrimRep1 ty) + Monadic _ ty -> ReturnsPrim (typePrimRep1 ty) + Compare _ _ -> ReturnsPrim (tyConPrimRep1 intPrimTyCon) + GenPrimOp _ _ _ ty | isPrimTyCon tc -> ReturnsPrim (tyConPrimRep1 tc) + | otherwise -> ReturnsAlg tc + where + tc = tyConAppTyCon ty + -- All primops return a tycon-app result + -- The tycon can be an unboxed tuple or sum, though, + -- which gives rise to a ReturnAlg + +{- +We do not currently make use of whether primops are commutable. + +We used to try to move constants to the right hand side for strength +reduction. +-} + +{- +commutableOp :: PrimOp -> Bool +#include "primop-commutable.hs-incl" +-} + +-- Utils: + +dyadic_fun_ty, monadic_fun_ty, compare_fun_ty :: Type -> Type +dyadic_fun_ty ty = mkVisFunTys [ty, ty] ty +monadic_fun_ty ty = mkVisFunTy ty ty +compare_fun_ty ty = mkVisFunTys [ty, ty] intPrimTy + +-- Output stuff: + +pprPrimOp :: PrimOp -> SDoc +pprPrimOp other_op = pprOccName (primOpOcc other_op) + +{- +************************************************************************ +* * +\subsubsection[PrimCall]{User-imported primitive calls} +* * +************************************************************************ +-} + +data PrimCall = PrimCall CLabelString UnitId + +instance Outputable PrimCall where + ppr (PrimCall lbl pkgId) + = text "__primcall" <+> ppr pkgId <+> ppr lbl diff --git a/compiler/GHC/Builtin/PrimOps.hs-boot b/compiler/GHC/Builtin/PrimOps.hs-boot new file mode 100644 index 0000000000..e9f913f602 --- /dev/null +++ b/compiler/GHC/Builtin/PrimOps.hs-boot @@ -0,0 +1,5 @@ +module GHC.Builtin.PrimOps where + +import GhcPrelude () + +data PrimOp diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs new file mode 100644 index 0000000000..2e4ba28b6a --- /dev/null +++ b/compiler/GHC/Builtin/Types.hs @@ -0,0 +1,1690 @@ +{- +(c) The GRASP Project, Glasgow University, 1994-1998 + +Wired-in knowledge about {\em non-primitive} types +-} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +-- | This module is about types that can be defined in Haskell, but which +-- must be wired into the compiler nonetheless. C.f module GHC.Builtin.Types.Prim +module GHC.Builtin.Types ( + -- * Helper functions defined here + mkWiredInTyConName, -- This is used in GHC.Builtin.Types.Literals to define the + -- built-in functions for evaluation. + + mkWiredInIdName, -- used in GHC.Types.Id.Make + + -- * All wired in things + wiredInTyCons, isBuiltInOcc_maybe, + + -- * Bool + boolTy, boolTyCon, boolTyCon_RDR, boolTyConName, + trueDataCon, trueDataConId, true_RDR, + falseDataCon, falseDataConId, false_RDR, + promotedFalseDataCon, promotedTrueDataCon, + + -- * Ordering + orderingTyCon, + ordLTDataCon, ordLTDataConId, + ordEQDataCon, ordEQDataConId, + ordGTDataCon, ordGTDataConId, + promotedLTDataCon, promotedEQDataCon, promotedGTDataCon, + + -- * Boxing primitive types + boxingDataCon_maybe, + + -- * Char + charTyCon, charDataCon, charTyCon_RDR, + charTy, stringTy, charTyConName, + + -- * Double + doubleTyCon, doubleDataCon, doubleTy, doubleTyConName, + + -- * Float + floatTyCon, floatDataCon, floatTy, floatTyConName, + + -- * Int + intTyCon, intDataCon, intTyCon_RDR, intDataCon_RDR, intTyConName, + intTy, + + -- * Word + wordTyCon, wordDataCon, wordTyConName, wordTy, + + -- * Word8 + word8TyCon, word8DataCon, word8TyConName, word8Ty, + + -- * List + listTyCon, listTyCon_RDR, listTyConName, listTyConKey, + nilDataCon, nilDataConName, nilDataConKey, + consDataCon_RDR, consDataCon, consDataConName, + promotedNilDataCon, promotedConsDataCon, + mkListTy, mkPromotedListTy, + + -- * Maybe + maybeTyCon, maybeTyConName, + nothingDataCon, nothingDataConName, promotedNothingDataCon, + justDataCon, justDataConName, promotedJustDataCon, + + -- * Tuples + mkTupleTy, mkTupleTy1, mkBoxedTupleTy, mkTupleStr, + tupleTyCon, tupleDataCon, tupleTyConName, + promotedTupleDataCon, + unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey, + pairTyCon, + unboxedUnitTyCon, unboxedUnitDataCon, + unboxedTupleKind, unboxedSumKind, + + -- ** Constraint tuples + cTupleTyConName, cTupleTyConNames, isCTupleTyConName, + cTupleTyConNameArity_maybe, + cTupleDataConName, cTupleDataConNames, + + -- * Any + anyTyCon, anyTy, anyTypeOfKind, + + -- * Recovery TyCon + makeRecoveryTyCon, + + -- * Sums + mkSumTy, sumTyCon, sumDataCon, + + -- * Kinds + typeNatKindCon, typeNatKind, typeSymbolKindCon, typeSymbolKind, + isLiftedTypeKindTyConName, liftedTypeKind, + typeToTypeKind, constraintKind, + liftedTypeKindTyCon, constraintKindTyCon, constraintKindTyConName, + liftedTypeKindTyConName, + + -- * Equality predicates + heqTyCon, heqTyConName, heqClass, heqDataCon, + eqTyCon, eqTyConName, eqClass, eqDataCon, eqTyCon_RDR, + coercibleTyCon, coercibleTyConName, coercibleDataCon, coercibleClass, + + -- * RuntimeRep and friends + runtimeRepTyCon, vecCountTyCon, vecElemTyCon, + + runtimeRepTy, liftedRepTy, liftedRepDataCon, liftedRepDataConTyCon, + + vecRepDataConTyCon, tupleRepDataConTyCon, sumRepDataConTyCon, + + liftedRepDataConTy, unliftedRepDataConTy, + intRepDataConTy, + int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy, + wordRepDataConTy, + word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy, + addrRepDataConTy, + floatRepDataConTy, doubleRepDataConTy, + + vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy, + vec64DataConTy, + + int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy, + int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy, + word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy, + doubleElemRepDataConTy + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import {-# SOURCE #-} GHC.Types.Id.Make ( mkDataConWorkId, mkDictSelId ) + +-- friends: +import GHC.Builtin.Names +import GHC.Builtin.Types.Prim +import {-# SOURCE #-} GHC.Builtin.Uniques + +-- others: +import GHC.Core.Coercion.Axiom +import GHC.Types.Id +import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE ) +import GHC.Types.Module ( Module ) +import GHC.Core.Type +import GHC.Types.RepType +import GHC.Core.DataCon +import {-# SOURCE #-} GHC.Core.ConLike +import GHC.Core.TyCon +import GHC.Core.Class ( Class, mkClass ) +import GHC.Types.Name.Reader +import GHC.Types.Name as Name +import GHC.Types.Name.Env ( NameEnv, mkNameEnv, lookupNameEnv, lookupNameEnv_NF ) +import GHC.Types.Name.Set ( NameSet, mkNameSet, elemNameSet ) +import GHC.Types.Basic +import GHC.Types.ForeignCall +import GHC.Types.SrcLoc ( noSrcSpan ) +import GHC.Types.Unique +import Data.Array +import FastString +import Outputable +import Util +import BooleanFormula ( mkAnd ) + +import qualified Data.ByteString.Char8 as BS + +import Data.List ( elemIndex ) + +alpha_tyvar :: [TyVar] +alpha_tyvar = [alphaTyVar] + +alpha_ty :: [Type] +alpha_ty = [alphaTy] + +{- +Note [Wiring in RuntimeRep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The RuntimeRep type (and friends) in GHC.Types has a bunch of constructors, +making it a pain to wire in. To ease the pain somewhat, we use lists of +the different bits, like Uniques, Names, DataCons. These lists must be +kept in sync with each other. The rule is this: use the order as declared +in GHC.Types. All places where such lists exist should contain a reference +to this Note, so a search for this Note's name should find all the lists. + +See also Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType. + +************************************************************************ +* * +\subsection{Wired in type constructors} +* * +************************************************************************ + +If you change which things are wired in, make sure you change their +names in GHC.Builtin.Names, so they use wTcQual, wDataQual, etc +-} + +-- This list is used only to define GHC.Builtin.Utils.wiredInThings. That in turn +-- is used to initialise the name environment carried around by the renamer. +-- This means that if we look up the name of a TyCon (or its implicit binders) +-- that occurs in this list that name will be assigned the wired-in key we +-- define here. +-- +-- Because of their infinite nature, this list excludes tuples, Any and implicit +-- parameter TyCons (see Note [Built-in syntax and the OrigNameCache]). +-- +-- See also Note [Known-key names] +wiredInTyCons :: [TyCon] + +wiredInTyCons = [ -- Units are not treated like other tuples, because they + -- are defined in GHC.Base, and there's only a few of them. We + -- put them in wiredInTyCons so that they will pre-populate + -- the name cache, so the parser in isBuiltInOcc_maybe doesn't + -- need to look out for them. + unitTyCon + , unboxedUnitTyCon + , anyTyCon + , boolTyCon + , charTyCon + , doubleTyCon + , floatTyCon + , intTyCon + , wordTyCon + , word8TyCon + , listTyCon + , maybeTyCon + , heqTyCon + , eqTyCon + , coercibleTyCon + , typeNatKindCon + , typeSymbolKindCon + , runtimeRepTyCon + , vecCountTyCon + , vecElemTyCon + , constraintKindTyCon + , liftedTypeKindTyCon + ] + +mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name +mkWiredInTyConName built_in modu fs unique tycon + = mkWiredInName modu (mkTcOccFS fs) unique + (ATyCon tycon) -- Relevant TyCon + built_in + +mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name +mkWiredInDataConName built_in modu fs unique datacon + = mkWiredInName modu (mkDataOccFS fs) unique + (AConLike (RealDataCon datacon)) -- Relevant DataCon + built_in + +mkWiredInIdName :: Module -> FastString -> Unique -> Id -> Name +mkWiredInIdName mod fs uniq id + = mkWiredInName mod (mkOccNameFS Name.varName fs) uniq (AnId id) UserSyntax + +-- See Note [Kind-changing of (~) and Coercible] +-- in libraries/ghc-prim/GHC/Types.hs +eqTyConName, eqDataConName, eqSCSelIdName :: Name +eqTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "~") eqTyConKey eqTyCon +eqDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Eq#") eqDataConKey eqDataCon +eqSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "eq_sel") eqSCSelIdKey eqSCSelId + +{- Note [eqTyCon (~) is built-in syntax] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The (~) type operator used in equality constraints (a~b) is considered built-in +syntax. This has a few consequences: + +* The user is not allowed to define their own type constructors with this name: + + ghci> class a ~ b + <interactive>:1:1: error: Illegal binding of built-in syntax: ~ + +* Writing (a ~ b) does not require enabling -XTypeOperators. It does, however, + require -XGADTs or -XTypeFamilies. + +* The (~) type operator is always in scope. It doesn't need to be be imported, + and it cannot be hidden. + +* We have a bunch of special cases in the compiler to arrange all of the above. + +There's no particular reason for (~) to be special, but fixing this would be a +breaking change. +-} +eqTyCon_RDR :: RdrName +eqTyCon_RDR = nameRdrName eqTyConName + +-- See Note [Kind-changing of (~) and Coercible] +-- in libraries/ghc-prim/GHC/Types.hs +heqTyConName, heqDataConName, heqSCSelIdName :: Name +heqTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "~~") heqTyConKey heqTyCon +heqDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "HEq#") heqDataConKey heqDataCon +heqSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "heq_sel") heqSCSelIdKey heqSCSelId + +-- See Note [Kind-changing of (~) and Coercible] in libraries/ghc-prim/GHC/Types.hs +coercibleTyConName, coercibleDataConName, coercibleSCSelIdName :: Name +coercibleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Coercible") coercibleTyConKey coercibleTyCon +coercibleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "MkCoercible") coercibleDataConKey coercibleDataCon +coercibleSCSelIdName = mkWiredInIdName gHC_TYPES (fsLit "coercible_sel") coercibleSCSelIdKey coercibleSCSelId + +charTyConName, charDataConName, intTyConName, intDataConName :: Name +charTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Char") charTyConKey charTyCon +charDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "C#") charDataConKey charDataCon +intTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Int") intTyConKey intTyCon +intDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "I#") intDataConKey intDataCon + +boolTyConName, falseDataConName, trueDataConName :: Name +boolTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Bool") boolTyConKey boolTyCon +falseDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "False") falseDataConKey falseDataCon +trueDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "True") trueDataConKey trueDataCon + +listTyConName, nilDataConName, consDataConName :: Name +listTyConName = mkWiredInTyConName BuiltInSyntax gHC_TYPES (fsLit "[]") listTyConKey listTyCon +nilDataConName = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "[]") nilDataConKey nilDataCon +consDataConName = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit ":") consDataConKey consDataCon + +maybeTyConName, nothingDataConName, justDataConName :: Name +maybeTyConName = mkWiredInTyConName UserSyntax gHC_MAYBE (fsLit "Maybe") + maybeTyConKey maybeTyCon +nothingDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Nothing") + nothingDataConKey nothingDataCon +justDataConName = mkWiredInDataConName UserSyntax gHC_MAYBE (fsLit "Just") + justDataConKey justDataCon + +wordTyConName, wordDataConName, word8TyConName, word8DataConName :: Name +wordTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Word") wordTyConKey wordTyCon +wordDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "W#") wordDataConKey wordDataCon +word8TyConName = mkWiredInTyConName UserSyntax gHC_WORD (fsLit "Word8") word8TyConKey word8TyCon +word8DataConName = mkWiredInDataConName UserSyntax gHC_WORD (fsLit "W8#") word8DataConKey word8DataCon + +floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name +floatTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Float") floatTyConKey floatTyCon +floatDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "F#") floatDataConKey floatDataCon +doubleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Double") doubleTyConKey doubleTyCon +doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") doubleDataConKey doubleDataCon + +-- Any + +{- +Note [Any types] +~~~~~~~~~~~~~~~~ +The type constructor Any, + + type family Any :: k where { } + +It has these properties: + + * Note that 'Any' is kind polymorphic since in some program we may + need to use Any to fill in a type variable of some kind other than * + (see #959 for examples). Its kind is thus `forall k. k``. + + * It is defined in module GHC.Types, and exported so that it is + available to users. For this reason it's treated like any other + wired-in type: + - has a fixed unique, anyTyConKey, + - lives in the global name cache + + * It is a *closed* type family, with no instances. This means that + if ty :: '(k1, k2) we add a given coercion + g :: ty ~ (Fst ty, Snd ty) + If Any was a *data* type, then we'd get inconsistency because 'ty' + could be (Any '(k1,k2)) and then we'd have an equality with Any on + one side and '(,) on the other. See also #9097 and #9636. + + * When instantiated at a lifted type it is inhabited by at least one value, + namely bottom + + * You can safely coerce any /lifted/ type to Any, and back with unsafeCoerce. + + * It does not claim to be a *data* type, and that's important for + the code generator, because the code gen may *enter* a data value + but never enters a function value. + + * It is wired-in so we can easily refer to it where we don't have a name + environment (e.g. see Rules.matchRule for one example) + + * If (Any k) is the type of a value, it must be a /lifted/ value. So + if we have (Any @(TYPE rr)) then rr must be 'LiftedRep. See + Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim. This is a convenient + invariant, and makes isUnliftedTyCon well-defined; otherwise what + would (isUnliftedTyCon Any) be? + +It's used to instantiate un-constrained type variables after type checking. For +example, 'length' has type + + length :: forall a. [a] -> Int + +and the list datacon for the empty list has type + + [] :: forall a. [a] + +In order to compose these two terms as @length []@ a type +application is required, but there is no constraint on the +choice. In this situation GHC uses 'Any', + +> length (Any *) ([] (Any *)) + +Above, we print kinds explicitly, as if with --fprint-explicit-kinds. + +The Any tycon used to be quite magic, but we have since been able to +implement it merely with an empty kind polymorphic type family. See #10886 for a +bit of history. +-} + + +anyTyConName :: Name +anyTyConName = + mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Any") anyTyConKey anyTyCon + +anyTyCon :: TyCon +anyTyCon = mkFamilyTyCon anyTyConName binders res_kind Nothing + (ClosedSynFamilyTyCon Nothing) + Nothing + NotInjective + where + binders@[kv] = mkTemplateKindTyConBinders [liftedTypeKind] + res_kind = mkTyVarTy (binderVar kv) + +anyTy :: Type +anyTy = mkTyConTy anyTyCon + +anyTypeOfKind :: Kind -> Type +anyTypeOfKind kind = mkTyConApp anyTyCon [kind] + +-- | Make a fake, recovery 'TyCon' from an existing one. +-- Used when recovering from errors in type declarations +makeRecoveryTyCon :: TyCon -> TyCon +makeRecoveryTyCon tc + = mkTcTyCon (tyConName tc) + bndrs res_kind + noTcTyConScopedTyVars + True -- Fully generalised + flavour -- Keep old flavour + where + flavour = tyConFlavour tc + [kv] = mkTemplateKindVars [liftedTypeKind] + (bndrs, res_kind) + = case flavour of + PromotedDataConFlavour -> ([mkNamedTyConBinder Inferred kv], mkTyVarTy kv) + _ -> (tyConBinders tc, tyConResKind tc) + -- For data types we have already validated their kind, so it + -- makes sense to keep it. For promoted data constructors we haven't, + -- so we recover with kind (forall k. k). Otherwise consider + -- data T a where { MkT :: Show a => T a } + -- If T is for some reason invalid, we don't want to fall over + -- at (promoted) use-sites of MkT. + +-- Kinds +typeNatKindConName, typeSymbolKindConName :: Name +typeNatKindConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Nat") typeNatKindConNameKey typeNatKindCon +typeSymbolKindConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Symbol") typeSymbolKindConNameKey typeSymbolKindCon + +constraintKindTyConName :: Name +constraintKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Constraint") constraintKindTyConKey constraintKindTyCon + +liftedTypeKindTyConName :: Name +liftedTypeKindTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Type") liftedTypeKindTyConKey liftedTypeKindTyCon + +runtimeRepTyConName, vecRepDataConName, tupleRepDataConName, sumRepDataConName :: Name +runtimeRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "RuntimeRep") runtimeRepTyConKey runtimeRepTyCon +vecRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "VecRep") vecRepDataConKey vecRepDataCon +tupleRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "TupleRep") tupleRepDataConKey tupleRepDataCon +sumRepDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "SumRep") sumRepDataConKey sumRepDataCon + +-- See Note [Wiring in RuntimeRep] +runtimeRepSimpleDataConNames :: [Name] +runtimeRepSimpleDataConNames + = zipWith3Lazy mk_special_dc_name + [ fsLit "LiftedRep", fsLit "UnliftedRep" + , fsLit "IntRep" + , fsLit "Int8Rep", fsLit "Int16Rep", fsLit "Int32Rep", fsLit "Int64Rep" + , fsLit "WordRep" + , fsLit "Word8Rep", fsLit "Word16Rep", fsLit "Word32Rep", fsLit "Word64Rep" + , fsLit "AddrRep" + , fsLit "FloatRep", fsLit "DoubleRep" + ] + runtimeRepSimpleDataConKeys + runtimeRepSimpleDataCons + +vecCountTyConName :: Name +vecCountTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "VecCount") vecCountTyConKey vecCountTyCon + +-- See Note [Wiring in RuntimeRep] +vecCountDataConNames :: [Name] +vecCountDataConNames = zipWith3Lazy mk_special_dc_name + [ fsLit "Vec2", fsLit "Vec4", fsLit "Vec8" + , fsLit "Vec16", fsLit "Vec32", fsLit "Vec64" ] + vecCountDataConKeys + vecCountDataCons + +vecElemTyConName :: Name +vecElemTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "VecElem") vecElemTyConKey vecElemTyCon + +-- See Note [Wiring in RuntimeRep] +vecElemDataConNames :: [Name] +vecElemDataConNames = zipWith3Lazy mk_special_dc_name + [ fsLit "Int8ElemRep", fsLit "Int16ElemRep", fsLit "Int32ElemRep" + , fsLit "Int64ElemRep", fsLit "Word8ElemRep", fsLit "Word16ElemRep" + , fsLit "Word32ElemRep", fsLit "Word64ElemRep" + , fsLit "FloatElemRep", fsLit "DoubleElemRep" ] + vecElemDataConKeys + vecElemDataCons + +mk_special_dc_name :: FastString -> Unique -> DataCon -> Name +mk_special_dc_name fs u dc = mkWiredInDataConName UserSyntax gHC_TYPES fs u dc + +boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR, + intDataCon_RDR, listTyCon_RDR, consDataCon_RDR :: RdrName +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 + +{- +************************************************************************ +* * +\subsection{mkWiredInTyCon} +* * +************************************************************************ +-} + +-- This function assumes that the types it creates have all parameters at +-- Representational role, and that there is no kind polymorphism. +pcTyCon :: Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon +pcTyCon name cType tyvars cons + = mkAlgTyCon name + (mkAnonTyConBinders VisArg tyvars) + liftedTypeKind + (map (const Representational) tyvars) + cType + [] -- No stupid theta + (mkDataTyConRhs cons) + (VanillaAlgTyCon (mkPrelTyConRepName name)) + False -- Not in GADT syntax + +pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon +pcDataCon n univs = pcDataConWithFixity False n univs + [] -- no ex_tvs + univs -- the univs are precisely the user-written tyvars + +pcDataConWithFixity :: Bool -- ^ declared infix? + -> Name -- ^ datacon name + -> [TyVar] -- ^ univ tyvars + -> [TyCoVar] -- ^ ex tycovars + -> [TyCoVar] -- ^ user-written tycovars + -> [Type] -- ^ args + -> TyCon + -> DataCon +pcDataConWithFixity infx n = pcDataConWithFixity' infx n (dataConWorkerUnique (nameUnique n)) + NoRRI +-- The Name's unique is the first of two free uniques; +-- the first is used for the datacon itself, +-- the second is used for the "worker name" +-- +-- To support this the mkPreludeDataConUnique function "allocates" +-- one DataCon unique per pair of Ints. + +pcDataConWithFixity' :: Bool -> Name -> Unique -> RuntimeRepInfo + -> [TyVar] -> [TyCoVar] -> [TyCoVar] + -> [Type] -> TyCon -> DataCon +-- The Name should be in the DataName name space; it's the name +-- of the DataCon itself. +-- +-- IMPORTANT NOTE: +-- if you try to wire-in a /GADT/ data constructor you will +-- find it hard (we did). You will need wrapper and worker +-- Names, a DataConBoxer, DataConRep, EqSpec, etc. +-- Try hard not to wire-in GADT data types. You will live +-- to regret doing so (we do). + +pcDataConWithFixity' declared_infix dc_name wrk_key rri + tyvars ex_tyvars user_tyvars arg_tys tycon + = data_con + where + tag_map = mkTyConTagMap tycon + -- This constructs the constructor Name to ConTag map once per + -- constructor, which is quadratic. It's OK here, because it's + -- only called for wired in data types that don't have a lot of + -- constructors. It's also likely that GHC will lift tag_map, since + -- we call pcDataConWithFixity' with static TyCons in the same module. + -- See Note [Constructor tag allocation] and #14657 + data_con = mkDataCon dc_name declared_infix prom_info + (map (const no_bang) arg_tys) + [] -- No labelled fields + tyvars ex_tyvars + (mkTyCoVarBinders Specified user_tyvars) + [] -- No equality spec + [] -- No theta + arg_tys (mkTyConApp tycon (mkTyVarTys tyvars)) + rri + tycon + (lookupNameEnv_NF tag_map dc_name) + [] -- No stupid theta + (mkDataConWorkId wrk_name data_con) + NoDataConRep -- Wired-in types are too simple to need wrappers + + no_bang = HsSrcBang NoSourceText NoSrcUnpack NoSrcStrict + + wrk_name = mkDataConWorkerName data_con wrk_key + + prom_info = mkPrelTyConRepName dc_name + +mkDataConWorkerName :: DataCon -> Unique -> Name +mkDataConWorkerName data_con wrk_key = + mkWiredInName modu wrk_occ wrk_key + (AnId (dataConWorkId data_con)) UserSyntax + where + modu = ASSERT( isExternalName dc_name ) + nameModule dc_name + dc_name = dataConName data_con + dc_occ = nameOccName dc_name + wrk_occ = mkDataConWorkerOcc dc_occ + +-- used for RuntimeRep and friends +pcSpecialDataCon :: Name -> [Type] -> TyCon -> RuntimeRepInfo -> DataCon +pcSpecialDataCon dc_name arg_tys tycon rri + = pcDataConWithFixity' False dc_name (dataConWorkerUnique (nameUnique dc_name)) rri + [] [] [] arg_tys tycon + +{- +************************************************************************ +* * + Kinds +* * +************************************************************************ +-} + +typeNatKindCon, typeSymbolKindCon :: TyCon +-- data Nat +-- data Symbol +typeNatKindCon = pcTyCon typeNatKindConName Nothing [] [] +typeSymbolKindCon = pcTyCon typeSymbolKindConName Nothing [] [] + +typeNatKind, typeSymbolKind :: Kind +typeNatKind = mkTyConTy typeNatKindCon +typeSymbolKind = mkTyConTy typeSymbolKindCon + +constraintKindTyCon :: TyCon +-- 'TyCon.isConstraintKindCon' assumes that this is an AlgTyCon! +constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] [] + +liftedTypeKind, typeToTypeKind, constraintKind :: Kind +liftedTypeKind = tYPE liftedRepTy +typeToTypeKind = liftedTypeKind `mkVisFunTy` liftedTypeKind +constraintKind = mkTyConApp constraintKindTyCon [] + +{- +************************************************************************ +* * + Stuff for dealing with tuples +* * +************************************************************************ + +Note [How tuples work] See also Note [Known-key names] in GHC.Builtin.Names +~~~~~~~~~~~~~~~~~~~~~~ +* There are three families of tuple TyCons and corresponding + DataCons, expressed by the type BasicTypes.TupleSort: + data TupleSort = BoxedTuple | UnboxedTuple | ConstraintTuple + +* All three families are AlgTyCons, whose AlgTyConRhs is TupleTyCon + +* BoxedTuples + - A wired-in type + - Data type declarations in GHC.Tuple + - The data constructors really have an info table + +* UnboxedTuples + - A wired-in type + - Have a pretend DataCon, defined in GHC.Prim, + but no actual declaration and no info table + +* ConstraintTuples + - Are known-key rather than wired-in. Reason: it's awkward to + have all the superclass selectors wired-in. + - Declared as classes in GHC.Classes, e.g. + class (c1,c2) => (c1,c2) + - Given constraints: the superclasses automatically become available + - Wanted constraints: there is a built-in instance + instance (c1,c2) => (c1,c2) + See GHC.Tc.Solver.Interact.matchCTuple + - Currently just go up to 62; beyond that + you have to use manual nesting + - Their OccNames look like (%,,,%), so they can easily be + distinguished from term tuples. But (following Haskell) we + pretty-print saturated constraint tuples with round parens; + see BasicTypes.tupleParens. + +* In quite a lot of places things are restricted just to + BoxedTuple/UnboxedTuple, and then we used BasicTypes.Boxity to distinguish + E.g. tupleTyCon has a Boxity argument + +* When looking up an OccName in the original-name cache + (GHC.Iface.Env.lookupOrigNameCache), we spot the tuple OccName to make sure + we get the right wired-in name. This guy can't tell the difference + between BoxedTuple and ConstraintTuple (same OccName!), so tuples + are not serialised into interface files using OccNames at all. + +* Serialization to interface files works via the usual mechanism for known-key + things: instead of serializing the OccName we just serialize the key. During + deserialization we lookup the Name associated with the unique with the logic + in GHC.Builtin.Uniques. See Note [Symbol table representation of names] for details. + +Note [One-tuples] +~~~~~~~~~~~~~~~~~ +GHC supports both boxed and unboxed one-tuples: + - Unboxed one-tuples are sometimes useful when returning a + single value after CPR analysis + - A boxed one-tuple is used by GHC.HsToCore.Utils.mkSelectorBinds, when + there is just one binder +Basically it keeps everything uniform. + +However the /naming/ of the type/data constructors for one-tuples is a +bit odd: + 3-tuples: (,,) (,,)# + 2-tuples: (,) (,)# + 1-tuples: ?? + 0-tuples: () ()# + +Zero-tuples have used up the logical name. So we use 'Unit' and 'Unit#' +for one-tuples. So in ghc-prim:GHC.Tuple we see the declarations: + data () = () + data Unit a = Unit a + data (a,b) = (a,b) + +There is no way to write a boxed one-tuple in Haskell, but it can be +created in Template Haskell or in, e.g., `deriving` code. There is +nothing special about one-tuples in Core; in particular, they have no +custom pretty-printing, just using `Unit`. + +Note that there is *not* a unary constraint tuple, unlike for other forms of +tuples. See [Ignore unary constraint tuples] in GHC.Tc.Gen.HsType for more +details. + +See also Note [Flattening one-tuples] in GHC.Core.Make and +Note [Don't flatten tuples from HsSyn] in GHC.Core.Make. + +-} + +-- | Built-in syntax isn't "in scope" so these OccNames map to wired-in Names +-- with BuiltInSyntax. However, this should only be necessary while resolving +-- names produced by Template Haskell splices since we take care to encode +-- built-in syntax names specially in interface files. See +-- Note [Symbol table representation of names]. +-- +-- Moreover, there is no need to include names of things that the user can't +-- write (e.g. type representation bindings like $tc(,,,)). +isBuiltInOcc_maybe :: OccName -> Maybe Name +isBuiltInOcc_maybe occ = + case name of + "[]" -> Just $ choose_ns listTyConName nilDataConName + ":" -> Just consDataConName + + -- equality tycon + "~" -> Just eqTyConName + + -- function tycon + "->" -> Just funTyConName + + -- boxed tuple data/tycon + "()" -> Just $ tup_name Boxed 0 + _ | Just rest <- "(" `BS.stripPrefix` name + , (commas, rest') <- BS.span (==',') rest + , ")" <- rest' + -> Just $ tup_name Boxed (1+BS.length commas) + + -- unboxed tuple data/tycon + "(##)" -> Just $ tup_name Unboxed 0 + "Unit#" -> Just $ tup_name Unboxed 1 + _ | Just rest <- "(#" `BS.stripPrefix` name + , (commas, rest') <- BS.span (==',') rest + , "#)" <- rest' + -> Just $ tup_name Unboxed (1+BS.length commas) + + -- unboxed sum tycon + _ | Just rest <- "(#" `BS.stripPrefix` name + , (pipes, rest') <- BS.span (=='|') rest + , "#)" <- rest' + -> Just $ tyConName $ sumTyCon (1+BS.length pipes) + + -- unboxed sum datacon + _ | Just rest <- "(#" `BS.stripPrefix` name + , (pipes1, rest') <- BS.span (=='|') rest + , Just rest'' <- "_" `BS.stripPrefix` rest' + , (pipes2, rest''') <- BS.span (=='|') rest'' + , "#)" <- rest''' + -> let arity = BS.length pipes1 + BS.length pipes2 + 1 + alt = BS.length pipes1 + 1 + in Just $ dataConName $ sumDataCon alt arity + _ -> Nothing + where + name = bytesFS $ occNameFS occ + + choose_ns :: Name -> Name -> Name + choose_ns tc dc + | isTcClsNameSpace ns = tc + | isDataConNameSpace ns = dc + | otherwise = pprPanic "tup_name" (ppr occ) + where ns = occNameSpace occ + + tup_name boxity arity + = choose_ns (getName (tupleTyCon boxity arity)) + (getName (tupleDataCon boxity arity)) + +mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName +-- No need to cache these, the caching is done in mk_tuple +mkTupleOcc ns Boxed ar = mkOccName ns (mkBoxedTupleStr ar) +mkTupleOcc ns Unboxed ar = mkOccName ns (mkUnboxedTupleStr ar) + +mkCTupleOcc :: NameSpace -> Arity -> OccName +mkCTupleOcc ns ar = mkOccName ns (mkConstraintTupleStr ar) + +mkTupleStr :: Boxity -> Arity -> String +mkTupleStr Boxed = mkBoxedTupleStr +mkTupleStr Unboxed = mkUnboxedTupleStr + +mkBoxedTupleStr :: Arity -> String +mkBoxedTupleStr 0 = "()" +mkBoxedTupleStr 1 = "Unit" -- See Note [One-tuples] +mkBoxedTupleStr ar = '(' : commas ar ++ ")" + +mkUnboxedTupleStr :: Arity -> String +mkUnboxedTupleStr 0 = "(##)" +mkUnboxedTupleStr 1 = "Unit#" -- See Note [One-tuples] +mkUnboxedTupleStr ar = "(#" ++ commas ar ++ "#)" + +mkConstraintTupleStr :: Arity -> String +mkConstraintTupleStr 0 = "(%%)" +mkConstraintTupleStr 1 = "Unit%" -- See Note [One-tuples] +mkConstraintTupleStr ar = "(%" ++ commas ar ++ "%)" + +commas :: Arity -> String +commas ar = take (ar-1) (repeat ',') + +cTupleTyConName :: Arity -> Name +cTupleTyConName arity + = mkExternalName (mkCTupleTyConUnique arity) gHC_CLASSES + (mkCTupleOcc tcName arity) noSrcSpan + +cTupleTyConNames :: [Name] +cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE]) + +cTupleTyConNameSet :: NameSet +cTupleTyConNameSet = mkNameSet cTupleTyConNames + +isCTupleTyConName :: Name -> Bool +-- Use Type.isCTupleClass where possible +isCTupleTyConName n + = ASSERT2( isExternalName n, ppr n ) + nameModule n == gHC_CLASSES + && n `elemNameSet` cTupleTyConNameSet + +-- | If the given name is that of a constraint tuple, return its arity. +-- Note that this is inefficient. +cTupleTyConNameArity_maybe :: Name -> Maybe Arity +cTupleTyConNameArity_maybe n + | not (isCTupleTyConName n) = Nothing + | otherwise = fmap adjustArity (n `elemIndex` cTupleTyConNames) + where + -- Since `cTupleTyConNames` jumps straight from the `0` to the `2` + -- case, we have to adjust accordingly our calculated arity. + adjustArity a = if a > 0 then a + 1 else a + +cTupleDataConName :: Arity -> Name +cTupleDataConName arity + = mkExternalName (mkCTupleDataConUnique arity) gHC_CLASSES + (mkCTupleOcc dataName arity) noSrcSpan + +cTupleDataConNames :: [Name] +cTupleDataConNames = map cTupleDataConName (0 : [2..mAX_CTUPLE_SIZE]) + +tupleTyCon :: Boxity -> Arity -> TyCon +tupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i) -- Build one specially +tupleTyCon Boxed i = fst (boxedTupleArr ! i) +tupleTyCon Unboxed i = fst (unboxedTupleArr ! i) + +tupleTyConName :: TupleSort -> Arity -> Name +tupleTyConName ConstraintTuple a = cTupleTyConName a +tupleTyConName BoxedTuple a = tyConName (tupleTyCon Boxed a) +tupleTyConName UnboxedTuple a = tyConName (tupleTyCon Unboxed a) + +promotedTupleDataCon :: Boxity -> Arity -> TyCon +promotedTupleDataCon boxity i = promoteDataCon (tupleDataCon boxity i) + +tupleDataCon :: Boxity -> Arity -> DataCon +tupleDataCon sort i | i > mAX_TUPLE_SIZE = snd (mk_tuple sort i) -- Build one specially +tupleDataCon Boxed i = snd (boxedTupleArr ! i) +tupleDataCon 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]] + +-- | Given the TupleRep/SumRep tycon and list of RuntimeReps of the unboxed +-- tuple/sum arguments, produces the return kind of an unboxed tuple/sum type +-- constructor. @unboxedTupleSumKind [IntRep, LiftedRep] --> TYPE (TupleRep/SumRep +-- [IntRep, LiftedRep])@ +unboxedTupleSumKind :: TyCon -> [Type] -> Kind +unboxedTupleSumKind tc rr_tys + = tYPE (mkTyConApp tc [mkPromotedListTy runtimeRepTy rr_tys]) + +-- | Specialization of 'unboxedTupleSumKind' for tuples +unboxedTupleKind :: [Type] -> Kind +unboxedTupleKind = unboxedTupleSumKind tupleRepDataConTyCon + +mk_tuple :: Boxity -> Int -> (TyCon,DataCon) +mk_tuple Boxed arity = (tycon, tuple_con) + where + tycon = mkTupleTyCon tc_name tc_binders tc_res_kind tc_arity tuple_con + BoxedTuple flavour + + tc_binders = mkTemplateAnonTyConBinders (replicate arity liftedTypeKind) + tc_res_kind = liftedTypeKind + tc_arity = arity + flavour = VanillaAlgTyCon (mkPrelTyConRepName tc_name) + + dc_tvs = binderVars tc_binders + dc_arg_tys = mkTyVarTys dc_tvs + tuple_con = pcDataCon dc_name dc_tvs dc_arg_tys tycon + + boxity = Boxed + modu = gHC_TUPLE + tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq + (ATyCon tycon) BuiltInSyntax + dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq + (AConLike (RealDataCon tuple_con)) BuiltInSyntax + tc_uniq = mkTupleTyConUnique boxity arity + dc_uniq = mkTupleDataConUnique boxity arity + +mk_tuple Unboxed arity = (tycon, tuple_con) + where + tycon = mkTupleTyCon tc_name tc_binders tc_res_kind tc_arity tuple_con + UnboxedTuple flavour + + -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon + -- Kind: forall (k1:RuntimeRep) (k2:RuntimeRep). TYPE k1 -> TYPE k2 -> # + tc_binders = mkTemplateTyConBinders (replicate arity runtimeRepTy) + (\ks -> map tYPE ks) + + tc_res_kind = unboxedTupleKind rr_tys + + tc_arity = arity * 2 + flavour = UnboxedAlgTyCon $ Just (mkPrelTyConRepName tc_name) + + dc_tvs = binderVars tc_binders + (rr_tys, dc_arg_tys) = splitAt arity (mkTyVarTys dc_tvs) + tuple_con = pcDataCon dc_name dc_tvs dc_arg_tys tycon + + boxity = Unboxed + modu = gHC_PRIM + tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq + (ATyCon tycon) BuiltInSyntax + dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq + (AConLike (RealDataCon tuple_con)) BuiltInSyntax + tc_uniq = mkTupleTyConUnique boxity arity + dc_uniq = mkTupleDataConUnique boxity arity + +unitTyCon :: TyCon +unitTyCon = tupleTyCon Boxed 0 + +unitTyConKey :: Unique +unitTyConKey = getUnique unitTyCon + +unitDataCon :: DataCon +unitDataCon = head (tyConDataCons unitTyCon) + +unitDataConId :: Id +unitDataConId = dataConWorkId unitDataCon + +pairTyCon :: TyCon +pairTyCon = tupleTyCon Boxed 2 + +unboxedUnitTyCon :: TyCon +unboxedUnitTyCon = tupleTyCon Unboxed 0 + +unboxedUnitDataCon :: DataCon +unboxedUnitDataCon = tupleDataCon Unboxed 0 + + +{- ********************************************************************* +* * + Unboxed sums +* * +********************************************************************* -} + +-- | OccName for n-ary unboxed sum type constructor. +mkSumTyConOcc :: Arity -> OccName +mkSumTyConOcc n = mkOccName tcName str + where + -- No need to cache these, the caching is done in mk_sum + str = '(' : '#' : bars ++ "#)" + bars = replicate (n-1) '|' + +-- | OccName for i-th alternative of n-ary unboxed sum data constructor. +mkSumDataConOcc :: ConTag -> Arity -> OccName +mkSumDataConOcc alt n = mkOccName dataName str + where + -- No need to cache these, the caching is done in mk_sum + str = '(' : '#' : bars alt ++ '_' : bars (n - alt - 1) ++ "#)" + bars i = replicate i '|' + +-- | Type constructor for n-ary unboxed sum. +sumTyCon :: Arity -> TyCon +sumTyCon arity + | arity > mAX_SUM_SIZE + = fst (mk_sum arity) -- Build one specially + + | arity < 2 + = panic ("sumTyCon: Arity starts from 2. (arity: " ++ show arity ++ ")") + + | otherwise + = fst (unboxedSumArr ! arity) + +-- | Data constructor for i-th alternative of a n-ary unboxed sum. +sumDataCon :: ConTag -- Alternative + -> Arity -- Arity + -> DataCon +sumDataCon alt arity + | alt > arity + = panic ("sumDataCon: index out of bounds: alt: " + ++ show alt ++ " > arity " ++ show arity) + + | alt <= 0 + = panic ("sumDataCon: Alts start from 1. (alt: " ++ show alt + ++ ", arity: " ++ show arity ++ ")") + + | arity < 2 + = panic ("sumDataCon: Arity starts from 2. (alt: " ++ show alt + ++ ", arity: " ++ show arity ++ ")") + + | arity > mAX_SUM_SIZE + = snd (mk_sum arity) ! (alt - 1) -- Build one specially + + | otherwise + = snd (unboxedSumArr ! arity) ! (alt - 1) + +-- | Cached type and data constructors for sums. The outer array is +-- indexed by the arity of the sum and the inner array is indexed by +-- the alternative. +unboxedSumArr :: Array Int (TyCon, Array Int DataCon) +unboxedSumArr = listArray (2,mAX_SUM_SIZE) [mk_sum i | i <- [2..mAX_SUM_SIZE]] + +-- | Specialization of 'unboxedTupleSumKind' for sums +unboxedSumKind :: [Type] -> Kind +unboxedSumKind = unboxedTupleSumKind sumRepDataConTyCon + +-- | Create type constructor and data constructors for n-ary unboxed sum. +mk_sum :: Arity -> (TyCon, Array ConTagZ DataCon) +mk_sum arity = (tycon, sum_cons) + where + tycon = mkSumTyCon tc_name tc_binders tc_res_kind (arity * 2) tyvars (elems sum_cons) + (UnboxedAlgTyCon rep_name) + + -- Unboxed sums are currently not Typeable due to efficiency concerns. See #13276. + rep_name = Nothing -- Just $ mkPrelTyConRepName tc_name + + tc_binders = mkTemplateTyConBinders (replicate arity runtimeRepTy) + (\ks -> map tYPE ks) + + tyvars = binderVars tc_binders + + tc_res_kind = unboxedSumKind rr_tys + + (rr_tys, tyvar_tys) = splitAt arity (mkTyVarTys tyvars) + + tc_name = mkWiredInName gHC_PRIM (mkSumTyConOcc arity) tc_uniq + (ATyCon tycon) BuiltInSyntax + + sum_cons = listArray (0,arity-1) [sum_con i | i <- [0..arity-1]] + sum_con i = let dc = pcDataCon dc_name + tyvars -- univ tyvars + [tyvar_tys !! i] -- arg types + tycon + + dc_name = mkWiredInName gHC_PRIM + (mkSumDataConOcc i arity) + (dc_uniq i) + (AConLike (RealDataCon dc)) + BuiltInSyntax + in dc + + tc_uniq = mkSumTyConUnique arity + dc_uniq i = mkSumDataConUnique i arity + +{- +************************************************************************ +* * + Equality types and classes +* * +********************************************************************* -} + +-- See Note [The equality types story] in GHC.Builtin.Types.Prim +-- ((~~) :: forall k1 k2 (a :: k1) (b :: k2). a -> b -> Constraint) +-- +-- It's tempting to put functional dependencies on (~~), but it's not +-- necessary because the functional-dependency coverage check looks +-- through superclasses, and (~#) is handled in that check. + +eqTyCon, heqTyCon, coercibleTyCon :: TyCon +eqClass, heqClass, coercibleClass :: Class +eqDataCon, heqDataCon, coercibleDataCon :: DataCon +eqSCSelId, heqSCSelId, coercibleSCSelId :: Id + +(eqTyCon, eqClass, eqDataCon, eqSCSelId) + = (tycon, klass, datacon, sc_sel_id) + where + tycon = mkClassTyCon eqTyConName binders roles + rhs klass + (mkPrelTyConRepName eqTyConName) + klass = mk_class tycon sc_pred sc_sel_id + datacon = pcDataCon eqDataConName tvs [sc_pred] tycon + + -- Kind: forall k. k -> k -> Constraint + binders = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k,k]) + roles = [Nominal, Nominal, Nominal] + rhs = mkDataTyConRhs [datacon] + + tvs@[k,a,b] = binderVars binders + sc_pred = mkTyConApp eqPrimTyCon (mkTyVarTys [k,k,a,b]) + sc_sel_id = mkDictSelId eqSCSelIdName klass + +(heqTyCon, heqClass, heqDataCon, heqSCSelId) + = (tycon, klass, datacon, sc_sel_id) + where + tycon = mkClassTyCon heqTyConName binders roles + rhs klass + (mkPrelTyConRepName heqTyConName) + klass = mk_class tycon sc_pred sc_sel_id + datacon = pcDataCon heqDataConName tvs [sc_pred] tycon + + -- Kind: forall k1 k2. k1 -> k2 -> Constraint + binders = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id + roles = [Nominal, Nominal, Nominal, Nominal] + rhs = mkDataTyConRhs [datacon] + + tvs = binderVars binders + sc_pred = mkTyConApp eqPrimTyCon (mkTyVarTys tvs) + sc_sel_id = mkDictSelId heqSCSelIdName klass + +(coercibleTyCon, coercibleClass, coercibleDataCon, coercibleSCSelId) + = (tycon, klass, datacon, sc_sel_id) + where + tycon = mkClassTyCon coercibleTyConName binders roles + rhs klass + (mkPrelTyConRepName coercibleTyConName) + klass = mk_class tycon sc_pred sc_sel_id + datacon = pcDataCon coercibleDataConName tvs [sc_pred] tycon + + -- Kind: forall k. k -> k -> Constraint + binders = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k,k]) + roles = [Nominal, Representational, Representational] + rhs = mkDataTyConRhs [datacon] + + tvs@[k,a,b] = binderVars binders + sc_pred = mkTyConApp eqReprPrimTyCon (mkTyVarTys [k, k, a, b]) + sc_sel_id = mkDictSelId coercibleSCSelIdName klass + +mk_class :: TyCon -> PredType -> Id -> Class +mk_class tycon sc_pred sc_sel_id + = mkClass (tyConName tycon) (tyConTyVars tycon) [] [sc_pred] [sc_sel_id] + [] [] (mkAnd []) tycon + + + +{- ********************************************************************* +* * + Kinds and RuntimeRep +* * +********************************************************************* -} + +-- For information about the usage of the following type, +-- see Note [TYPE and RuntimeRep] in module GHC.Builtin.Types.Prim +runtimeRepTy :: Type +runtimeRepTy = mkTyConTy runtimeRepTyCon + +-- Type synonyms; see Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim +-- type Type = tYPE 'LiftedRep +liftedTypeKindTyCon :: TyCon +liftedTypeKindTyCon = buildSynTyCon liftedTypeKindTyConName + [] liftedTypeKind [] + (tYPE liftedRepTy) + +runtimeRepTyCon :: TyCon +runtimeRepTyCon = pcTyCon runtimeRepTyConName Nothing [] + (vecRepDataCon : tupleRepDataCon : + sumRepDataCon : runtimeRepSimpleDataCons) + +vecRepDataCon :: DataCon +vecRepDataCon = pcSpecialDataCon vecRepDataConName [ mkTyConTy vecCountTyCon + , mkTyConTy vecElemTyCon ] + runtimeRepTyCon + (RuntimeRep prim_rep_fun) + where + -- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType + prim_rep_fun [count, elem] + | VecCount n <- tyConRuntimeRepInfo (tyConAppTyCon count) + , VecElem e <- tyConRuntimeRepInfo (tyConAppTyCon elem) + = [VecRep n e] + prim_rep_fun args + = pprPanic "vecRepDataCon" (ppr args) + +vecRepDataConTyCon :: TyCon +vecRepDataConTyCon = promoteDataCon vecRepDataCon + +tupleRepDataCon :: DataCon +tupleRepDataCon = pcSpecialDataCon tupleRepDataConName [ mkListTy runtimeRepTy ] + runtimeRepTyCon (RuntimeRep prim_rep_fun) + where + -- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType + prim_rep_fun [rr_ty_list] + = concatMap (runtimeRepPrimRep doc) rr_tys + where + rr_tys = extractPromotedList rr_ty_list + doc = text "tupleRepDataCon" <+> ppr rr_tys + prim_rep_fun args + = pprPanic "tupleRepDataCon" (ppr args) + +tupleRepDataConTyCon :: TyCon +tupleRepDataConTyCon = promoteDataCon tupleRepDataCon + +sumRepDataCon :: DataCon +sumRepDataCon = pcSpecialDataCon sumRepDataConName [ mkListTy runtimeRepTy ] + runtimeRepTyCon (RuntimeRep prim_rep_fun) + where + -- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType + prim_rep_fun [rr_ty_list] + = map slotPrimRep (ubxSumRepType prim_repss) + where + rr_tys = extractPromotedList rr_ty_list + doc = text "sumRepDataCon" <+> ppr rr_tys + prim_repss = map (runtimeRepPrimRep doc) rr_tys + prim_rep_fun args + = pprPanic "sumRepDataCon" (ppr args) + +sumRepDataConTyCon :: TyCon +sumRepDataConTyCon = promoteDataCon sumRepDataCon + +-- See Note [Wiring in RuntimeRep] +-- See Note [Getting from RuntimeRep to PrimRep] in GHC.Types.RepType +runtimeRepSimpleDataCons :: [DataCon] +liftedRepDataCon :: DataCon +runtimeRepSimpleDataCons@(liftedRepDataCon : _) + = zipWithLazy mk_runtime_rep_dc + [ LiftedRep, UnliftedRep + , IntRep + , Int8Rep, Int16Rep, Int32Rep, Int64Rep + , WordRep + , Word8Rep, Word16Rep, Word32Rep, Word64Rep + , AddrRep + , FloatRep, DoubleRep + ] + runtimeRepSimpleDataConNames + where + mk_runtime_rep_dc primrep name + = pcSpecialDataCon name [] runtimeRepTyCon (RuntimeRep (\_ -> [primrep])) + +-- See Note [Wiring in RuntimeRep] +liftedRepDataConTy, unliftedRepDataConTy, + intRepDataConTy, + int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy, + wordRepDataConTy, + word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy, + addrRepDataConTy, + floatRepDataConTy, doubleRepDataConTy :: Type +[liftedRepDataConTy, unliftedRepDataConTy, + intRepDataConTy, + int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy, + wordRepDataConTy, + word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy, + addrRepDataConTy, + floatRepDataConTy, doubleRepDataConTy + ] + = map (mkTyConTy . promoteDataCon) runtimeRepSimpleDataCons + +vecCountTyCon :: TyCon +vecCountTyCon = pcTyCon vecCountTyConName Nothing [] vecCountDataCons + +-- See Note [Wiring in RuntimeRep] +vecCountDataCons :: [DataCon] +vecCountDataCons = zipWithLazy mk_vec_count_dc + [ 2, 4, 8, 16, 32, 64 ] + vecCountDataConNames + where + mk_vec_count_dc n name + = pcSpecialDataCon name [] vecCountTyCon (VecCount n) + +-- See Note [Wiring in RuntimeRep] +vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy, + vec64DataConTy :: Type +[vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy, + vec64DataConTy] = map (mkTyConTy . promoteDataCon) vecCountDataCons + +vecElemTyCon :: TyCon +vecElemTyCon = pcTyCon vecElemTyConName Nothing [] vecElemDataCons + +-- See Note [Wiring in RuntimeRep] +vecElemDataCons :: [DataCon] +vecElemDataCons = zipWithLazy mk_vec_elem_dc + [ Int8ElemRep, Int16ElemRep, Int32ElemRep, Int64ElemRep + , Word8ElemRep, Word16ElemRep, Word32ElemRep, Word64ElemRep + , FloatElemRep, DoubleElemRep ] + vecElemDataConNames + where + mk_vec_elem_dc elem name + = pcSpecialDataCon name [] vecElemTyCon (VecElem elem) + +-- See Note [Wiring in RuntimeRep] +int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy, + int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy, + word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy, + doubleElemRepDataConTy :: Type +[int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy, + int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy, + word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy, + doubleElemRepDataConTy] = map (mkTyConTy . promoteDataCon) + vecElemDataCons + +liftedRepDataConTyCon :: TyCon +liftedRepDataConTyCon = promoteDataCon liftedRepDataCon + +-- The type ('LiftedRep) +liftedRepTy :: Type +liftedRepTy = liftedRepDataConTy + +{- ********************************************************************* +* * + The boxed primitive types: Char, Int, etc +* * +********************************************************************* -} + +boxingDataCon_maybe :: TyCon -> Maybe DataCon +-- boxingDataCon_maybe Char# = C# +-- boxingDataCon_maybe Int# = I# +-- ... etc ... +-- See Note [Boxing primitive types] +boxingDataCon_maybe tc + = lookupNameEnv boxing_constr_env (tyConName tc) + +boxing_constr_env :: NameEnv DataCon +boxing_constr_env + = mkNameEnv [(charPrimTyConName , charDataCon ) + ,(intPrimTyConName , intDataCon ) + ,(wordPrimTyConName , wordDataCon ) + ,(floatPrimTyConName , floatDataCon ) + ,(doublePrimTyConName, doubleDataCon) ] + +{- Note [Boxing primitive types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For a handful of primitive types (Int, Char, Word, Float, Double), +we can readily box and an unboxed version (Int#, Char# etc) using +the corresponding data constructor. This is useful in a couple +of places, notably let-floating -} + + +charTy :: Type +charTy = mkTyConTy charTyCon + +charTyCon :: TyCon +charTyCon = pcTyCon charTyConName + (Just (CType NoSourceText Nothing + (NoSourceText,fsLit "HsChar"))) + [] [charDataCon] +charDataCon :: DataCon +charDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon + +stringTy :: Type +stringTy = mkListTy charTy -- convenience only + +intTy :: Type +intTy = mkTyConTy intTyCon + +intTyCon :: TyCon +intTyCon = pcTyCon intTyConName + (Just (CType NoSourceText Nothing (NoSourceText,fsLit "HsInt"))) + [] [intDataCon] +intDataCon :: DataCon +intDataCon = pcDataCon intDataConName [] [intPrimTy] intTyCon + +wordTy :: Type +wordTy = mkTyConTy wordTyCon + +wordTyCon :: TyCon +wordTyCon = pcTyCon wordTyConName + (Just (CType NoSourceText Nothing (NoSourceText, fsLit "HsWord"))) + [] [wordDataCon] +wordDataCon :: DataCon +wordDataCon = pcDataCon wordDataConName [] [wordPrimTy] wordTyCon + +word8Ty :: Type +word8Ty = mkTyConTy word8TyCon + +word8TyCon :: TyCon +word8TyCon = pcTyCon word8TyConName + (Just (CType NoSourceText Nothing + (NoSourceText, fsLit "HsWord8"))) [] + [word8DataCon] +word8DataCon :: DataCon +word8DataCon = pcDataCon word8DataConName [] [wordPrimTy] word8TyCon + +floatTy :: Type +floatTy = mkTyConTy floatTyCon + +floatTyCon :: TyCon +floatTyCon = pcTyCon floatTyConName + (Just (CType NoSourceText Nothing + (NoSourceText, fsLit "HsFloat"))) [] + [floatDataCon] +floatDataCon :: DataCon +floatDataCon = pcDataCon floatDataConName [] [floatPrimTy] floatTyCon + +doubleTy :: Type +doubleTy = mkTyConTy doubleTyCon + +doubleTyCon :: TyCon +doubleTyCon = pcTyCon doubleTyConName + (Just (CType NoSourceText Nothing + (NoSourceText,fsLit "HsDouble"))) [] + [doubleDataCon] + +doubleDataCon :: DataCon +doubleDataCon = pcDataCon doubleDataConName [] [doublePrimTy] doubleTyCon + +{- +************************************************************************ +* * + 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} +-} + +boolTy :: Type +boolTy = mkTyConTy boolTyCon + +boolTyCon :: TyCon +boolTyCon = pcTyCon boolTyConName + (Just (CType NoSourceText Nothing + (NoSourceText, fsLit "HsBool"))) + [] [falseDataCon, trueDataCon] + +falseDataCon, trueDataCon :: DataCon +falseDataCon = pcDataCon falseDataConName [] [] boolTyCon +trueDataCon = pcDataCon trueDataConName [] [] boolTyCon + +falseDataConId, trueDataConId :: Id +falseDataConId = dataConWorkId falseDataCon +trueDataConId = dataConWorkId trueDataCon + +orderingTyCon :: TyCon +orderingTyCon = pcTyCon orderingTyConName Nothing + [] [ordLTDataCon, ordEQDataCon, ordGTDataCon] + +ordLTDataCon, ordEQDataCon, ordGTDataCon :: DataCon +ordLTDataCon = pcDataCon ordLTDataConName [] [] orderingTyCon +ordEQDataCon = pcDataCon ordEQDataConName [] [] orderingTyCon +ordGTDataCon = pcDataCon ordGTDataConName [] [] orderingTyCon + +ordLTDataConId, ordEQDataConId, ordGTDataConId :: Id +ordLTDataConId = dataConWorkId ordLTDataCon +ordEQDataConId = dataConWorkId ordEQDataCon +ordGTDataConId = dataConWorkId ordGTDataCon + +{- +************************************************************************ +* * + The List type + Special syntax, deeply wired in, + but otherwise an ordinary algebraic data type +* * +************************************************************************ + + data [] a = [] | a : (List a) +-} + +mkListTy :: Type -> Type +mkListTy ty = mkTyConApp listTyCon [ty] + +listTyCon :: TyCon +listTyCon = pcTyCon listTyConName Nothing [alphaTyVar] [nilDataCon, consDataCon] + +-- See also Note [Empty lists] in GHC.Hs.Expr. +nilDataCon :: DataCon +nilDataCon = pcDataCon nilDataConName alpha_tyvar [] listTyCon + +consDataCon :: DataCon +consDataCon = pcDataConWithFixity True {- Declared infix -} + consDataConName + alpha_tyvar [] 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) + +-- Wired-in type Maybe + +maybeTyCon :: TyCon +maybeTyCon = pcTyCon maybeTyConName Nothing alpha_tyvar + [nothingDataCon, justDataCon] + +nothingDataCon :: DataCon +nothingDataCon = pcDataCon nothingDataConName alpha_tyvar [] maybeTyCon + +justDataCon :: DataCon +justDataCon = pcDataCon justDataConName alpha_tyvar [alphaTy] maybeTyCon + +{- +** ********************************************************************* +* * + 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} +-} + +-- | Make a tuple type. The list of types should /not/ include any +-- RuntimeRep specifications. Boxed 1-tuples are flattened. +-- See Note [One-tuples] +mkTupleTy :: Boxity -> [Type] -> Type +-- Special case for *boxed* 1-tuples, which are represented by the type itself +mkTupleTy Boxed [ty] = ty +mkTupleTy boxity tys = mkTupleTy1 boxity tys + +-- | Make a tuple type. The list of types should /not/ include any +-- RuntimeRep specifications. Boxed 1-tuples are *not* flattened. +-- See Note [One-tuples] and Note [Don't flatten tuples from HsSyn] +-- in GHC.Core.Make +mkTupleTy1 :: Boxity -> [Type] -> Type +mkTupleTy1 Boxed tys = mkTyConApp (tupleTyCon Boxed (length tys)) tys +mkTupleTy1 Unboxed tys = mkTyConApp (tupleTyCon Unboxed (length tys)) + (map getRuntimeRep tys ++ tys) + +-- | Build the type of a small tuple that holds the specified type of thing +-- Flattens 1-tuples. See Note [One-tuples]. +mkBoxedTupleTy :: [Type] -> Type +mkBoxedTupleTy tys = mkTupleTy Boxed tys + +unitTy :: Type +unitTy = mkTupleTy Boxed [] + +{- ********************************************************************* +* * + The sum types +* * +************************************************************************ +-} + +mkSumTy :: [Type] -> Type +mkSumTy tys = mkTyConApp (sumTyCon (length tys)) + (map getRuntimeRep tys ++ tys) + +-- Promoted Booleans + +promotedFalseDataCon, promotedTrueDataCon :: TyCon +promotedTrueDataCon = promoteDataCon trueDataCon +promotedFalseDataCon = promoteDataCon falseDataCon + +-- Promoted Maybe +promotedNothingDataCon, promotedJustDataCon :: TyCon +promotedNothingDataCon = promoteDataCon nothingDataCon +promotedJustDataCon = promoteDataCon justDataCon + +-- Promoted Ordering + +promotedLTDataCon + , promotedEQDataCon + , promotedGTDataCon + :: TyCon +promotedLTDataCon = promoteDataCon ordLTDataCon +promotedEQDataCon = promoteDataCon ordEQDataCon +promotedGTDataCon = promoteDataCon ordGTDataCon + +-- Promoted List +promotedConsDataCon, promotedNilDataCon :: TyCon +promotedConsDataCon = promoteDataCon consDataCon +promotedNilDataCon = promoteDataCon nilDataCon + +-- | Make a *promoted* list. +mkPromotedListTy :: Kind -- ^ of the elements of the list + -> [Type] -- ^ elements + -> Type +mkPromotedListTy k tys + = foldr cons nil tys + where + cons :: Type -- element + -> Type -- list + -> Type + cons elt list = mkTyConApp promotedConsDataCon [k, elt, list] + + nil :: Type + nil = mkTyConApp promotedNilDataCon [k] + +-- | Extract the elements of a promoted list. Panics if the type is not a +-- promoted list +extractPromotedList :: Type -- ^ The promoted list + -> [Type] +extractPromotedList tys = go tys + where + go list_ty + | Just (tc, [_k, t, ts]) <- splitTyConApp_maybe list_ty + = ASSERT( tc `hasKey` consDataConKey ) + t : go ts + + | Just (tc, [_k]) <- splitTyConApp_maybe list_ty + = ASSERT( tc `hasKey` nilDataConKey ) + [] + + | otherwise + = pprPanic "extractPromotedList" (ppr tys) diff --git a/compiler/GHC/Builtin/Types.hs-boot b/compiler/GHC/Builtin/Types.hs-boot new file mode 100644 index 0000000000..b575fd2de3 --- /dev/null +++ b/compiler/GHC/Builtin/Types.hs-boot @@ -0,0 +1,47 @@ +module GHC.Builtin.Types where + +import {-# SOURCE #-} GHC.Core.TyCon ( TyCon ) +import {-# SOURCE #-} GHC.Core.TyCo.Rep (Type, Kind) + +import GHC.Types.Basic (Arity, TupleSort) +import GHC.Types.Name (Name) + +listTyCon :: TyCon +typeNatKind, typeSymbolKind :: Type +mkBoxedTupleTy :: [Type] -> Type + +coercibleTyCon, heqTyCon :: TyCon + +unitTy :: Type + +liftedTypeKind :: Kind +liftedTypeKindTyCon :: TyCon + +constraintKind :: Kind + +runtimeRepTyCon, vecCountTyCon, vecElemTyCon :: TyCon +runtimeRepTy :: Type + +liftedRepDataConTyCon, vecRepDataConTyCon, tupleRepDataConTyCon :: TyCon + +liftedRepDataConTy, unliftedRepDataConTy, + intRepDataConTy, + int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy, + wordRepDataConTy, + word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy, + addrRepDataConTy, + floatRepDataConTy, doubleRepDataConTy :: Type + +vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy, + vec64DataConTy :: Type + +int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy, + int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy, + word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy, + doubleElemRepDataConTy :: Type + +anyTypeOfKind :: Kind -> Type +unboxedTupleKind :: [Type] -> Type +mkPromotedListTy :: Type -> [Type] -> Type + +tupleTyConName :: TupleSort -> Arity -> Name diff --git a/compiler/GHC/Builtin/Types/Literals.hs b/compiler/GHC/Builtin/Types/Literals.hs new file mode 100644 index 0000000000..d5c1d209c6 --- /dev/null +++ b/compiler/GHC/Builtin/Types/Literals.hs @@ -0,0 +1,993 @@ +{-# LANGUAGE LambdaCase #-} + +module GHC.Builtin.Types.Literals + ( typeNatTyCons + , typeNatCoAxiomRules + , BuiltInSynFamily(..) + + -- If you define a new built-in type family, make sure to export its TyCon + -- from here as well. + -- See Note [Adding built-in type families] + , typeNatAddTyCon + , typeNatMulTyCon + , typeNatExpTyCon + , typeNatLeqTyCon + , typeNatSubTyCon + , typeNatDivTyCon + , typeNatModTyCon + , typeNatLogTyCon + , typeNatCmpTyCon + , typeSymbolCmpTyCon + , typeSymbolAppendTyCon + ) where + +import GhcPrelude + +import GHC.Core.Type +import Pair +import GHC.Tc.Utils.TcType ( TcType, tcEqType ) +import GHC.Core.TyCon ( TyCon, FamTyConFlav(..), mkFamilyTyCon + , Injectivity(..) ) +import GHC.Core.Coercion ( Role(..) ) +import GHC.Tc.Types.Constraint ( Xi ) +import GHC.Core.Coercion.Axiom ( CoAxiomRule(..), BuiltInSynFamily(..), TypeEqn ) +import GHC.Types.Name ( Name, BuiltInSyntax(..) ) +import GHC.Builtin.Types +import GHC.Builtin.Types.Prim ( mkTemplateAnonTyConBinders ) +import GHC.Builtin.Names + ( gHC_TYPELITS + , gHC_TYPENATS + , typeNatAddTyFamNameKey + , typeNatMulTyFamNameKey + , typeNatExpTyFamNameKey + , typeNatLeqTyFamNameKey + , typeNatSubTyFamNameKey + , typeNatDivTyFamNameKey + , typeNatModTyFamNameKey + , typeNatLogTyFamNameKey + , typeNatCmpTyFamNameKey + , typeSymbolCmpTyFamNameKey + , typeSymbolAppendFamNameKey + ) +import FastString ( FastString + , fsLit, nilFS, nullFS, unpackFS, mkFastString, appendFS + ) +import qualified Data.Map as Map +import Data.Maybe ( isJust ) +import Control.Monad ( guard ) +import Data.List ( isPrefixOf, isSuffixOf ) + +{- +Note [Type-level literals] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +There are currently two forms of type-level literals: natural numbers, and +symbols (even though this module is named GHC.Builtin.Types.Literals, it covers both). + +Type-level literals are supported by CoAxiomRules (conditional axioms), which +power the built-in type families (see Note [Adding built-in type families]). +Currently, all built-in type families are for the express purpose of supporting +type-level literals. + +See also the Wiki page: + + https://gitlab.haskell.org/ghc/ghc/wikis/type-nats + +Note [Adding built-in type families] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +There are a few steps to adding a built-in type family: + +* Adding a unique for the type family TyCon + + These go in GHC.Builtin.Names. It will likely be of the form + @myTyFamNameKey = mkPreludeTyConUnique xyz@, where @xyz@ is a number that + has not been chosen before in GHC.Builtin.Names. There are several examples already + in GHC.Builtin.Names—see, for instance, typeNatAddTyFamNameKey. + +* Adding the type family TyCon itself + + This goes in GHC.Builtin.Types.Literals. There are plenty of examples of how to define + these—see, for instance, typeNatAddTyCon. + + Once your TyCon has been defined, be sure to: + + - Export it from GHC.Builtin.Types.Literals. (Not doing so caused #14632.) + - Include it in the typeNatTyCons list, defined in GHC.Builtin.Types.Literals. + +* Exposing associated type family axioms + + When defining the type family TyCon, you will need to define an axiom for + the type family in general (see, for instance, axAddDef), and perhaps other + auxiliary axioms for special cases of the type family (see, for instance, + axAdd0L and axAdd0R). + + After you have defined all of these axioms, be sure to include them in the + typeNatCoAxiomRules list, defined in GHC.Builtin.Types.Literals. + (Not doing so caused #14934.) + +* Define the type family somewhere + + Finally, you will need to define the type family somewhere, likely in @base@. + Currently, all of the built-in type families are defined in GHC.TypeLits or + GHC.TypeNats, so those are likely candidates. + + Since the behavior of your built-in type family is specified in GHC.Builtin.Types.Literals, + you should give an open type family definition with no instances, like so: + + type family MyTypeFam (m :: Nat) (n :: Nat) :: Nat + + Changing the argument and result kinds as appropriate. + +* Update the relevant test cases + + The GHC test suite will likely need to be updated after you add your built-in + type family. For instance: + + - The T9181 test prints the :browse contents of GHC.TypeLits, so if you added + a test there, the expected output of T9181 will need to change. + - The TcTypeNatSimple and TcTypeSymbolSimple tests have compile-time unit + tests, as well as TcTypeNatSimpleRun and TcTypeSymbolSimpleRun, which have + runtime unit tests. Consider adding further unit tests to those if your + built-in type family deals with Nats or Symbols, respectively. +-} + +{------------------------------------------------------------------------------- +Built-in type constructors for functions on type-level nats +-} + +-- The list of built-in type family TyCons that GHC uses. +-- If you define a built-in type family, make sure to add it to this list. +-- See Note [Adding built-in type families] +typeNatTyCons :: [TyCon] +typeNatTyCons = + [ typeNatAddTyCon + , typeNatMulTyCon + , typeNatExpTyCon + , typeNatLeqTyCon + , typeNatSubTyCon + , typeNatDivTyCon + , typeNatModTyCon + , typeNatLogTyCon + , typeNatCmpTyCon + , typeSymbolCmpTyCon + , typeSymbolAppendTyCon + ] + +typeNatAddTyCon :: TyCon +typeNatAddTyCon = mkTypeNatFunTyCon2 name + BuiltInSynFamily + { sfMatchFam = matchFamAdd + , sfInteractTop = interactTopAdd + , sfInteractInert = interactInertAdd + } + where + name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "+") + typeNatAddTyFamNameKey typeNatAddTyCon + +typeNatSubTyCon :: TyCon +typeNatSubTyCon = mkTypeNatFunTyCon2 name + BuiltInSynFamily + { sfMatchFam = matchFamSub + , sfInteractTop = interactTopSub + , sfInteractInert = interactInertSub + } + where + name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "-") + typeNatSubTyFamNameKey typeNatSubTyCon + +typeNatMulTyCon :: TyCon +typeNatMulTyCon = mkTypeNatFunTyCon2 name + BuiltInSynFamily + { sfMatchFam = matchFamMul + , sfInteractTop = interactTopMul + , sfInteractInert = interactInertMul + } + where + name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "*") + typeNatMulTyFamNameKey typeNatMulTyCon + +typeNatDivTyCon :: TyCon +typeNatDivTyCon = mkTypeNatFunTyCon2 name + BuiltInSynFamily + { sfMatchFam = matchFamDiv + , sfInteractTop = interactTopDiv + , sfInteractInert = interactInertDiv + } + where + name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "Div") + typeNatDivTyFamNameKey typeNatDivTyCon + +typeNatModTyCon :: TyCon +typeNatModTyCon = mkTypeNatFunTyCon2 name + BuiltInSynFamily + { sfMatchFam = matchFamMod + , sfInteractTop = interactTopMod + , sfInteractInert = interactInertMod + } + where + name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "Mod") + typeNatModTyFamNameKey typeNatModTyCon + + + + + +typeNatExpTyCon :: TyCon +typeNatExpTyCon = mkTypeNatFunTyCon2 name + BuiltInSynFamily + { sfMatchFam = matchFamExp + , sfInteractTop = interactTopExp + , sfInteractInert = interactInertExp + } + where + name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "^") + typeNatExpTyFamNameKey typeNatExpTyCon + +typeNatLogTyCon :: TyCon +typeNatLogTyCon = mkTypeNatFunTyCon1 name + BuiltInSynFamily + { sfMatchFam = matchFamLog + , sfInteractTop = interactTopLog + , sfInteractInert = interactInertLog + } + where + name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "Log2") + typeNatLogTyFamNameKey typeNatLogTyCon + + + +typeNatLeqTyCon :: TyCon +typeNatLeqTyCon = + mkFamilyTyCon name + (mkTemplateAnonTyConBinders [ typeNatKind, typeNatKind ]) + boolTy + Nothing + (BuiltInSynFamTyCon ops) + Nothing + NotInjective + + where + name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "<=?") + typeNatLeqTyFamNameKey typeNatLeqTyCon + ops = BuiltInSynFamily + { sfMatchFam = matchFamLeq + , sfInteractTop = interactTopLeq + , sfInteractInert = interactInertLeq + } + +typeNatCmpTyCon :: TyCon +typeNatCmpTyCon = + mkFamilyTyCon name + (mkTemplateAnonTyConBinders [ typeNatKind, typeNatKind ]) + orderingKind + Nothing + (BuiltInSynFamTyCon ops) + Nothing + NotInjective + + where + name = mkWiredInTyConName UserSyntax gHC_TYPENATS (fsLit "CmpNat") + typeNatCmpTyFamNameKey typeNatCmpTyCon + ops = BuiltInSynFamily + { sfMatchFam = matchFamCmpNat + , sfInteractTop = interactTopCmpNat + , sfInteractInert = \_ _ _ _ -> [] + } + +typeSymbolCmpTyCon :: TyCon +typeSymbolCmpTyCon = + mkFamilyTyCon name + (mkTemplateAnonTyConBinders [ typeSymbolKind, typeSymbolKind ]) + orderingKind + Nothing + (BuiltInSynFamTyCon ops) + Nothing + NotInjective + + where + name = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "CmpSymbol") + typeSymbolCmpTyFamNameKey typeSymbolCmpTyCon + ops = BuiltInSynFamily + { sfMatchFam = matchFamCmpSymbol + , sfInteractTop = interactTopCmpSymbol + , sfInteractInert = \_ _ _ _ -> [] + } + +typeSymbolAppendTyCon :: TyCon +typeSymbolAppendTyCon = mkTypeSymbolFunTyCon2 name + BuiltInSynFamily + { sfMatchFam = matchFamAppendSymbol + , sfInteractTop = interactTopAppendSymbol + , sfInteractInert = interactInertAppendSymbol + } + where + name = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "AppendSymbol") + typeSymbolAppendFamNameKey typeSymbolAppendTyCon + + + +-- Make a unary built-in constructor of kind: Nat -> Nat +mkTypeNatFunTyCon1 :: Name -> BuiltInSynFamily -> TyCon +mkTypeNatFunTyCon1 op tcb = + mkFamilyTyCon op + (mkTemplateAnonTyConBinders [ typeNatKind ]) + typeNatKind + Nothing + (BuiltInSynFamTyCon tcb) + Nothing + NotInjective + + +-- Make a binary built-in constructor of kind: Nat -> Nat -> Nat +mkTypeNatFunTyCon2 :: Name -> BuiltInSynFamily -> TyCon +mkTypeNatFunTyCon2 op tcb = + mkFamilyTyCon op + (mkTemplateAnonTyConBinders [ typeNatKind, typeNatKind ]) + typeNatKind + Nothing + (BuiltInSynFamTyCon tcb) + Nothing + NotInjective + +-- Make a binary built-in constructor of kind: Symbol -> Symbol -> Symbol +mkTypeSymbolFunTyCon2 :: Name -> BuiltInSynFamily -> TyCon +mkTypeSymbolFunTyCon2 op tcb = + mkFamilyTyCon op + (mkTemplateAnonTyConBinders [ typeSymbolKind, typeSymbolKind ]) + typeSymbolKind + Nothing + (BuiltInSynFamTyCon tcb) + Nothing + NotInjective + + +{------------------------------------------------------------------------------- +Built-in rules axioms +-------------------------------------------------------------------------------} + +-- If you add additional rules, please remember to add them to +-- `typeNatCoAxiomRules` also. +-- See Note [Adding built-in type families] +axAddDef + , axMulDef + , axExpDef + , axLeqDef + , axCmpNatDef + , axCmpSymbolDef + , axAppendSymbolDef + , axAdd0L + , axAdd0R + , axMul0L + , axMul0R + , axMul1L + , axMul1R + , axExp1L + , axExp0R + , axExp1R + , axLeqRefl + , axCmpNatRefl + , axCmpSymbolRefl + , axLeq0L + , axSubDef + , axSub0R + , axAppendSymbol0R + , axAppendSymbol0L + , axDivDef + , axDiv1 + , axModDef + , axMod1 + , axLogDef + :: CoAxiomRule + +axAddDef = mkBinAxiom "AddDef" typeNatAddTyCon $ + \x y -> Just $ num (x + y) + +axMulDef = mkBinAxiom "MulDef" typeNatMulTyCon $ + \x y -> Just $ num (x * y) + +axExpDef = mkBinAxiom "ExpDef" typeNatExpTyCon $ + \x y -> Just $ num (x ^ y) + +axLeqDef = mkBinAxiom "LeqDef" typeNatLeqTyCon $ + \x y -> Just $ bool (x <= y) + +axCmpNatDef = mkBinAxiom "CmpNatDef" typeNatCmpTyCon + $ \x y -> Just $ ordering (compare x y) + +axCmpSymbolDef = + CoAxiomRule + { coaxrName = fsLit "CmpSymbolDef" + , coaxrAsmpRoles = [Nominal, Nominal] + , coaxrRole = Nominal + , coaxrProves = \cs -> + do [Pair s1 s2, Pair t1 t2] <- return cs + s2' <- isStrLitTy s2 + t2' <- isStrLitTy t2 + return (mkTyConApp typeSymbolCmpTyCon [s1,t1] === + ordering (compare s2' t2')) } + +axAppendSymbolDef = CoAxiomRule + { coaxrName = fsLit "AppendSymbolDef" + , coaxrAsmpRoles = [Nominal, Nominal] + , coaxrRole = Nominal + , coaxrProves = \cs -> + do [Pair s1 s2, Pair t1 t2] <- return cs + s2' <- isStrLitTy s2 + t2' <- isStrLitTy t2 + let z = mkStrLitTy (appendFS s2' t2') + return (mkTyConApp typeSymbolAppendTyCon [s1, t1] === z) + } + +axSubDef = mkBinAxiom "SubDef" typeNatSubTyCon $ + \x y -> fmap num (minus x y) + +axDivDef = mkBinAxiom "DivDef" typeNatDivTyCon $ + \x y -> do guard (y /= 0) + return (num (div x y)) + +axModDef = mkBinAxiom "ModDef" typeNatModTyCon $ + \x y -> do guard (y /= 0) + return (num (mod x y)) + +axLogDef = mkUnAxiom "LogDef" typeNatLogTyCon $ + \x -> do (a,_) <- genLog x 2 + return (num a) + +axAdd0L = mkAxiom1 "Add0L" $ \(Pair s t) -> (num 0 .+. s) === t +axAdd0R = mkAxiom1 "Add0R" $ \(Pair s t) -> (s .+. num 0) === t +axSub0R = mkAxiom1 "Sub0R" $ \(Pair s t) -> (s .-. num 0) === t +axMul0L = mkAxiom1 "Mul0L" $ \(Pair s _) -> (num 0 .*. s) === num 0 +axMul0R = mkAxiom1 "Mul0R" $ \(Pair s _) -> (s .*. num 0) === num 0 +axMul1L = mkAxiom1 "Mul1L" $ \(Pair s t) -> (num 1 .*. s) === t +axMul1R = mkAxiom1 "Mul1R" $ \(Pair s t) -> (s .*. num 1) === t +axDiv1 = mkAxiom1 "Div1" $ \(Pair s t) -> (tDiv s (num 1) === t) +axMod1 = mkAxiom1 "Mod1" $ \(Pair s _) -> (tMod s (num 1) === num 0) + -- XXX: Shouldn't we check that _ is 0? +axExp1L = mkAxiom1 "Exp1L" $ \(Pair s _) -> (num 1 .^. s) === num 1 +axExp0R = mkAxiom1 "Exp0R" $ \(Pair s _) -> (s .^. num 0) === num 1 +axExp1R = mkAxiom1 "Exp1R" $ \(Pair s t) -> (s .^. num 1) === t +axLeqRefl = mkAxiom1 "LeqRefl" $ \(Pair s _) -> (s <== s) === bool True +axCmpNatRefl = mkAxiom1 "CmpNatRefl" + $ \(Pair s _) -> (cmpNat s s) === ordering EQ +axCmpSymbolRefl = mkAxiom1 "CmpSymbolRefl" + $ \(Pair s _) -> (cmpSymbol s s) === ordering EQ +axLeq0L = mkAxiom1 "Leq0L" $ \(Pair s _) -> (num 0 <== s) === bool True +axAppendSymbol0R = mkAxiom1 "Concat0R" + $ \(Pair s t) -> (mkStrLitTy nilFS `appendSymbol` s) === t +axAppendSymbol0L = mkAxiom1 "Concat0L" + $ \(Pair s t) -> (s `appendSymbol` mkStrLitTy nilFS) === t + +-- The list of built-in type family axioms that GHC uses. +-- If you define new axioms, make sure to include them in this list. +-- See Note [Adding built-in type families] +typeNatCoAxiomRules :: Map.Map FastString CoAxiomRule +typeNatCoAxiomRules = Map.fromList $ map (\x -> (coaxrName x, x)) + [ axAddDef + , axMulDef + , axExpDef + , axLeqDef + , axCmpNatDef + , axCmpSymbolDef + , axAppendSymbolDef + , axAdd0L + , axAdd0R + , axMul0L + , axMul0R + , axMul1L + , axMul1R + , axExp1L + , axExp0R + , axExp1R + , axLeqRefl + , axCmpNatRefl + , axCmpSymbolRefl + , axLeq0L + , axSubDef + , axSub0R + , axAppendSymbol0R + , axAppendSymbol0L + , axDivDef + , axDiv1 + , axModDef + , axMod1 + , axLogDef + ] + + + +{------------------------------------------------------------------------------- +Various utilities for making axioms and types +-------------------------------------------------------------------------------} + +(.+.) :: Type -> Type -> Type +s .+. t = mkTyConApp typeNatAddTyCon [s,t] + +(.-.) :: Type -> Type -> Type +s .-. t = mkTyConApp typeNatSubTyCon [s,t] + +(.*.) :: Type -> Type -> Type +s .*. t = mkTyConApp typeNatMulTyCon [s,t] + +tDiv :: Type -> Type -> Type +tDiv s t = mkTyConApp typeNatDivTyCon [s,t] + +tMod :: Type -> Type -> Type +tMod s t = mkTyConApp typeNatModTyCon [s,t] + +(.^.) :: Type -> Type -> Type +s .^. t = mkTyConApp typeNatExpTyCon [s,t] + +(<==) :: Type -> Type -> Type +s <== t = mkTyConApp typeNatLeqTyCon [s,t] + +cmpNat :: Type -> Type -> Type +cmpNat s t = mkTyConApp typeNatCmpTyCon [s,t] + +cmpSymbol :: Type -> Type -> Type +cmpSymbol s t = mkTyConApp typeSymbolCmpTyCon [s,t] + +appendSymbol :: Type -> Type -> Type +appendSymbol s t = mkTyConApp typeSymbolAppendTyCon [s, t] + +(===) :: Type -> Type -> Pair Type +x === y = Pair x y + +num :: Integer -> Type +num = mkNumLitTy + +bool :: Bool -> Type +bool b = if b then mkTyConApp promotedTrueDataCon [] + else mkTyConApp promotedFalseDataCon [] + +isBoolLitTy :: Type -> Maybe Bool +isBoolLitTy tc = + do (tc,[]) <- splitTyConApp_maybe tc + case () of + _ | tc == promotedFalseDataCon -> return False + | tc == promotedTrueDataCon -> return True + | otherwise -> Nothing + +orderingKind :: Kind +orderingKind = mkTyConApp orderingTyCon [] + +ordering :: Ordering -> Type +ordering o = + case o of + LT -> mkTyConApp promotedLTDataCon [] + EQ -> mkTyConApp promotedEQDataCon [] + GT -> mkTyConApp promotedGTDataCon [] + +isOrderingLitTy :: Type -> Maybe Ordering +isOrderingLitTy tc = + do (tc1,[]) <- splitTyConApp_maybe tc + case () of + _ | tc1 == promotedLTDataCon -> return LT + | tc1 == promotedEQDataCon -> return EQ + | tc1 == promotedGTDataCon -> return GT + | otherwise -> Nothing + +known :: (Integer -> Bool) -> TcType -> Bool +known p x = case isNumLitTy x of + Just a -> p a + Nothing -> False + + +mkUnAxiom :: String -> TyCon -> (Integer -> Maybe Type) -> CoAxiomRule +mkUnAxiom str tc f = + CoAxiomRule + { coaxrName = fsLit str + , coaxrAsmpRoles = [Nominal] + , coaxrRole = Nominal + , coaxrProves = \cs -> + do [Pair s1 s2] <- return cs + s2' <- isNumLitTy s2 + z <- f s2' + return (mkTyConApp tc [s1] === z) + } + + + +-- For the definitional axioms +mkBinAxiom :: String -> TyCon -> + (Integer -> Integer -> Maybe Type) -> CoAxiomRule +mkBinAxiom str tc f = + CoAxiomRule + { coaxrName = fsLit str + , coaxrAsmpRoles = [Nominal, Nominal] + , coaxrRole = Nominal + , coaxrProves = \cs -> + do [Pair s1 s2, Pair t1 t2] <- return cs + s2' <- isNumLitTy s2 + t2' <- isNumLitTy t2 + z <- f s2' t2' + return (mkTyConApp tc [s1,t1] === z) + } + + + +mkAxiom1 :: String -> (TypeEqn -> TypeEqn) -> CoAxiomRule +mkAxiom1 str f = + CoAxiomRule + { coaxrName = fsLit str + , coaxrAsmpRoles = [Nominal] + , coaxrRole = Nominal + , coaxrProves = \case [eqn] -> Just (f eqn) + _ -> Nothing + } + + +{------------------------------------------------------------------------------- +Evaluation +-------------------------------------------------------------------------------} + +matchFamAdd :: [Type] -> Maybe (CoAxiomRule, [Type], Type) +matchFamAdd [s,t] + | Just 0 <- mbX = Just (axAdd0L, [t], t) + | Just 0 <- mbY = Just (axAdd0R, [s], s) + | Just x <- mbX, Just y <- mbY = + Just (axAddDef, [s,t], num (x + y)) + where mbX = isNumLitTy s + mbY = isNumLitTy t +matchFamAdd _ = Nothing + +matchFamSub :: [Type] -> Maybe (CoAxiomRule, [Type], Type) +matchFamSub [s,t] + | Just 0 <- mbY = Just (axSub0R, [s], s) + | Just x <- mbX, Just y <- mbY, Just z <- minus x y = + Just (axSubDef, [s,t], num z) + where mbX = isNumLitTy s + mbY = isNumLitTy t +matchFamSub _ = Nothing + +matchFamMul :: [Type] -> Maybe (CoAxiomRule, [Type], Type) +matchFamMul [s,t] + | Just 0 <- mbX = Just (axMul0L, [t], num 0) + | Just 0 <- mbY = Just (axMul0R, [s], num 0) + | Just 1 <- mbX = Just (axMul1L, [t], t) + | Just 1 <- mbY = Just (axMul1R, [s], s) + | Just x <- mbX, Just y <- mbY = + Just (axMulDef, [s,t], num (x * y)) + where mbX = isNumLitTy s + mbY = isNumLitTy t +matchFamMul _ = Nothing + +matchFamDiv :: [Type] -> Maybe (CoAxiomRule, [Type], Type) +matchFamDiv [s,t] + | Just 1 <- mbY = Just (axDiv1, [s], s) + | Just x <- mbX, Just y <- mbY, y /= 0 = Just (axDivDef, [s,t], num (div x y)) + where mbX = isNumLitTy s + mbY = isNumLitTy t +matchFamDiv _ = Nothing + +matchFamMod :: [Type] -> Maybe (CoAxiomRule, [Type], Type) +matchFamMod [s,t] + | Just 1 <- mbY = Just (axMod1, [s], num 0) + | Just x <- mbX, Just y <- mbY, y /= 0 = Just (axModDef, [s,t], num (mod x y)) + where mbX = isNumLitTy s + mbY = isNumLitTy t +matchFamMod _ = Nothing + + + +matchFamExp :: [Type] -> Maybe (CoAxiomRule, [Type], Type) +matchFamExp [s,t] + | Just 0 <- mbY = Just (axExp0R, [s], num 1) + | Just 1 <- mbX = Just (axExp1L, [t], num 1) + | Just 1 <- mbY = Just (axExp1R, [s], s) + | Just x <- mbX, Just y <- mbY = + Just (axExpDef, [s,t], num (x ^ y)) + where mbX = isNumLitTy s + mbY = isNumLitTy t +matchFamExp _ = Nothing + +matchFamLog :: [Type] -> Maybe (CoAxiomRule, [Type], Type) +matchFamLog [s] + | Just x <- mbX, Just (n,_) <- genLog x 2 = Just (axLogDef, [s], num n) + where mbX = isNumLitTy s +matchFamLog _ = Nothing + + +matchFamLeq :: [Type] -> Maybe (CoAxiomRule, [Type], Type) +matchFamLeq [s,t] + | Just 0 <- mbX = Just (axLeq0L, [t], bool True) + | Just x <- mbX, Just y <- mbY = + Just (axLeqDef, [s,t], bool (x <= y)) + | tcEqType s t = Just (axLeqRefl, [s], bool True) + where mbX = isNumLitTy s + mbY = isNumLitTy t +matchFamLeq _ = Nothing + +matchFamCmpNat :: [Type] -> Maybe (CoAxiomRule, [Type], Type) +matchFamCmpNat [s,t] + | Just x <- mbX, Just y <- mbY = + Just (axCmpNatDef, [s,t], ordering (compare x y)) + | tcEqType s t = Just (axCmpNatRefl, [s], ordering EQ) + where mbX = isNumLitTy s + mbY = isNumLitTy t +matchFamCmpNat _ = Nothing + +matchFamCmpSymbol :: [Type] -> Maybe (CoAxiomRule, [Type], Type) +matchFamCmpSymbol [s,t] + | Just x <- mbX, Just y <- mbY = + Just (axCmpSymbolDef, [s,t], ordering (compare x y)) + | tcEqType s t = Just (axCmpSymbolRefl, [s], ordering EQ) + where mbX = isStrLitTy s + mbY = isStrLitTy t +matchFamCmpSymbol _ = Nothing + +matchFamAppendSymbol :: [Type] -> Maybe (CoAxiomRule, [Type], Type) +matchFamAppendSymbol [s,t] + | Just x <- mbX, nullFS x = Just (axAppendSymbol0R, [t], t) + | Just y <- mbY, nullFS y = Just (axAppendSymbol0L, [s], s) + | Just x <- mbX, Just y <- mbY = + Just (axAppendSymbolDef, [s,t], mkStrLitTy (appendFS x y)) + where + mbX = isStrLitTy s + mbY = isStrLitTy t +matchFamAppendSymbol _ = Nothing + +{------------------------------------------------------------------------------- +Interact with axioms +-------------------------------------------------------------------------------} + +interactTopAdd :: [Xi] -> Xi -> [Pair Type] +interactTopAdd [s,t] r + | Just 0 <- mbZ = [ s === num 0, t === num 0 ] -- (s + t ~ 0) => (s ~ 0, t ~ 0) + | Just x <- mbX, Just z <- mbZ, Just y <- minus z x = [t === num y] -- (5 + t ~ 8) => (t ~ 3) + | Just y <- mbY, Just z <- mbZ, Just x <- minus z y = [s === num x] -- (s + 5 ~ 8) => (s ~ 3) + where + mbX = isNumLitTy s + mbY = isNumLitTy t + mbZ = isNumLitTy r +interactTopAdd _ _ = [] + +{- +Note [Weakened interaction rule for subtraction] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +A simpler interaction here might be: + + `s - t ~ r` --> `t + r ~ s` + +This would enable us to reuse all the code for addition. +Unfortunately, this works a little too well at the moment. +Consider the following example: + + 0 - 5 ~ r --> 5 + r ~ 0 --> (5 = 0, r = 0) + +This (correctly) spots that the constraint cannot be solved. + +However, this may be a problem if the constraint did not +need to be solved in the first place! Consider the following example: + +f :: Proxy (If (5 <=? 0) (0 - 5) (5 - 0)) -> Proxy 5 +f = id + +Currently, GHC is strict while evaluating functions, so this does not +work, because even though the `If` should evaluate to `5 - 0`, we +also evaluate the "then" branch which generates the constraint `0 - 5 ~ r`, +which fails. + +So, for the time being, we only add an improvement when the RHS is a constant, +which happens to work OK for the moment, although clearly we need to do +something more general. +-} +interactTopSub :: [Xi] -> Xi -> [Pair Type] +interactTopSub [s,t] r + | Just z <- mbZ = [ s === (num z .+. t) ] -- (s - t ~ 5) => (5 + t ~ s) + where + mbZ = isNumLitTy r +interactTopSub _ _ = [] + + + + + +interactTopMul :: [Xi] -> Xi -> [Pair Type] +interactTopMul [s,t] r + | Just 1 <- mbZ = [ s === num 1, t === num 1 ] -- (s * t ~ 1) => (s ~ 1, t ~ 1) + | Just x <- mbX, Just z <- mbZ, Just y <- divide z x = [t === num y] -- (3 * t ~ 15) => (t ~ 5) + | Just y <- mbY, Just z <- mbZ, Just x <- divide z y = [s === num x] -- (s * 3 ~ 15) => (s ~ 5) + where + mbX = isNumLitTy s + mbY = isNumLitTy t + mbZ = isNumLitTy r +interactTopMul _ _ = [] + +interactTopDiv :: [Xi] -> Xi -> [Pair Type] +interactTopDiv _ _ = [] -- I can't think of anything... + +interactTopMod :: [Xi] -> Xi -> [Pair Type] +interactTopMod _ _ = [] -- I can't think of anything... + +interactTopExp :: [Xi] -> Xi -> [Pair Type] +interactTopExp [s,t] r + | Just 0 <- mbZ = [ s === num 0 ] -- (s ^ t ~ 0) => (s ~ 0) + | Just x <- mbX, Just z <- mbZ, Just y <- logExact z x = [t === num y] -- (2 ^ t ~ 8) => (t ~ 3) + | Just y <- mbY, Just z <- mbZ, Just x <- rootExact z y = [s === num x] -- (s ^ 2 ~ 9) => (s ~ 3) + where + mbX = isNumLitTy s + mbY = isNumLitTy t + mbZ = isNumLitTy r +interactTopExp _ _ = [] + +interactTopLog :: [Xi] -> Xi -> [Pair Type] +interactTopLog _ _ = [] -- I can't think of anything... + + + +interactTopLeq :: [Xi] -> Xi -> [Pair Type] +interactTopLeq [s,t] r + | Just 0 <- mbY, Just True <- mbZ = [ s === num 0 ] -- (s <= 0) => (s ~ 0) + where + mbY = isNumLitTy t + mbZ = isBoolLitTy r +interactTopLeq _ _ = [] + +interactTopCmpNat :: [Xi] -> Xi -> [Pair Type] +interactTopCmpNat [s,t] r + | Just EQ <- isOrderingLitTy r = [ s === t ] +interactTopCmpNat _ _ = [] + +interactTopCmpSymbol :: [Xi] -> Xi -> [Pair Type] +interactTopCmpSymbol [s,t] r + | Just EQ <- isOrderingLitTy r = [ s === t ] +interactTopCmpSymbol _ _ = [] + +interactTopAppendSymbol :: [Xi] -> Xi -> [Pair Type] +interactTopAppendSymbol [s,t] r + -- (AppendSymbol a b ~ "") => (a ~ "", b ~ "") + | Just z <- mbZ, nullFS z = + [s === mkStrLitTy nilFS, t === mkStrLitTy nilFS ] + + -- (AppendSymbol "foo" b ~ "foobar") => (b ~ "bar") + | Just x <- fmap unpackFS mbX, Just z <- fmap unpackFS mbZ, x `isPrefixOf` z = + [ t === mkStrLitTy (mkFastString $ drop (length x) z) ] + + -- (AppendSymbol f "bar" ~ "foobar") => (f ~ "foo") + | Just y <- fmap unpackFS mbY, Just z <- fmap unpackFS mbZ, y `isSuffixOf` z = + [ t === mkStrLitTy (mkFastString $ take (length z - length y) z) ] + + where + mbX = isStrLitTy s + mbY = isStrLitTy t + mbZ = isStrLitTy r + +interactTopAppendSymbol _ _ = [] + +{------------------------------------------------------------------------------- +Interaction with inerts +-------------------------------------------------------------------------------} + +interactInertAdd :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type] +interactInertAdd [x1,y1] z1 [x2,y2] z2 + | sameZ && tcEqType x1 x2 = [ y1 === y2 ] + | sameZ && tcEqType y1 y2 = [ x1 === x2 ] + where sameZ = tcEqType z1 z2 +interactInertAdd _ _ _ _ = [] + +interactInertSub :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type] +interactInertSub [x1,y1] z1 [x2,y2] z2 + | sameZ && tcEqType x1 x2 = [ y1 === y2 ] + | sameZ && tcEqType y1 y2 = [ x1 === x2 ] + where sameZ = tcEqType z1 z2 +interactInertSub _ _ _ _ = [] + +interactInertMul :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type] +interactInertMul [x1,y1] z1 [x2,y2] z2 + | sameZ && known (/= 0) x1 && tcEqType x1 x2 = [ y1 === y2 ] + | sameZ && known (/= 0) y1 && tcEqType y1 y2 = [ x1 === x2 ] + where sameZ = tcEqType z1 z2 + +interactInertMul _ _ _ _ = [] + +interactInertDiv :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type] +interactInertDiv _ _ _ _ = [] + +interactInertMod :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type] +interactInertMod _ _ _ _ = [] + +interactInertExp :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type] +interactInertExp [x1,y1] z1 [x2,y2] z2 + | sameZ && known (> 1) x1 && tcEqType x1 x2 = [ y1 === y2 ] + | sameZ && known (> 0) y1 && tcEqType y1 y2 = [ x1 === x2 ] + where sameZ = tcEqType z1 z2 + +interactInertExp _ _ _ _ = [] + +interactInertLog :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type] +interactInertLog _ _ _ _ = [] + + +interactInertLeq :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type] +interactInertLeq [x1,y1] z1 [x2,y2] z2 + | bothTrue && tcEqType x1 y2 && tcEqType y1 x2 = [ x1 === y1 ] + | bothTrue && tcEqType y1 x2 = [ (x1 <== y2) === bool True ] + | bothTrue && tcEqType y2 x1 = [ (x2 <== y1) === bool True ] + where bothTrue = isJust $ do True <- isBoolLitTy z1 + True <- isBoolLitTy z2 + return () + +interactInertLeq _ _ _ _ = [] + + +interactInertAppendSymbol :: [Xi] -> Xi -> [Xi] -> Xi -> [Pair Type] +interactInertAppendSymbol [x1,y1] z1 [x2,y2] z2 + | sameZ && tcEqType x1 x2 = [ y1 === y2 ] + | sameZ && tcEqType y1 y2 = [ x1 === x2 ] + where sameZ = tcEqType z1 z2 +interactInertAppendSymbol _ _ _ _ = [] + + + +{- ----------------------------------------------------------------------------- +These inverse functions are used for simplifying propositions using +concrete natural numbers. +----------------------------------------------------------------------------- -} + +-- | Subtract two natural numbers. +minus :: Integer -> Integer -> Maybe Integer +minus x y = if x >= y then Just (x - y) else Nothing + +-- | Compute the exact logarithm of a natural number. +-- The logarithm base is the second argument. +logExact :: Integer -> Integer -> Maybe Integer +logExact x y = do (z,True) <- genLog x y + return z + + +-- | Divide two natural numbers. +divide :: Integer -> Integer -> Maybe Integer +divide _ 0 = Nothing +divide x y = case divMod x y of + (a,0) -> Just a + _ -> Nothing + +-- | Compute the exact root of a natural number. +-- The second argument specifies which root we are computing. +rootExact :: Integer -> Integer -> Maybe Integer +rootExact x y = do (z,True) <- genRoot x y + return z + + + +{- | Compute the n-th root of a natural number, rounded down to +the closest natural number. The boolean indicates if the result +is exact (i.e., True means no rounding was done, False means rounded down). +The second argument specifies which root we are computing. -} +genRoot :: Integer -> Integer -> Maybe (Integer, Bool) +genRoot _ 0 = Nothing +genRoot x0 1 = Just (x0, True) +genRoot x0 root = Just (search 0 (x0+1)) + where + search from to = let x = from + div (to - from) 2 + a = x ^ root + in case compare a x0 of + EQ -> (x, True) + LT | x /= from -> search x to + | otherwise -> (from, False) + GT | x /= to -> search from x + | otherwise -> (from, False) + +{- | Compute the logarithm of a number in the given base, rounded down to the +closest integer. The boolean indicates if we the result is exact +(i.e., True means no rounding happened, False means we rounded down). +The logarithm base is the second argument. -} +genLog :: Integer -> Integer -> Maybe (Integer, Bool) +genLog x 0 = if x == 1 then Just (0, True) else Nothing +genLog _ 1 = Nothing +genLog 0 _ = Nothing +genLog x base = Just (exactLoop 0 x) + where + exactLoop s i + | i == 1 = (s,True) + | i < base = (s,False) + | otherwise = + let s1 = s + 1 + in s1 `seq` case divMod i base of + (j,r) + | r == 0 -> exactLoop s1 j + | otherwise -> (underLoop s1 j, False) + + underLoop s i + | i < base = s + | otherwise = let s1 = s + 1 in s1 `seq` underLoop s1 (div i base) diff --git a/compiler/GHC/Builtin/Types/Prim.hs b/compiler/GHC/Builtin/Types/Prim.hs new file mode 100644 index 0000000000..4bee18b964 --- /dev/null +++ b/compiler/GHC/Builtin/Types/Prim.hs @@ -0,0 +1,1110 @@ +{- +(c) The AQUA Project, Glasgow University, 1994-1998 + + +Wired-in knowledge about primitive types +-} + +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +-- | This module defines TyCons that can't be expressed in Haskell. +-- They are all, therefore, wired-in TyCons. C.f module GHC.Builtin.Types +module GHC.Builtin.Types.Prim( + mkPrimTyConName, -- For implicit parameters in GHC.Builtin.Types only + + mkTemplateKindVars, mkTemplateTyVars, mkTemplateTyVarsFrom, + mkTemplateKiTyVars, mkTemplateKiTyVar, + + mkTemplateTyConBinders, mkTemplateKindTyConBinders, + mkTemplateAnonTyConBinders, + + alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar, + alphaTys, alphaTy, betaTy, gammaTy, deltaTy, + alphaTyVarsUnliftedRep, alphaTyVarUnliftedRep, + alphaTysUnliftedRep, alphaTyUnliftedRep, + runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep1Ty, runtimeRep2Ty, + openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar, + + -- Kind constructors... + tYPETyCon, tYPETyConName, + + -- Kinds + tYPE, primRepToRuntimeRep, + + funTyCon, funTyConName, + unexposedPrimTyCons, exposedPrimTyCons, primTyCons, + + charPrimTyCon, charPrimTy, charPrimTyConName, + intPrimTyCon, intPrimTy, intPrimTyConName, + wordPrimTyCon, wordPrimTy, wordPrimTyConName, + addrPrimTyCon, addrPrimTy, addrPrimTyConName, + floatPrimTyCon, floatPrimTy, floatPrimTyConName, + doublePrimTyCon, doublePrimTy, doublePrimTyConName, + + voidPrimTyCon, voidPrimTy, + statePrimTyCon, mkStatePrimTy, + realWorldTyCon, realWorldTy, realWorldStatePrimTy, + + proxyPrimTyCon, mkProxyPrimTy, + + arrayPrimTyCon, mkArrayPrimTy, + byteArrayPrimTyCon, byteArrayPrimTy, + arrayArrayPrimTyCon, mkArrayArrayPrimTy, + smallArrayPrimTyCon, mkSmallArrayPrimTy, + mutableArrayPrimTyCon, mkMutableArrayPrimTy, + mutableByteArrayPrimTyCon, mkMutableByteArrayPrimTy, + mutableArrayArrayPrimTyCon, mkMutableArrayArrayPrimTy, + smallMutableArrayPrimTyCon, mkSmallMutableArrayPrimTy, + mutVarPrimTyCon, mkMutVarPrimTy, + + mVarPrimTyCon, mkMVarPrimTy, + tVarPrimTyCon, mkTVarPrimTy, + stablePtrPrimTyCon, mkStablePtrPrimTy, + stableNamePrimTyCon, mkStableNamePrimTy, + compactPrimTyCon, compactPrimTy, + bcoPrimTyCon, bcoPrimTy, + weakPrimTyCon, mkWeakPrimTy, + threadIdPrimTyCon, threadIdPrimTy, + + int8PrimTyCon, int8PrimTy, int8PrimTyConName, + word8PrimTyCon, word8PrimTy, word8PrimTyConName, + + int16PrimTyCon, int16PrimTy, int16PrimTyConName, + word16PrimTyCon, word16PrimTy, word16PrimTyConName, + + int32PrimTyCon, int32PrimTy, int32PrimTyConName, + word32PrimTyCon, word32PrimTy, word32PrimTyConName, + + int64PrimTyCon, int64PrimTy, int64PrimTyConName, + word64PrimTyCon, word64PrimTy, word64PrimTyConName, + + eqPrimTyCon, -- ty1 ~# ty2 + eqReprPrimTyCon, -- ty1 ~R# ty2 (at role Representational) + eqPhantPrimTyCon, -- ty1 ~P# ty2 (at role Phantom) + equalityTyCon, + + -- * SIMD +#include "primop-vector-tys-exports.hs-incl" + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import {-# SOURCE #-} GHC.Builtin.Types + ( runtimeRepTy, unboxedTupleKind, liftedTypeKind + , vecRepDataConTyCon, tupleRepDataConTyCon + , liftedRepDataConTy, unliftedRepDataConTy + , intRepDataConTy + , int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy + , wordRepDataConTy + , word16RepDataConTy, word8RepDataConTy, word32RepDataConTy, word64RepDataConTy + , addrRepDataConTy + , floatRepDataConTy, doubleRepDataConTy + , vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy + , vec64DataConTy + , int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy + , int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy + , word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy + , doubleElemRepDataConTy + , mkPromotedListTy ) + +import GHC.Types.Var ( TyVar, mkTyVar ) +import GHC.Types.Name +import GHC.Core.TyCon +import GHC.Types.SrcLoc +import GHC.Types.Unique +import GHC.Builtin.Names +import FastString +import Outputable +import GHC.Core.TyCo.Rep -- Doesn't need special access, but this is easier to avoid + -- import loops which show up if you import Type instead + +import Data.Char + +{- +************************************************************************ +* * +\subsection{Primitive type constructors} +* * +************************************************************************ +-} + +primTyCons :: [TyCon] +primTyCons = unexposedPrimTyCons ++ exposedPrimTyCons + +-- | Primitive 'TyCon's that are defined in "GHC.Prim" but not exposed. +-- It's important to keep these separate as we don't want users to be able to +-- write them (see #15209) or see them in GHCi's @:browse@ output +-- (see #12023). +unexposedPrimTyCons :: [TyCon] +unexposedPrimTyCons + = [ eqPrimTyCon + , eqReprPrimTyCon + , eqPhantPrimTyCon + ] + +-- | Primitive 'TyCon's that are defined in, and exported from, "GHC.Prim". +exposedPrimTyCons :: [TyCon] +exposedPrimTyCons + = [ addrPrimTyCon + , arrayPrimTyCon + , byteArrayPrimTyCon + , arrayArrayPrimTyCon + , smallArrayPrimTyCon + , charPrimTyCon + , doublePrimTyCon + , floatPrimTyCon + , intPrimTyCon + , int8PrimTyCon + , int16PrimTyCon + , int32PrimTyCon + , int64PrimTyCon + , bcoPrimTyCon + , weakPrimTyCon + , mutableArrayPrimTyCon + , mutableByteArrayPrimTyCon + , mutableArrayArrayPrimTyCon + , smallMutableArrayPrimTyCon + , mVarPrimTyCon + , tVarPrimTyCon + , mutVarPrimTyCon + , realWorldTyCon + , stablePtrPrimTyCon + , stableNamePrimTyCon + , compactPrimTyCon + , statePrimTyCon + , voidPrimTyCon + , proxyPrimTyCon + , threadIdPrimTyCon + , wordPrimTyCon + , word8PrimTyCon + , word16PrimTyCon + , word32PrimTyCon + , word64PrimTyCon + + , tYPETyCon + +#include "primop-vector-tycons.hs-incl" + ] + +mkPrimTc :: FastString -> Unique -> TyCon -> Name +mkPrimTc fs unique tycon + = mkWiredInName gHC_PRIM (mkTcOccFS fs) + unique + (ATyCon tycon) -- Relevant TyCon + UserSyntax + +mkBuiltInPrimTc :: FastString -> Unique -> TyCon -> Name +mkBuiltInPrimTc fs unique tycon + = mkWiredInName gHC_PRIM (mkTcOccFS fs) + unique + (ATyCon tycon) -- Relevant TyCon + BuiltInSyntax + + +charPrimTyConName, intPrimTyConName, int8PrimTyConName, int16PrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word8PrimTyConName, word16PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, proxyPrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, eqPhantPrimTyConName, voidPrimTyConName :: Name +charPrimTyConName = mkPrimTc (fsLit "Char#") charPrimTyConKey charPrimTyCon +intPrimTyConName = mkPrimTc (fsLit "Int#") intPrimTyConKey intPrimTyCon +int8PrimTyConName = mkPrimTc (fsLit "Int8#") int8PrimTyConKey int8PrimTyCon +int16PrimTyConName = mkPrimTc (fsLit "Int16#") int16PrimTyConKey int16PrimTyCon +int32PrimTyConName = mkPrimTc (fsLit "Int32#") int32PrimTyConKey int32PrimTyCon +int64PrimTyConName = mkPrimTc (fsLit "Int64#") int64PrimTyConKey int64PrimTyCon +wordPrimTyConName = mkPrimTc (fsLit "Word#") wordPrimTyConKey wordPrimTyCon +word8PrimTyConName = mkPrimTc (fsLit "Word8#") word8PrimTyConKey word8PrimTyCon +word16PrimTyConName = mkPrimTc (fsLit "Word16#") word16PrimTyConKey word16PrimTyCon +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 +voidPrimTyConName = mkPrimTc (fsLit "Void#") voidPrimTyConKey voidPrimTyCon +proxyPrimTyConName = mkPrimTc (fsLit "Proxy#") proxyPrimTyConKey proxyPrimTyCon +eqPrimTyConName = mkPrimTc (fsLit "~#") eqPrimTyConKey eqPrimTyCon +eqReprPrimTyConName = mkBuiltInPrimTc (fsLit "~R#") eqReprPrimTyConKey eqReprPrimTyCon +eqPhantPrimTyConName = mkBuiltInPrimTc (fsLit "~P#") eqPhantPrimTyConKey eqPhantPrimTyCon +realWorldTyConName = mkPrimTc (fsLit "RealWorld") realWorldTyConKey realWorldTyCon +arrayPrimTyConName = mkPrimTc (fsLit "Array#") arrayPrimTyConKey arrayPrimTyCon +byteArrayPrimTyConName = mkPrimTc (fsLit "ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon +arrayArrayPrimTyConName = mkPrimTc (fsLit "ArrayArray#") arrayArrayPrimTyConKey arrayArrayPrimTyCon +smallArrayPrimTyConName = mkPrimTc (fsLit "SmallArray#") smallArrayPrimTyConKey smallArrayPrimTyCon +mutableArrayPrimTyConName = mkPrimTc (fsLit "MutableArray#") mutableArrayPrimTyConKey mutableArrayPrimTyCon +mutableByteArrayPrimTyConName = mkPrimTc (fsLit "MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon +mutableArrayArrayPrimTyConName= mkPrimTc (fsLit "MutableArrayArray#") mutableArrayArrayPrimTyConKey mutableArrayArrayPrimTyCon +smallMutableArrayPrimTyConName= mkPrimTc (fsLit "SmallMutableArray#") smallMutableArrayPrimTyConKey smallMutableArrayPrimTyCon +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 +compactPrimTyConName = mkPrimTc (fsLit "Compact#") compactPrimTyConKey compactPrimTyCon +bcoPrimTyConName = mkPrimTc (fsLit "BCO") bcoPrimTyConKey bcoPrimTyCon +weakPrimTyConName = mkPrimTc (fsLit "Weak#") weakPrimTyConKey weakPrimTyCon +threadIdPrimTyConName = mkPrimTc (fsLit "ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon + +{- +************************************************************************ +* * +\subsection{Support code} +* * +************************************************************************ + +alphaTyVars is a list of type variables for use in templates: + ["a", "b", ..., "z", "t1", "t2", ... ] +-} + +mkTemplateKindVar :: Kind -> TyVar +mkTemplateKindVar = mkTyVar (mk_tv_name 0 "k") + +mkTemplateKindVars :: [Kind] -> [TyVar] +-- k0 with unique (mkAlphaTyVarUnique 0) +-- k1 with unique (mkAlphaTyVarUnique 1) +-- ... etc +mkTemplateKindVars [kind] = [mkTemplateKindVar kind] + -- Special case for one kind: just "k" +mkTemplateKindVars kinds + = [ mkTyVar (mk_tv_name u ('k' : show u)) kind + | (kind, u) <- kinds `zip` [0..] ] +mk_tv_name :: Int -> String -> Name +mk_tv_name u s = mkInternalName (mkAlphaTyVarUnique u) + (mkTyVarOccFS (mkFastString s)) + noSrcSpan + +mkTemplateTyVarsFrom :: Int -> [Kind] -> [TyVar] +-- a with unique (mkAlphaTyVarUnique n) +-- b with unique (mkAlphaTyVarUnique n+1) +-- ... etc +-- Typically called as +-- mkTemplateTyVarsFrom (length kv_bndrs) kinds +-- where kv_bndrs are the kind-level binders of a TyCon +mkTemplateTyVarsFrom n kinds + = [ mkTyVar name kind + | (kind, index) <- zip kinds [0..], + let ch_ord = index + ord 'a' + name_str | ch_ord <= ord 'z' = [chr ch_ord] + | otherwise = 't':show index + name = mk_tv_name (index + n) name_str + ] + +mkTemplateTyVars :: [Kind] -> [TyVar] +mkTemplateTyVars = mkTemplateTyVarsFrom 1 + +mkTemplateTyConBinders + :: [Kind] -- [k1, .., kn] Kinds of kind-forall'd vars + -> ([Kind] -> [Kind]) -- Arg is [kv1:k1, ..., kvn:kn] + -- same length as first arg + -- Result is anon arg kinds + -> [TyConBinder] +mkTemplateTyConBinders kind_var_kinds mk_anon_arg_kinds + = kv_bndrs ++ tv_bndrs + where + kv_bndrs = mkTemplateKindTyConBinders kind_var_kinds + anon_kinds = mk_anon_arg_kinds (mkTyVarTys (binderVars kv_bndrs)) + tv_bndrs = mkTemplateAnonTyConBindersFrom (length kv_bndrs) anon_kinds + +mkTemplateKiTyVars + :: [Kind] -- [k1, .., kn] Kinds of kind-forall'd vars + -> ([Kind] -> [Kind]) -- Arg is [kv1:k1, ..., kvn:kn] + -- same length as first arg + -- Result is anon arg kinds [ak1, .., akm] + -> [TyVar] -- [kv1:k1, ..., kvn:kn, av1:ak1, ..., avm:akm] +-- Example: if you want the tyvars for +-- forall (r:RuntimeRep) (a:TYPE r) (b:*). blah +-- call mkTemplateKiTyVars [RuntimeRep] (\[r] -> [TYPE r, *]) +mkTemplateKiTyVars kind_var_kinds mk_arg_kinds + = kv_bndrs ++ tv_bndrs + where + kv_bndrs = mkTemplateKindVars kind_var_kinds + anon_kinds = mk_arg_kinds (mkTyVarTys kv_bndrs) + tv_bndrs = mkTemplateTyVarsFrom (length kv_bndrs) anon_kinds + +mkTemplateKiTyVar + :: Kind -- [k1, .., kn] Kind of kind-forall'd var + -> (Kind -> [Kind]) -- Arg is kv1:k1 + -- Result is anon arg kinds [ak1, .., akm] + -> [TyVar] -- [kv1:k1, ..., kvn:kn, av1:ak1, ..., avm:akm] +-- Example: if you want the tyvars for +-- forall (r:RuntimeRep) (a:TYPE r) (b:*). blah +-- call mkTemplateKiTyVar RuntimeRep (\r -> [TYPE r, *]) +mkTemplateKiTyVar kind mk_arg_kinds + = kv_bndr : tv_bndrs + where + kv_bndr = mkTemplateKindVar kind + anon_kinds = mk_arg_kinds (mkTyVarTy kv_bndr) + tv_bndrs = mkTemplateTyVarsFrom 1 anon_kinds + +mkTemplateKindTyConBinders :: [Kind] -> [TyConBinder] +-- Makes named, Specified binders +mkTemplateKindTyConBinders kinds = [mkNamedTyConBinder Specified tv | tv <- mkTemplateKindVars kinds] + +mkTemplateAnonTyConBinders :: [Kind] -> [TyConBinder] +mkTemplateAnonTyConBinders kinds = mkAnonTyConBinders VisArg (mkTemplateTyVars kinds) + +mkTemplateAnonTyConBindersFrom :: Int -> [Kind] -> [TyConBinder] +mkTemplateAnonTyConBindersFrom n kinds = mkAnonTyConBinders VisArg (mkTemplateTyVarsFrom n kinds) + +alphaTyVars :: [TyVar] +alphaTyVars = mkTemplateTyVars $ repeat liftedTypeKind + +alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar :: TyVar +(alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars + +alphaTys :: [Type] +alphaTys = mkTyVarTys alphaTyVars +alphaTy, betaTy, gammaTy, deltaTy :: Type +(alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys + +alphaTyVarsUnliftedRep :: [TyVar] +alphaTyVarsUnliftedRep = mkTemplateTyVars $ repeat (tYPE unliftedRepDataConTy) + +alphaTyVarUnliftedRep :: TyVar +(alphaTyVarUnliftedRep:_) = alphaTyVarsUnliftedRep + +alphaTysUnliftedRep :: [Type] +alphaTysUnliftedRep = mkTyVarTys alphaTyVarsUnliftedRep +alphaTyUnliftedRep :: Type +(alphaTyUnliftedRep:_) = alphaTysUnliftedRep + +runtimeRep1TyVar, runtimeRep2TyVar :: TyVar +(runtimeRep1TyVar : runtimeRep2TyVar : _) + = drop 16 (mkTemplateTyVars (repeat runtimeRepTy)) -- selects 'q','r' + +runtimeRep1Ty, runtimeRep2Ty :: Type +runtimeRep1Ty = mkTyVarTy runtimeRep1TyVar +runtimeRep2Ty = mkTyVarTy runtimeRep2TyVar + +openAlphaTyVar, openBetaTyVar :: TyVar +-- alpha :: TYPE r1 +-- beta :: TYPE r2 +[openAlphaTyVar,openBetaTyVar] + = mkTemplateTyVars [tYPE runtimeRep1Ty, tYPE runtimeRep2Ty] + +openAlphaTy, openBetaTy :: Type +openAlphaTy = mkTyVarTy openAlphaTyVar +openBetaTy = mkTyVarTy openBetaTyVar + +{- +************************************************************************ +* * + FunTyCon +* * +************************************************************************ +-} + +funTyConName :: Name +funTyConName = mkPrimTyConName (fsLit "->") funTyConKey funTyCon + +-- | The @(->)@ type constructor. +-- +-- @ +-- (->) :: forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep). +-- TYPE rep1 -> TYPE rep2 -> * +-- @ +funTyCon :: TyCon +funTyCon = mkFunTyCon funTyConName tc_bndrs tc_rep_nm + where + tc_bndrs = [ mkNamedTyConBinder Inferred runtimeRep1TyVar + , mkNamedTyConBinder Inferred runtimeRep2TyVar ] + ++ mkTemplateAnonTyConBinders [ tYPE runtimeRep1Ty + , tYPE runtimeRep2Ty + ] + tc_rep_nm = mkPrelTyConRepName funTyConName + +{- +************************************************************************ +* * + Kinds +* * +************************************************************************ + +Note [TYPE and RuntimeRep] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +All types that classify values have a kind of the form (TYPE rr), where + + data RuntimeRep -- Defined in ghc-prim:GHC.Types + = LiftedRep + | UnliftedRep + | IntRep + | FloatRep + .. etc .. + + rr :: RuntimeRep + + TYPE :: RuntimeRep -> TYPE 'LiftedRep -- Built in + +So for example: + Int :: TYPE 'LiftedRep + Array# Int :: TYPE 'UnliftedRep + Int# :: TYPE 'IntRep + Float# :: TYPE 'FloatRep + Maybe :: TYPE 'LiftedRep -> TYPE 'LiftedRep + (# , #) :: TYPE r1 -> TYPE r2 -> TYPE (TupleRep [r1, r2]) + +We abbreviate '*' specially: + type * = TYPE 'LiftedRep + +The 'rr' parameter tells us how the value is represented at runtime. + +Generally speaking, you can't be polymorphic in 'rr'. E.g + f :: forall (rr:RuntimeRep) (a:TYPE rr). a -> [a] + f = /\(rr:RuntimeRep) (a:rr) \(a:rr). ... +This is no good: we could not generate code code for 'f', because the +calling convention for 'f' varies depending on whether the argument is +a a Int, Int#, or Float#. (You could imagine generating specialised +code, one for each instantiation of 'rr', but we don't do that.) + +Certain functions CAN be runtime-rep-polymorphic, because the code +generator never has to manipulate a value of type 'a :: TYPE rr'. + +* error :: forall (rr:RuntimeRep) (a:TYPE rr). String -> a + Code generator never has to manipulate the return value. + +* unsafeCoerce#, defined in Desugar.mkUnsafeCoercePair: + Always inlined to be a no-op + unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) + (a :: TYPE r1) (b :: TYPE r2). + a -> b + +* Unboxed tuples, and unboxed sums, defined in GHC.Builtin.Types + Always inlined, and hence specialised to the call site + (#,#) :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) + (a :: TYPE r1) (b :: TYPE r2). + a -> b -> TYPE ('TupleRep '[r1, r2]) + +Note [PrimRep and kindPrimRep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +As part of its source code, in GHC.Core.TyCon, GHC has + data PrimRep = LiftedRep | UnliftedRep | IntRep | FloatRep | ...etc... + +Notice that + * RuntimeRep is part of the syntax tree of the program being compiled + (defined in a library: ghc-prim:GHC.Types) + * PrimRep is part of GHC's source code. + (defined in GHC.Core.TyCon) + +We need to get from one to the other; that is what kindPrimRep does. +Suppose we have a value + (v :: t) where (t :: k) +Given this kind + k = TyConApp "TYPE" [rep] +GHC needs to be able to figure out how 'v' is represented at runtime. +It expects 'rep' to be form + TyConApp rr_dc args +where 'rr_dc' is a promoteed data constructor from RuntimeRep. So +now we need to go from 'dc' to the corresponding PrimRep. We store this +PrimRep in the promoted data constructor itself: see TyCon.promDcRepInfo. + +-} + +tYPETyCon :: TyCon +tYPETyConName :: Name + +tYPETyCon = mkKindTyCon tYPETyConName + (mkTemplateAnonTyConBinders [runtimeRepTy]) + liftedTypeKind + [Nominal] + (mkPrelTyConRepName tYPETyConName) + +-------------------------- +-- ... and now their names + +-- If you edit these, you may need to update the GHC formalism +-- See Note [GHC Formalism] in GHC.Core.Lint +tYPETyConName = mkPrimTyConName (fsLit "TYPE") tYPETyConKey tYPETyCon + +mkPrimTyConName :: FastString -> Unique -> TyCon -> Name +mkPrimTyConName = mkPrimTcName BuiltInSyntax + -- All of the super kinds and kinds are defined in Prim, + -- and use BuiltInSyntax, because they are never in scope in the source + +mkPrimTcName :: BuiltInSyntax -> FastString -> Unique -> TyCon -> Name +mkPrimTcName built_in_syntax occ key tycon + = mkWiredInName gHC_PRIM (mkTcOccFS occ) key (ATyCon tycon) built_in_syntax + +----------------------------- +-- | Given a RuntimeRep, applies TYPE to it. +-- see Note [TYPE and RuntimeRep] +tYPE :: Type -> Type +tYPE rr = TyConApp tYPETyCon [rr] + +{- +************************************************************************ +* * + Basic primitive types (@Char#@, @Int#@, etc.) +* * +************************************************************************ +-} + +-- only used herein +pcPrimTyCon :: Name -> [Role] -> PrimRep -> TyCon +pcPrimTyCon name roles rep + = mkPrimTyCon name binders result_kind roles + where + binders = mkTemplateAnonTyConBinders (map (const liftedTypeKind) roles) + result_kind = tYPE (primRepToRuntimeRep rep) + +-- | Convert a 'PrimRep' to a 'Type' of kind RuntimeRep +-- Defined here to avoid (more) module loops +primRepToRuntimeRep :: PrimRep -> Type +primRepToRuntimeRep rep = case rep of + VoidRep -> TyConApp tupleRepDataConTyCon [mkPromotedListTy runtimeRepTy []] + LiftedRep -> liftedRepDataConTy + UnliftedRep -> unliftedRepDataConTy + IntRep -> intRepDataConTy + Int8Rep -> int8RepDataConTy + Int16Rep -> int16RepDataConTy + Int32Rep -> int32RepDataConTy + Int64Rep -> int64RepDataConTy + WordRep -> wordRepDataConTy + Word8Rep -> word8RepDataConTy + Word16Rep -> word16RepDataConTy + Word32Rep -> word32RepDataConTy + Word64Rep -> word64RepDataConTy + AddrRep -> addrRepDataConTy + FloatRep -> floatRepDataConTy + DoubleRep -> doubleRepDataConTy + VecRep n elem -> TyConApp vecRepDataConTyCon [n', elem'] + where + n' = case n of + 2 -> vec2DataConTy + 4 -> vec4DataConTy + 8 -> vec8DataConTy + 16 -> vec16DataConTy + 32 -> vec32DataConTy + 64 -> vec64DataConTy + _ -> pprPanic "Disallowed VecCount" (ppr n) + + elem' = case elem of + Int8ElemRep -> int8ElemRepDataConTy + Int16ElemRep -> int16ElemRepDataConTy + Int32ElemRep -> int32ElemRepDataConTy + Int64ElemRep -> int64ElemRepDataConTy + Word8ElemRep -> word8ElemRepDataConTy + Word16ElemRep -> word16ElemRepDataConTy + Word32ElemRep -> word32ElemRepDataConTy + Word64ElemRep -> word64ElemRepDataConTy + FloatElemRep -> floatElemRepDataConTy + DoubleElemRep -> doubleElemRepDataConTy + +pcPrimTyCon0 :: Name -> PrimRep -> TyCon +pcPrimTyCon0 name rep + = pcPrimTyCon name [] rep + +charPrimTy :: Type +charPrimTy = mkTyConTy charPrimTyCon +charPrimTyCon :: TyCon +charPrimTyCon = pcPrimTyCon0 charPrimTyConName WordRep + +intPrimTy :: Type +intPrimTy = mkTyConTy intPrimTyCon +intPrimTyCon :: TyCon +intPrimTyCon = pcPrimTyCon0 intPrimTyConName IntRep + +int8PrimTy :: Type +int8PrimTy = mkTyConTy int8PrimTyCon +int8PrimTyCon :: TyCon +int8PrimTyCon = pcPrimTyCon0 int8PrimTyConName Int8Rep + +int16PrimTy :: Type +int16PrimTy = mkTyConTy int16PrimTyCon +int16PrimTyCon :: TyCon +int16PrimTyCon = pcPrimTyCon0 int16PrimTyConName Int16Rep + +int32PrimTy :: Type +int32PrimTy = mkTyConTy int32PrimTyCon +int32PrimTyCon :: TyCon +int32PrimTyCon = pcPrimTyCon0 int32PrimTyConName Int32Rep + +int64PrimTy :: Type +int64PrimTy = mkTyConTy int64PrimTyCon +int64PrimTyCon :: TyCon +int64PrimTyCon = pcPrimTyCon0 int64PrimTyConName Int64Rep + +wordPrimTy :: Type +wordPrimTy = mkTyConTy wordPrimTyCon +wordPrimTyCon :: TyCon +wordPrimTyCon = pcPrimTyCon0 wordPrimTyConName WordRep + +word8PrimTy :: Type +word8PrimTy = mkTyConTy word8PrimTyCon +word8PrimTyCon :: TyCon +word8PrimTyCon = pcPrimTyCon0 word8PrimTyConName Word8Rep + +word16PrimTy :: Type +word16PrimTy = mkTyConTy word16PrimTyCon +word16PrimTyCon :: TyCon +word16PrimTyCon = pcPrimTyCon0 word16PrimTyConName Word16Rep + +word32PrimTy :: Type +word32PrimTy = mkTyConTy word32PrimTyCon +word32PrimTyCon :: TyCon +word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName Word32Rep + +word64PrimTy :: Type +word64PrimTy = mkTyConTy word64PrimTyCon +word64PrimTyCon :: TyCon +word64PrimTyCon = pcPrimTyCon0 word64PrimTyConName Word64Rep + +addrPrimTy :: Type +addrPrimTy = mkTyConTy addrPrimTyCon +addrPrimTyCon :: TyCon +addrPrimTyCon = pcPrimTyCon0 addrPrimTyConName AddrRep + +floatPrimTy :: Type +floatPrimTy = mkTyConTy floatPrimTyCon +floatPrimTyCon :: TyCon +floatPrimTyCon = pcPrimTyCon0 floatPrimTyConName FloatRep + +doublePrimTy :: Type +doublePrimTy = mkTyConTy doublePrimTyCon +doublePrimTyCon :: TyCon +doublePrimTyCon = pcPrimTyCon0 doublePrimTyConName DoubleRep + +{- +************************************************************************ +* * + The @State#@ type (and @_RealWorld@ types) +* * +************************************************************************ + +Note [The equality types story] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +GHC sports a veritable menagerie of equality types: + + Type or Lifted? Hetero? Role Built in Defining module + class? L/U TyCon +----------------------------------------------------------------------------------------- +~# T U hetero nominal eqPrimTyCon GHC.Prim +~~ C L hetero nominal heqTyCon GHC.Types +~ C L homo nominal eqTyCon GHC.Types +:~: T L homo nominal (not built-in) Data.Type.Equality +:~~: T L hetero nominal (not built-in) Data.Type.Equality + +~R# T U hetero repr eqReprPrimTy GHC.Prim +Coercible C L homo repr coercibleTyCon GHC.Types +Coercion T L homo repr (not built-in) Data.Type.Coercion +~P# T U hetero phantom eqPhantPrimTyCon GHC.Prim + +Recall that "hetero" means the equality can related types of different +kinds. Knowing that (t1 ~# t2) or (t1 ~R# t2) or even that (t1 ~P# t2) +also means that (k1 ~# k2), where (t1 :: k1) and (t2 :: k2). + +To produce less confusion for end users, when not dumping and without +-fprint-equality-relations, each of these groups is printed as the bottommost +listed equality. That is, (~#) and (~~) are both rendered as (~) in +error messages, and (~R#) is rendered as Coercible. + +Let's take these one at a time: + + -------------------------- + (~#) :: forall k1 k2. k1 -> k2 -> # + -------------------------- +This is The Type Of Equality in GHC. It classifies nominal coercions. +This type is used in the solver for recording equality constraints. +It responds "yes" to Type.isEqPrimPred and classifies as an EqPred in +Type.classifyPredType. + +All wanted constraints of this type are built with coercion holes. +(See Note [Coercion holes] in GHC.Core.TyCo.Rep.) But see also +Note [Deferred errors for coercion holes] in GHC.Tc.Errors to see how +equality constraints are deferred. + +Within GHC, ~# is called eqPrimTyCon, and it is defined in GHC.Builtin.Types.Prim. + + + -------------------------- + (~~) :: forall k1 k2. k1 -> k2 -> Constraint + -------------------------- +This is (almost) an ordinary class, defined as if by + class a ~# b => a ~~ b + instance a ~# b => a ~~ b +Here's what's unusual about it: + + * We can't actually declare it that way because we don't have syntax for ~#. + And ~# isn't a constraint, so even if we could write it, it wouldn't kind + check. + + * Users cannot write instances of it. + + * It is "naturally coherent". This means that the solver won't hesitate to + solve a goal of type (a ~~ b) even if there is, say (Int ~~ c) in the + context. (Normally, it waits to learn more, just in case the given + influences what happens next.) See Note [Naturally coherent classes] + in GHC.Tc.Solver.Interact. + + * It always terminates. That is, in the UndecidableInstances checks, we + don't worry if a (~~) constraint is too big, as we know that solving + equality terminates. + +On the other hand, this behaves just like any class w.r.t. eager superclass +unpacking in the solver. So a lifted equality given quickly becomes an unlifted +equality given. This is good, because the solver knows all about unlifted +equalities. There is some special-casing in GHC.Tc.Solver.Interact.matchClassInst to +pretend that there is an instance of this class, as we can't write the instance +in Haskell. + +Within GHC, ~~ is called heqTyCon, and it is defined in GHC.Builtin.Types. + + + -------------------------- + (~) :: forall k. k -> k -> Constraint + -------------------------- +This is /exactly/ like (~~), except with a homogeneous kind. +It is an almost-ordinary class defined as if by + class a ~# b => (a :: k) ~ (b :: k) + instance a ~# b => a ~ b + + * All the bullets for (~~) apply + + * In addition (~) is magical syntax, as ~ is a reserved symbol. + It cannot be exported or imported. + +Within GHC, ~ is called eqTyCon, and it is defined in GHC.Builtin.Types. + +Historical note: prior to July 18 (~) was defined as a + more-ordinary class with (~~) as a superclass. But that made it + special in different ways; and the extra superclass selections to + get from (~) to (~#) via (~~) were tiresome. Now it's defined + uniformly with (~~) and Coercible; much nicer.) + + + -------------------------- + (:~:) :: forall k. k -> k -> * + (:~~:) :: forall k1 k2. k1 -> k2 -> * + -------------------------- +These are perfectly ordinary GADTs, wrapping (~) and (~~) resp. +They are not defined within GHC at all. + + + -------------------------- + (~R#) :: forall k1 k2. k1 -> k2 -> # + -------------------------- +The is the representational analogue of ~#. This is the type of representational +equalities that the solver works on. All wanted constraints of this type are +built with coercion holes. + +Within GHC, ~R# is called eqReprPrimTyCon, and it is defined in GHC.Builtin.Types.Prim. + + + -------------------------- + Coercible :: forall k. k -> k -> Constraint + -------------------------- +This is quite like (~~) in the way it's defined and treated within GHC, but +it's homogeneous. Homogeneity helps with type inference (as GHC can solve one +kind from the other) and, in my (Richard's) estimation, will be more intuitive +for users. + +An alternative design included HCoercible (like (~~)) and Coercible (like (~)). +One annoyance was that we want `coerce :: Coercible a b => a -> b`, and +we need the type of coerce to be fully wired-in. So the HCoercible/Coercible +split required that both types be fully wired-in. Instead of doing this, +I just got rid of HCoercible, as I'm not sure who would use it, anyway. + +Within GHC, Coercible is called coercibleTyCon, and it is defined in +GHC.Builtin.Types. + + + -------------------------- + Coercion :: forall k. k -> k -> * + -------------------------- +This is a perfectly ordinary GADT, wrapping Coercible. It is not defined +within GHC at all. + + + -------------------------- + (~P#) :: forall k1 k2. k1 -> k2 -> # + -------------------------- +This is the phantom analogue of ~# and it is barely used at all. +(The solver has no idea about this one.) Here is the motivation: + + data Phant a = MkPhant + type role Phant phantom + + Phant <Int, Bool>_P :: Phant Int ~P# Phant Bool + +We just need to have something to put on that last line. You probably +don't need to worry about it. + + + +Note [The State# TyCon] +~~~~~~~~~~~~~~~~~~~~~~~ +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. + +The type parameter to State# is intended to keep separate threads separate. +Even though this parameter is not used in the definition of State#, it is +given role Nominal to enforce its intended use. +-} + +mkStatePrimTy :: Type -> Type +mkStatePrimTy ty = TyConApp statePrimTyCon [ty] + +statePrimTyCon :: TyCon -- See Note [The State# TyCon] +statePrimTyCon = pcPrimTyCon statePrimTyConName [Nominal] VoidRep + +{- +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#. +-} + +realWorldTyCon :: TyCon +realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName [] liftedTypeKind [] +realWorldTy :: Type +realWorldTy = mkTyConTy realWorldTyCon +realWorldStatePrimTy :: Type +realWorldStatePrimTy = mkStatePrimTy realWorldTy -- State# RealWorld + +-- Note: the ``state-pairing'' types are not truly primitive, +-- so they are defined in \tr{GHC.Builtin.Types}, not here. + + +voidPrimTy :: Type +voidPrimTy = TyConApp voidPrimTyCon [] + +voidPrimTyCon :: TyCon +voidPrimTyCon = pcPrimTyCon voidPrimTyConName [] VoidRep + +mkProxyPrimTy :: Type -> Type -> Type +mkProxyPrimTy k ty = TyConApp proxyPrimTyCon [k, ty] + +proxyPrimTyCon :: TyCon +proxyPrimTyCon = mkPrimTyCon proxyPrimTyConName binders res_kind [Nominal,Phantom] + where + -- Kind: forall k. k -> TYPE (Tuple '[]) + binders = mkTemplateTyConBinders [liftedTypeKind] id + res_kind = unboxedTupleKind [] + + +{- ********************************************************************* +* * + Primitive equality constraints + See Note [The equality types story] +* * +********************************************************************* -} + +eqPrimTyCon :: TyCon -- The representation type for equality predicates + -- See Note [The equality types story] +eqPrimTyCon = mkPrimTyCon eqPrimTyConName binders res_kind roles + where + -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (Tuple '[]) + binders = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id + res_kind = unboxedTupleKind [] + roles = [Nominal, Nominal, Nominal, Nominal] + +-- like eqPrimTyCon, but the type for *Representational* coercions +-- this should only ever appear as the type of a covar. Its role is +-- interpreted in coercionRole +eqReprPrimTyCon :: TyCon -- See Note [The equality types story] +eqReprPrimTyCon = mkPrimTyCon eqReprPrimTyConName binders res_kind roles + where + -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (Tuple '[]) + binders = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id + res_kind = unboxedTupleKind [] + roles = [Nominal, Nominal, Representational, Representational] + +-- like eqPrimTyCon, but the type for *Phantom* coercions. +-- This is only used to make higher-order equalities. Nothing +-- should ever actually have this type! +eqPhantPrimTyCon :: TyCon +eqPhantPrimTyCon = mkPrimTyCon eqPhantPrimTyConName binders res_kind roles + where + -- Kind :: forall k1 k2. k1 -> k2 -> TYPE (Tuple '[]) + binders = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id + res_kind = unboxedTupleKind [] + roles = [Nominal, Nominal, Phantom, Phantom] + +-- | Given a Role, what TyCon is the type of equality predicates at that role? +equalityTyCon :: Role -> TyCon +equalityTyCon Nominal = eqPrimTyCon +equalityTyCon Representational = eqReprPrimTyCon +equalityTyCon Phantom = eqPhantPrimTyCon + +{- ********************************************************************* +* * + The primitive array types +* * +********************************************************************* -} + +arrayPrimTyCon, mutableArrayPrimTyCon, mutableByteArrayPrimTyCon, + byteArrayPrimTyCon, arrayArrayPrimTyCon, mutableArrayArrayPrimTyCon, + smallArrayPrimTyCon, smallMutableArrayPrimTyCon :: TyCon +arrayPrimTyCon = pcPrimTyCon arrayPrimTyConName [Representational] UnliftedRep +mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConName [Nominal, Representational] UnliftedRep +mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConName [Nominal] UnliftedRep +byteArrayPrimTyCon = pcPrimTyCon0 byteArrayPrimTyConName UnliftedRep +arrayArrayPrimTyCon = pcPrimTyCon0 arrayArrayPrimTyConName UnliftedRep +mutableArrayArrayPrimTyCon = pcPrimTyCon mutableArrayArrayPrimTyConName [Nominal] UnliftedRep +smallArrayPrimTyCon = pcPrimTyCon smallArrayPrimTyConName [Representational] UnliftedRep +smallMutableArrayPrimTyCon = pcPrimTyCon smallMutableArrayPrimTyConName [Nominal, Representational] UnliftedRep + +mkArrayPrimTy :: Type -> Type +mkArrayPrimTy elt = TyConApp arrayPrimTyCon [elt] +byteArrayPrimTy :: Type +byteArrayPrimTy = mkTyConTy byteArrayPrimTyCon +mkArrayArrayPrimTy :: Type +mkArrayArrayPrimTy = mkTyConTy arrayArrayPrimTyCon +mkSmallArrayPrimTy :: Type -> Type +mkSmallArrayPrimTy elt = TyConApp smallArrayPrimTyCon [elt] +mkMutableArrayPrimTy :: Type -> Type -> Type +mkMutableArrayPrimTy s elt = TyConApp mutableArrayPrimTyCon [s, elt] +mkMutableByteArrayPrimTy :: Type -> Type +mkMutableByteArrayPrimTy s = TyConApp mutableByteArrayPrimTyCon [s] +mkMutableArrayArrayPrimTy :: Type -> Type +mkMutableArrayArrayPrimTy s = TyConApp mutableArrayArrayPrimTyCon [s] +mkSmallMutableArrayPrimTy :: Type -> Type -> Type +mkSmallMutableArrayPrimTy s elt = TyConApp smallMutableArrayPrimTyCon [s, elt] + + +{- ********************************************************************* +* * + The mutable variable type +* * +********************************************************************* -} + +mutVarPrimTyCon :: TyCon +mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName [Nominal, Representational] UnliftedRep + +mkMutVarPrimTy :: Type -> Type -> Type +mkMutVarPrimTy s elt = TyConApp mutVarPrimTyCon [s, elt] + +{- +************************************************************************ +* * + The synchronizing variable type +* * +************************************************************************ +-} + +mVarPrimTyCon :: TyCon +mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName [Nominal, Representational] UnliftedRep + +mkMVarPrimTy :: Type -> Type -> Type +mkMVarPrimTy s elt = TyConApp mVarPrimTyCon [s, elt] + +{- +************************************************************************ +* * + The transactional variable type +* * +************************************************************************ +-} + +tVarPrimTyCon :: TyCon +tVarPrimTyCon = pcPrimTyCon tVarPrimTyConName [Nominal, Representational] UnliftedRep + +mkTVarPrimTy :: Type -> Type -> Type +mkTVarPrimTy s elt = TyConApp tVarPrimTyCon [s, elt] + +{- +************************************************************************ +* * + The stable-pointer type +* * +************************************************************************ +-} + +stablePtrPrimTyCon :: TyCon +stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName [Representational] AddrRep + +mkStablePtrPrimTy :: Type -> Type +mkStablePtrPrimTy ty = TyConApp stablePtrPrimTyCon [ty] + +{- +************************************************************************ +* * + The stable-name type +* * +************************************************************************ +-} + +stableNamePrimTyCon :: TyCon +stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName [Phantom] UnliftedRep + +mkStableNamePrimTy :: Type -> Type +mkStableNamePrimTy ty = TyConApp stableNamePrimTyCon [ty] + +{- +************************************************************************ +* * + The Compact NFData (CNF) type +* * +************************************************************************ +-} + +compactPrimTyCon :: TyCon +compactPrimTyCon = pcPrimTyCon0 compactPrimTyConName UnliftedRep + +compactPrimTy :: Type +compactPrimTy = mkTyConTy compactPrimTyCon + +{- +************************************************************************ +* * + The ``bytecode object'' type +* * +************************************************************************ +-} + +-- Unlike most other primitive types, BCO is lifted. This is because in +-- general a BCO may be a thunk for the reasons given in Note [Updatable CAF +-- BCOs] in GHCi.CreateBCO. +bcoPrimTy :: Type +bcoPrimTy = mkTyConTy bcoPrimTyCon +bcoPrimTyCon :: TyCon +bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName LiftedRep + +{- +************************************************************************ +* * + The ``weak pointer'' type +* * +************************************************************************ +-} + +weakPrimTyCon :: TyCon +weakPrimTyCon = pcPrimTyCon weakPrimTyConName [Representational] UnliftedRep + +mkWeakPrimTy :: Type -> Type +mkWeakPrimTy v = TyConApp weakPrimTyCon [v] + +{- +************************************************************************ +* * + 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. +-} + +threadIdPrimTy :: Type +threadIdPrimTy = mkTyConTy threadIdPrimTyCon +threadIdPrimTyCon :: TyCon +threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName UnliftedRep + +{- +************************************************************************ +* * +\subsection{SIMD vector types} +* * +************************************************************************ +-} + +#include "primop-vector-tys.hs-incl" diff --git a/compiler/GHC/Builtin/Uniques.hs b/compiler/GHC/Builtin/Uniques.hs new file mode 100644 index 0000000000..d73544378b --- /dev/null +++ b/compiler/GHC/Builtin/Uniques.hs @@ -0,0 +1,180 @@ +{-# LANGUAGE CPP #-} + +-- | This is where we define a mapping from Uniques to their associated +-- known-key Names for things associated with tuples and sums. We use this +-- mapping while deserializing known-key Names in interface file symbol tables, +-- which are encoded as their Unique. See Note [Symbol table representation of +-- names] for details. +-- + +module GHC.Builtin.Uniques + ( -- * Looking up known-key names + knownUniqueName + + -- * Getting the 'Unique's of 'Name's + -- ** Anonymous sums + , mkSumTyConUnique + , mkSumDataConUnique + -- ** Tuples + -- *** Vanilla + , mkTupleTyConUnique + , mkTupleDataConUnique + -- *** Constraint + , mkCTupleTyConUnique + , mkCTupleDataConUnique + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import GHC.Builtin.Types +import GHC.Core.TyCon +import GHC.Core.DataCon +import GHC.Types.Id +import GHC.Types.Basic +import Outputable +import GHC.Types.Unique +import GHC.Types.Name +import Util + +import Data.Bits +import Data.Maybe + +-- | Get the 'Name' associated with a known-key 'Unique'. +knownUniqueName :: Unique -> Maybe Name +knownUniqueName u = + case tag of + 'z' -> Just $ getUnboxedSumName n + '4' -> Just $ getTupleTyConName Boxed n + '5' -> Just $ getTupleTyConName Unboxed n + '7' -> Just $ getTupleDataConName Boxed n + '8' -> Just $ getTupleDataConName Unboxed n + 'k' -> Just $ getCTupleTyConName n + 'm' -> Just $ getCTupleDataConUnique n + _ -> Nothing + where + (tag, n) = unpkUnique u + +-------------------------------------------------- +-- Anonymous sums +-- +-- Sum arities start from 2. The encoding is a bit funny: we break up the +-- integral part into bitfields for the arity, an alternative index (which is +-- taken to be 0xff in the case of the TyCon), and, in the case of a datacon, a +-- tag (used to identify the sum's TypeRep binding). +-- +-- This layout is chosen to remain compatible with the usual unique allocation +-- for wired-in data constructors described in GHC.Types.Unique +-- +-- TyCon for sum of arity k: +-- 00000000 kkkkkkkk 11111100 + +-- TypeRep of TyCon for sum of arity k: +-- 00000000 kkkkkkkk 11111101 +-- +-- DataCon for sum of arity k and alternative n (zero-based): +-- 00000000 kkkkkkkk nnnnnn00 +-- +-- TypeRep for sum DataCon of arity k and alternative n (zero-based): +-- 00000000 kkkkkkkk nnnnnn10 + +mkSumTyConUnique :: Arity -> Unique +mkSumTyConUnique arity = + ASSERT(arity < 0x3f) -- 0x3f since we only have 6 bits to encode the + -- alternative + mkUnique 'z' (arity `shiftL` 8 .|. 0xfc) + +mkSumDataConUnique :: ConTagZ -> Arity -> Unique +mkSumDataConUnique alt arity + | alt >= arity + = panic ("mkSumDataConUnique: " ++ show alt ++ " >= " ++ show arity) + | otherwise + = mkUnique 'z' (arity `shiftL` 8 + alt `shiftL` 2) {- skip the tycon -} + +getUnboxedSumName :: Int -> Name +getUnboxedSumName n + | n .&. 0xfc == 0xfc + = case tag of + 0x0 -> tyConName $ sumTyCon arity + 0x1 -> getRep $ sumTyCon arity + _ -> pprPanic "getUnboxedSumName: invalid tag" (ppr tag) + | tag == 0x0 + = dataConName $ sumDataCon (alt + 1) arity + | tag == 0x1 + = getName $ dataConWrapId $ sumDataCon (alt + 1) arity + | tag == 0x2 + = getRep $ promoteDataCon $ sumDataCon (alt + 1) arity + | otherwise + = pprPanic "getUnboxedSumName" (ppr n) + where + arity = n `shiftR` 8 + alt = (n .&. 0xfc) `shiftR` 2 + tag = 0x3 .&. n + getRep tycon = + fromMaybe (pprPanic "getUnboxedSumName(getRep)" (ppr tycon)) + $ tyConRepName_maybe tycon + +-- Note [Uniques for tuple type and data constructors] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Wired-in type constructor keys occupy *two* slots: +-- * u: the TyCon itself +-- * u+1: the TyConRepName of the TyCon +-- +-- Wired-in tuple data constructor keys occupy *three* slots: +-- * u: the DataCon itself +-- * u+1: its worker Id +-- * u+2: the TyConRepName of the promoted TyCon + +-------------------------------------------------- +-- Constraint tuples + +mkCTupleTyConUnique :: Arity -> Unique +mkCTupleTyConUnique a = mkUnique 'k' (2*a) + +mkCTupleDataConUnique :: Arity -> Unique +mkCTupleDataConUnique a = mkUnique 'm' (3*a) + +getCTupleTyConName :: Int -> Name +getCTupleTyConName n = + case n `divMod` 2 of + (arity, 0) -> cTupleTyConName arity + (arity, 1) -> mkPrelTyConRepName $ cTupleTyConName arity + _ -> panic "getCTupleTyConName: impossible" + +getCTupleDataConUnique :: Int -> Name +getCTupleDataConUnique n = + case n `divMod` 3 of + (arity, 0) -> cTupleDataConName arity + (_arity, 1) -> panic "getCTupleDataConName: no worker" + (arity, 2) -> mkPrelTyConRepName $ cTupleDataConName arity + _ -> panic "getCTupleDataConName: impossible" + +-------------------------------------------------- +-- Normal tuples + +mkTupleDataConUnique :: Boxity -> Arity -> Unique +mkTupleDataConUnique Boxed a = mkUnique '7' (3*a) -- may be used in C labels +mkTupleDataConUnique Unboxed a = mkUnique '8' (3*a) + +mkTupleTyConUnique :: Boxity -> Arity -> Unique +mkTupleTyConUnique Boxed a = mkUnique '4' (2*a) +mkTupleTyConUnique Unboxed a = mkUnique '5' (2*a) + +getTupleTyConName :: Boxity -> Int -> Name +getTupleTyConName boxity n = + case n `divMod` 2 of + (arity, 0) -> tyConName $ tupleTyCon boxity arity + (arity, 1) -> fromMaybe (panic "getTupleTyConName") + $ tyConRepName_maybe $ tupleTyCon boxity arity + _ -> panic "getTupleTyConName: impossible" + +getTupleDataConName :: Boxity -> Int -> Name +getTupleDataConName boxity n = + case n `divMod` 3 of + (arity, 0) -> dataConName $ tupleDataCon boxity arity + (arity, 1) -> idName $ dataConWorkId $ tupleDataCon boxity arity + (arity, 2) -> fromMaybe (panic "getTupleDataCon") + $ tyConRepName_maybe $ promotedTupleDataCon boxity arity + _ -> panic "getTupleDataConName: impossible" diff --git a/compiler/GHC/Builtin/Uniques.hs-boot b/compiler/GHC/Builtin/Uniques.hs-boot new file mode 100644 index 0000000000..f00490b538 --- /dev/null +++ b/compiler/GHC/Builtin/Uniques.hs-boot @@ -0,0 +1,18 @@ +module GHC.Builtin.Uniques where + +import GhcPrelude +import GHC.Types.Unique +import GHC.Types.Name +import GHC.Types.Basic + +-- Needed by GHC.Builtin.Types +knownUniqueName :: Unique -> Maybe Name + +mkSumTyConUnique :: Arity -> Unique +mkSumDataConUnique :: ConTagZ -> Arity -> Unique + +mkCTupleTyConUnique :: Arity -> Unique +mkCTupleDataConUnique :: Arity -> Unique + +mkTupleTyConUnique :: Boxity -> Arity -> Unique +mkTupleDataConUnique :: Boxity -> Arity -> Unique diff --git a/compiler/GHC/Builtin/Utils.hs b/compiler/GHC/Builtin/Utils.hs new file mode 100644 index 0000000000..0725ee85fa --- /dev/null +++ b/compiler/GHC/Builtin/Utils.hs @@ -0,0 +1,287 @@ +{- +(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 + +-} + +{-# LANGUAGE CPP #-} + +-- | The @GHC.Builtin.Utils@ interface to the compiler's prelude knowledge. +-- +-- This module serves as the central gathering point for names which the +-- compiler knows something about. This includes functions for, +-- +-- * discerning whether a 'Name' is known-key +-- +-- * given a 'Unique', looking up its corresponding known-key 'Name' +-- +-- See Note [Known-key names] and Note [About wired-in things] for information +-- about the two types of prelude things in GHC. +-- +module GHC.Builtin.Utils ( + -- * Known-key names + isKnownKeyName, + lookupKnownKeyName, + lookupKnownNameInfo, + + -- ** Internal use + -- | 'knownKeyNames' is exported to seed the original name cache only; + -- if you find yourself wanting to look at it you might consider using + -- 'lookupKnownKeyName' or 'isKnownKeyName'. + knownKeyNames, + + -- * Miscellaneous + wiredInIds, ghcPrimIds, + primOpRules, builtinRules, + + ghcPrimExports, + primOpId, + + -- * Random other things + maybeCharLikeCon, maybeIntLikeCon, + + -- * Class categories + isNumericClass, isStandardClass + + ) where + +#include "HsVersions.h" + +import GhcPrelude + +import GHC.Builtin.Uniques +import GHC.Types.Unique ( isValidKnownKeyUnique ) + +import GHC.Core.ConLike ( ConLike(..) ) +import GHC.Builtin.Names.TH ( templateHaskellNames ) +import GHC.Builtin.Names +import GHC.Core.Opt.ConstantFold +import GHC.Types.Avail +import GHC.Builtin.PrimOps +import GHC.Core.DataCon +import GHC.Types.Id +import GHC.Types.Name +import GHC.Types.Name.Env +import GHC.Types.Id.Make +import Outputable +import GHC.Builtin.Types.Prim +import GHC.Builtin.Types +import GHC.Driver.Types +import GHC.Core.Class +import GHC.Core.TyCon +import GHC.Types.Unique.FM +import Util +import GHC.Builtin.Types.Literals ( typeNatTyCons ) + +import Control.Applicative ((<|>)) +import Data.List ( intercalate ) +import Data.Array +import Data.Maybe + +{- +************************************************************************ +* * +\subsection[builtinNameInfo]{Lookup built-in names} +* * +************************************************************************ + +Note [About wired-in things] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +* Wired-in things are Ids\/TyCons that are completely known to the compiler. + They are global values in GHC, (e.g. listTyCon :: TyCon). + +* A wired-in Name contains the thing itself inside the Name: + see Name.wiredInNameTyThing_maybe + (E.g. listTyConName contains listTyCon. + +* The name cache is initialised with (the names of) all wired-in things + (except tuples and sums; see Note [Infinite families of known-key names]) + +* The type environment itself contains no wired in things. The type + checker sees if the Name is wired in before looking up the name in + the type environment. + +* GHC.Iface.Make prunes out wired-in things before putting them in an interface file. + So interface files never contain wired-in things. +-} + + +-- | This list is used to ensure that when you say "Prelude.map" in your source +-- code, or in an interface file, you get a Name with the correct known key (See +-- Note [Known-key names] in GHC.Builtin.Names) +knownKeyNames :: [Name] +knownKeyNames + | debugIsOn + , Just badNamesStr <- knownKeyNamesOkay all_names + = panic ("badAllKnownKeyNames:\n" ++ badNamesStr) + -- NB: We can't use ppr here, because this is sometimes evaluated in a + -- context where there are no DynFlags available, leading to a cryptic + -- "<<details unavailable>>" error. (This seems to happen only in the + -- stage 2 compiler, for reasons I [Richard] have no clue of.) + | otherwise + = all_names + where + all_names = + concat [ wired_tycon_kk_names funTyCon + , concatMap wired_tycon_kk_names primTyCons + + , concatMap wired_tycon_kk_names wiredInTyCons + -- Does not include tuples + + , concatMap wired_tycon_kk_names typeNatTyCons + + , map idName wiredInIds + , map (idName . primOpId) allThePrimOps + , map (idName . primOpWrapperId) allThePrimOps + , basicKnownKeyNames + , templateHaskellNames + ] + -- All of the names associated with a wired-in TyCon. + -- This includes the TyCon itself, its DataCons and promoted TyCons. + wired_tycon_kk_names :: TyCon -> [Name] + wired_tycon_kk_names tc = + tyConName tc : (rep_names tc ++ implicits) + where implicits = concatMap thing_kk_names (implicitTyConThings tc) + + wired_datacon_kk_names :: DataCon -> [Name] + wired_datacon_kk_names dc = + dataConName dc : rep_names (promoteDataCon dc) + + thing_kk_names :: TyThing -> [Name] + thing_kk_names (ATyCon tc) = wired_tycon_kk_names tc + thing_kk_names (AConLike (RealDataCon dc)) = wired_datacon_kk_names dc + thing_kk_names thing = [getName thing] + + -- The TyConRepName for a known-key TyCon has a known key, + -- but isn't itself an implicit thing. Yurgh. + -- NB: if any of the wired-in TyCons had record fields, the record + -- field names would be in a similar situation. Ditto class ops. + -- But it happens that there aren't any + rep_names tc = case tyConRepName_maybe tc of + Just n -> [n] + Nothing -> [] + +-- | Check the known-key names list of consistency. +knownKeyNamesOkay :: [Name] -> Maybe String +knownKeyNamesOkay all_names + | ns@(_:_) <- filter (not . isValidKnownKeyUnique . getUnique) all_names + = Just $ " Out-of-range known-key uniques: [" + ++ intercalate ", " (map (occNameString . nameOccName) ns) ++ + "]" + | null badNamesPairs + = Nothing + | otherwise + = Just badNamesStr + where + namesEnv = foldl' (\m n -> extendNameEnv_Acc (:) singleton m n n) + emptyUFM all_names + badNamesEnv = filterNameEnv (\ns -> ns `lengthExceeds` 1) namesEnv + badNamesPairs = nonDetUFMToList badNamesEnv + -- It's OK to use nonDetUFMToList here because the ordering only affects + -- the message when we get a panic + badNamesStrs = map pairToStr badNamesPairs + badNamesStr = unlines badNamesStrs + + pairToStr (uniq, ns) = " " ++ + show uniq ++ + ": [" ++ + intercalate ", " (map (occNameString . nameOccName) ns) ++ + "]" + +-- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a +-- known-key thing. +lookupKnownKeyName :: Unique -> Maybe Name +lookupKnownKeyName u = + knownUniqueName u <|> lookupUFM knownKeysMap u + +-- | Is a 'Name' known-key? +isKnownKeyName :: Name -> Bool +isKnownKeyName n = + isJust (knownUniqueName $ nameUnique n) || elemUFM n knownKeysMap + +knownKeysMap :: UniqFM Name +knownKeysMap = listToUFM [ (nameUnique n, n) | n <- knownKeyNames ] + +-- | Given a 'Unique' lookup any associated arbitrary SDoc's to be displayed by +-- GHCi's ':info' command. +lookupKnownNameInfo :: Name -> SDoc +lookupKnownNameInfo name = case lookupNameEnv knownNamesInfo name of + -- If we do find a doc, we add comment delimiters to make the output + -- of ':info' valid Haskell. + Nothing -> empty + Just doc -> vcat [text "{-", doc, text "-}"] + +-- A map from Uniques to SDocs, used in GHCi's ':info' command. (#12390) +knownNamesInfo :: NameEnv SDoc +knownNamesInfo = unitNameEnv coercibleTyConName $ + vcat [ text "Coercible is a special constraint with custom solving rules." + , text "It is not a class." + , text "Please see section `The Coercible constraint`" + , text "of the user's guide for details." ] + +{- +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 +* * +************************************************************************ +-} + +primOpIds :: Array Int Id +-- A cache of the PrimOp Ids, indexed by PrimOp tag +primOpIds = array (1,maxPrimOpTag) [ (primOpTag op, mkPrimOpId op) + | op <- allThePrimOps ] + +primOpId :: PrimOp -> Id +primOpId op = primOpIds ! primOpTag op + +{- +************************************************************************ +* * + Export lists for pseudo-modules (GHC.Prim) +* * +************************************************************************ + +GHC.Prim "exports" all the primops and primitive types, some +wired-in Ids. +-} + +ghcPrimExports :: [IfaceExport] +ghcPrimExports + = map (avail . idName) ghcPrimIds ++ + map (avail . idName . primOpId) allThePrimOps ++ + [ AvailTC n [n] [] + | tc <- funTyCon : exposedPrimTyCons, let n = tyConName tc ] + +{- +************************************************************************ +* * + Built-in keys +* * +************************************************************************ + +ToDo: make it do the ``like'' part properly (as in 0.26 and before). +-} + +maybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool +maybeCharLikeCon con = con `hasKey` charDataConKey +maybeIntLikeCon con = con `hasKey` intDataConKey + +{- +************************************************************************ +* * + Class predicates +* * +************************************************************************ +-} + +isNumericClass, isStandardClass :: Class -> Bool + +isNumericClass clas = classKey clas `is_elem` numericClassKeys +isStandardClass clas = classKey clas `is_elem` standardClassKeys + +is_elem :: Eq a => a -> [a] -> Bool +is_elem = isIn "is_X_Class" diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp new file mode 100644 index 0000000000..a29fbf48d7 --- /dev/null +++ b/compiler/GHC/Builtin/primops.txt.pp @@ -0,0 +1,3841 @@ +----------------------------------------------------------------------- +-- +-- (c) 2010 The University of Glasgow +-- +-- Primitive Operations and Types +-- +-- For more information on PrimOps, see +-- https://gitlab.haskell.org/ghc/ghc/wikis/commentary/prim-ops +-- +----------------------------------------------------------------------- + +-- 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. +-- +-- Information on how PrimOps are implemented and the steps necessary to +-- add a new one can be found in the Commentary: +-- +-- https://gitlab.haskell.org/ghc/ghc/wikis/commentary/prim-ops +-- +-- Note in particular that Haskell block-style comments are not recognized +-- here, so stick to '--' (even for Notes spanning multiple lines). + +-- 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" category type {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 info. +-- +-- type refers to the general category of the primop. Valid settings include, +-- +-- * Compare: A comparison operation of the shape a -> a -> Int# +-- * Monadic: A unary operation of shape a -> a +-- * Dyadic: A binary operation of shape a -> a -> a +-- * GenPrimOp: Any other sort of primop +-- + +-- The vector attribute is rather special. It takes a list of 3-tuples, each of +-- which is of the form <ELEM_TYPE,SCALAR_TYPE,LENGTH>. ELEM_TYPE is the type of +-- the elements in the vector; LENGTH is the length of the vector; and +-- SCALAR_TYPE is the scalar type used to inject to/project from vector +-- element. Note that ELEM_TYPE and SCALAR_TYPE are not the same; for example, +-- to broadcast a scalar value to a vector whose elements are of type Int8, we +-- use an Int#. + +-- When a primtype or primop has a vector attribute, it is instantiated at each +-- 3-tuple in the list of 3-tuples. That is, the vector attribute allows us to +-- define a family of types or primops. Vector support also adds three new +-- keywords: VECTOR, SCALAR, and VECTUPLE. These keywords are expanded to types +-- derived from the 3-tuple. For the 3-tuple <Int64,INT64,2>, VECTOR expands to +-- Int64X2#, SCALAR expands to INT64, and VECTUPLE expands to (# INT64, INT64 +-- #). + +defaults + has_side_effects = False + out_of_line = False -- See Note [When do out-of-line primops go in primops.txt.pp] + can_fail = False -- See Note [PrimOp can_fail and has_side_effects] in PrimOp + commutable = False + code_size = { primOpCodeSizeDefault } + strictness = { \ arity -> mkClosedStrictSig (replicate arity topDmd) topDiv } + fixity = Nothing + llvm_only = False + vector = [] + deprecated_msg = {} -- A non-empty message indicates deprecation + + +-- Note [When do out-of-line primops go in primops.txt.pp] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Out of line primops are those with a C-- implementation. But that +-- doesn't mean they *just* have an C-- implementation. As mentioned in +-- Note [Inlining out-of-line primops and heap checks], some out-of-line +-- primops also have additional internal implementations under certain +-- conditions. Now that `foreign import prim` exists, only those primops +-- which have both internal and external implementations ought to be +-- this file. The rest aren't really primops, since they don't need +-- bespoke compiler support but just a general way to interface with +-- C--. They are just foreign calls. +-- +-- Unfortunately, for the time being most of the primops which should be +-- moved according to the previous paragraph can't yet. There are some +-- superficial restrictions in `foreign import prim` which mus be fixed +-- first. Specifically, `foreign import prim` always requires: +-- +-- - No polymorphism in type +-- - `strictness = <default>` +-- - `can_fail = False` +-- - `has_side_effects = True` +-- +-- https://gitlab.haskell.org/ghc/ghc/issues/16929 tracks this issue, +-- and has a table of which external-only primops are blocked by which +-- of these. Hopefully those restrictions are relaxed so the rest of +-- those can be moved over. +-- +-- 'module GHC.Prim.Ext is a temporarily "holding ground" for primops +-- that were formally in here, until they can be given a better home. +-- Likewise, their underlying C-- implementation need not live in the +-- RTS either. Best case (in my view), both the C-- and `foreign import +-- prim` can be moved to a small library tailured to the features being +-- implemented and dependencies of those features. + +-- Currently, documentation is produced using latex, so contents of +-- description fields should be legal latex. Descriptions can contain +-- matched pairs of embedded curly brackets. + +#include "MachDeps.h" + +section "The word size story." + {Haskell98 specifies that signed integers (type {\tt Int}) + must contain at least 30 bits. GHC always implements {\tt + Int} using the primitive type {\tt Int\#}, whose size equals + the {\tt MachDeps.h} constant {\tt WORD\_SIZE\_IN\_BITS}. + This is normally set based on the {\tt config.h} parameter + {\tt SIZEOF\_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 than 64, e.g., 62 bits, to allow the + possibility of using tag bits. Currently GHC itself has only + 32-bit and 64-bit variants, but 61, 62, or 63-bit code can be + exported as an external core file for use in other back ends. + 30 and 31-bit code is no longer supported. + + 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 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 ByteArray\# -> Int\# + -> Int\#}; otherwise it has type {\tt ByteArray\# -> 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. + +#define INT32 Int# +#define WORD32 Word# + +#if WORD_SIZE_IN_BITS < 64 +#define INT64 Int64# +#define WORD64 Word64# +#else +#define INT64 Int# +#define WORD64 Word# +#endif + +-- This type won't be exported directly (since there is no concrete +-- syntax for this sort of export) so we'll have to manually patch +-- export lists in both GHC and Haddock. +primtype (->) a b + {The builtin function type, written in infix form as {\tt a -> b} and + in prefix form as {\tt (->) a b}. Values of this type are functions + taking inputs of type {\tt a} and producing outputs of type {\tt b}. + + Note that {\tt a -> b} permits levity-polymorphism in both {\tt a} and + {\tt b}, so that types like {\tt Int\# -> Int\#} can still be well-kinded. + } + with fixity = infixr -1 + -- This fixity is only the one picked up by Haddock. If you + -- change this, do update 'ghcPrimIface' in 'GHC.Iface.Load'. + +------------------------------------------------------------------------ +section "Char#" + {Operations on 31-bit characters.} +------------------------------------------------------------------------ + +primtype Char# + +primop CharGtOp "gtChar#" Compare Char# -> Char# -> Int# +primop CharGeOp "geChar#" Compare Char# -> Char# -> Int# + +primop CharEqOp "eqChar#" Compare + Char# -> Char# -> Int# + with commutable = True + +primop CharNeOp "neChar#" Compare + Char# -> Char# -> Int# + with commutable = True + +primop CharLtOp "ltChar#" Compare Char# -> Char# -> Int# +primop CharLeOp "leChar#" Compare Char# -> Char# -> Int# + +primop OrdOp "ord#" GenPrimOp Char# -> Int# + with code_size = 0 + +------------------------------------------------------------------------ +section "Int8#" + {Operations on 8-bit integers.} +------------------------------------------------------------------------ + +primtype Int8# + +primop Int8Extend "extendInt8#" GenPrimOp Int8# -> Int# +primop Int8Narrow "narrowInt8#" GenPrimOp Int# -> Int8# + +primop Int8NegOp "negateInt8#" Monadic Int8# -> Int8# + +primop Int8AddOp "plusInt8#" Dyadic Int8# -> Int8# -> Int8# + with + commutable = True + +primop Int8SubOp "subInt8#" Dyadic Int8# -> Int8# -> Int8# + +primop Int8MulOp "timesInt8#" Dyadic Int8# -> Int8# -> Int8# + with + commutable = True + +primop Int8QuotOp "quotInt8#" Dyadic Int8# -> Int8# -> Int8# + with + can_fail = True + +primop Int8RemOp "remInt8#" Dyadic Int8# -> Int8# -> Int8# + with + can_fail = True + +primop Int8QuotRemOp "quotRemInt8#" GenPrimOp Int8# -> Int8# -> (# Int8#, Int8# #) + with + can_fail = True + +primop Int8EqOp "eqInt8#" Compare Int8# -> Int8# -> Int# +primop Int8GeOp "geInt8#" Compare Int8# -> Int8# -> Int# +primop Int8GtOp "gtInt8#" Compare Int8# -> Int8# -> Int# +primop Int8LeOp "leInt8#" Compare Int8# -> Int8# -> Int# +primop Int8LtOp "ltInt8#" Compare Int8# -> Int8# -> Int# +primop Int8NeOp "neInt8#" Compare Int8# -> Int8# -> Int# + +------------------------------------------------------------------------ +section "Word8#" + {Operations on 8-bit unsigned integers.} +------------------------------------------------------------------------ + +primtype Word8# + +primop Word8Extend "extendWord8#" GenPrimOp Word8# -> Word# +primop Word8Narrow "narrowWord8#" GenPrimOp Word# -> Word8# + +primop Word8NotOp "notWord8#" Monadic Word8# -> Word8# + +primop Word8AddOp "plusWord8#" Dyadic Word8# -> Word8# -> Word8# + with + commutable = True + +primop Word8SubOp "subWord8#" Dyadic Word8# -> Word8# -> Word8# + +primop Word8MulOp "timesWord8#" Dyadic Word8# -> Word8# -> Word8# + with + commutable = True + +primop Word8QuotOp "quotWord8#" Dyadic Word8# -> Word8# -> Word8# + with + can_fail = True + +primop Word8RemOp "remWord8#" Dyadic Word8# -> Word8# -> Word8# + with + can_fail = True + +primop Word8QuotRemOp "quotRemWord8#" GenPrimOp Word8# -> Word8# -> (# Word8#, Word8# #) + with + can_fail = True + +primop Word8EqOp "eqWord8#" Compare Word8# -> Word8# -> Int# +primop Word8GeOp "geWord8#" Compare Word8# -> Word8# -> Int# +primop Word8GtOp "gtWord8#" Compare Word8# -> Word8# -> Int# +primop Word8LeOp "leWord8#" Compare Word8# -> Word8# -> Int# +primop Word8LtOp "ltWord8#" Compare Word8# -> Word8# -> Int# +primop Word8NeOp "neWord8#" Compare Word8# -> Word8# -> Int# + +------------------------------------------------------------------------ +section "Int16#" + {Operations on 16-bit integers.} +------------------------------------------------------------------------ + +primtype Int16# + +primop Int16Extend "extendInt16#" GenPrimOp Int16# -> Int# +primop Int16Narrow "narrowInt16#" GenPrimOp Int# -> Int16# + +primop Int16NegOp "negateInt16#" Monadic Int16# -> Int16# + +primop Int16AddOp "plusInt16#" Dyadic Int16# -> Int16# -> Int16# + with + commutable = True + +primop Int16SubOp "subInt16#" Dyadic Int16# -> Int16# -> Int16# + +primop Int16MulOp "timesInt16#" Dyadic Int16# -> Int16# -> Int16# + with + commutable = True + +primop Int16QuotOp "quotInt16#" Dyadic Int16# -> Int16# -> Int16# + with + can_fail = True + +primop Int16RemOp "remInt16#" Dyadic Int16# -> Int16# -> Int16# + with + can_fail = True + +primop Int16QuotRemOp "quotRemInt16#" GenPrimOp Int16# -> Int16# -> (# Int16#, Int16# #) + with + can_fail = True + +primop Int16EqOp "eqInt16#" Compare Int16# -> Int16# -> Int# +primop Int16GeOp "geInt16#" Compare Int16# -> Int16# -> Int# +primop Int16GtOp "gtInt16#" Compare Int16# -> Int16# -> Int# +primop Int16LeOp "leInt16#" Compare Int16# -> Int16# -> Int# +primop Int16LtOp "ltInt16#" Compare Int16# -> Int16# -> Int# +primop Int16NeOp "neInt16#" Compare Int16# -> Int16# -> Int# + +------------------------------------------------------------------------ +section "Word16#" + {Operations on 16-bit unsigned integers.} +------------------------------------------------------------------------ + +primtype Word16# + +primop Word16Extend "extendWord16#" GenPrimOp Word16# -> Word# +primop Word16Narrow "narrowWord16#" GenPrimOp Word# -> Word16# + +primop Word16NotOp "notWord16#" Monadic Word16# -> Word16# + +primop Word16AddOp "plusWord16#" Dyadic Word16# -> Word16# -> Word16# + with + commutable = True + +primop Word16SubOp "subWord16#" Dyadic Word16# -> Word16# -> Word16# + +primop Word16MulOp "timesWord16#" Dyadic Word16# -> Word16# -> Word16# + with + commutable = True + +primop Word16QuotOp "quotWord16#" Dyadic Word16# -> Word16# -> Word16# + with + can_fail = True + +primop Word16RemOp "remWord16#" Dyadic Word16# -> Word16# -> Word16# + with + can_fail = True + +primop Word16QuotRemOp "quotRemWord16#" GenPrimOp Word16# -> Word16# -> (# Word16#, Word16# #) + with + can_fail = True + +primop Word16EqOp "eqWord16#" Compare Word16# -> Word16# -> Int# +primop Word16GeOp "geWord16#" Compare Word16# -> Word16# -> Int# +primop Word16GtOp "gtWord16#" Compare Word16# -> Word16# -> Int# +primop Word16LeOp "leWord16#" Compare Word16# -> Word16# -> Int# +primop Word16LtOp "ltWord16#" Compare Word16# -> Word16# -> Int# +primop Word16NeOp "neWord16#" Compare Word16# -> Word16# -> Int# + +#if WORD_SIZE_IN_BITS < 64 +------------------------------------------------------------------------ +section "Int64#" + {Operations on 64-bit unsigned words. This type is only used + if plain {\tt Int\#} has less than 64 bits. In any case, the operations + are not primops; they are implemented (if needed) as ccalls instead.} +------------------------------------------------------------------------ + +primtype Int64# + +------------------------------------------------------------------------ +section "Word64#" + {Operations on 64-bit unsigned words. This type is only used + if plain {\tt Word\#} has less than 64 bits. In any case, the operations + are not primops; they are implemented (if needed) as ccalls instead.} +------------------------------------------------------------------------ + +primtype Word64# + +#endif + +------------------------------------------------------------------------ +section "Int#" + {Operations on native-size integers (32+ bits).} +------------------------------------------------------------------------ + +primtype Int# + +primop IntAddOp "+#" Dyadic + Int# -> Int# -> Int# + with commutable = True + fixity = infixl 6 + +primop IntSubOp "-#" Dyadic Int# -> Int# -> Int# + with fixity = infixl 6 + +primop IntMulOp "*#" + Dyadic Int# -> Int# -> Int# + {Low word of signed integer multiply.} + with commutable = True + fixity = infixl 7 + +primop IntMul2Op "timesInt2#" GenPrimOp + Int# -> Int# -> (# Int#, Int#, Int# #) + {Return a triple (isHighNeeded,high,low) where high and low are respectively + the high and low bits of the double-word result. isHighNeeded is a cheap way + to test if the high word is a sign-extension of the low word (isHighNeeded = + 0#) or not (isHighNeeded = 1#).} + +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 recommended 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 + \texttt{(*) :: Integer -> Integer -> Integer} will be poor. + } + with commutable = True + +primop IntQuotOp "quotInt#" Dyadic + Int# -> Int# -> Int# + {Rounds towards zero. The behavior is undefined if the second argument is + zero. + } + with can_fail = True + +primop IntRemOp "remInt#" Dyadic + Int# -> Int# -> Int# + {Satisfies \texttt{(quotInt\# x y) *\# y +\# (remInt\# x y) == x}. The + behavior is undefined if the second argument is zero. + } + with can_fail = True + +primop IntQuotRemOp "quotRemInt#" GenPrimOp + Int# -> Int# -> (# Int#, Int# #) + {Rounds towards zero.} + with can_fail = True + +primop AndIOp "andI#" Dyadic Int# -> Int# -> Int# + {Bitwise "and".} + with commutable = True + +primop OrIOp "orI#" Dyadic Int# -> Int# -> Int# + {Bitwise "or".} + with commutable = True + +primop XorIOp "xorI#" Dyadic Int# -> Int# -> Int# + {Bitwise "xor".} + with commutable = True + +primop NotIOp "notI#" Monadic Int# -> Int# + {Bitwise "not", also known as the binary complement.} + +primop IntNegOp "negateInt#" Monadic Int# -> Int# + {Unary negation. + Since the negative {\tt Int#} range extends one further than the + positive range, {\tt negateInt#} of the most negative number is an + identity operation. This way, {\tt negateInt#} is always its own inverse.} + +primop IntAddCOp "addIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #) + {Add signed integers reporting overflow. + First member of result is the sum truncated to an {\tt Int#}; + second member is zero if the true sum fits in an {\tt Int#}, + nonzero if overflow occurred (the sum is either too large + or too small to fit in an {\tt Int#}).} + with code_size = 2 + commutable = True + +primop IntSubCOp "subIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #) + {Subtract signed integers reporting overflow. + First member of result is the difference truncated to an {\tt Int#}; + second member is zero if the true difference fits in an {\tt Int#}, + nonzero if overflow occurred (the difference is either too large + or too small to fit in an {\tt Int#}).} + with code_size = 2 + +primop IntGtOp ">#" Compare Int# -> Int# -> Int# + with fixity = infix 4 + +primop IntGeOp ">=#" Compare Int# -> Int# -> Int# + with fixity = infix 4 + +primop IntEqOp "==#" Compare + Int# -> Int# -> Int# + with commutable = True + fixity = infix 4 + +primop IntNeOp "/=#" Compare + Int# -> Int# -> Int# + with commutable = True + fixity = infix 4 + +primop IntLtOp "<#" Compare Int# -> Int# -> Int# + with fixity = infix 4 + +primop IntLeOp "<=#" Compare Int# -> Int# -> Int# + with fixity = infix 4 + +primop ChrOp "chr#" GenPrimOp Int# -> Char# + with code_size = 0 + +primop Int2WordOp "int2Word#" GenPrimOp Int# -> Word# + with code_size = 0 + +primop Int2FloatOp "int2Float#" GenPrimOp Int# -> Float# +primop Int2DoubleOp "int2Double#" GenPrimOp Int# -> Double# + +primop Word2FloatOp "word2Float#" GenPrimOp Word# -> Float# +primop Word2DoubleOp "word2Double#" GenPrimOp Word# -> Double# + +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 (32+ bits).} +------------------------------------------------------------------------ + +primtype Word# + +primop WordAddOp "plusWord#" Dyadic Word# -> Word# -> Word# + with commutable = True + +primop WordAddCOp "addWordC#" GenPrimOp Word# -> Word# -> (# Word#, Int# #) + {Add unsigned integers reporting overflow. + The first element of the pair is the result. The second element is + the carry flag, which is nonzero on overflow. See also {\tt plusWord2#}.} + with code_size = 2 + commutable = True + +primop WordSubCOp "subWordC#" GenPrimOp Word# -> Word# -> (# Word#, Int# #) + {Subtract unsigned integers reporting overflow. + The first element of the pair is the result. The second element is + the carry flag, which is nonzero on overflow.} + with code_size = 2 + +primop WordAdd2Op "plusWord2#" GenPrimOp Word# -> Word# -> (# Word#, Word# #) + {Add unsigned integers, with the high part (carry) in the first + component of the returned pair and the low part in the second + component of the pair. See also {\tt addWordC#}.} + with code_size = 2 + commutable = True + +primop WordSubOp "minusWord#" Dyadic Word# -> Word# -> Word# + +primop WordMulOp "timesWord#" Dyadic Word# -> Word# -> Word# + with commutable = True + +-- Returns (# high, low #) +primop WordMul2Op "timesWord2#" GenPrimOp + Word# -> 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 WordQuotRemOp "quotRemWord#" GenPrimOp + Word# -> Word# -> (# Word#, Word# #) + with can_fail = True + +primop WordQuotRem2Op "quotRemWord2#" GenPrimOp + Word# -> Word# -> Word# -> (# Word#, Word# #) + { Takes high word of dividend, then low word of dividend, then divisor. + Requires that high word < divisor.} + 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# + with code_size = 0 + +primop WordGtOp "gtWord#" Compare Word# -> Word# -> Int# +primop WordGeOp "geWord#" Compare Word# -> Word# -> Int# +primop WordEqOp "eqWord#" Compare Word# -> Word# -> Int# +primop WordNeOp "neWord#" Compare Word# -> Word# -> Int# +primop WordLtOp "ltWord#" Compare Word# -> Word# -> Int# +primop WordLeOp "leWord#" Compare Word# -> Word# -> Int# + +primop PopCnt8Op "popCnt8#" Monadic Word# -> Word# + {Count the number of set bits in the lower 8 bits of a word.} +primop PopCnt16Op "popCnt16#" Monadic Word# -> Word# + {Count the number of set bits in the lower 16 bits of a word.} +primop PopCnt32Op "popCnt32#" Monadic Word# -> Word# + {Count the number of set bits in the lower 32 bits of a word.} +primop PopCnt64Op "popCnt64#" GenPrimOp WORD64 -> Word# + {Count the number of set bits in a 64-bit word.} +primop PopCntOp "popCnt#" Monadic Word# -> Word# + {Count the number of set bits in a word.} + +primop Pdep8Op "pdep8#" Dyadic Word# -> Word# -> Word# + {Deposit bits to lower 8 bits of a word at locations specified by a mask.} +primop Pdep16Op "pdep16#" Dyadic Word# -> Word# -> Word# + {Deposit bits to lower 16 bits of a word at locations specified by a mask.} +primop Pdep32Op "pdep32#" Dyadic Word# -> Word# -> Word# + {Deposit bits to lower 32 bits of a word at locations specified by a mask.} +primop Pdep64Op "pdep64#" GenPrimOp WORD64 -> WORD64 -> WORD64 + {Deposit bits to a word at locations specified by a mask.} +primop PdepOp "pdep#" Dyadic Word# -> Word# -> Word# + {Deposit bits to a word at locations specified by a mask.} + +primop Pext8Op "pext8#" Dyadic Word# -> Word# -> Word# + {Extract bits from lower 8 bits of a word at locations specified by a mask.} +primop Pext16Op "pext16#" Dyadic Word# -> Word# -> Word# + {Extract bits from lower 16 bits of a word at locations specified by a mask.} +primop Pext32Op "pext32#" Dyadic Word# -> Word# -> Word# + {Extract bits from lower 32 bits of a word at locations specified by a mask.} +primop Pext64Op "pext64#" GenPrimOp WORD64 -> WORD64 -> WORD64 + {Extract bits from a word at locations specified by a mask.} +primop PextOp "pext#" Dyadic Word# -> Word# -> Word# + {Extract bits from a word at locations specified by a mask.} + +primop Clz8Op "clz8#" Monadic Word# -> Word# + {Count leading zeros in the lower 8 bits of a word.} +primop Clz16Op "clz16#" Monadic Word# -> Word# + {Count leading zeros in the lower 16 bits of a word.} +primop Clz32Op "clz32#" Monadic Word# -> Word# + {Count leading zeros in the lower 32 bits of a word.} +primop Clz64Op "clz64#" GenPrimOp WORD64 -> Word# + {Count leading zeros in a 64-bit word.} +primop ClzOp "clz#" Monadic Word# -> Word# + {Count leading zeros in a word.} + +primop Ctz8Op "ctz8#" Monadic Word# -> Word# + {Count trailing zeros in the lower 8 bits of a word.} +primop Ctz16Op "ctz16#" Monadic Word# -> Word# + {Count trailing zeros in the lower 16 bits of a word.} +primop Ctz32Op "ctz32#" Monadic Word# -> Word# + {Count trailing zeros in the lower 32 bits of a word.} +primop Ctz64Op "ctz64#" GenPrimOp WORD64 -> Word# + {Count trailing zeros in a 64-bit word.} +primop CtzOp "ctz#" Monadic Word# -> Word# + {Count trailing zeros in a word.} + +primop BSwap16Op "byteSwap16#" Monadic Word# -> Word# + {Swap bytes in the lower 16 bits of a word. The higher bytes are undefined. } +primop BSwap32Op "byteSwap32#" Monadic Word# -> Word# + {Swap bytes in the lower 32 bits of a word. The higher bytes are undefined. } +primop BSwap64Op "byteSwap64#" Monadic WORD64 -> WORD64 + {Swap bytes in a 64 bits of a word.} +primop BSwapOp "byteSwap#" Monadic Word# -> Word# + {Swap bytes in a word.} + +primop BRev8Op "bitReverse8#" Monadic Word# -> Word# + {Reverse the order of the bits in a 8-bit word.} +primop BRev16Op "bitReverse16#" Monadic Word# -> Word# + {Reverse the order of the bits in a 16-bit word.} +primop BRev32Op "bitReverse32#" Monadic Word# -> Word# + {Reverse the order of the bits in a 32-bit word.} +primop BRev64Op "bitReverse64#" Monadic WORD64 -> WORD64 + {Reverse the order of the bits in a 64-bit word.} +primop BRevOp "bitReverse#" Monadic Word# -> Word# + {Reverse the order of the bits in a word.} + +------------------------------------------------------------------------ +section "Narrowings" + {Explicit narrowing of native-sized ints or words.} +------------------------------------------------------------------------ + +primop Narrow8IntOp "narrow8Int#" Monadic Int# -> Int# +primop Narrow16IntOp "narrow16Int#" Monadic Int# -> Int# +primop Narrow32IntOp "narrow32Int#" Monadic Int# -> Int# +primop Narrow8WordOp "narrow8Word#" Monadic Word# -> Word# +primop Narrow16WordOp "narrow16Word#" Monadic Word# -> Word# +primop Narrow32WordOp "narrow32Word#" Monadic Word# -> Word# + +------------------------------------------------------------------------ +section "Double#" + {Operations on double-precision (64 bit) floating-point numbers.} +------------------------------------------------------------------------ + +primtype Double# + +primop DoubleGtOp ">##" Compare Double# -> Double# -> Int# + with fixity = infix 4 + +primop DoubleGeOp ">=##" Compare Double# -> Double# -> Int# + with fixity = infix 4 + +primop DoubleEqOp "==##" Compare + Double# -> Double# -> Int# + with commutable = True + fixity = infix 4 + +primop DoubleNeOp "/=##" Compare + Double# -> Double# -> Int# + with commutable = True + fixity = infix 4 + +primop DoubleLtOp "<##" Compare Double# -> Double# -> Int# + with fixity = infix 4 + +primop DoubleLeOp "<=##" Compare Double# -> Double# -> Int# + with fixity = infix 4 + +primop DoubleAddOp "+##" Dyadic + Double# -> Double# -> Double# + with commutable = True + fixity = infixl 6 + +primop DoubleSubOp "-##" Dyadic Double# -> Double# -> Double# + with fixity = infixl 6 + +primop DoubleMulOp "*##" Dyadic + Double# -> Double# -> Double# + with commutable = True + fixity = infixl 7 + +primop DoubleDivOp "/##" Dyadic + Double# -> Double# -> Double# + with can_fail = True + fixity = infixl 7 + +primop DoubleNegOp "negateDouble#" Monadic Double# -> Double# + +primop DoubleFabsOp "fabsDouble#" Monadic Double# -> Double# + +primop Double2IntOp "double2Int#" GenPrimOp Double# -> Int# + {Truncates a {\tt Double#} value to the nearest {\tt Int#}. + Results are undefined if the truncation if truncation yields + a value outside the range of {\tt Int#}.} + +primop Double2FloatOp "double2Float#" GenPrimOp Double# -> Float# + +primop DoubleExpOp "expDouble#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + +primop DoubleExpM1Op "expm1Double#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + +primop DoubleLogOp "logDouble#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + can_fail = True + +primop DoubleLog1POp "log1pDouble#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + can_fail = True + +primop DoubleSqrtOp "sqrtDouble#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + +primop DoubleSinOp "sinDouble#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + +primop DoubleCosOp "cosDouble#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + +primop DoubleTanOp "tanDouble#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + +primop DoubleAsinOp "asinDouble#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + can_fail = True + +primop DoubleAcosOp "acosDouble#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + can_fail = True + +primop DoubleAtanOp "atanDouble#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + +primop DoubleSinhOp "sinhDouble#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + +primop DoubleCoshOp "coshDouble#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + +primop DoubleTanhOp "tanhDouble#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + +primop DoubleAsinhOp "asinhDouble#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + +primop DoubleAcoshOp "acoshDouble#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + +primop DoubleAtanhOp "atanhDouble#" Monadic + Double# -> Double# + with + code_size = { primOpCodeSizeForeignCall } + +primop DoublePowerOp "**##" Dyadic + Double# -> Double# -> Double# + {Exponentiation.} + with + code_size = { primOpCodeSizeForeignCall } + +primop DoubleDecode_2IntOp "decodeDouble_2Int#" GenPrimOp + Double# -> (# Int#, Word#, Word#, Int# #) + {Convert to integer. + First component of the result is -1 or 1, indicating the sign of the + mantissa. The next two are the high and low 32 bits of the mantissa + respectively, and the last is the exponent.} + with out_of_line = True + +primop DoubleDecode_Int64Op "decodeDouble_Int64#" GenPrimOp + Double# -> (# INT64, Int# #) + {Decode {\tt Double\#} into mantissa and base-2 exponent.} + with out_of_line = True + +------------------------------------------------------------------------ +section "Float#" + {Operations on single-precision (32-bit) floating-point numbers.} +------------------------------------------------------------------------ + +primtype Float# + +primop FloatGtOp "gtFloat#" Compare Float# -> Float# -> Int# +primop FloatGeOp "geFloat#" Compare Float# -> Float# -> Int# + +primop FloatEqOp "eqFloat#" Compare + Float# -> Float# -> Int# + with commutable = True + +primop FloatNeOp "neFloat#" Compare + Float# -> Float# -> Int# + with commutable = True + +primop FloatLtOp "ltFloat#" Compare Float# -> Float# -> Int# +primop FloatLeOp "leFloat#" Compare Float# -> Float# -> Int# + +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 FloatFabsOp "fabsFloat#" Monadic Float# -> Float# + +primop Float2IntOp "float2Int#" GenPrimOp Float# -> Int# + {Truncates a {\tt Float#} value to the nearest {\tt Int#}. + Results are undefined if the truncation if truncation yields + a value outside the range of {\tt Int#}.} + +primop FloatExpOp "expFloat#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + +primop FloatExpM1Op "expm1Float#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + +primop FloatLogOp "logFloat#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + can_fail = True + +primop FloatLog1POp "log1pFloat#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + can_fail = True + +primop FloatSqrtOp "sqrtFloat#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + +primop FloatSinOp "sinFloat#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + +primop FloatCosOp "cosFloat#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + +primop FloatTanOp "tanFloat#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + +primop FloatAsinOp "asinFloat#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + can_fail = True + +primop FloatAcosOp "acosFloat#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + can_fail = True + +primop FloatAtanOp "atanFloat#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + +primop FloatSinhOp "sinhFloat#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + +primop FloatCoshOp "coshFloat#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + +primop FloatTanhOp "tanhFloat#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + +primop FloatAsinhOp "asinhFloat#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + +primop FloatAcoshOp "acoshFloat#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + +primop FloatAtanhOp "atanhFloat#" Monadic + Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + +primop FloatPowerOp "powerFloat#" Dyadic + Float# -> Float# -> Float# + with + code_size = { primOpCodeSizeForeignCall } + +primop Float2DoubleOp "float2Double#" GenPrimOp Float# -> Double# + +primop FloatDecode_IntOp "decodeFloat_Int#" GenPrimOp + Float# -> (# Int#, Int# #) + {Convert to integers. + First {\tt Int\#} in result is the mantissa; second is the exponent.} + with out_of_line = True + +------------------------------------------------------------------------ +section "Arrays" + {Operations on {\tt Array\#}.} +------------------------------------------------------------------------ + +primtype Array# a + +primtype MutableArray# s a + +primop NewArrayOp "newArray#" GenPrimOp + Int# -> a -> State# s -> (# State# s, MutableArray# s a #) + {Create a new mutable array with the specified number of elements, + in the specified state thread, + with each element containing the specified initial value.} + with + out_of_line = True + has_side_effects = True + +primop SameMutableArrayOp "sameMutableArray#" GenPrimOp + MutableArray# s a -> MutableArray# s a -> Int# + +primop ReadArrayOp "readArray#" GenPrimOp + MutableArray# s a -> Int# -> State# s -> (# State# s, a #) + {Read from specified index of mutable array. Result is not yet evaluated.} + with + has_side_effects = True + can_fail = True + +primop WriteArrayOp "writeArray#" GenPrimOp + MutableArray# s a -> Int# -> a -> State# s -> State# s + {Write to specified index of mutable array.} + with + has_side_effects = True + can_fail = True + code_size = 2 -- card update too + +primop SizeofArrayOp "sizeofArray#" GenPrimOp + Array# a -> Int# + {Return the number of elements in the array.} + +primop SizeofMutableArrayOp "sizeofMutableArray#" GenPrimOp + MutableArray# s a -> Int# + {Return the number of elements in the array.} + +primop IndexArrayOp "indexArray#" GenPrimOp + Array# a -> Int# -> (# a #) + {Read from the specified index of an immutable array. The result is packaged + into an unboxed unary tuple; the result itself is not yet + evaluated. Pattern matching on the tuple forces the indexing of the + array to happen but does not evaluate the element itself. Evaluating + the thunk prevents additional thunks from building up on the + heap. Avoiding these thunks, in turn, reduces references to the + argument array, allowing it to be garbage collected more promptly.} + with + can_fail = True + +primop UnsafeFreezeArrayOp "unsafeFreezeArray#" GenPrimOp + MutableArray# s a -> State# s -> (# State# s, Array# a #) + {Make a mutable array immutable, without copying.} + with + has_side_effects = True + +primop UnsafeThawArrayOp "unsafeThawArray#" GenPrimOp + Array# a -> State# s -> (# State# s, MutableArray# s a #) + {Make an immutable array mutable, without copying.} + with + out_of_line = True + has_side_effects = True + +primop CopyArrayOp "copyArray#" GenPrimOp + Array# a -> Int# -> MutableArray# s a -> Int# -> Int# -> State# s -> State# s + {Given a source array, an offset into the source array, a + destination array, an offset into the destination array, and a + number of elements to copy, copy the elements from the source array + to the destination array. Both arrays must fully contain the + specified ranges, but this is not checked. The two arrays must not + be the same array in different states, but this is not checked + either.} + with + out_of_line = True + has_side_effects = True + can_fail = True + +primop CopyMutableArrayOp "copyMutableArray#" GenPrimOp + MutableArray# s a -> Int# -> MutableArray# s a -> Int# -> Int# -> State# s -> State# s + {Given a source array, an offset into the source array, a + destination array, an offset into the destination array, and a + number of elements to copy, copy the elements from the source array + to the destination array. Both arrays must fully contain the + specified ranges, but this is not checked. In the case where + the source and destination are the same array the source and + destination regions may overlap.} + with + out_of_line = True + has_side_effects = True + can_fail = True + +primop CloneArrayOp "cloneArray#" GenPrimOp + Array# a -> Int# -> Int# -> Array# a + {Given a source array, an offset into the source array, and a number + of elements to copy, create a new array with the elements from the + source array. The provided array must fully contain the specified + range, but this is not checked.} + with + out_of_line = True + has_side_effects = True + can_fail = True + +primop CloneMutableArrayOp "cloneMutableArray#" GenPrimOp + MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #) + {Given a source array, an offset into the source array, and a number + of elements to copy, create a new array with the elements from the + source array. The provided array must fully contain the specified + range, but this is not checked.} + with + out_of_line = True + has_side_effects = True + can_fail = True + +primop FreezeArrayOp "freezeArray#" GenPrimOp + MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, Array# a #) + {Given a source array, an offset into the source array, and a number + of elements to copy, create a new array with the elements from the + source array. The provided array must fully contain the specified + range, but this is not checked.} + with + out_of_line = True + has_side_effects = True + can_fail = True + +primop ThawArrayOp "thawArray#" GenPrimOp + Array# a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #) + {Given a source array, an offset into the source array, and a number + of elements to copy, create a new array with the elements from the + source array. The provided array must fully contain the specified + range, but this is not checked.} + with + out_of_line = True + has_side_effects = True + can_fail = True + +primop CasArrayOp "casArray#" GenPrimOp + MutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #) + {Given an array, an offset, the expected old value, and + the new value, perform an atomic compare and swap (i.e. write the new + value if the current value and the old value are the same pointer). + Returns 0 if the swap succeeds and 1 if it fails. Additionally, returns + the element at the offset after the operation completes. This means that + on a success the new value is returned, and on a failure the actual old + value (not the expected one) is returned. Implies a full memory barrier. + The use of a pointer equality on a lifted value makes this function harder + to use correctly than {\tt casIntArray\#}. All of the difficulties + of using {\tt reallyUnsafePtrEquality\#} correctly apply to + {\tt casArray\#} as well. + } + with + out_of_line = True + has_side_effects = True + + +------------------------------------------------------------------------ +section "Small Arrays" + + {Operations on {\tt SmallArray\#}. A {\tt SmallArray\#} works + just like an {\tt Array\#}, but with different space use and + performance characteristics (that are often useful with small + arrays). The {\tt SmallArray\#} and {\tt SmallMutableArray#} + lack a `card table'. The purpose of a card table is to avoid + having to scan every element of the array on each GC by + keeping track of which elements have changed since the last GC + and only scanning those that have changed. So the consequence + of there being no card table is that the representation is + somewhat smaller and the writes are somewhat faster (because + the card table does not need to be updated). The disadvantage + of course is that for a {\tt SmallMutableArray#} the whole + array has to be scanned on each GC. Thus it is best suited for + use cases where the mutable array is not long lived, e.g. + where a mutable array is initialised quickly and then frozen + to become an immutable {\tt SmallArray\#}. + } + +------------------------------------------------------------------------ + +primtype SmallArray# a + +primtype SmallMutableArray# s a + +primop NewSmallArrayOp "newSmallArray#" GenPrimOp + Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #) + {Create a new mutable array with the specified number of elements, + in the specified state thread, + with each element containing the specified initial value.} + with + out_of_line = True + has_side_effects = True + +primop SameSmallMutableArrayOp "sameSmallMutableArray#" GenPrimOp + SmallMutableArray# s a -> SmallMutableArray# s a -> Int# + +primop ShrinkSmallMutableArrayOp_Char "shrinkSmallMutableArray#" GenPrimOp + SmallMutableArray# s a -> Int# -> State# s -> State# s + {Shrink mutable array to new specified size, in + the specified state thread. The new size argument must be less than or + equal to the current size as reported by {\tt sizeofSmallMutableArray\#}.} + with out_of_line = True + has_side_effects = True + +primop ReadSmallArrayOp "readSmallArray#" GenPrimOp + SmallMutableArray# s a -> Int# -> State# s -> (# State# s, a #) + {Read from specified index of mutable array. Result is not yet evaluated.} + with + has_side_effects = True + can_fail = True + +primop WriteSmallArrayOp "writeSmallArray#" GenPrimOp + SmallMutableArray# s a -> Int# -> a -> State# s -> State# s + {Write to specified index of mutable array.} + with + has_side_effects = True + can_fail = True + +primop SizeofSmallArrayOp "sizeofSmallArray#" GenPrimOp + SmallArray# a -> Int# + {Return the number of elements in the array.} + +primop SizeofSmallMutableArrayOp "sizeofSmallMutableArray#" GenPrimOp + SmallMutableArray# s a -> Int# + {Return the number of elements in the array. Note that this is deprecated + as it is unsafe in the presence of resize operations on the + same byte array.} + with deprecated_msg = { Use 'getSizeofSmallMutableArray#' instead } + +primop GetSizeofSmallMutableArrayOp "getSizeofSmallMutableArray#" GenPrimOp + SmallMutableArray# s a -> State# s -> (# State# s, Int# #) + {Return the number of elements in the array.} + +primop IndexSmallArrayOp "indexSmallArray#" GenPrimOp + SmallArray# 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 + can_fail = True + +primop UnsafeFreezeSmallArrayOp "unsafeFreezeSmallArray#" GenPrimOp + SmallMutableArray# s a -> State# s -> (# State# s, SmallArray# a #) + {Make a mutable array immutable, without copying.} + with + has_side_effects = True + +primop UnsafeThawSmallArrayOp "unsafeThawSmallArray#" GenPrimOp + SmallArray# a -> State# s -> (# State# s, SmallMutableArray# s a #) + {Make an immutable array mutable, without copying.} + with + out_of_line = True + has_side_effects = True + +-- The code_size is only correct for the case when the copy family of +-- primops aren't inlined. It would be nice to keep track of both. + +primop CopySmallArrayOp "copySmallArray#" GenPrimOp + SmallArray# a -> Int# -> SmallMutableArray# s a -> Int# -> Int# -> State# s -> State# s + {Given a source array, an offset into the source array, a + destination array, an offset into the destination array, and a + number of elements to copy, copy the elements from the source array + to the destination array. Both arrays must fully contain the + specified ranges, but this is not checked. The two arrays must not + be the same array in different states, but this is not checked + either.} + with + out_of_line = True + has_side_effects = True + can_fail = True + +primop CopySmallMutableArrayOp "copySmallMutableArray#" GenPrimOp + SmallMutableArray# s a -> Int# -> SmallMutableArray# s a -> Int# -> Int# -> State# s -> State# s + {Given a source array, an offset into the source array, a + destination array, an offset into the destination array, and a + number of elements to copy, copy the elements from the source array + to the destination array. The source and destination arrays can + refer to the same array. Both arrays must fully contain the + specified ranges, but this is not checked. + The regions are allowed to overlap, although this is only possible when the same + array is provided as both the source and the destination. } + with + out_of_line = True + has_side_effects = True + can_fail = True + +primop CloneSmallArrayOp "cloneSmallArray#" GenPrimOp + SmallArray# a -> Int# -> Int# -> SmallArray# a + {Given a source array, an offset into the source array, and a number + of elements to copy, create a new array with the elements from the + source array. The provided array must fully contain the specified + range, but this is not checked.} + with + out_of_line = True + has_side_effects = True + can_fail = True + +primop CloneSmallMutableArrayOp "cloneSmallMutableArray#" GenPrimOp + SmallMutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s a #) + {Given a source array, an offset into the source array, and a number + of elements to copy, create a new array with the elements from the + source array. The provided array must fully contain the specified + range, but this is not checked.} + with + out_of_line = True + has_side_effects = True + can_fail = True + +primop FreezeSmallArrayOp "freezeSmallArray#" GenPrimOp + SmallMutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, SmallArray# a #) + {Given a source array, an offset into the source array, and a number + of elements to copy, create a new array with the elements from the + source array. The provided array must fully contain the specified + range, but this is not checked.} + with + out_of_line = True + has_side_effects = True + can_fail = True + +primop ThawSmallArrayOp "thawSmallArray#" GenPrimOp + SmallArray# a -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s a #) + {Given a source array, an offset into the source array, and a number + of elements to copy, create a new array with the elements from the + source array. The provided array must fully contain the specified + range, but this is not checked.} + with + out_of_line = True + has_side_effects = True + can_fail = True + +primop CasSmallArrayOp "casSmallArray#" GenPrimOp + SmallMutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #) + {Unsafe, machine-level atomic compare and swap on an element within an array. + See the documentation of {\tt casArray\#}.} + with + out_of_line = True + has_side_effects = True + +------------------------------------------------------------------------ +section "Byte Arrays" + {Operations on {\tt ByteArray\#}. A {\tt 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 of the primitive type + being read or written.} + +------------------------------------------------------------------------ + +primtype ByteArray# + +primtype MutableByteArray# s + +primop NewByteArrayOp_Char "newByteArray#" GenPrimOp + Int# -> State# s -> (# State# s, MutableByteArray# s #) + {Create a new mutable byte array of specified size (in bytes), in + the specified state thread.} + with out_of_line = True + has_side_effects = True + +primop NewPinnedByteArrayOp_Char "newPinnedByteArray#" GenPrimOp + Int# -> State# s -> (# State# s, MutableByteArray# s #) + {Create a mutable byte array that the GC guarantees not to move.} + with out_of_line = True + has_side_effects = True + +primop NewAlignedPinnedByteArrayOp_Char "newAlignedPinnedByteArray#" GenPrimOp + Int# -> Int# -> State# s -> (# State# s, MutableByteArray# s #) + {Create a mutable byte array, aligned by the specified amount, that the GC guarantees not to move.} + with out_of_line = True + has_side_effects = True + +primop MutableByteArrayIsPinnedOp "isMutableByteArrayPinned#" GenPrimOp + MutableByteArray# s -> Int# + {Determine whether a {\tt MutableByteArray\#} is guaranteed not to move + during GC.} + with out_of_line = True + +primop ByteArrayIsPinnedOp "isByteArrayPinned#" GenPrimOp + ByteArray# -> Int# + {Determine whether a {\tt ByteArray\#} is guaranteed not to move during GC.} + with out_of_line = True + +primop ByteArrayContents_Char "byteArrayContents#" GenPrimOp + ByteArray# -> Addr# + {Intended for use with pinned arrays; otherwise very unsafe!} + +primop SameMutableByteArrayOp "sameMutableByteArray#" GenPrimOp + MutableByteArray# s -> MutableByteArray# s -> Int# + +primop ShrinkMutableByteArrayOp_Char "shrinkMutableByteArray#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> State# s + {Shrink mutable byte array to new specified size (in bytes), in + the specified state thread. The new size argument must be less than or + equal to the current size as reported by {\tt sizeofMutableByteArray\#}.} + with out_of_line = True + has_side_effects = True + +primop ResizeMutableByteArrayOp_Char "resizeMutableByteArray#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #) + {Resize (unpinned) mutable byte array to new specified size (in bytes). + The returned {\tt MutableByteArray\#} is either the original + {\tt MutableByteArray\#} resized in-place or, if not possible, a newly + allocated (unpinned) {\tt MutableByteArray\#} (with the original content + copied over). + + To avoid undefined behaviour, the original {\tt MutableByteArray\#} shall + not be accessed anymore after a {\tt resizeMutableByteArray\#} has been + performed. Moreover, no reference to the old one should be kept in order + to allow garbage collection of the original {\tt MutableByteArray\#} in + case a new {\tt MutableByteArray\#} had to be allocated.} + with out_of_line = True + has_side_effects = True + +primop UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp + MutableByteArray# s -> State# s -> (# State# s, ByteArray# #) + {Make a mutable byte array immutable, without copying.} + with + has_side_effects = True + +primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp + ByteArray# -> Int# + {Return the size of the array in bytes.} + +primop SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp + MutableByteArray# s -> Int# + {Return the size of the array in bytes. Note that this is deprecated as it is + unsafe in the presence of resize operations on the same byte + array.} + with deprecated_msg = { Use 'getSizeofMutableByteArray#' instead } + +primop GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp + MutableByteArray# s -> State# s -> (# State# s, Int# #) + {Return the number of elements in the array.} + +primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp + ByteArray# -> Int# -> Char# + {Read 8-bit character; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_WideChar "indexWideCharArray#" GenPrimOp + ByteArray# -> Int# -> Char# + {Read 31-bit character; offset in 4-byte words.} + with can_fail = True + +primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp + ByteArray# -> Int# -> Int# + with can_fail = True + +primop IndexByteArrayOp_Word "indexWordArray#" GenPrimOp + ByteArray# -> Int# -> Word# + with can_fail = True + +primop IndexByteArrayOp_Addr "indexAddrArray#" GenPrimOp + ByteArray# -> Int# -> Addr# + with can_fail = True + +primop IndexByteArrayOp_Float "indexFloatArray#" GenPrimOp + ByteArray# -> Int# -> Float# + with can_fail = True + +primop IndexByteArrayOp_Double "indexDoubleArray#" GenPrimOp + ByteArray# -> Int# -> Double# + with can_fail = True + +primop IndexByteArrayOp_StablePtr "indexStablePtrArray#" GenPrimOp + ByteArray# -> Int# -> StablePtr# a + with can_fail = True + +primop IndexByteArrayOp_Int8 "indexInt8Array#" GenPrimOp + ByteArray# -> Int# -> Int# + {Read 8-bit integer; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp + ByteArray# -> Int# -> Int# + {Read 16-bit integer; offset in 16-bit words.} + with can_fail = True + +primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp + ByteArray# -> Int# -> INT32 + {Read 32-bit integer; offset in 32-bit words.} + with can_fail = True + +primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp + ByteArray# -> Int# -> INT64 + {Read 64-bit integer; offset in 64-bit words.} + with can_fail = True + +primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp + ByteArray# -> Int# -> Word# + {Read 8-bit word; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp + ByteArray# -> Int# -> Word# + {Read 16-bit word; offset in 16-bit words.} + with can_fail = True + +primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp + ByteArray# -> Int# -> WORD32 + {Read 32-bit word; offset in 32-bit words.} + with can_fail = True + +primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp + ByteArray# -> Int# -> WORD64 + {Read 64-bit word; offset in 64-bit words.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsChar "indexWord8ArrayAsChar#" GenPrimOp + ByteArray# -> Int# -> Char# + {Read 8-bit character; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsWideChar "indexWord8ArrayAsWideChar#" GenPrimOp + ByteArray# -> Int# -> Char# + {Read 31-bit character; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsAddr "indexWord8ArrayAsAddr#" GenPrimOp + ByteArray# -> Int# -> Addr# + {Read address; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsFloat "indexWord8ArrayAsFloat#" GenPrimOp + ByteArray# -> Int# -> Float# + {Read float; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsDouble "indexWord8ArrayAsDouble#" GenPrimOp + ByteArray# -> Int# -> Double# + {Read double; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsStablePtr "indexWord8ArrayAsStablePtr#" GenPrimOp + ByteArray# -> Int# -> StablePtr# a + {Read stable pointer; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsInt16 "indexWord8ArrayAsInt16#" GenPrimOp + ByteArray# -> Int# -> Int# + {Read 16-bit int; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsInt32 "indexWord8ArrayAsInt32#" GenPrimOp + ByteArray# -> Int# -> INT32 + {Read 32-bit int; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsInt64 "indexWord8ArrayAsInt64#" GenPrimOp + ByteArray# -> Int# -> INT64 + {Read 64-bit int; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsInt "indexWord8ArrayAsInt#" GenPrimOp + ByteArray# -> Int# -> Int# + {Read int; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsWord16 "indexWord8ArrayAsWord16#" GenPrimOp + ByteArray# -> Int# -> Word# + {Read 16-bit word; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsWord32 "indexWord8ArrayAsWord32#" GenPrimOp + ByteArray# -> Int# -> WORD32 + {Read 32-bit word; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsWord64 "indexWord8ArrayAsWord64#" GenPrimOp + ByteArray# -> Int# -> WORD64 + {Read 64-bit word; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsWord "indexWord8ArrayAsWord#" GenPrimOp + ByteArray# -> Int# -> Word# + {Read word; offset in bytes.} + with can_fail = True + +primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) + {Read 8-bit character; offset in bytes.} + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) + {Read 31-bit character; offset in 4-byte words.} + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Int "readIntArray#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) + {Read integer; offset in machine words.} + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word "readWordArray#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) + {Read word; offset in machine words.} + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Addr "readAddrArray#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Float "readFloatArray#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Double "readDoubleArray#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_StablePtr "readStablePtrArray#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Int8 "readInt8Array#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Int16 "readInt16Array#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, INT32 #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, INT64 #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8 "readWord8Array#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word16 "readWord16Array#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, WORD32 #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, WORD64 #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsChar "readWord8ArrayAsChar#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsWideChar "readWord8ArrayAsWideChar#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsAddr "readWord8ArrayAsAddr#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsFloat "readWord8ArrayAsFloat#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsDouble "readWord8ArrayAsDouble#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsStablePtr "readWord8ArrayAsStablePtr#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsInt16 "readWord8ArrayAsInt16#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsInt32 "readWord8ArrayAsInt32#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, INT32 #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsInt64 "readWord8ArrayAsInt64#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, INT64 #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsInt "readWord8ArrayAsInt#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsWord16 "readWord8ArrayAsWord16#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsWord32 "readWord8ArrayAsWord32#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, WORD32 #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsWord64 "readWord8ArrayAsWord64#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, WORD64 #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsWord "readWord8ArrayAsWord#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Char "writeCharArray#" GenPrimOp + MutableByteArray# s -> Int# -> Char# -> State# s -> State# s + {Write 8-bit character; offset in bytes.} + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_WideChar "writeWideCharArray#" GenPrimOp + MutableByteArray# s -> Int# -> Char# -> State# s -> State# s + {Write 31-bit character; offset in 4-byte words.} + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Int "writeIntArray#" GenPrimOp + MutableByteArray# s -> Int# -> Int# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word "writeWordArray#" GenPrimOp + MutableByteArray# s -> Int# -> Word# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Addr "writeAddrArray#" GenPrimOp + MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Float "writeFloatArray#" GenPrimOp + MutableByteArray# s -> Int# -> Float# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Double "writeDoubleArray#" GenPrimOp + MutableByteArray# s -> Int# -> Double# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_StablePtr "writeStablePtrArray#" GenPrimOp + MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Int8 "writeInt8Array#" GenPrimOp + MutableByteArray# s -> Int# -> Int# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Int16 "writeInt16Array#" GenPrimOp + MutableByteArray# s -> Int# -> Int# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp + MutableByteArray# s -> Int# -> INT32 -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp + MutableByteArray# s -> Int# -> INT64 -> State# s -> State# s + with can_fail = True + has_side_effects = True + +primop WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp + MutableByteArray# s -> Int# -> Word# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word16 "writeWord16Array#" GenPrimOp + MutableByteArray# s -> Int# -> Word# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp + MutableByteArray# s -> Int# -> WORD32 -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp + MutableByteArray# s -> Int# -> WORD64 -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsChar "writeWord8ArrayAsChar#" GenPrimOp + MutableByteArray# s -> Int# -> Char# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsWideChar "writeWord8ArrayAsWideChar#" GenPrimOp + MutableByteArray# s -> Int# -> Char# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsAddr "writeWord8ArrayAsAddr#" GenPrimOp + MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsFloat "writeWord8ArrayAsFloat#" GenPrimOp + MutableByteArray# s -> Int# -> Float# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsDouble "writeWord8ArrayAsDouble#" GenPrimOp + MutableByteArray# s -> Int# -> Double# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsStablePtr "writeWord8ArrayAsStablePtr#" GenPrimOp + MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsInt16 "writeWord8ArrayAsInt16#" GenPrimOp + MutableByteArray# s -> Int# -> Int# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsInt32 "writeWord8ArrayAsInt32#" GenPrimOp + MutableByteArray# s -> Int# -> INT32 -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsInt64 "writeWord8ArrayAsInt64#" GenPrimOp + MutableByteArray# s -> Int# -> INT64 -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsInt "writeWord8ArrayAsInt#" GenPrimOp + MutableByteArray# s -> Int# -> Int# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsWord16 "writeWord8ArrayAsWord16#" GenPrimOp + MutableByteArray# s -> Int# -> Word# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsWord32 "writeWord8ArrayAsWord32#" GenPrimOp + MutableByteArray# s -> Int# -> WORD32 -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsWord64 "writeWord8ArrayAsWord64#" GenPrimOp + MutableByteArray# s -> Int# -> WORD64 -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsWord "writeWord8ArrayAsWord#" GenPrimOp + MutableByteArray# s -> Int# -> Word# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop CompareByteArraysOp "compareByteArrays#" GenPrimOp + ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int# + {{\tt compareByteArrays# src1 src1_ofs src2 src2_ofs n} compares + {\tt n} bytes starting at offset {\tt src1_ofs} in the first + {\tt ByteArray#} {\tt src1} to the range of {\tt n} bytes + (i.e. same length) starting at offset {\tt src2_ofs} of the second + {\tt ByteArray#} {\tt src2}. Both arrays must fully contain the + specified ranges, but this is not checked. Returns an {\tt Int#} + less than, equal to, or greater than zero if the range is found, + respectively, to be byte-wise lexicographically less than, to + match, or be greater than the second range.} + with + can_fail = True + +primop CopyByteArrayOp "copyByteArray#" GenPrimOp + ByteArray# -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s + {{\tt copyByteArray# src src_ofs dst dst_ofs n} copies the range + starting at offset {\tt src_ofs} of length {\tt n} from the + {\tt ByteArray#} {\tt src} to the {\tt MutableByteArray#} {\tt dst} + starting at offset {\tt dst_ofs}. Both arrays must fully contain + the specified ranges, but this is not checked. The two arrays must + not be the same array in different states, but this is not checked + either.} + with + has_side_effects = True + code_size = { primOpCodeSizeForeignCall + 4} + can_fail = True + +primop CopyMutableByteArrayOp "copyMutableByteArray#" GenPrimOp + MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s + {Copy a range of the first MutableByteArray\# to the specified region in the second MutableByteArray\#. + Both arrays must fully contain the specified ranges, but this is not checked. The regions are + allowed to overlap, although this is only possible when the same array is provided + as both the source and the destination.} + with + has_side_effects = True + code_size = { primOpCodeSizeForeignCall + 4 } + can_fail = True + +primop CopyByteArrayToAddrOp "copyByteArrayToAddr#" GenPrimOp + ByteArray# -> Int# -> Addr# -> Int# -> State# s -> State# s + {Copy a range of the ByteArray\# to the memory range starting at the Addr\#. + The ByteArray\# and the memory region at Addr\# must fully contain the + specified ranges, but this is not checked. The Addr\# must not point into the + ByteArray\# (e.g. if the ByteArray\# were pinned), but this is not checked + either.} + with + has_side_effects = True + code_size = { primOpCodeSizeForeignCall + 4} + can_fail = True + +primop CopyMutableByteArrayToAddrOp "copyMutableByteArrayToAddr#" GenPrimOp + MutableByteArray# s -> Int# -> Addr# -> Int# -> State# s -> State# s + {Copy a range of the MutableByteArray\# to the memory range starting at the + Addr\#. The MutableByteArray\# and the memory region at Addr\# must fully + contain the specified ranges, but this is not checked. The Addr\# must not + point into the MutableByteArray\# (e.g. if the MutableByteArray\# were + pinned), but this is not checked either.} + with + has_side_effects = True + code_size = { primOpCodeSizeForeignCall + 4} + can_fail = True + +primop CopyAddrToByteArrayOp "copyAddrToByteArray#" GenPrimOp + Addr# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s + {Copy a memory range starting at the Addr\# to the specified range in the + MutableByteArray\#. The memory region at Addr\# and the ByteArray\# must fully + contain the specified ranges, but this is not checked. The Addr\# must not + point into the MutableByteArray\# (e.g. if the MutableByteArray\# were pinned), + but this is not checked either.} + with + has_side_effects = True + code_size = { primOpCodeSizeForeignCall + 4} + can_fail = True + +primop SetByteArrayOp "setByteArray#" GenPrimOp + MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> State# s + {{\tt setByteArray# ba off len c} sets the byte range {\tt [off, off+len]} of + the {\tt MutableByteArray#} to the byte {\tt c}.} + with + has_side_effects = True + code_size = { primOpCodeSizeForeignCall + 4 } + can_fail = True + +-- Atomic operations + +primop AtomicReadByteArrayOp_Int "atomicReadIntArray#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) + {Given an array and an offset in machine words, read an element. The + index is assumed to be in bounds. Implies a full memory barrier.} + with has_side_effects = True + can_fail = True + +primop AtomicWriteByteArrayOp_Int "atomicWriteIntArray#" GenPrimOp + MutableByteArray# s -> Int# -> Int# -> State# s -> State# s + {Given an array and an offset in machine words, write an element. The + index is assumed to be in bounds. Implies a full memory barrier.} + with has_side_effects = True + can_fail = True + +primop CasByteArrayOp_Int "casIntArray#" GenPrimOp + MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> (# State# s, Int# #) + {Given an array, an offset in machine words, the expected old value, and + the new value, perform an atomic compare and swap i.e. write the new + value if the current value matches the provided old value. Returns + the value of the element before the operation. Implies a full memory + barrier.} + with has_side_effects = True + can_fail = True + +primop FetchAddByteArrayOp_Int "fetchAddIntArray#" GenPrimOp + MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) + {Given an array, and offset in machine words, and a value to add, + atomically add the value to the element. Returns the value of the + element before the operation. Implies a full memory barrier.} + with has_side_effects = True + can_fail = True + +primop FetchSubByteArrayOp_Int "fetchSubIntArray#" GenPrimOp + MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) + {Given an array, and offset in machine words, and a value to subtract, + atomically subtract the value to the element. Returns the value of + the element before the operation. Implies a full memory barrier.} + with has_side_effects = True + can_fail = True + +primop FetchAndByteArrayOp_Int "fetchAndIntArray#" GenPrimOp + MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) + {Given an array, and offset in machine words, and a value to AND, + atomically AND the value to the element. Returns the value of the + element before the operation. Implies a full memory barrier.} + with has_side_effects = True + can_fail = True + +primop FetchNandByteArrayOp_Int "fetchNandIntArray#" GenPrimOp + MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) + {Given an array, and offset in machine words, and a value to NAND, + atomically NAND the value to the element. Returns the value of the + element before the operation. Implies a full memory barrier.} + with has_side_effects = True + can_fail = True + +primop FetchOrByteArrayOp_Int "fetchOrIntArray#" GenPrimOp + MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) + {Given an array, and offset in machine words, and a value to OR, + atomically OR the value to the element. Returns the value of the + element before the operation. Implies a full memory barrier.} + with has_side_effects = True + can_fail = True + +primop FetchXorByteArrayOp_Int "fetchXorIntArray#" GenPrimOp + MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) + {Given an array, and offset in machine words, and a value to XOR, + atomically XOR the value to the element. Returns the value of the + element before the operation. Implies a full memory barrier.} + with has_side_effects = True + can_fail = True + + +------------------------------------------------------------------------ +section "Arrays of arrays" + {Operations on {\tt ArrayArray\#}. An {\tt ArrayArray\#} contains references to {\em unpointed} + arrays, such as {\tt ByteArray\#s}. Hence, it is not parameterised by the element types, + just like a {\tt ByteArray\#}, but it needs to be scanned during GC, just like an {\tt Array\#}. + We represent an {\tt ArrayArray\#} exactly as a {\tt Array\#}, but provide element-type-specific + indexing, reading, and writing.} +------------------------------------------------------------------------ + +primtype ArrayArray# + +primtype MutableArrayArray# s + +primop NewArrayArrayOp "newArrayArray#" GenPrimOp + Int# -> State# s -> (# State# s, MutableArrayArray# s #) + {Create a new mutable array of arrays with the specified number of elements, + in the specified state thread, with each element recursively referring to the + newly created array.} + with + out_of_line = True + has_side_effects = True + +primop SameMutableArrayArrayOp "sameMutableArrayArray#" GenPrimOp + MutableArrayArray# s -> MutableArrayArray# s -> Int# + +primop UnsafeFreezeArrayArrayOp "unsafeFreezeArrayArray#" GenPrimOp + MutableArrayArray# s -> State# s -> (# State# s, ArrayArray# #) + {Make a mutable array of arrays immutable, without copying.} + with + has_side_effects = True + +primop SizeofArrayArrayOp "sizeofArrayArray#" GenPrimOp + ArrayArray# -> Int# + {Return the number of elements in the array.} + +primop SizeofMutableArrayArrayOp "sizeofMutableArrayArray#" GenPrimOp + MutableArrayArray# s -> Int# + {Return the number of elements in the array.} + +primop IndexArrayArrayOp_ByteArray "indexByteArrayArray#" GenPrimOp + ArrayArray# -> Int# -> ByteArray# + with can_fail = True + +primop IndexArrayArrayOp_ArrayArray "indexArrayArrayArray#" GenPrimOp + ArrayArray# -> Int# -> ArrayArray# + with can_fail = True + +primop ReadArrayArrayOp_ByteArray "readByteArrayArray#" GenPrimOp + MutableArrayArray# s -> Int# -> State# s -> (# State# s, ByteArray# #) + with has_side_effects = True + can_fail = True + +primop ReadArrayArrayOp_MutableByteArray "readMutableByteArrayArray#" GenPrimOp + MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #) + with has_side_effects = True + can_fail = True + +primop ReadArrayArrayOp_ArrayArray "readArrayArrayArray#" GenPrimOp + MutableArrayArray# s -> Int# -> State# s -> (# State# s, ArrayArray# #) + with has_side_effects = True + can_fail = True + +primop ReadArrayArrayOp_MutableArrayArray "readMutableArrayArrayArray#" GenPrimOp + MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableArrayArray# s #) + with has_side_effects = True + can_fail = True + +primop WriteArrayArrayOp_ByteArray "writeByteArrayArray#" GenPrimOp + MutableArrayArray# s -> Int# -> ByteArray# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteArrayArrayOp_MutableByteArray "writeMutableByteArrayArray#" GenPrimOp + MutableArrayArray# s -> Int# -> MutableByteArray# s -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteArrayArrayOp_ArrayArray "writeArrayArrayArray#" GenPrimOp + MutableArrayArray# s -> Int# -> ArrayArray# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteArrayArrayOp_MutableArrayArray "writeMutableArrayArrayArray#" GenPrimOp + MutableArrayArray# s -> Int# -> MutableArrayArray# s -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop CopyArrayArrayOp "copyArrayArray#" GenPrimOp + ArrayArray# -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s + {Copy a range of the ArrayArray\# to the specified region in the MutableArrayArray\#. + Both arrays must fully contain the specified ranges, but this is not checked. + The two arrays must not be the same array in different states, but this is not checked either.} + with + out_of_line = True + has_side_effects = True + can_fail = True + +primop CopyMutableArrayArrayOp "copyMutableArrayArray#" GenPrimOp + MutableArrayArray# s -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s + {Copy a range of the first MutableArrayArray# to the specified region in the second + MutableArrayArray#. + Both arrays must fully contain the specified ranges, but this is not checked. + The regions are allowed to overlap, although this is only possible when the same + array is provided as both the source and the destination. + } + with + out_of_line = True + has_side_effects = True + can_fail = True + +------------------------------------------------------------------------ +section "Addr#" +------------------------------------------------------------------------ + +primtype Addr# + { An arbitrary machine address assumed to point outside + the garbage-collected heap. } + +pseudoop "nullAddr#" Addr# + { The null address. } + +primop AddrAddOp "plusAddr#" GenPrimOp Addr# -> Int# -> Addr# +primop AddrSubOp "minusAddr#" GenPrimOp Addr# -> Addr# -> Int# + {Result is meaningless if two {\tt Addr\#}s are so far apart that their + difference doesn't fit in an {\tt Int\#}.} +primop AddrRemOp "remAddr#" GenPrimOp Addr# -> Int# -> Int# + {Return the remainder when the {\tt Addr\#} arg, treated like an {\tt Int\#}, + is divided by the {\tt Int\#} arg.} +primop Addr2IntOp "addr2Int#" GenPrimOp Addr# -> Int# + {Coerce directly from address to int.} + with code_size = 0 + deprecated_msg = { This operation is strongly deprecated. } +primop Int2AddrOp "int2Addr#" GenPrimOp Int# -> Addr# + {Coerce directly from int to address.} + with code_size = 0 + deprecated_msg = { This operation is strongly deprecated. } + +primop AddrGtOp "gtAddr#" Compare Addr# -> Addr# -> Int# +primop AddrGeOp "geAddr#" Compare Addr# -> Addr# -> Int# +primop AddrEqOp "eqAddr#" Compare Addr# -> Addr# -> Int# +primop AddrNeOp "neAddr#" Compare Addr# -> Addr# -> Int# +primop AddrLtOp "ltAddr#" Compare Addr# -> Addr# -> Int# +primop AddrLeOp "leAddr#" Compare Addr# -> Addr# -> Int# + +primop IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp + Addr# -> Int# -> Char# + {Reads 8-bit character; offset in bytes.} + with can_fail = True + +primop IndexOffAddrOp_WideChar "indexWideCharOffAddr#" GenPrimOp + Addr# -> Int# -> Char# + {Reads 31-bit character; offset in 4-byte words.} + with can_fail = True + +primop IndexOffAddrOp_Int "indexIntOffAddr#" GenPrimOp + Addr# -> Int# -> Int# + with can_fail = True + +primop IndexOffAddrOp_Word "indexWordOffAddr#" GenPrimOp + Addr# -> Int# -> Word# + with can_fail = True + +primop IndexOffAddrOp_Addr "indexAddrOffAddr#" GenPrimOp + Addr# -> Int# -> Addr# + with can_fail = True + +primop IndexOffAddrOp_Float "indexFloatOffAddr#" GenPrimOp + Addr# -> Int# -> Float# + with can_fail = True + +primop IndexOffAddrOp_Double "indexDoubleOffAddr#" GenPrimOp + Addr# -> Int# -> Double# + with can_fail = True + +primop IndexOffAddrOp_StablePtr "indexStablePtrOffAddr#" GenPrimOp + Addr# -> Int# -> StablePtr# a + with can_fail = True + +primop IndexOffAddrOp_Int8 "indexInt8OffAddr#" GenPrimOp + Addr# -> Int# -> Int# + with can_fail = True + +primop IndexOffAddrOp_Int16 "indexInt16OffAddr#" GenPrimOp + Addr# -> Int# -> Int# + with can_fail = True + +primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp + Addr# -> Int# -> INT32 + with can_fail = True + +primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp + Addr# -> Int# -> INT64 + with can_fail = True + +primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp + Addr# -> Int# -> Word# + with can_fail = True + +primop IndexOffAddrOp_Word16 "indexWord16OffAddr#" GenPrimOp + Addr# -> Int# -> Word# + with can_fail = True + +primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp + Addr# -> Int# -> WORD32 + with can_fail = True + +primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp + Addr# -> Int# -> WORD64 + with can_fail = True + +primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Char# #) + {Reads 8-bit character; offset in bytes.} + with has_side_effects = True + can_fail = True + +primop ReadOffAddrOp_WideChar "readWideCharOffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Char# #) + {Reads 31-bit character; offset in 4-byte words.} + with has_side_effects = True + can_fail = True + +primop ReadOffAddrOp_Int "readIntOffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Int# #) + with has_side_effects = True + can_fail = True + +primop ReadOffAddrOp_Word "readWordOffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Word# #) + with has_side_effects = True + can_fail = True + +primop ReadOffAddrOp_Addr "readAddrOffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Addr# #) + with has_side_effects = True + can_fail = True + +primop ReadOffAddrOp_Float "readFloatOffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Float# #) + with has_side_effects = True + can_fail = True + +primop ReadOffAddrOp_Double "readDoubleOffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Double# #) + with has_side_effects = True + can_fail = True + +primop ReadOffAddrOp_StablePtr "readStablePtrOffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, StablePtr# a #) + with has_side_effects = True + can_fail = True + +primop ReadOffAddrOp_Int8 "readInt8OffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Int# #) + with has_side_effects = True + can_fail = True + +primop ReadOffAddrOp_Int16 "readInt16OffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Int# #) + with has_side_effects = True + can_fail = True + +primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, INT32 #) + with has_side_effects = True + can_fail = True + +primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, INT64 #) + with has_side_effects = True + can_fail = True + +primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Word# #) + with has_side_effects = True + can_fail = True + +primop ReadOffAddrOp_Word16 "readWord16OffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, Word# #) + with has_side_effects = True + can_fail = True + +primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, WORD32 #) + with has_side_effects = True + can_fail = True + +primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, WORD64 #) + with has_side_effects = True + can_fail = True + +primop WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp + Addr# -> Int# -> Char# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteOffAddrOp_WideChar "writeWideCharOffAddr#" GenPrimOp + Addr# -> Int# -> Char# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteOffAddrOp_Int "writeIntOffAddr#" GenPrimOp + Addr# -> Int# -> Int# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteOffAddrOp_Word "writeWordOffAddr#" GenPrimOp + Addr# -> Int# -> Word# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp + Addr# -> Int# -> Addr# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp + Addr# -> Int# -> Float# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteOffAddrOp_Double "writeDoubleOffAddr#" GenPrimOp + Addr# -> Int# -> Double# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteOffAddrOp_StablePtr "writeStablePtrOffAddr#" GenPrimOp + Addr# -> Int# -> StablePtr# a -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteOffAddrOp_Int8 "writeInt8OffAddr#" GenPrimOp + Addr# -> Int# -> Int# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteOffAddrOp_Int16 "writeInt16OffAddr#" GenPrimOp + Addr# -> Int# -> Int# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp + Addr# -> Int# -> INT32 -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp + Addr# -> Int# -> INT64 -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteOffAddrOp_Word8 "writeWord8OffAddr#" GenPrimOp + Addr# -> Int# -> Word# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteOffAddrOp_Word16 "writeWord16OffAddr#" GenPrimOp + Addr# -> Int# -> Word# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp + Addr# -> Int# -> WORD32 -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp + Addr# -> Int# -> WORD64 -> State# s -> State# s + with has_side_effects = True + can_fail = True + +------------------------------------------------------------------------ +section "Mutable variables" + {Operations on MutVar\#s.} +------------------------------------------------------------------------ + +primtype MutVar# s a + {A {\tt MutVar\#} behaves like a single-element mutable array.} + +primop NewMutVarOp "newMutVar#" GenPrimOp + a -> State# s -> (# State# s, MutVar# s a #) + {Create {\tt MutVar\#} with specified initial value in specified state thread.} + with + out_of_line = True + has_side_effects = True + +-- Note [Why MutVar# ops can't fail] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- We don't label readMutVar# or writeMutVar# as can_fail. +-- This may seem a bit peculiar, because they surely *could* +-- fail spectacularly if passed a pointer to unallocated memory. +-- But MutVar#s are always correct by construction; we never +-- test if a pointer is valid before using it with these operations. +-- So we never have to worry about floating the pointer reference +-- outside a validity test. At the moment, has_side_effects blocks +-- up the relevant optimizations anyway, but we hope to draw finer +-- distinctions soon, which should improve matters for readMutVar# +-- at least. + +primop ReadMutVarOp "readMutVar#" GenPrimOp + MutVar# s a -> State# s -> (# State# s, a #) + {Read contents of {\tt MutVar\#}. Result is not yet evaluated.} + with + -- See Note [Why MutVar# ops can't fail] + has_side_effects = True + +primop WriteMutVarOp "writeMutVar#" GenPrimOp + MutVar# s a -> a -> State# s -> State# s + {Write contents of {\tt MutVar\#}.} + with + -- See Note [Why MutVar# ops can't fail] + has_side_effects = True + code_size = { primOpCodeSizeForeignCall } -- for the write barrier + +primop SameMutVarOp "sameMutVar#" GenPrimOp + MutVar# s a -> MutVar# s a -> Int# + +-- Note [Why not an unboxed tuple in atomicModifyMutVar2#?] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Looking at the type of atomicModifyMutVar2#, one might wonder why +-- it doesn't return an unboxed tuple. e.g., +-- +-- MutVar# s a -> (a -> (# a, b #)) -> State# s -> (# State# s, a, (# a, b #) #) +-- +-- The reason is that atomicModifyMutVar2# relies on laziness for its atomicity. +-- Given a MutVar# containing x, atomicModifyMutVar2# merely replaces +-- its contents with a thunk of the form (fst (f x)). This can be done using an +-- atomic compare-and-swap as it is merely replacing a pointer. + +primop AtomicModifyMutVar2Op "atomicModifyMutVar2#" GenPrimOp + MutVar# s a -> (a -> c) -> State# s -> (# State# s, a, c #) + { Modify the contents of a {\tt MutVar\#}, returning the previous + contents and the result of applying the given function to the + previous contents. Note that this isn't strictly + speaking the correct type for this function; it should really be + {\tt MutVar\# s a -> (a -> (a,b)) -> State\# s -> (\# State\# s, a, (a, b) \#)}, + but we don't know about pairs here. } + with + out_of_line = True + has_side_effects = True + can_fail = True + +primop AtomicModifyMutVar_Op "atomicModifyMutVar_#" GenPrimOp + MutVar# s a -> (a -> a) -> State# s -> (# State# s, a, a #) + { Modify the contents of a {\tt MutVar\#}, returning the previous + contents and the result of applying the given function to the + previous contents. } + with + out_of_line = True + has_side_effects = True + can_fail = True + +primop CasMutVarOp "casMutVar#" GenPrimOp + MutVar# s a -> a -> a -> State# s -> (# State# s, Int#, a #) + with + out_of_line = True + has_side_effects = True + +------------------------------------------------------------------------ +section "Exceptions" +------------------------------------------------------------------------ + +-- Note [Strictness for mask/unmask/catch] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Consider this example, which comes from GHC.IO.Handle.Internals: +-- wantReadableHandle3 f ma b st +-- = case ... of +-- DEFAULT -> case ma of MVar a -> ... +-- 0# -> maskAsynchExceptions# (\st -> case ma of MVar a -> ...) +-- The outer case just decides whether to mask exceptions, but we don't want +-- thereby to hide the strictness in 'ma'! Hence the use of strictApply1Dmd. + +primop CatchOp "catch#" GenPrimOp + (State# RealWorld -> (# State# RealWorld, a #) ) + -> (b -> State# RealWorld -> (# State# RealWorld, a #) ) + -> State# RealWorld + -> (# State# RealWorld, a #) + with + strictness = { \ _arity -> mkClosedStrictSig [ lazyApply1Dmd + , lazyApply2Dmd + , topDmd] topDiv } + -- See Note [Strictness for mask/unmask/catch] + out_of_line = True + has_side_effects = True + +primop RaiseOp "raise#" GenPrimOp + b -> o + -- NB: the type variable "o" is "a", but with OpenKind + with + strictness = { \ _arity -> mkClosedStrictSig [topDmd] botDiv } + out_of_line = True + has_side_effects = True + -- raise# certainly throws a Haskell exception and hence has_side_effects + -- It doesn't actually make much difference because the fact that it + -- returns bottom independently ensures that we are careful not to discard + -- it. But still, it's better to say the Right Thing. + +-- Note [Arithmetic exception primops] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- The RTS provides several primops to raise specific exceptions (raiseDivZero#, +-- raiseUnderflow#, raiseOverflow#). These primops are meant to be used by the +-- package implementing arbitrary precision numbers (Natural,Integer). It can't +-- depend on `base` package to raise exceptions in a normal way because it would +-- create a package dependency circle (base <-> bignum package). +-- +-- See #14664 + +primtype Void# + +primop RaiseDivZeroOp "raiseDivZero#" GenPrimOp + Void# -> o + {Raise a 'DivideByZero' arithmetic exception.} + -- NB: the type variable "o" is "a", but with OpenKind + -- See Note [Arithmetic exception primops] + with + strictness = { \ _arity -> mkClosedStrictSig [topDmd] botDiv } + out_of_line = True + has_side_effects = True + +primop RaiseUnderflowOp "raiseUnderflow#" GenPrimOp + Void# -> o + {Raise an 'Underflow' arithmetic exception.} + -- NB: the type variable "o" is "a", but with OpenKind + -- See Note [Arithmetic exception primops] + with + strictness = { \ _arity -> mkClosedStrictSig [topDmd] botDiv } + out_of_line = True + has_side_effects = True + +primop RaiseOverflowOp "raiseOverflow#" GenPrimOp + Void# -> o + {Raise an 'Overflow' arithmetic exception.} + -- NB: the type variable "o" is "a", but with OpenKind + -- See Note [Arithmetic exception primops] + with + strictness = { \ _arity -> mkClosedStrictSig [topDmd] botDiv } + out_of_line = True + has_side_effects = True + +primop RaiseIOOp "raiseIO#" GenPrimOp + a -> State# RealWorld -> (# State# RealWorld, b #) + with + -- See Note [Precise exceptions and strictness analysis] in Demand.hs + -- for why we give it topDiv + -- strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] topDiv } + out_of_line = True + has_side_effects = True + +primop MaskAsyncExceptionsOp "maskAsyncExceptions#" GenPrimOp + (State# RealWorld -> (# State# RealWorld, a #)) + -> (State# RealWorld -> (# State# RealWorld, a #)) + with + strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topDiv } + -- See Note [Strictness for mask/unmask/catch] + out_of_line = True + has_side_effects = True + +primop MaskUninterruptibleOp "maskUninterruptible#" GenPrimOp + (State# RealWorld -> (# State# RealWorld, a #)) + -> (State# RealWorld -> (# State# RealWorld, a #)) + with + strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topDiv } + out_of_line = True + has_side_effects = True + +primop UnmaskAsyncExceptionsOp "unmaskAsyncExceptions#" GenPrimOp + (State# RealWorld -> (# State# RealWorld, a #)) + -> (State# RealWorld -> (# State# RealWorld, a #)) + with + strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topDiv } + -- See Note [Strictness for mask/unmask/catch] + out_of_line = True + has_side_effects = True + +primop MaskStatus "getMaskingState#" GenPrimOp + State# RealWorld -> (# State# RealWorld, Int# #) + with + out_of_line = True + has_side_effects = True + +------------------------------------------------------------------------ +section "STM-accessible Mutable Variables" +------------------------------------------------------------------------ + +primtype TVar# s a + +primop AtomicallyOp "atomically#" GenPrimOp + (State# RealWorld -> (# State# RealWorld, a #) ) + -> State# RealWorld -> (# State# RealWorld, a #) + with + strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topDiv } + -- See Note [Strictness for mask/unmask/catch] + out_of_line = True + has_side_effects = True + +-- NB: retry#'s strictness information specifies it to diverge. +-- This lets the compiler perform some extra simplifications, since retry# +-- will technically never return. +-- +-- This allows the simplifier to replace things like: +-- case retry# s1 +-- (# s2, a #) -> e +-- with: +-- retry# s1 +-- where 'e' would be unreachable anyway. See #8091. +primop RetryOp "retry#" GenPrimOp + State# RealWorld -> (# State# RealWorld, a #) + with + strictness = { \ _arity -> mkClosedStrictSig [topDmd] botDiv } + 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 + strictness = { \ _arity -> mkClosedStrictSig [ lazyApply1Dmd + , lazyApply1Dmd + , topDmd ] topDiv } + -- See Note [Strictness for mask/unmask/catch] + 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 + strictness = { \ _arity -> mkClosedStrictSig [ lazyApply1Dmd + , lazyApply2Dmd + , topDmd ] topDiv } + -- See Note [Strictness for mask/unmask/catch] + out_of_line = True + has_side_effects = True + +primop NewTVarOp "newTVar#" GenPrimOp + a + -> State# s -> (# State# s, TVar# s a #) + {Create a new {\tt TVar\#} holding a specified initial value.} + with + out_of_line = True + has_side_effects = True + +primop ReadTVarOp "readTVar#" GenPrimOp + TVar# s a + -> State# s -> (# State# s, a #) + {Read contents of {\tt TVar\#}. Result is not yet evaluated.} + with + out_of_line = True + has_side_effects = True + +primop ReadTVarIOOp "readTVarIO#" GenPrimOp + TVar# s a + -> State# s -> (# State# s, a #) + {Read contents of {\tt TVar\#} outside an STM transaction} + with + out_of_line = True + has_side_effects = True + +primop WriteTVarOp "writeTVar#" GenPrimOp + TVar# s a + -> a + -> State# s -> State# s + {Write contents of {\tt TVar\#}.} + with + out_of_line = True + has_side_effects = True + +primop SameTVarOp "sameTVar#" GenPrimOp + TVar# s a -> TVar# s a -> Int# + + +------------------------------------------------------------------------ +section "Synchronized Mutable Variables" + {Operations on {\tt MVar\#}s. } +------------------------------------------------------------------------ + +primtype MVar# s a + { A shared mutable variable ({\it not} the same as a {\tt MutVar\#}!). + (Note: in a non-concurrent implementation, {\tt (MVar\# a)} can be + represented by {\tt (MutVar\# (Maybe a))}.) } + +primop NewMVarOp "newMVar#" GenPrimOp + State# s -> (# State# s, MVar# s a #) + {Create new {\tt MVar\#}; initially empty.} + with + out_of_line = True + has_side_effects = True + +primop TakeMVarOp "takeMVar#" GenPrimOp + MVar# s a -> State# s -> (# State# s, a #) + {If {\tt MVar\#} is empty, block until it becomes full. + Then remove and return its contents, and set it empty.} + with + out_of_line = True + has_side_effects = True + +primop TryTakeMVarOp "tryTakeMVar#" GenPrimOp + MVar# s a -> State# s -> (# State# s, Int#, a #) + {If {\tt MVar\#} is empty, immediately return with integer 0 and value undefined. + Otherwise, return with integer 1 and contents of {\tt MVar\#}, and set {\tt MVar\#} empty.} + with + out_of_line = True + has_side_effects = True + +primop PutMVarOp "putMVar#" GenPrimOp + MVar# s a -> a -> State# s -> State# s + {If {\tt MVar\#} is full, block until it becomes empty. + Then store value arg as its new contents.} + with + out_of_line = True + has_side_effects = True + +primop TryPutMVarOp "tryPutMVar#" GenPrimOp + MVar# s a -> a -> State# s -> (# State# s, Int# #) + {If {\tt MVar\#} is full, immediately return with integer 0. + Otherwise, store value arg as {\tt MVar\#}'s new contents, and return with integer 1.} + with + out_of_line = True + has_side_effects = True + +primop ReadMVarOp "readMVar#" GenPrimOp + MVar# s a -> State# s -> (# State# s, a #) + {If {\tt MVar\#} is empty, block until it becomes full. + Then read its contents without modifying the MVar, without possibility + of intervention from other threads.} + with + out_of_line = True + has_side_effects = True + +primop TryReadMVarOp "tryReadMVar#" GenPrimOp + MVar# s a -> State# s -> (# State# s, Int#, a #) + {If {\tt MVar\#} is empty, immediately return with integer 0 and value undefined. + Otherwise, return with integer 1 and contents of {\tt MVar\#}.} + with + out_of_line = True + has_side_effects = True + +primop SameMVarOp "sameMVar#" GenPrimOp + MVar# s a -> MVar# s a -> Int# + +primop IsEmptyMVarOp "isEmptyMVar#" GenPrimOp + MVar# s a -> State# s -> (# State# s, Int# #) + {Return 1 if {\tt MVar\#} is empty; 0 otherwise.} + with + out_of_line = True + has_side_effects = True + +------------------------------------------------------------------------ +section "Delay/wait operations" +------------------------------------------------------------------------ + +primop DelayOp "delay#" GenPrimOp + Int# -> State# s -> State# s + {Sleep specified number of microseconds.} + with + 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 + 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 + has_side_effects = True + out_of_line = True + +------------------------------------------------------------------------ +section "Concurrency primitives" +------------------------------------------------------------------------ + +primtype State# s + { {\tt State\#} is the primitive, unlifted type of states. It has + one type parameter, thus {\tt State\# RealWorld}, or {\tt 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. } + +primtype RealWorld + { {\tt RealWorld} is deeply magical. It is {\it primitive}, but it is not + {\it unlifted} (hence {\tt ptrArg}). We never manipulate values of type + {\tt RealWorld}; it's only used in the type system, to parameterise {\tt State\#}. } + +primtype ThreadId# + {(In a non-concurrent implementation, this can be a singleton + type, whose (unique) value is returned by {\tt myThreadId\#}. The + other operations can be omitted.)} + +primop ForkOp "fork#" GenPrimOp + a -> State# RealWorld -> (# State# RealWorld, ThreadId# #) + with + has_side_effects = True + out_of_line = True + +primop ForkOnOp "forkOn#" GenPrimOp + Int# -> a -> State# RealWorld -> (# State# RealWorld, ThreadId# #) + with + has_side_effects = True + out_of_line = True + +primop KillThreadOp "killThread#" GenPrimOp + ThreadId# -> a -> State# RealWorld -> State# RealWorld + with + 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 + has_side_effects = 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 + has_side_effects = True + +primop NoDuplicateOp "noDuplicate#" GenPrimOp + State# s -> State# s + with + out_of_line = True + has_side_effects = True + +primop ThreadStatusOp "threadStatus#" GenPrimOp + ThreadId# -> State# RealWorld -> (# State# RealWorld, Int#, Int#, Int# #) + with + out_of_line = True + has_side_effects = True + +------------------------------------------------------------------------ +section "Weak pointers" +------------------------------------------------------------------------ + +primtype Weak# b + +-- note that tyvar "o" denotes openAlphaTyVar + +primop MkWeakOp "mkWeak#" GenPrimOp + o -> b -> (State# RealWorld -> (# State# RealWorld, c #)) + -> State# RealWorld -> (# State# RealWorld, Weak# b #) + { {\tt mkWeak# k v finalizer s} creates a weak reference to value {\tt k}, + with an associated reference to some value {\tt v}. If {\tt k} is still + alive then {\tt v} can be retrieved using {\tt deRefWeak#}. Note that + the type of {\tt k} must be represented by a pointer (i.e. of kind {\tt + TYPE 'LiftedRep} or {\tt TYPE 'UnliftedRep}). } + with + has_side_effects = True + out_of_line = True + +primop MkWeakNoFinalizerOp "mkWeakNoFinalizer#" GenPrimOp + o -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #) + with + has_side_effects = True + out_of_line = True + +primop AddCFinalizerToWeakOp "addCFinalizerToWeak#" GenPrimOp + Addr# -> Addr# -> Int# -> Addr# -> Weak# b + -> State# RealWorld -> (# State# RealWorld, Int# #) + { {\tt addCFinalizerToWeak# fptr ptr flag eptr w} attaches a C + function pointer {\tt fptr} to a weak pointer {\tt w} as a finalizer. If + {\tt flag} is zero, {\tt fptr} will be called with one argument, + {\tt ptr}. Otherwise, it will be called with two arguments, + {\tt eptr} and {\tt ptr}. {\tt addCFinalizerToWeak#} returns + 1 on success, or 0 if {\tt w} is already dead. } + with + has_side_effects = True + out_of_line = True + +primop DeRefWeakOp "deRefWeak#" GenPrimOp + Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, a #) + with + has_side_effects = True + out_of_line = True + +primop FinalizeWeakOp "finalizeWeak#" GenPrimOp + Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, + (State# RealWorld -> (# State# RealWorld, b #) ) #) + { Finalize a weak pointer. The return value is an unboxed tuple + containing the new state of the world and an "unboxed Maybe", + represented by an {\tt Int#} and a (possibly invalid) finalization + action. An {\tt Int#} of {\tt 1} indicates that the finalizer is valid. The + return value {\tt b} from the finalizer should be ignored. } + with + has_side_effects = True + out_of_line = True + +primop TouchOp "touch#" GenPrimOp + o -> State# RealWorld -> State# RealWorld + with + code_size = { 0 } + has_side_effects = True + +------------------------------------------------------------------------ +section "Stable pointers and names" +------------------------------------------------------------------------ + +primtype StablePtr# a + +primtype StableName# a + +primop MakeStablePtrOp "makeStablePtr#" GenPrimOp + a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #) + with + has_side_effects = True + out_of_line = True + +primop DeRefStablePtrOp "deRefStablePtr#" GenPrimOp + StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #) + with + has_side_effects = True + out_of_line = True + +primop EqStablePtrOp "eqStablePtr#" GenPrimOp + StablePtr# a -> StablePtr# a -> Int# + with + has_side_effects = True + +primop MakeStableNameOp "makeStableName#" GenPrimOp + a -> State# RealWorld -> (# State# RealWorld, StableName# a #) + with + has_side_effects = True + out_of_line = True + +primop EqStableNameOp "eqStableName#" GenPrimOp + StableName# a -> StableName# b -> Int# + +primop StableNameToIntOp "stableNameToInt#" GenPrimOp + StableName# a -> Int# + +------------------------------------------------------------------------ +section "Compact normal form" + + {Primitives for working with compact regions. The {\tt ghc\-compact} + library and the {\tt compact} library demonstrate how to use these + primitives. The documentation below draws a distinction between + a CNF and a compact block. A CNF contains one or more compact + blocks. The source file {\tt rts\/sm\/CNF.c} + diagrams this relationship. When discussing a compact + block, an additional distinction is drawn between capacity and + utilized bytes. The capacity is the maximum number of bytes that + the compact block can hold. The utilized bytes is the number of + bytes that are actually used by the compact block. + } + +------------------------------------------------------------------------ + +primtype Compact# + +primop CompactNewOp "compactNew#" GenPrimOp + Word# -> State# RealWorld -> (# State# RealWorld, Compact# #) + { Create a new CNF with a single compact block. The argument is + the capacity of the compact block (in bytes, not words). + The capacity is rounded up to a multiple of the allocator block size + and is capped to one mega block. } + with + has_side_effects = True + out_of_line = True + +primop CompactResizeOp "compactResize#" GenPrimOp + Compact# -> Word# -> State# RealWorld -> + State# RealWorld + { Set the new allocation size of the CNF. This value (in bytes) + determines the capacity of each compact block in the CNF. It + does not retroactively affect existing compact blocks in the CNF. } + with + has_side_effects = True + out_of_line = True + +primop CompactContainsOp "compactContains#" GenPrimOp + Compact# -> a -> State# RealWorld -> (# State# RealWorld, Int# #) + { Returns 1\# if the object is contained in the CNF, 0\# otherwise. } + with + out_of_line = True + +primop CompactContainsAnyOp "compactContainsAny#" GenPrimOp + a -> State# RealWorld -> (# State# RealWorld, Int# #) + { Returns 1\# if the object is in any CNF at all, 0\# otherwise. } + with + out_of_line = True + +primop CompactGetFirstBlockOp "compactGetFirstBlock#" GenPrimOp + Compact# -> State# RealWorld -> (# State# RealWorld, Addr#, Word# #) + { Returns the address and the utilized size (in bytes) of the + first compact block of a CNF.} + with + out_of_line = True + +primop CompactGetNextBlockOp "compactGetNextBlock#" GenPrimOp + Compact# -> Addr# -> State# RealWorld -> (# State# RealWorld, Addr#, Word# #) + { Given a CNF and the address of one its compact blocks, returns the + next compact block and its utilized size, or {\tt nullAddr\#} if the + argument was the last compact block in the CNF. } + with + out_of_line = True + +primop CompactAllocateBlockOp "compactAllocateBlock#" GenPrimOp + Word# -> Addr# -> State# RealWorld -> (# State# RealWorld, Addr# #) + { Attempt to allocate a compact block with the capacity (in + bytes) given by the first argument. The {\texttt Addr\#} is a pointer + to previous compact block of the CNF or {\texttt nullAddr\#} to create a + new CNF with a single compact block. + + The resulting block is not known to the GC until + {\texttt compactFixupPointers\#} is called on it, and care must be taken + so that the address does not escape or memory will be leaked. + } + with + has_side_effects = True + out_of_line = True + +primop CompactFixupPointersOp "compactFixupPointers#" GenPrimOp + Addr# -> Addr# -> State# RealWorld -> (# State# RealWorld, Compact#, Addr# #) + { Given the pointer to the first block of a CNF and the + address of the root object in the old address space, fix up + the internal pointers inside the CNF to account for + a different position in memory than when it was serialized. + This method must be called exactly once after importing + a serialized CNF. It returns the new CNF and the new adjusted + root address. } + with + has_side_effects = True + out_of_line = True + +primop CompactAdd "compactAdd#" GenPrimOp + Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #) + { Recursively add a closure and its transitive closure to a + {\texttt Compact\#} (a CNF), evaluating any unevaluated components + at the same time. Note: {\texttt compactAdd\#} is not thread-safe, so + only one thread may call {\texttt compactAdd\#} with a particular + {\texttt Compact\#} at any given time. The primop does not + enforce any mutual exclusion; the caller is expected to + arrange this. } + with + has_side_effects = True + out_of_line = True + +primop CompactAddWithSharing "compactAddWithSharing#" GenPrimOp + Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #) + { Like {\texttt compactAdd\#}, but retains sharing and cycles + during compaction. } + with + has_side_effects = True + out_of_line = True + +primop CompactSize "compactSize#" GenPrimOp + Compact# -> State# RealWorld -> (# State# RealWorld, Word# #) + { Return the total capacity (in bytes) of all the compact blocks + in the CNF. } + with + has_side_effects = True + out_of_line = True + +------------------------------------------------------------------------ +section "Unsafe pointer equality" +-- (#1 Bad Guy: Alastair Reid :) +------------------------------------------------------------------------ + +primop ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp + a -> a -> Int# + { Returns {\texttt 1\#} if the given pointers are equal and {\texttt 0\#} otherwise. } + with + can_fail = True -- See Note [reallyUnsafePtrEquality#] + + +-- Note [reallyUnsafePtrEquality#] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- reallyUnsafePtrEquality# can't actually fail, per se, but we mark it can_fail +-- anyway. Until 5a9a1738023a, GHC considered primops okay for speculation only +-- when their arguments were known to be forced. This was unnecessarily +-- conservative, but it prevented reallyUnsafePtrEquality# from floating out of +-- places where its arguments were known to be forced. Unfortunately, GHC could +-- sometimes lose track of whether those arguments were forced, leading to let/app +-- invariant failures (see #13027 and the discussion in #11444). Now that +-- ok_for_speculation skips over lifted arguments, we need to explicitly prevent +-- reallyUnsafePtrEquality# from floating out. Imagine if we had +-- +-- \x y . case x of x' +-- DEFAULT -> +-- case y of y' +-- DEFAULT -> +-- let eq = reallyUnsafePtrEquality# x' y' +-- in ... +-- +-- If the let floats out, we'll get +-- +-- \x y . let eq = reallyUnsafePtrEquality# x y +-- in case x of ... +-- +-- The trouble is that pointer equality between thunks is very different +-- from pointer equality between the values those thunks reduce to, and the latter +-- is typically much more precise. + +------------------------------------------------------------------------ +section "Parallelism" +------------------------------------------------------------------------ + +primop ParOp "par#" GenPrimOp + a -> Int# + with + -- Note that Par is lazy to avoid that the sparked thing + -- gets evaluated strictly, which it should *not* be + has_side_effects = True + code_size = { primOpCodeSizeForeignCall } + deprecated_msg = { Use 'spark#' instead } + +primop SparkOp "spark#" GenPrimOp + a -> State# s -> (# State# s, a #) + with has_side_effects = True + code_size = { primOpCodeSizeForeignCall } + +primop SeqOp "seq#" GenPrimOp + a -> State# s -> (# State# s, a #) + -- See Note [seq# magic] in GHC.Core.Op.ConstantFold + +primop GetSparkOp "getSpark#" GenPrimOp + State# s -> (# State# s, Int#, a #) + with + has_side_effects = True + out_of_line = True + +primop NumSparks "numSparks#" GenPrimOp + State# s -> (# State# s, Int# #) + { Returns the number of sparks in the local spark pool. } + with + has_side_effects = True + out_of_line = True + +------------------------------------------------------------------------ +section "Tag to enum stuff" + {Convert back and forth between values of enumerated types + and small integers.} +------------------------------------------------------------------------ + +primop DataToTagOp "dataToTag#" GenPrimOp + a -> Int# -- Zero-indexed; the first constructor has tag zero + with + strictness = { \ _arity -> mkClosedStrictSig [evalDmd] topDiv } + -- See Note [dataToTag# magic] in GHC.Core.Op.ConstantFold + +primop TagToEnumOp "tagToEnum#" GenPrimOp + Int# -> a + +------------------------------------------------------------------------ +section "Bytecode operations" + {Support for manipulating bytecode objects used by the interpreter and + linker. + + Bytecode objects are heap objects which represent top-level bindings and + contain a list of instructions and data needed by these instructions.} +------------------------------------------------------------------------ + +primtype BCO + { Primitive bytecode type. } + +primop AddrToAnyOp "addrToAny#" GenPrimOp + Addr# -> (# a #) + { Convert an {\tt Addr\#} to a followable Any type. } + with + code_size = 0 + +primop AnyToAddrOp "anyToAddr#" GenPrimOp + a -> State# RealWorld -> (# State# RealWorld, Addr# #) + { Retrieve the address of any Haskell value. This is + essentially an {\texttt unsafeCoerce\#}, but if implemented as such + the core lint pass complains and fails to compile. + As a primop, it is opaque to core/stg, and only appears + in cmm (where the copy propagation pass will get rid of it). + Note that "a" must be a value, not a thunk! It's too late + for strictness analysis to enforce this, so you're on your + own to guarantee this. Also note that {\texttt Addr\#} is not a GC + pointer - up to you to guarantee that it does not become + a dangling pointer immediately after you get it.} + with + code_size = 0 + +primop MkApUpd0_Op "mkApUpd0#" GenPrimOp + BCO -> (# a #) + { Wrap a BCO in a {\tt AP_UPD} thunk which will be updated with the value of + the BCO when evaluated. } + with + out_of_line = True + +primop NewBCOOp "newBCO#" GenPrimOp + ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s, BCO #) + { {\tt newBCO\# instrs lits ptrs arity bitmap} creates a new bytecode object. The + resulting object encodes a function of the given arity with the instructions + encoded in {\tt instrs}, and a static reference table usage bitmap given by + {\tt bitmap}. } + with + has_side_effects = True + out_of_line = True + +primop UnpackClosureOp "unpackClosure#" GenPrimOp + a -> (# Addr#, ByteArray#, Array# b #) + { {\tt unpackClosure\# closure} copies the closure and pointers in the + payload of the given closure into two new arrays, and returns a pointer to + the first word of the closure's info table, a non-pointer array for the raw + bytes of the closure, and a pointer array for the pointers in the payload. } + with + out_of_line = True + +primop ClosureSizeOp "closureSize#" GenPrimOp + a -> Int# + { {\tt closureSize\# closure} returns the size of the given closure in + machine words. } + with + out_of_line = True + +primop GetApStackValOp "getApStackVal#" GenPrimOp + a -> Int# -> (# Int#, b #) + with + out_of_line = True + +------------------------------------------------------------------------ +section "Misc" + {These aren't nearly as wired in as Etc...} +------------------------------------------------------------------------ + +primop GetCCSOfOp "getCCSOf#" GenPrimOp + a -> State# s -> (# State# s, Addr# #) + +primop GetCurrentCCSOp "getCurrentCCS#" GenPrimOp + a -> State# s -> (# State# s, Addr# #) + { Returns the current {\tt CostCentreStack} (value is {\tt NULL} if + not profiling). Takes a dummy argument which can be used to + avoid the call to {\tt getCurrentCCS\#} being floated out by the + simplifier, which would result in an uninformative stack + ("CAF"). } + +primop ClearCCSOp "clearCCS#" GenPrimOp + (State# s -> (# State# s, a #)) -> State# s -> (# State# s, a #) + { Run the supplied IO action with an empty CCS. For example, this + is used by the interpreter to run an interpreted computation + without the call stack showing that it was invoked from GHC. } + with + out_of_line = True + +------------------------------------------------------------------------ +section "Etc" + {Miscellaneous built-ins} +------------------------------------------------------------------------ + +primtype Proxy# a + { The type constructor {\tt Proxy#} is used to bear witness to some + type variable. It's used when you want to pass around proxy values + for doing things like modelling type applications. A {\tt Proxy#} + is not only unboxed, it also has a polymorphic kind, and has no + runtime representation, being totally free. } + +pseudoop "proxy#" + Proxy# a + { Witness for an unboxed {\tt Proxy#} value, which has no runtime + representation. } + +pseudoop "seq" + a -> b -> b + { The value of {\tt seq a b} is bottom if {\tt a} is bottom, and + otherwise equal to {\tt b}. In other words, it evaluates the first + argument {\tt a} to weak head normal form (WHNF). {\tt seq} is usually + introduced to improve performance by avoiding unneeded laziness. + + A note on evaluation order: the expression {\tt seq a b} does + {\it not} guarantee that {\tt a} will be evaluated before {\tt b}. + The only guarantee given by {\tt seq} is that the both {\tt a} + and {\tt b} will be evaluated before {\tt seq} returns a value. + In particular, this means that {\tt b} may be evaluated before + {\tt a}. If you need to guarantee a specific order of evaluation, + you must use the function {\tt pseq} from the "parallel" package. } + with fixity = infixr 0 + -- This fixity is only the one picked up by Haddock. If you + -- change this, do update 'ghcPrimIface' in 'GHC.Iface.Load'. + +pseudoop "unsafeCoerce#" + a -> b + { The function {\tt unsafeCoerce\#} allows you to side-step the typechecker entirely. That + is, it allows you to coerce any type into any other type. If you use this function, + you had better get it right, otherwise segmentation faults await. It is generally + used when you want to write a program that you know is well-typed, but where Haskell's + type system is not expressive enough to prove that it is well typed. + + The following uses of {\tt unsafeCoerce\#} are supposed to work (i.e. not lead to + spurious compile-time or run-time crashes): + + * Casting any lifted type to {\tt Any} + + * Casting {\tt Any} back to the real type + + * Casting an unboxed type to another unboxed type of the same size. + (Casting between floating-point and integral types does not work. + See the {\tt GHC.Float} module for functions to do work.) + + * Casting between two types that have the same runtime representation. One case is when + the two types differ only in "phantom" type parameters, for example + {\tt Ptr Int} to {\tt Ptr Float}, or {\tt [Int]} to {\tt [Float]} when the list is + known to be empty. Also, a {\tt newtype} of a type {\tt T} has the same representation + at runtime as {\tt T}. + + Other uses of {\tt unsafeCoerce\#} are undefined. In particular, you should not use + {\tt unsafeCoerce\#} to cast a T to an algebraic data type D, unless T is also + an algebraic data type. For example, do not cast {\tt Int->Int} to {\tt Bool}, even if + you later cast that {\tt Bool} back to {\tt Int->Int} before applying it. The reasons + have to do with GHC's internal representation details (for the cognoscenti, data values + can be entered but function closures cannot). If you want a safe type to cast things + to, use {\tt Any}, which is not an algebraic data type. + + } + with can_fail = True + +-- NB. It is tempting to think that casting a value to a type that it doesn't have is safe +-- as long as you don't "do anything" with the value in its cast form, such as seq on it. This +-- isn't the case: the compiler can insert seqs itself, and if these happen at the wrong type, +-- Bad Things Might Happen. See bug #1616: in this case we cast a function of type (a,b) -> (a,b) +-- to () -> () and back again. The strictness analyser saw that the function was strict, but +-- the wrapper had type () -> (), and hence the wrapper de-constructed the (), the worker re-constructed +-- a new (), with the result that the code ended up with "case () of (a,b) -> ...". + +primop TraceEventOp "traceEvent#" GenPrimOp + Addr# -> State# s -> State# s + { Emits an event via the RTS tracing framework. The contents + of the event is the zero-terminated byte string passed as the first + argument. The event will be emitted either to the {\tt .eventlog} file, + or to stderr, depending on the runtime RTS flags. } + with + has_side_effects = True + out_of_line = True + +primop TraceEventBinaryOp "traceBinaryEvent#" GenPrimOp + Addr# -> Int# -> State# s -> State# s + { Emits an event via the RTS tracing framework. The contents + of the event is the binary object passed as the first argument with + the the given length passed as the second argument. The event will be + emitted to the {\tt .eventlog} file. } + with + has_side_effects = True + out_of_line = True + +primop TraceMarkerOp "traceMarker#" GenPrimOp + Addr# -> State# s -> State# s + { Emits a marker event via the RTS tracing framework. The contents + of the event is the zero-terminated byte string passed as the first + argument. The event will be emitted either to the {\tt .eventlog} file, + or to stderr, depending on the runtime RTS flags. } + with + has_side_effects = True + out_of_line = True + +primop SetThreadAllocationCounter "setThreadAllocationCounter#" GenPrimOp + INT64 -> State# RealWorld -> State# RealWorld + { Sets the allocation counter for the current thread to the given value. } + with + has_side_effects = True + out_of_line = True + +------------------------------------------------------------------------ +section "Safe coercions" +------------------------------------------------------------------------ + +pseudoop "coerce" + Coercible a b => a -> b + { The function {\tt coerce} allows you to safely convert between values of + types that have the same representation with no run-time overhead. In the + simplest case you can use it instead of a newtype constructor, to go from + the newtype's concrete type to the abstract type. But it also works in + more complicated settings, e.g. converting a list of newtypes to a list of + concrete types. + + This function is runtime-representation polymorphic, but the + {\tt RuntimeRep} type argument is marked as {\tt Inferred}, meaning + that it is not available for visible type application. This means + the typechecker will accept {\tt coerce @Int @Age 42}. + } + +------------------------------------------------------------------------ +section "SIMD Vectors" + {Operations on SIMD vectors.} +------------------------------------------------------------------------ + +#define ALL_VECTOR_TYPES \ + [<Int8,Int#,16>,<Int16,Int#,8>,<Int32,INT32,4>,<Int64,INT64,2> \ + ,<Int8,Int#,32>,<Int16,Int#,16>,<Int32,INT32,8>,<Int64,INT64,4> \ + ,<Int8,Int#,64>,<Int16,Int#,32>,<Int32,INT32,16>,<Int64,INT64,8> \ + ,<Word8,Word#,16>,<Word16,Word#,8>,<Word32,WORD32,4>,<Word64,WORD64,2> \ + ,<Word8,Word#,32>,<Word16,Word#,16>,<Word32,WORD32,8>,<Word64,WORD64,4> \ + ,<Word8,Word#,64>,<Word16,Word#,32>,<Word32,WORD32,16>,<Word64,WORD64,8> \ + ,<Float,Float#,4>,<Double,Double#,2> \ + ,<Float,Float#,8>,<Double,Double#,4> \ + ,<Float,Float#,16>,<Double,Double#,8>] + +#define SIGNED_VECTOR_TYPES \ + [<Int8,Int#,16>,<Int16,Int#,8>,<Int32,INT32,4>,<Int64,INT64,2> \ + ,<Int8,Int#,32>,<Int16,Int#,16>,<Int32,INT32,8>,<Int64,INT64,4> \ + ,<Int8,Int#,64>,<Int16,Int#,32>,<Int32,INT32,16>,<Int64,INT64,8> \ + ,<Float,Float#,4>,<Double,Double#,2> \ + ,<Float,Float#,8>,<Double,Double#,4> \ + ,<Float,Float#,16>,<Double,Double#,8>] + +#define FLOAT_VECTOR_TYPES \ + [<Float,Float#,4>,<Double,Double#,2> \ + ,<Float,Float#,8>,<Double,Double#,4> \ + ,<Float,Float#,16>,<Double,Double#,8>] + +#define INT_VECTOR_TYPES \ + [<Int8,Int#,16>,<Int16,Int#,8>,<Int32,INT32,4>,<Int64,INT64,2> \ + ,<Int8,Int#,32>,<Int16,Int#,16>,<Int32,INT32,8>,<Int64,INT64,4> \ + ,<Int8,Int#,64>,<Int16,Int#,32>,<Int32,INT32,16>,<Int64,INT64,8> \ + ,<Word8,Word#,16>,<Word16,Word#,8>,<Word32,WORD32,4>,<Word64,WORD64,2> \ + ,<Word8,Word#,32>,<Word16,Word#,16>,<Word32,WORD32,8>,<Word64,WORD64,4> \ + ,<Word8,Word#,64>,<Word16,Word#,32>,<Word32,WORD32,16>,<Word64,WORD64,8>] + +primtype VECTOR + with llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecBroadcastOp "broadcast#" GenPrimOp + SCALAR -> VECTOR + { Broadcast a scalar to all elements of a vector. } + with llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecPackOp "pack#" GenPrimOp + VECTUPLE -> VECTOR + { Pack the elements of an unboxed tuple into a vector. } + with llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecUnpackOp "unpack#" GenPrimOp + VECTOR -> VECTUPLE + { Unpack the elements of a vector into an unboxed tuple. #} + with llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecInsertOp "insert#" GenPrimOp + VECTOR -> SCALAR -> Int# -> VECTOR + { Insert a scalar at the given position in a vector. } + with can_fail = True + llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecAddOp "plus#" Dyadic + VECTOR -> VECTOR -> VECTOR + { Add two vectors element-wise. } + with commutable = True + llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecSubOp "minus#" Dyadic + VECTOR -> VECTOR -> VECTOR + { Subtract two vectors element-wise. } + with llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecMulOp "times#" Dyadic + VECTOR -> VECTOR -> VECTOR + { Multiply two vectors element-wise. } + with commutable = True + llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecDivOp "divide#" Dyadic + VECTOR -> VECTOR -> VECTOR + { Divide two vectors element-wise. } + with can_fail = True + llvm_only = True + vector = FLOAT_VECTOR_TYPES + +primop VecQuotOp "quot#" Dyadic + VECTOR -> VECTOR -> VECTOR + { Rounds towards zero element-wise. } + with can_fail = True + llvm_only = True + vector = INT_VECTOR_TYPES + +primop VecRemOp "rem#" Dyadic + VECTOR -> VECTOR -> VECTOR + { Satisfies \texttt{(quot\# x y) times\# y plus\# (rem\# x y) == x}. } + with can_fail = True + llvm_only = True + vector = INT_VECTOR_TYPES + +primop VecNegOp "negate#" Monadic + VECTOR -> VECTOR + { Negate element-wise. } + with llvm_only = True + vector = SIGNED_VECTOR_TYPES + +primop VecIndexByteArrayOp "indexArray#" GenPrimOp + ByteArray# -> Int# -> VECTOR + { Read a vector from specified index of immutable array. } + with can_fail = True + llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecReadByteArrayOp "readArray#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, VECTOR #) + { Read a vector from specified index of mutable array. } + with has_side_effects = True + can_fail = True + llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecWriteByteArrayOp "writeArray#" GenPrimOp + MutableByteArray# s -> Int# -> VECTOR -> State# s -> State# s + { Write a vector to specified index of mutable array. } + with has_side_effects = True + can_fail = True + llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecIndexOffAddrOp "indexOffAddr#" GenPrimOp + Addr# -> Int# -> VECTOR + { Reads vector; offset in bytes. } + with can_fail = True + llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecReadOffAddrOp "readOffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, VECTOR #) + { Reads vector; offset in bytes. } + with has_side_effects = True + can_fail = True + llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecWriteOffAddrOp "writeOffAddr#" GenPrimOp + Addr# -> Int# -> VECTOR -> State# s -> State# s + { Write vector; offset in bytes. } + with has_side_effects = True + can_fail = True + llvm_only = True + vector = ALL_VECTOR_TYPES + + +primop VecIndexScalarByteArrayOp "indexArrayAs#" GenPrimOp + ByteArray# -> Int# -> VECTOR + { Read a vector from specified index of immutable array of scalars; offset is in scalar elements. } + with can_fail = True + llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecReadScalarByteArrayOp "readArrayAs#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, VECTOR #) + { Read a vector from specified index of mutable array of scalars; offset is in scalar elements. } + with has_side_effects = True + can_fail = True + llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecWriteScalarByteArrayOp "writeArrayAs#" GenPrimOp + MutableByteArray# s -> Int# -> VECTOR -> State# s -> State# s + { Write a vector to specified index of mutable array of scalars; offset is in scalar elements. } + with has_side_effects = True + can_fail = True + llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecIndexScalarOffAddrOp "indexOffAddrAs#" GenPrimOp + Addr# -> Int# -> VECTOR + { Reads vector; offset in scalar elements. } + with can_fail = True + llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecReadScalarOffAddrOp "readOffAddrAs#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, VECTOR #) + { Reads vector; offset in scalar elements. } + with has_side_effects = True + can_fail = True + llvm_only = True + vector = ALL_VECTOR_TYPES + +primop VecWriteScalarOffAddrOp "writeOffAddrAs#" GenPrimOp + Addr# -> Int# -> VECTOR -> State# s -> State# s + { Write vector; offset in scalar elements. } + with has_side_effects = True + can_fail = True + llvm_only = True + vector = ALL_VECTOR_TYPES + +------------------------------------------------------------------------ + +section "Prefetch" + {Prefetch operations: Note how every prefetch operation has a name + with the pattern prefetch*N#, where N is either 0,1,2, or 3. + + This suffix number, N, is the "locality level" of the prefetch, following the + convention in GCC and other compilers. + Higher locality numbers correspond to the memory being loaded in more + levels of the cpu cache, and being retained after initial use. The naming + convention follows the naming convention of the prefetch intrinsic found + in the GCC and Clang C compilers. + + On the LLVM backend, prefetch*N# uses the LLVM prefetch intrinsic + with locality level N. The code generated by LLVM is target architecture + dependent, but should agree with the GHC NCG on x86 systems. + + On the Sparc and PPC native backends, prefetch*N is a No-Op. + + On the x86 NCG, N=0 will generate prefetchNTA, + N=1 generates prefetcht2, N=2 generates prefetcht1, and + N=3 generates prefetcht0. + + For streaming workloads, the prefetch*0 operations are recommended. + For workloads which do many reads or writes to a memory location in a short period of time, + prefetch*3 operations are recommended. + + For further reading about prefetch and associated systems performance optimization, + the instruction set and optimization manuals by Intel and other CPU vendors are + excellent starting place. + + + The "Intel 64 and IA-32 Architectures Optimization Reference Manual" is + especially a helpful read, even if your software is meant for other CPU + architectures or vendor hardware. The manual can be found at + http://www.intel.com/content/www/us/en/architecture-and-technology/64-ia-32-architectures-optimization-manual.html . + + The {\tt prefetch*} family of operations has the order of operations + determined by passing around the {\tt State#} token. + + To get a "pure" version of these operations, use {\tt inlinePerformIO} which is quite safe in this context. + + It is important to note that while the prefetch operations will never change the + answer to a pure computation, They CAN change the memory locations resident + in a CPU cache and that may change the performance and timing characteristics + of an application. The prefetch operations are marked has_side_effects=True + to reflect that these operations have side effects with respect to the runtime + performance characteristics of the resulting code. Additionally, if the prefetchValue + operations did not have this attribute, GHC does a float out transformation that + results in a let/app violation, at least with the current design. + } + + + +------------------------------------------------------------------------ + + +--- the Int# argument for prefetch is the byte offset on the byteArray or Addr# + +--- +primop PrefetchByteArrayOp3 "prefetchByteArray3#" GenPrimOp + ByteArray# -> Int# -> State# s -> State# s + with has_side_effects = True + +primop PrefetchMutableByteArrayOp3 "prefetchMutableByteArray3#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> State# s + with has_side_effects = True + +primop PrefetchAddrOp3 "prefetchAddr3#" GenPrimOp + Addr# -> Int# -> State# s -> State# s + with has_side_effects = True + +primop PrefetchValueOp3 "prefetchValue3#" GenPrimOp + a -> State# s -> State# s + with strictness = { \ _arity -> mkClosedStrictSig [botDmd, topDmd] topDiv } + has_side_effects = True +---- + +primop PrefetchByteArrayOp2 "prefetchByteArray2#" GenPrimOp + ByteArray# -> Int# -> State# s -> State# s + with has_side_effects = True + +primop PrefetchMutableByteArrayOp2 "prefetchMutableByteArray2#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> State# s + with has_side_effects = True + +primop PrefetchAddrOp2 "prefetchAddr2#" GenPrimOp + Addr# -> Int# -> State# s -> State# s + with has_side_effects = True + +primop PrefetchValueOp2 "prefetchValue2#" GenPrimOp + a -> State# s -> State# s + with strictness = { \ _arity -> mkClosedStrictSig [botDmd, topDmd] topDiv } + has_side_effects = True +---- + +primop PrefetchByteArrayOp1 "prefetchByteArray1#" GenPrimOp + ByteArray# -> Int# -> State# s -> State# s + with has_side_effects = True + +primop PrefetchMutableByteArrayOp1 "prefetchMutableByteArray1#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> State# s + with has_side_effects = True + +primop PrefetchAddrOp1 "prefetchAddr1#" GenPrimOp + Addr# -> Int# -> State# s -> State# s + with has_side_effects = True + +primop PrefetchValueOp1 "prefetchValue1#" GenPrimOp + a -> State# s -> State# s + with strictness = { \ _arity -> mkClosedStrictSig [botDmd, topDmd] topDiv } + has_side_effects = True +---- + +primop PrefetchByteArrayOp0 "prefetchByteArray0#" GenPrimOp + ByteArray# -> Int# -> State# s -> State# s + with has_side_effects = True + +primop PrefetchMutableByteArrayOp0 "prefetchMutableByteArray0#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> State# s + with has_side_effects = True + +primop PrefetchAddrOp0 "prefetchAddr0#" GenPrimOp + Addr# -> Int# -> State# s -> State# s + with has_side_effects = True + +primop PrefetchValueOp0 "prefetchValue0#" GenPrimOp + a -> State# s -> State# s + with strictness = { \ _arity -> mkClosedStrictSig [botDmd, topDmd] topDiv } + has_side_effects = True + +------------------------------------------------------------------------ +--- --- +------------------------------------------------------------------------ + +thats_all_folks |