ghc-lib 9.6.3.20231121 → 9.6.4.20240109
raw patch · 27 files changed
+2024/−1575 lines, 27 filesdep ~ghc-lib-parserdep ~hpcPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: ghc-lib-parser, hpc
API changes (from Hackage documentation)
- GHC.CmmToAsm.AArch64.Cond: NEVER :: Cond
- GHC.Iface.Ext.Ast: instance GHC.Iface.Ext.Ast.ToHie Data.Void.Void
+ GHC.CmmToAsm.AArch64.CodeGen: makeFarBranches :: Platform -> LabelMap RawCmmStatics -> [NatBasicBlock Instr] -> UniqSM [NatBasicBlock Instr]
+ GHC.CmmToAsm.AArch64.Instr: instance GHC.Classes.Eq GHC.CmmToAsm.AArch64.Instr.Target
+ GHC.CmmToAsm.AArch64.Instr: instance GHC.Classes.Ord GHC.CmmToAsm.AArch64.Instr.Target
+ GHC.CmmToAsm.AArch64.Ppr: pprBasicBlock :: IsDoc doc => NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr -> doc
+ GHC.Iface.Ext.Ast: instance GHC.Iface.Ext.Ast.ToHie GHC.Base.Void
- GHC: class NamedThing a
+ GHC: class () => NamedThing a
- GHC: data AnnKeywordId
+ GHC: data () => AnnKeywordId
- GHC: data Backend
+ GHC: data () => Backend
- GHC: data BreakInfo
+ GHC: data () => BreakInfo
- GHC: data Class
+ GHC: data () => Class
- GHC: data ClsInst
+ GHC: data () => ClsInst
- GHC: data DataCon
+ GHC: data () => DataCon
- GHC: data DynFlags
+ GHC: data () => DynFlags
- GHC: data EpaComment
+ GHC: data () => EpaComment
- GHC: data ExecOptions
+ GHC: data () => ExecOptions
- GHC: data ExecResult
+ GHC: data () => ExecResult
- GHC: data FamInst
+ GHC: data () => FamInst
- GHC: data FixityDirection
+ GHC: data () => FixityDirection
- GHC: data GenLocated l e
+ GHC: data () => GenLocated l e
- GHC: data GeneralFlag
+ GHC: data () => GeneralFlag
- GHC: data Ghc a
+ GHC: data () => Ghc a
- GHC: data GhcException
+ GHC: data () => GhcException
- GHC: data GhcLink
+ GHC: data () => GhcLink
- GHC: data GhcMode
+ GHC: data () => GhcMode
- GHC: data GhcT (m :: Type -> Type) a
+ GHC: data () => GhcT (m :: Type -> Type) a
- GHC: data HValue
+ GHC: data () => HValue
- GHC: data History
+ GHC: data () => History
- GHC: data HscEnv
+ GHC: data () => HscEnv
- GHC: data InteractiveImport
+ GHC: data () => InteractiveImport
- GHC: data LexicalFixity
+ GHC: data () => LexicalFixity
- GHC: data Logger
+ GHC: data () => Logger
- GHC: data ModBreaks
+ GHC: data () => ModBreaks
- GHC: data ModIface_ (phase :: ModIfacePhase)
+ GHC: data () => ModIface_ (phase :: ModIfacePhase)
- GHC: data ModLocation
+ GHC: data () => ModLocation
- GHC: data ModSummary
+ GHC: data () => ModSummary
- GHC: data ModuleGraph
+ GHC: data () => ModuleGraph
- GHC: data Name
+ GHC: data () => Name
- GHC: data NamePprCtx
+ GHC: data () => NamePprCtx
- GHC: data Phase
+ GHC: data () => Phase
- GHC: data PkgQual
+ GHC: data () => PkgQual
- GHC: data RdrName
+ GHC: data () => RdrName
- GHC: data RealSrcLoc
+ GHC: data () => RealSrcLoc
- GHC: data RealSrcSpan
+ GHC: data () => RealSrcSpan
- GHC: data Resume
+ GHC: data () => Resume
- GHC: data SafeHaskellMode
+ GHC: data () => SafeHaskellMode
- GHC: data Severity
+ GHC: data () => Severity
- GHC: data SingleStep
+ GHC: data () => SingleStep
- GHC: data SrcLoc
+ GHC: data () => SrcLoc
- GHC: data SrcSpan
+ GHC: data () => SrcSpan
- GHC: data StrictnessMark
+ GHC: data () => StrictnessMark
- GHC: data SuccessFlag
+ GHC: data () => SuccessFlag
- GHC: data Target
+ GHC: data () => Target
- GHC: data TargetId
+ GHC: data () => TargetId
- GHC: data Token
+ GHC: data () => Token
- GHC: data TyCon
+ GHC: data () => TyCon
- GHC: data TyThing
+ GHC: data () => TyThing
- GHC: data Type
+ GHC: data () => Type
- GHC.Builtin.Types.Literals: data BuiltInSynFamily
+ GHC.Builtin.Types.Literals: data () => BuiltInSynFamily
- GHC.ByteCode.Asm: data SizedSeq a
+ GHC.ByteCode.Asm: data () => SizedSeq a
- GHC.Cmm.Dataflow: data Block (n :: Extensibility -> Extensibility -> Type) (e :: Extensibility) (x :: Extensibility)
+ GHC.Cmm.Dataflow: data () => Block (n :: Extensibility -> Extensibility -> Type) (e :: Extensibility) (x :: Extensibility)
- GHC.CmmToAsm: NcgImpl :: !NCGConfig -> (RawCmmDecl -> NatM [NatCmmDecl statics instr]) -> (instr -> Maybe (NatCmmDecl statics instr)) -> (jumpDest -> Maybe BlockId) -> (instr -> Maybe jumpDest) -> ((BlockId -> Maybe jumpDest) -> statics -> statics) -> ((BlockId -> Maybe jumpDest) -> instr -> instr) -> (NatCmmDecl statics instr -> SDoc) -> (NatCmmDecl statics instr -> HDoc) -> Int -> [RealReg] -> (Int -> NatCmmDecl statics instr -> UniqSM (NatCmmDecl statics instr, [(BlockId, BlockId)])) -> (LabelMap RawCmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr]) -> ([instr] -> [UnwindPoint]) -> (Maybe CFG -> LabelMap RawCmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr]) -> NcgImpl statics instr jumpDest
+ GHC.CmmToAsm: NcgImpl :: !NCGConfig -> (RawCmmDecl -> NatM [NatCmmDecl statics instr]) -> (instr -> Maybe (NatCmmDecl statics instr)) -> (jumpDest -> Maybe BlockId) -> (instr -> Maybe jumpDest) -> ((BlockId -> Maybe jumpDest) -> statics -> statics) -> ((BlockId -> Maybe jumpDest) -> instr -> instr) -> (NatCmmDecl statics instr -> SDoc) -> (NatCmmDecl statics instr -> HDoc) -> Int -> [RealReg] -> (Int -> NatCmmDecl statics instr -> UniqSM (NatCmmDecl statics instr, [(BlockId, BlockId)])) -> (Platform -> LabelMap RawCmmStatics -> [NatBasicBlock instr] -> UniqSM [NatBasicBlock instr]) -> ([instr] -> [UnwindPoint]) -> (Maybe CFG -> LabelMap RawCmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr]) -> NcgImpl statics instr jumpDest
- GHC.CmmToAsm: [ncgMakeFarBranches] :: NcgImpl statics instr jumpDest -> LabelMap RawCmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr]
+ GHC.CmmToAsm: [ncgMakeFarBranches] :: NcgImpl statics instr jumpDest -> Platform -> LabelMap RawCmmStatics -> [NatBasicBlock instr] -> UniqSM [NatBasicBlock instr]
- GHC.CmmToAsm.BlockLayout: sequenceTop :: Instruction instr => NcgImpl statics instr jumpDest -> Maybe CFG -> NatCmmDecl statics instr -> NatCmmDecl statics instr
+ GHC.CmmToAsm.BlockLayout: sequenceTop :: Instruction instr => NcgImpl statics instr jumpDest -> Maybe CFG -> NatCmmDecl statics instr -> UniqSM (NatCmmDecl statics instr)
- GHC.CmmToAsm.Monad: NcgImpl :: !NCGConfig -> (RawCmmDecl -> NatM [NatCmmDecl statics instr]) -> (instr -> Maybe (NatCmmDecl statics instr)) -> (jumpDest -> Maybe BlockId) -> (instr -> Maybe jumpDest) -> ((BlockId -> Maybe jumpDest) -> statics -> statics) -> ((BlockId -> Maybe jumpDest) -> instr -> instr) -> (NatCmmDecl statics instr -> SDoc) -> (NatCmmDecl statics instr -> HDoc) -> Int -> [RealReg] -> (Int -> NatCmmDecl statics instr -> UniqSM (NatCmmDecl statics instr, [(BlockId, BlockId)])) -> (LabelMap RawCmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr]) -> ([instr] -> [UnwindPoint]) -> (Maybe CFG -> LabelMap RawCmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr]) -> NcgImpl statics instr jumpDest
+ GHC.CmmToAsm.Monad: NcgImpl :: !NCGConfig -> (RawCmmDecl -> NatM [NatCmmDecl statics instr]) -> (instr -> Maybe (NatCmmDecl statics instr)) -> (jumpDest -> Maybe BlockId) -> (instr -> Maybe jumpDest) -> ((BlockId -> Maybe jumpDest) -> statics -> statics) -> ((BlockId -> Maybe jumpDest) -> instr -> instr) -> (NatCmmDecl statics instr -> SDoc) -> (NatCmmDecl statics instr -> HDoc) -> Int -> [RealReg] -> (Int -> NatCmmDecl statics instr -> UniqSM (NatCmmDecl statics instr, [(BlockId, BlockId)])) -> (Platform -> LabelMap RawCmmStatics -> [NatBasicBlock instr] -> UniqSM [NatBasicBlock instr]) -> ([instr] -> [UnwindPoint]) -> (Maybe CFG -> LabelMap RawCmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr]) -> NcgImpl statics instr jumpDest
- GHC.CmmToAsm.Monad: [ncgMakeFarBranches] :: NcgImpl statics instr jumpDest -> LabelMap RawCmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr]
+ GHC.CmmToAsm.Monad: [ncgMakeFarBranches] :: NcgImpl statics instr jumpDest -> Platform -> LabelMap RawCmmStatics -> [NatBasicBlock instr] -> UniqSM [NatBasicBlock instr]
- GHC.CmmToAsm.PPC.Instr: makeFarBranches :: LabelMap RawCmmStatics -> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
+ GHC.CmmToAsm.PPC.Instr: makeFarBranches :: Platform -> LabelMap RawCmmStatics -> [NatBasicBlock Instr] -> UniqSM [NatBasicBlock Instr]
- GHC.CmmToAsm.Types: data GenBasicBlock i
+ GHC.CmmToAsm.Types: data () => GenBasicBlock i
- GHC.CmmToAsm.Types: newtype ListGraph i
+ GHC.CmmToAsm.Types: newtype () => ListGraph i
- GHC.CmmToLlvm: data LlvmVersion
+ GHC.CmmToLlvm: data () => LlvmVersion
- GHC.Core.Opt.SpecConstr: data SpecConstrAnnotation
+ GHC.Core.Opt.SpecConstr: data () => SpecConstrAnnotation
- GHC.Driver.Config.Finder: data FinderOpts
+ GHC.Driver.Config.Finder: data () => FinderOpts
- GHC.Driver.Main: data HscBackendAction
+ GHC.Driver.Main: data () => HscBackendAction
- GHC.Driver.Main: data HscRecompStatus
+ GHC.Driver.Main: data () => HscRecompStatus
- GHC.Driver.Make: data IsBootInterface
+ GHC.Driver.Make: data () => IsBootInterface
- GHC.Driver.Make: data ModNodeKeyWithUid
+ GHC.Driver.Make: data () => ModNodeKeyWithUid
- GHC.Driver.Pipeline: class MonadUse (f :: Type -> Type) (m :: Type -> Type)
+ GHC.Driver.Pipeline: class () => MonadUse (f :: Type -> Type) (m :: Type -> Type)
- GHC.Driver.Pipeline: data PipeEnv
+ GHC.Driver.Pipeline: data () => PipeEnv
- GHC.Driver.Pipeline: data TPhase res
+ GHC.Driver.Pipeline: data () => TPhase res
- GHC.HsToCore.Monad: data UniqSupply
+ GHC.HsToCore.Monad: data () => UniqSupply
- GHC.HsToCore.Pmc.Solver: data Nabla
+ GHC.HsToCore.Pmc.Solver: data () => Nabla
- GHC.HsToCore.Pmc.Solver: newtype Nablas
+ GHC.HsToCore.Pmc.Solver: newtype () => Nablas
- GHC.Linker.Loader: data LoaderState
+ GHC.Linker.Loader: data () => LoaderState
- GHC.Linker.Loader: newtype Loader
+ GHC.Linker.Loader: newtype () => Loader
- GHC.Plugins: class HasOccName name
+ GHC.Plugins: class () => HasOccName name
- GHC.Plugins: class NamedThing a
+ GHC.Plugins: class () => NamedThing a
- GHC.Plugins: class Uniquable a
+ GHC.Plugins: class () => Uniquable a
- GHC.Plugins: data BuiltInSyntax
+ GHC.Plugins: data () => BuiltInSyntax
- GHC.Plugins: data CoSel
+ GHC.Plugins: data () => CoSel
- GHC.Plugins: data Coercion
+ GHC.Plugins: data () => Coercion
- GHC.Plugins: data CoercionHole
+ GHC.Plugins: data () => CoercionHole
- GHC.Plugins: data ForAllTyFlag
+ GHC.Plugins: data () => ForAllTyFlag
- GHC.Plugins: data FunSel
+ GHC.Plugins: data () => FunSel
- GHC.Plugins: data FunTyFlag
+ GHC.Plugins: data () => FunTyFlag
- GHC.Plugins: data HsParsedModule
+ GHC.Plugins: data () => HsParsedModule
- GHC.Plugins: data InScopeSet
+ GHC.Plugins: data () => InScopeSet
- GHC.Plugins: data LeftOrRight
+ GHC.Plugins: data () => LeftOrRight
- GHC.Plugins: data LiftingContext
+ GHC.Plugins: data () => LiftingContext
- GHC.Plugins: data MCoercion
+ GHC.Plugins: data () => MCoercion
- GHC.Plugins: data Messages e
+ GHC.Plugins: data () => Messages e
- GHC.Plugins: data Name
+ GHC.Plugins: data () => Name
- GHC.Plugins: data NameSpace
+ GHC.Plugins: data () => NameSpace
- GHC.Plugins: data NormaliseStepResult ev
+ GHC.Plugins: data () => NormaliseStepResult ev
- GHC.Plugins: data OccEnv a
+ GHC.Plugins: data () => OccEnv a
- GHC.Plugins: data OccName
+ GHC.Plugins: data () => OccName
- GHC.Plugins: data PiTyBinder
+ GHC.Plugins: data () => PiTyBinder
- GHC.Plugins: data Role
+ GHC.Plugins: data () => Role
- GHC.Plugins: data Scaled a
+ GHC.Plugins: data () => Scaled a
- GHC.Plugins: data Specificity
+ GHC.Plugins: data () => Specificity
- GHC.Plugins: data Subst
+ GHC.Plugins: data () => Subst
- GHC.Plugins: data TyCoFolder env a
+ GHC.Plugins: data () => TyCoFolder env a
- GHC.Plugins: data TyCoMapper env (m :: Type -> Type)
+ GHC.Plugins: data () => TyCoMapper env (m :: Type -> Type)
- GHC.Plugins: data Type
+ GHC.Plugins: data () => Type
- GHC.Plugins: data Unique
+ GHC.Plugins: data () => Unique
- GHC.Plugins: data UnivCoProvenance
+ GHC.Plugins: data () => UnivCoProvenance
- GHC.Plugins: data Var
+ GHC.Plugins: data () => Var
- GHC.Plugins: infixl 1 `asJoinId`
+ GHC.Plugins: infixl 1 `setIdOneShotInfo`
- GHC.Plugins: infixr 3 `mkFunTy`
+ GHC.Plugins: infixr 3 `mkVisFunTyMany`
- GHC.Rename.Expr: data UnexpectedStatement
+ GHC.Rename.Expr: data () => UnexpectedStatement
- GHC.Runtime.Eval: data ExecOptions
+ GHC.Runtime.Eval: data () => ExecOptions
- GHC.Runtime.Eval: data ExecResult
+ GHC.Runtime.Eval: data () => ExecResult
- GHC.Runtime.Eval: data History
+ GHC.Runtime.Eval: data () => History
- GHC.Runtime.Eval: data Resume
+ GHC.Runtime.Eval: data () => Resume
- GHC.Runtime.Eval: data SingleStep
+ GHC.Runtime.Eval: data () => SingleStep
- GHC.StgToByteCode: data UnlinkedBCO
+ GHC.StgToByteCode: data () => UnlinkedBCO
- GHC.StgToCmm.Closure: data LambdaFormInfo
+ GHC.StgToCmm.Closure: data () => LambdaFormInfo
- GHC.StgToCmm.Closure: data StandardFormInfo
+ GHC.StgToCmm.Closure: data () => StandardFormInfo
- GHC.StgToCmm.Monad: data StgToCmmConfig
+ GHC.StgToCmm.Monad: data () => StgToCmmConfig
- GHC.SysTools: data Option
+ GHC.SysTools: data () => Option
- GHC.Tc.Errors.Hole: data HoleFitDispConfig
+ GHC.Tc.Errors.Hole: data () => HoleFitDispConfig
- GHC.Tc.Errors.Hole: data HoleFitPlugin
+ GHC.Tc.Errors.Hole: data () => HoleFitPlugin
- GHC.Tc.Errors.Hole: data HoleFitPluginR
+ GHC.Tc.Errors.Hole: data () => HoleFitPluginR
- GHC.Tc.Gen.Expr: data SyntaxOpType
+ GHC.Tc.Gen.Expr: data () => SyntaxOpType
- GHC.Tc.Gen.HsType: data DataSort
+ GHC.Tc.Gen.HsType: data () => DataSort
- GHC.Tc.Gen.HsType: data UserTypeCtxt
+ GHC.Tc.Gen.HsType: data () => UserTypeCtxt
- GHC.Tc.Gen.Sig: data TcIdSigInfo
+ GHC.Tc.Gen.Sig: data () => TcIdSigInfo
- GHC.Tc.Gen.Sig: data TcIdSigInst
+ GHC.Tc.Gen.Sig: data () => TcIdSigInst
- GHC.Tc.Gen.Sig: data TcPatSynInfo
+ GHC.Tc.Gen.Sig: data () => TcPatSynInfo
- GHC.Tc.Gen.Sig: data TcSigInfo
+ GHC.Tc.Gen.Sig: data () => TcSigInfo
- GHC.Tc.Solver.Monad: data QCInst
+ GHC.Tc.Solver.Monad: data () => QCInst
- GHC.Tc.Solver.Monad: data TcLevel
+ GHC.Tc.Solver.Monad: data () => TcLevel
- GHC.Tc.Utils.Env: data TcTyThing
+ GHC.Tc.Utils.Env: data () => TcTyThing
- GHC.Tc.Utils.Env: data TyThing
+ GHC.Tc.Utils.Env: data () => TyThing
- GHC.Tc.Utils.TcMType: data ExpType
+ GHC.Tc.Utils.TcMType: data () => ExpType
- GHC.Tc.Validity: data Rank
+ GHC.Tc.Validity: data () => Rank
- GHC.Tc.Validity: data UserTypeCtxt
+ GHC.Tc.Validity: data () => UserTypeCtxt
- GHC.Types.Name.Shape: data NameShape
+ GHC.Types.Name.Shape: data () => NameShape
- GHC.Unit.Finder: NotFound :: [FilePath] -> Maybe Unit -> [Unit] -> [Unit] -> [(Unit, UnusableUnitReason)] -> [ModuleSuggestion] -> FindResult
+ GHC.Unit.Finder: NotFound :: [FilePath] -> Maybe Unit -> [Unit] -> [Unit] -> [UnusableUnit] -> [ModuleSuggestion] -> FindResult
- GHC.Unit.Finder: [fr_unusables] :: FindResult -> [(Unit, UnusableUnitReason)]
+ GHC.Unit.Finder: [fr_unusables] :: FindResult -> [UnusableUnit]
- GHC.Unit.Finder: data FindResult
+ GHC.Unit.Finder: data () => FindResult
- GHC.Unit.Finder: data FinderCache
+ GHC.Unit.Finder: data () => FinderCache
- GHC.Unit.Finder: data FinderOpts
+ GHC.Unit.Finder: data () => FinderOpts
- GHC.Unit.Finder: data InstalledFindResult
+ GHC.Unit.Finder: data () => InstalledFindResult
Files
- compiler/GHC/CmmToAsm.hs +12/−10
- compiler/GHC/CmmToAsm/AArch64.hs +2/−2
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs +193/−7
- compiler/GHC/CmmToAsm/AArch64/Cond.hs +8/−2
- compiler/GHC/CmmToAsm/AArch64/Instr.hs +1/−0
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs +6/−3
- compiler/GHC/CmmToAsm/BlockLayout.hs +23/−19
- compiler/GHC/CmmToAsm/Monad.hs +3/−2
- compiler/GHC/CmmToAsm/PPC/Instr.hs +6/−5
- compiler/GHC/CmmToAsm/Ppr.hs +3/−2
- compiler/GHC/CmmToAsm/X86.hs +1/−1
- compiler/GHC/CmmToLlvm/Data.hs +1/−0
- compiler/GHC/Core/Opt/CprAnal.hs +40/−4
- compiler/GHC/Driver/Make.hs +27/−23
- compiler/GHC/Iface/Errors.hs +4/−3
- compiler/GHC/Linker/Dynamic.hs +9/−2
- compiler/GHC/Settings/IO.hs +2/−0
- compiler/GHC/Stg/Debug.hs +20/−16
- compiler/GHC/StgToCmm/Bind.hs +12/−3
- compiler/GHC/StgToCmm/CgUtils.hs +7/−4
- compiler/GHC/StgToJS/Linker/Utils.hs +4/−0
- compiler/GHC/StgToJS/Prim.hs +1521/−1443
- compiler/GHC/Tc/Gen/HsType.hs +110/−13
- compiler/GHC/Unit/Finder.hs +1/−1
- ghc-lib.cabal +3/−3
- ghc-lib/stage0/lib/settings +2/−1
- ghc-lib/stage0/rts/build/include/GhclibDerivedConstants.h +3/−6
compiler/GHC/CmmToAsm.hs view
@@ -127,6 +127,7 @@ import GHC.Utils.BufHandle import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic+import GHC.Utils.Panic.Plain import GHC.Utils.Error import GHC.Utils.Exception (evaluate) import GHC.Utils.Constants (debugIsOn)@@ -655,14 +656,15 @@ text "cfg not in lockstep") () ---- sequence blocks- let sequenced :: [NatCmmDecl statics instr]- sequenced =- checkLayout shorted $- {-# SCC "sequenceBlocks" #-}- map (BlockLayout.sequenceTop- ncgImpl optimizedCFG)- shorted+ -- sequenced :: [NatCmmDecl statics instr]+ let (sequenced, us_seq) =+ {-# SCC "sequenceBlocks" #-}+ initUs usAlloc $ mapM (BlockLayout.sequenceTop+ ncgImpl optimizedCFG)+ shorted + massert (checkLayout shorted sequenced)+ let branchOpt :: [NatCmmDecl statics instr] branchOpt = {-# SCC "invertCondBranches" #-}@@ -684,7 +686,7 @@ addUnwind acc proc = acc `mapUnion` computeUnwinding config ncgImpl proc - return ( usAlloc+ return ( us_seq , fileIds' , branchOpt , lastMinuteImports ++ imports@@ -704,10 +706,10 @@ -- | Make sure all blocks we want the layout algorithm to place have been placed. checkLayout :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr]- -> [NatCmmDecl statics instr]+ -> Bool checkLayout procsUnsequenced procsSequenced = assertPpr (setNull diff) (text "Block sequencing dropped blocks:" <> ppr diff)- procsSequenced+ True where blocks1 = foldl' (setUnion) setEmpty $ map getBlockIds procsUnsequenced :: LabelSet
compiler/GHC/CmmToAsm/AArch64.hs view
@@ -34,9 +34,9 @@ ,maxSpillSlots = AArch64.maxSpillSlots config ,allocatableRegs = AArch64.allocatableRegs platform ,ncgAllocMoreStack = AArch64.allocMoreStack platform- ,ncgMakeFarBranches = const id+ ,ncgMakeFarBranches = AArch64.makeFarBranches ,extractUnwindPoints = const []- ,invertCondBranches = \_ _ -> id+ ,invertCondBranches = \_ _ blocks -> blocks } where platform = ncgPlatform config
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs view
@@ -6,6 +6,7 @@ module GHC.CmmToAsm.AArch64.CodeGen ( cmmTopCodeGen , generateJumpTableForInstr+ , makeFarBranches ) where@@ -42,9 +43,11 @@ import GHC.Cmm.Switch import GHC.Cmm.CLabel import GHC.Cmm.Dataflow.Block+import GHC.Cmm.Dataflow.Label import GHC.Cmm.Dataflow.Graph import GHC.Types.Tickish ( GenTickish(..) ) import GHC.Types.SrcLoc ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )+import GHC.Types.Unique.Supply -- The rest: import GHC.Data.OrdList@@ -59,8 +62,12 @@ import GHC.Data.FastString import GHC.Utils.Misc import GHC.Utils.Panic+import GHC.Utils.Panic.Plain import GHC.Utils.Constants (debugIsOn)+import GHC.Utils.Monad (mapAccumLM) +import GHC.Cmm.Dataflow.Collections+ -- Note [General layout of an NCG] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- @cmmTopCodeGen@ will be our main entry point to code gen. Here we'll get@@ -160,15 +167,17 @@ let (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs - mkBlocks (NEWBLOCK id) (instrs,blocks,statics)- = ([], BasicBlock id instrs : blocks, statics)- mkBlocks (LDATA sec dat) (instrs,blocks,statics)- = (instrs, blocks, CmmData sec dat:statics)- mkBlocks instr (instrs,blocks,statics)- = (instr:instrs, blocks, statics) return (BasicBlock id top : other_blocks, statics) -+mkBlocks :: Instr+ -> ([Instr], [GenBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])+ -> ([Instr], [GenBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])+mkBlocks (NEWBLOCK id) (instrs,blocks,statics)+ = ([], BasicBlock id instrs : blocks, statics)+mkBlocks (LDATA sec dat) (instrs,blocks,statics)+ = (instrs, blocks, CmmData sec dat:statics)+mkBlocks instr (instrs,blocks,statics)+ = (instr:instrs, blocks, statics) -- ----------------------------------------------------------------------------- -- | Utilities ann :: SDoc -> Instr -> Instr@@ -1183,6 +1192,7 @@ -- ----------------------------------------------------------------------------- -- Jumps+ genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock genJump expr@(CmmLit (CmmLabel lbl)) = return $ unitOL (annExpr expr (J (TLabel lbl)))@@ -1268,7 +1278,23 @@ _ -> pprPanic "AArch64.genCondJump:case mop: " (text $ show expr) _ -> pprPanic "AArch64.genCondJump: " (text $ show expr) +-- A conditional jump with at least +/-128M jump range+genCondFarJump :: MonadUnique m => Cond -> Target -> m InstrBlock+genCondFarJump cond far_target = do+ skip_lbl_id <- newBlockId+ jmp_lbl_id <- newBlockId + -- TODO: We can improve this by inverting the condition+ -- but it's not quite trivial since we don't know if we+ -- need to consider float orderings.+ -- So we take the hit of the additional jump in the false+ -- case for now.+ return $ toOL [ BCOND cond (TBlock jmp_lbl_id)+ , B (TBlock skip_lbl_id)+ , NEWBLOCK jmp_lbl_id+ , B far_target+ , NEWBLOCK skip_lbl_id]+ genCondBranch :: BlockId -- the source of the jump -> BlockId -- the true branch target@@ -1783,3 +1809,163 @@ let dst = getRegisterReg platform (CmmLocal dest_reg) let code = code_fx `appOL` op (OpReg w dst) (OpReg w reg_fx) return (code, Nothing)++{- Note [AArch64 far jumps]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+AArch conditional jump instructions can only encode an offset of +/-1MB+which is usually enough but can be exceeded in edge cases. In these cases+we will replace:++ b.cond <cond> foo++with the sequence:++ b.cond <cond> <lbl_true>+ b <lbl_false>+ <lbl_true>:+ b foo+ <lbl_false>:++Note the encoding of the `b` instruction still limits jumps to++/-128M offsets, but that seems like an acceptable limitation.++Since AArch64 instructions are all of equal length we can reasonably estimate jumps+in range by counting the instructions between a jump and its target label.++We make some simplifications in the name of performance which can result in overestimating+jump <-> label offsets:++* To avoid having to recalculate the label offsets once we replaced a jump we simply+ assume all jumps will be expanded to a three instruction far jump sequence.+* For labels associated with a info table we assume the info table is 64byte large.+ Most info tables are smaller than that but it means we don't have to distinguish+ between multiple types of info tables.++In terms of implementation we walk the instruction stream at least once calculating+label offsets, and if we determine during this that the functions body is big enough+to potentially contain out of range jumps we walk the instructions a second time, replacing+out of range jumps with the sequence of instructions described above.++-}++-- See Note [AArch64 far jumps]+data BlockInRange = InRange | NotInRange Target++-- See Note [AArch64 far jumps]+makeFarBranches :: Platform -> LabelMap RawCmmStatics -> [NatBasicBlock Instr]+ -> UniqSM [NatBasicBlock Instr]+makeFarBranches {- only used when debugging -} _platform statics basic_blocks = do+ -- All offsets/positions are counted in multiples of 4 bytes (the size of AArch64 instructions)+ -- That is an offset of 1 represents a 4-byte/one instruction offset.+ let (func_size, lblMap) = foldl' calc_lbl_positions (0, mapEmpty) basic_blocks+ if func_size < max_jump_dist+ then pure basic_blocks+ else do+ (_,blocks) <- mapAccumLM (replace_blk lblMap) 0 basic_blocks+ pure $ concat blocks+ -- pprTrace "lblMap" (ppr lblMap) $ basic_blocks++ where+ -- 2^18, 19 bit immediate with one bit is reserved for the sign+ max_jump_dist = 2^(18::Int) - 1 :: Int+ -- Currently all inline info tables fit into 64 bytes.+ max_info_size = 16 :: Int+ long_bc_jump_size = 3 :: Int+ long_bz_jump_size = 4 :: Int++ -- Replace out of range conditional jumps with unconditional jumps.+ replace_blk :: LabelMap Int -> Int -> GenBasicBlock Instr -> UniqSM (Int, [GenBasicBlock Instr])+ replace_blk !m !pos (BasicBlock lbl instrs) = do+ -- Account for a potential info table before the label.+ let !block_pos = pos + infoTblSize_maybe lbl+ (!pos', instrs') <- mapAccumLM (replace_jump m) block_pos instrs+ let instrs'' = concat instrs'+ -- We might have introduced new labels, so split the instructions into basic blocks again if neccesary.+ let (top, split_blocks, no_data) = foldr mkBlocks ([],[],[]) instrs''+ -- There should be no data in the instruction stream at this point+ massert (null no_data)++ let final_blocks = BasicBlock lbl top : split_blocks+ pure (pos', final_blocks)++ replace_jump :: LabelMap Int -> Int -> Instr -> UniqSM (Int, [Instr])+ replace_jump !m !pos instr = do+ case instr of+ ANN ann instr -> do+ (idx,instr':instrs') <- replace_jump m pos instr+ pure (idx, ANN ann instr':instrs')+ BCOND cond t+ -> case target_in_range m t pos of+ InRange -> pure (pos+long_bc_jump_size,[instr])+ NotInRange far_target -> do+ jmp_code <- genCondFarJump cond far_target+ pure (pos+long_bc_jump_size, fromOL jmp_code)+ CBZ op t -> long_zero_jump op t EQ+ CBNZ op t -> long_zero_jump op t NE+ instr+ | isMetaInstr instr -> pure (pos,[instr])+ | otherwise -> pure (pos+1, [instr])++ where+ -- cmp_op: EQ = CBZ, NEQ = CBNZ+ long_zero_jump op t cmp_op =+ case target_in_range m t pos of+ InRange -> pure (pos+long_bz_jump_size,[instr])+ NotInRange far_target -> do+ jmp_code <- genCondFarJump cmp_op far_target+ -- TODO: Fix zero reg so we can use it here+ pure (pos + long_bz_jump_size, CMP op (OpImm (ImmInt 0)) : fromOL jmp_code)+++ target_in_range :: LabelMap Int -> Target -> Int -> BlockInRange+ target_in_range m target src =+ case target of+ (TReg{}) -> InRange+ (TBlock bid) -> block_in_range m src bid+ (TLabel clbl)+ | Just bid <- maybeLocalBlockLabel clbl+ -> block_in_range m src bid+ | otherwise+ -- Maybe we should be pessimistic here, for now just fixing intra proc jumps+ -> InRange++ block_in_range :: LabelMap Int -> Int -> BlockId -> BlockInRange+ block_in_range m src_pos dest_lbl =+ case mapLookup dest_lbl m of+ Nothing ->+ pprTrace "not in range" (ppr dest_lbl) $+ NotInRange (TBlock dest_lbl)+ Just dest_pos -> if abs (dest_pos - src_pos) < max_jump_dist+ then InRange+ else NotInRange (TBlock dest_lbl)++ calc_lbl_positions :: (Int, LabelMap Int) -> GenBasicBlock Instr -> (Int, LabelMap Int)+ calc_lbl_positions (pos, m) (BasicBlock lbl instrs)+ = let !pos' = pos + infoTblSize_maybe lbl+ in foldl' instr_pos (pos',mapInsert lbl pos' m) instrs++ instr_pos :: (Int, LabelMap Int) -> Instr -> (Int, LabelMap Int)+ instr_pos (pos, m) instr =+ case instr of+ ANN _ann instr -> instr_pos (pos, m) instr+ NEWBLOCK _bid -> panic "mkFarBranched - unexpected NEWBLOCK" -- At this point there should be no NEWBLOCK+ -- in the instruction stream+ -- (pos, mapInsert bid pos m)+ COMMENT{} -> (pos, m)+ instr+ | Just jump_size <- is_expandable_jump instr -> (pos+jump_size, m)+ | otherwise -> (pos+1, m)++ infoTblSize_maybe bid =+ case mapLookup bid statics of+ Nothing -> 0 :: Int+ Just _info_static -> max_info_size++ -- These jumps have a 19bit immediate as offset which is quite+ -- limiting so we potentially have to expand them into+ -- multiple instructions.+ is_expandable_jump i = case i of+ CBZ{} -> Just long_bz_jump_size+ CBNZ{} -> Just long_bz_jump_size+ BCOND{} -> Just long_bc_jump_size+ _ -> Nothing
compiler/GHC/CmmToAsm/AArch64/Cond.hs view
@@ -1,6 +1,6 @@ module GHC.CmmToAsm.AArch64.Cond where -import GHC.Prelude+import GHC.Prelude hiding (EQ) -- https://developer.arm.com/documentation/den0024/a/the-a64-instruction-set/data-processing-instructions/conditional-instructions @@ -60,7 +60,13 @@ | UOGE -- b.pl | UOGT -- b.hi -- others- | NEVER -- b.nv+ -- NEVER -- b.nv+ -- I removed never. According to the ARM spec:+ -- > The Condition code NV exists only to provide a valid disassembly of+ -- > the 0b1111 encoding, otherwise its behavior is identical to AL.+ -- This can only lead to disaster. Better to not have it than someone+ -- using it assuming it actually means never.+ | VS -- oVerflow set | VC -- oVerflow clear deriving Eq
compiler/GHC/CmmToAsm/AArch64/Instr.hs view
@@ -721,6 +721,7 @@ = TBlock BlockId | TLabel CLabel | TReg Reg+ deriving (Eq, Ord) -- Extension
compiler/GHC/CmmToAsm/AArch64/Ppr.hs view
@@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE CPP #-} -module GHC.CmmToAsm.AArch64.Ppr (pprNatCmmDecl, pprInstr) where+module GHC.CmmToAsm.AArch64.Ppr (pprNatCmmDecl, pprInstr, pprBasicBlock) where import GHC.Prelude hiding (EQ) @@ -366,7 +366,10 @@ -> line (text "\t.loc" <+> int file <+> int line' <+> int col) DELTA d -> dualDoc (asmComment $ text "\tdelta = " <> int d) empty -- see Note [dualLine and dualDoc] in GHC.Utils.Outputable- NEWBLOCK _ -> panic "PprInstr: NEWBLOCK"+ NEWBLOCK blockid -> -- This is invalid assembly. But NEWBLOCK should never be contained+ -- in the final instruction stream. But we still want to be able to+ -- print it for debugging purposes.+ line (text "BLOCK " <> pprAsmLabel platform (blockLbl blockid)) LDATA _ _ -> panic "pprInstr: LDATA" -- Pseudo Instructions -------------------------------------------------------@@ -572,7 +575,7 @@ UGE -> text "hs" -- Carry set/unsigned higher or same ; Greater than or equal, or unordered UGT -> text "hi" -- Unsigned higher ; Greater than, or unordered - NEVER -> text "nv" -- Never+ -- NEVER -> text "nv" -- Never VS -> text "vs" -- Overflow ; Unordered (at least one NaN operand) VC -> text "vc" -- No overflow ; Not unordered
compiler/GHC/CmmToAsm/BlockLayout.hs view
@@ -50,6 +50,7 @@ import Control.Monad.ST.Strict import Control.Monad (foldM, unless) import GHC.Data.UnionFind+import GHC.Types.Unique.Supply (UniqSM) {- Note [CFG based code layout]@@ -799,29 +800,32 @@ => NcgImpl statics instr jumpDest -> Maybe CFG -- ^ CFG if we have one. -> NatCmmDecl statics instr -- ^ Function to serialize- -> NatCmmDecl statics instr+ -> UniqSM (NatCmmDecl statics instr) -sequenceTop _ _ top@(CmmData _ _) = top-sequenceTop ncgImpl edgeWeights (CmmProc info lbl live (ListGraph blocks))- = let- config = ncgConfig ncgImpl- platform = ncgPlatform config+sequenceTop _ _ top@(CmmData _ _) = pure top+sequenceTop ncgImpl edgeWeights (CmmProc info lbl live (ListGraph blocks)) = do+ let config = ncgConfig ncgImpl+ platform = ncgPlatform config - in CmmProc info lbl live $ ListGraph $ ncgMakeFarBranches ncgImpl info $- if -- Chain based algorithm- | ncgCfgBlockLayout config- , backendMaintainsCfg platform- , Just cfg <- edgeWeights- -> {-# SCC layoutBlocks #-} sequenceChain info cfg blocks+ seq_blocks =+ if -- Chain based algorithm+ | ncgCfgBlockLayout config+ , backendMaintainsCfg platform+ , Just cfg <- edgeWeights+ -> {-# SCC layoutBlocks #-} sequenceChain info cfg blocks - -- Old algorithm without edge weights- | ncgCfgWeightlessLayout config- || not (backendMaintainsCfg platform)- -> {-# SCC layoutBlocks #-} sequenceBlocks Nothing info blocks+ -- Old algorithm without edge weights+ | ncgCfgWeightlessLayout config+ || not (backendMaintainsCfg platform)+ -> {-# SCC layoutBlocks #-} sequenceBlocks Nothing info blocks - -- Old algorithm with edge weights (if any)- | otherwise- -> {-# SCC layoutBlocks #-} sequenceBlocks edgeWeights info blocks+ -- Old algorithm with edge weights (if any)+ | otherwise+ -> {-# SCC layoutBlocks #-} sequenceBlocks edgeWeights info blocks++ far_blocks <- (ncgMakeFarBranches ncgImpl) platform info seq_blocks+ pure $ CmmProc info lbl live $ ListGraph far_blocks+ -- The old algorithm: -- It is very simple (and stupid): We make a graph out of
compiler/GHC/CmmToAsm/Monad.hs view
@@ -93,7 +93,8 @@ -> UniqSM (NatCmmDecl statics instr, [(BlockId,BlockId)]), -- ^ The list of block ids records the redirected jumps to allow us to update -- the CFG.- ncgMakeFarBranches :: LabelMap RawCmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr],+ ncgMakeFarBranches :: Platform -> LabelMap RawCmmStatics -> [NatBasicBlock instr]+ -> UniqSM [NatBasicBlock instr], extractUnwindPoints :: [instr] -> [UnwindPoint], -- ^ given the instruction sequence of a block, produce a list of -- the block's 'UnwindPoint's@@ -140,7 +141,7 @@ data NatM_State = NatM_State { natm_us :: UniqSupply,- natm_delta :: Int,+ natm_delta :: Int, -- ^ Stack offset for unwinding information natm_imports :: [(CLabel)], natm_pic :: Maybe Reg, natm_config :: NCGConfig,
compiler/GHC/CmmToAsm/PPC/Instr.hs view
@@ -677,12 +677,13 @@ -- big, we have to work around this limitation. makeFarBranches- :: LabelMap RawCmmStatics- -> [NatBasicBlock Instr]+ :: Platform+ -> LabelMap RawCmmStatics -> [NatBasicBlock Instr]-makeFarBranches info_env blocks- | NE.last blockAddresses < nearLimit = blocks- | otherwise = zipWith handleBlock blockAddressList blocks+ -> UniqSM [NatBasicBlock Instr]+makeFarBranches _platform info_env blocks+ | NE.last blockAddresses < nearLimit = return blocks+ | otherwise = return $ zipWith handleBlock blockAddressList blocks where blockAddresses = NE.scanl (+) 0 $ map blockLen blocks blockAddressList = toList blockAddresses
compiler/GHC/CmmToAsm/Ppr.hs view
@@ -246,9 +246,10 @@ panic "PprBase.pprGNUSectionHeader: unknown section type" flags = case t of Text- | OSMinGW32 <- platformOS platform+ | OSMinGW32 <- platformOS platform, splitSections -> text ",\"xr\""- | otherwise -> text ",\"ax\"," <> sectionType platform "progbits"+ | splitSections+ -> text ",\"ax\"," <> sectionType platform "progbits" CString | OSMinGW32 <- platformOS platform -> empty
compiler/GHC/CmmToAsm/X86.hs view
@@ -38,7 +38,7 @@ , maxSpillSlots = X86.maxSpillSlots config , allocatableRegs = X86.allocatableRegs platform , ncgAllocMoreStack = X86.allocMoreStack platform- , ncgMakeFarBranches = const id+ , ncgMakeFarBranches = \_p _i bs -> pure bs , extractUnwindPoints = X86.extractUnwindPoints , invertCondBranches = X86.invertCondBranches }
compiler/GHC/CmmToLlvm/Data.hs view
@@ -89,6 +89,7 @@ align = case sec of Section CString _ -> if (platformArch platform == ArchS390X) then Just 2 else Just 1+ Section Data _ -> Just $ platformWordSizeInBytes platform _ -> Nothing const = if sectionProtection sec == ReadOnlySection then Constant else Global
compiler/GHC/Core/Opt/CprAnal.hs view
@@ -35,7 +35,6 @@ import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Panic-import GHC.Utils.Panic.Plain import GHC.Utils.Logger ( Logger, putDumpFileMaybe, DumpFormat (..) ) import Data.List ( mapAccumL )@@ -271,11 +270,11 @@ cprAnalAlt env scrut_ty (Alt con bndrs rhs) = (rhs_ty, Alt con bndrs rhs') where+ ids = filter isId bndrs env_alt | DataAlt dc <- con- , let ids = filter isId bndrs , CprType arity cpr <- scrut_ty- , assert (arity == 0 ) True+ , arity == 0 -- See Note [Dead code may contain type confusions] = case unpackConFieldsCpr dc cpr of AllFieldsSame field_cpr | let sig = mkCprSig 0 field_cpr@@ -284,7 +283,7 @@ | let sigs = zipWith (mkCprSig . idArity) ids field_cprs -> extendSigEnvList env (zipEqual "cprAnalAlt" ids sigs) | otherwise- = env+ = extendSigEnvAllSame env ids topCprSig (rhs_ty, rhs') = cprAnal env_alt rhs --@@ -431,6 +430,43 @@ (id', rhs', env') = cprAnalBind env id rhs {-+Note [Dead code may contain type confusions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In T23862, we have a nested case match that looks like this++ data CheckSingleton (check :: Bool) where+ Checked :: CheckSingleton True+ Unchecked :: CheckSingleton False+ data family Result (check :: Bool) a+ data instance Result True a = CheckedResult a+ newtype instance Result True a = UncheckedResult a++ case m () of Checked co1 ->+ case m () of Unchecked co2 ->+ case ((\_ -> True)+ |> .. UncheckedResult ..+ |> sym co2+ |> co1) :: Result True (Bool -> Bool) of+ CheckedResult f -> CheckedResult (f True)++Clearly, the innermost case is dead code, because the `Checked` and `Unchecked`+cases are apart.+However, both constructors introduce mutually contradictory coercions `co1` and+`co2` along which GHC generates a type confusion:++ 1. (\_ -> True) :: Bool -> Bool+ 2. newtype coercion UncheckedResult (\_ -> True) :: Result False (Bool -> Bool)+ 3. |> ... sym co1 ... :: Result check (Bool -> Bool)+ 4. |> ... co2 ... :: Result True (Bool -> Bool)++Note that we started with a function, injected into `Result` via a newtype+instance and then match on it with a datatype instance.++We have to handle this case gracefully in `cprAnalAlt`, where for the innermost+case we see a `DataAlt` for `CheckedResult`, yet have a scrutinee type that+abstracts the function `(\_ -> True)` with arity 1.+In this case, don't pretend we know anything about the fields of `CheckedResult`!+ Note [The OPAQUE pragma and avoiding the reboxing of results] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider:
compiler/GHC/Driver/Make.hs view
@@ -595,7 +595,7 @@ -- Now perform another toposort but just with these nodes and relevant hs-boot files. -- The result should be acyclic, if it's not, then there's an unresolved cycle in the graph. mresolved_cycle = collapseSCC (topSortWithBoot nodes)- in acyclic ++ [maybe (UnresolvedCycle nodes) ResolvedCycle mresolved_cycle] ++ toBuildPlan sccs []+ in acyclic ++ [either UnresolvedCycle ResolvedCycle mresolved_cycle] ++ toBuildPlan sccs [] (mg, lookup_node) = moduleGraphNodes False (mgModSummaries' mod_graph) trans_deps_map = allReachable mg (mkNodeKey . node_payload)@@ -626,12 +626,12 @@ get_boot_module m = case m of ModuleNode _ ms | HsSrcFile <- ms_hsc_src ms -> lookupModuleEnv boot_modules (ms_mod ms); _ -> Nothing -- Any cycles should be resolved now- collapseSCC :: [SCC ModuleGraphNode] -> Maybe [(Either ModuleGraphNode ModuleGraphNodeWithBootFile)]+ collapseSCC :: [SCC ModuleGraphNode] -> Either [ModuleGraphNode] [(Either ModuleGraphNode ModuleGraphNodeWithBootFile)] -- Must be at least two nodes, as we were in a cycle- collapseSCC [AcyclicSCC node1, AcyclicSCC node2] = Just [toNodeWithBoot node1, toNodeWithBoot node2]+ collapseSCC [AcyclicSCC node1, AcyclicSCC node2] = Right [toNodeWithBoot node1, toNodeWithBoot node2] collapseSCC (AcyclicSCC node : nodes) = (toNodeWithBoot node :) <$> collapseSCC nodes -- Cyclic- collapseSCC _ = Nothing+ collapseSCC nodes = Left (flattenSCCs nodes) toNodeWithBoot :: ModuleGraphNode -> Either ModuleGraphNode ModuleGraphNodeWithBootFile toNodeWithBoot mn =@@ -732,6 +732,7 @@ let pruneHomeUnitEnv hme = hme { homeUnitEnv_hpt = emptyHomePackageTable } setSession $ discardIC $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env+ hsc_env <- getSession -- Unload everything liftIO $ unload interp hsc_env@@ -743,7 +744,6 @@ Nothing -> liftIO getNumProcessors Just n -> return n - setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env (upsweep_ok, new_deps) <- withDeferredDiagnostics $ do hsc_env <- getSession liftIO $ upsweep n_jobs hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan@@ -1113,33 +1113,37 @@ -- which would retain all the result variables, preventing us from collecting them -- after they are no longer used. !build_deps = getDependencies direct_deps build_map- let build_action =- withCurrentUnit (moduleGraphNodeUnitId mod) $ do- (hug, deps) <- wait_deps_hug hug_var build_deps+ let !build_action = case mod of InstantiationNode uid iu -> do- executeInstantiationNode mod_idx n_mods hug uid iu- return (Nothing, deps)- ModuleNode _build_deps ms -> do+ withCurrentUnit (moduleGraphNodeUnitId mod) $ do+ (hug, deps) <- wait_deps_hug hug_var build_deps+ executeInstantiationNode mod_idx n_mods hug uid iu+ return (Nothing, deps)+ ModuleNode _build_deps ms -> let !old_hmi = M.lookup (msKey ms) old_hpt rehydrate_mods = mapMaybe nodeKeyModName <$> rehydrate_nodes- hmi <- executeCompileNode mod_idx n_mods old_hmi hug rehydrate_mods ms- -- Write the HMI to an external cache (if one exists)- -- See Note [Caching HomeModInfo]- liftIO $ forM mhmi_cache $ \hmi_cache -> addHmiToCache hmi_cache hmi- -- This global MVar is incrementally modified in order to avoid having to- -- recreate the HPT before compiling each module which leads to a quadratic amount of work.- liftIO $ modifyMVar_ hug_var (return . addHomeModInfoToHug hmi)- return (Just hmi, addToModuleNameSet (moduleGraphNodeUnitId mod) (ms_mod_name ms) deps )+ in withCurrentUnit (moduleGraphNodeUnitId mod) $ do+ (hug, deps) <- wait_deps_hug hug_var build_deps+ hmi <- executeCompileNode mod_idx n_mods old_hmi hug rehydrate_mods ms+ -- Write the HMI to an external cache (if one exists)+ -- See Note [Caching HomeModInfo]+ liftIO $ forM mhmi_cache $ \hmi_cache -> addHmiToCache hmi_cache hmi+ -- This global MVar is incrementally modified in order to avoid having to+ -- recreate the HPT before compiling each module which leads to a quadratic amount of work.+ liftIO $ modifyMVar_ hug_var (return . addHomeModInfoToHug hmi)+ return (Just hmi, addToModuleNameSet (moduleGraphNodeUnitId mod) (ms_mod_name ms) deps ) LinkNode _nks uid -> do- executeLinkNode hug (mod_idx, n_mods) uid direct_deps- return (Nothing, deps)+ withCurrentUnit (moduleGraphNodeUnitId mod) $ do+ (hug, deps) <- wait_deps_hug hug_var build_deps+ executeLinkNode hug (mod_idx, n_mods) uid direct_deps+ return (Nothing, deps) res_var <- liftIO newEmptyMVar let result_var = mkResultVar res_var setModulePipeline (mkNodeKey mod) (mkBuildResult origin result_var)- return $ (MakeAction build_action res_var)+ return $! (MakeAction build_action res_var) buildOneLoopyModule :: ModuleGraphNodeWithBootFile -> BuildM [MakeAction]@@ -2941,7 +2945,7 @@ run_pipeline :: RunMakeM a -> IO (Maybe a) run_pipeline p = runMaybeT (runReaderT p env) -data MakeAction = forall a . MakeAction (RunMakeM a) (MVar (Maybe a))+data MakeAction = forall a . MakeAction !(RunMakeM a) !(MVar (Maybe a)) waitMakeAction :: MakeAction -> IO () waitMakeAction (MakeAction _ mvar) = () <$ readMVar mvar
compiler/GHC/Iface/Errors.hs view
@@ -289,9 +289,10 @@ mod_hidden pkg = text "it is a hidden module in the package" <+> quotes (ppr pkg) - unusable (pkg, reason)- = text "It is a member of the package"- <+> quotes (ppr pkg)+ unusable (UnusableUnit unit reason reexport)+ = text "It is " <> (if reexport then text "reexported from the package"+ else text "a member of the package")+ <+> quotes (ppr unit) $$ pprReason (text "which is") reason pp_suggestions :: [ModuleSuggestion] -> SDoc
compiler/GHC/Linker/Dynamic.hs view
@@ -11,6 +11,7 @@ import GHC.Prelude import GHC.Platform import GHC.Platform.Ways+import GHC.Settings (ToolSettings(toolSettings_ldSupportsSingleModule)) import GHC.Driver.Config.Linker import GHC.Driver.Session@@ -150,6 +151,9 @@ -- dynamic binding nonsense when referring to symbols from -- within the library. The NCG assumes that this option is -- specified (on i386, at least).+ -- In XCode 15, -single_module is the default and passing the+ -- flag is now obsolete and raises a warning (#24168). We encode+ -- this information into the toolchain field ...SupportsSingleModule. -- -install_name -- Mac OS/X stores the path where a dynamic library is (to -- be) installed in the library itself. It's called the@@ -175,8 +179,11 @@ ] ++ map Option o_files ++ [ Option "-undefined",- Option "dynamic_lookup",- Option "-single_module" ]+ Option "dynamic_lookup"+ ]+ ++ (if toolSettings_ldSupportsSingleModule (toolSettings dflags)+ then [ Option "-single_module" ]+ else [ ]) ++ (if platformArch platform `elem` [ ArchX86_64, ArchAArch64 ] then [ ] else [ Option "-Wl,-read_only_relocs,suppress" ])
compiler/GHC/Settings/IO.hs view
@@ -95,6 +95,7 @@ cxx_args = words cxx_args_str ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsFilelist <- getBooleanSetting "ld supports filelist"+ ldSupportsSingleModule <- getBooleanSetting "ld supports single module" ldIsGnuLd <- getBooleanSetting "ld is GNU ld" arSupportsDashL <- getBooleanSetting "ar supports -L" @@ -163,6 +164,7 @@ , sToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind , toolSettings_ldSupportsFilelist = ldSupportsFilelist+ , toolSettings_ldSupportsSingleModule = ldSupportsSingleModule , toolSettings_ldIsGnuLd = ldIsGnuLd , toolSettings_ccSupportsNoPie = gccSupportsNoPie , toolSettings_useInplaceMinGW = useInplaceMinGW
compiler/GHC/Stg/Debug.hs view
@@ -16,7 +16,7 @@ import GHC.Core.DataCon import GHC.Types.IPE import GHC.Unit.Module-import GHC.Types.Name ( getName, getOccName, occNameString, nameSrcSpan)+import GHC.Types.Name ( getName, getOccName, occNameString, nameSrcSpan ) import GHC.Data.FastString import Control.Monad (when)@@ -68,21 +68,25 @@ return (StgRec es) collectStgRhs :: Id -> StgRhs -> M StgRhs-collectStgRhs bndr (StgRhsClosure ext cc us bs e)= do- let- name = idName bndr- -- If the name has a span, use that initially as the source position in-case- -- we don't get anything better.- with_span = case nameSrcSpan name of- RealSrcSpan pos _ -> withSpan (pos, occNameString (getOccName name))- _ -> id- e' <- with_span $ collectExpr e- recordInfo bndr e'- return $ StgRhsClosure ext cc us bs e'-collectStgRhs _bndr (StgRhsCon cc dc _mn ticks args) = do- n' <- numberDataCon dc ticks- return (StgRhsCon cc dc n' ticks args)-+collectStgRhs bndr rhs =+ case rhs of+ StgRhsClosure ext cc us bs e -> do+ e' <- with_span $ collectExpr e+ recordInfo bndr e'+ return $ StgRhsClosure ext cc us bs e'+ StgRhsCon cc dc _mn ticks args -> do+ n' <- with_span $ numberDataCon dc ticks+ return (StgRhsCon cc dc n' ticks args)+ where+ -- If the binder name has a span, use that initially as the source position+ -- in case we don't get anything better+ with_span :: M a -> M a+ with_span =+ let name = idName bndr in+ case nameSrcSpan name of+ RealSrcSpan pos _ ->+ withSpan (pos, occNameString (getOccName name))+ _ -> id recordInfo :: Id -> StgExpr -> M () recordInfo bndr new_rhs = do
compiler/GHC/StgToCmm/Bind.hs view
@@ -701,10 +701,19 @@ when eager_blackholing $ do whenUpdRemSetEnabled $ emitUpdRemSetPushThunk node- emitStore (cmmOffsetW platform node (fixedHdrSizeW profile)) currentTSOExpr+ emitAtomicStore platform MemOrderRelease+ (cmmOffsetW platform node (fixedHdrSizeW profile))+ currentTSOExpr -- See Note [Heap memory barriers] in SMP.h.- let w = wordWidth platform- emitPrimCall [] (MO_AtomicWrite w MemOrderRelease) [node, CmmReg (CmmGlobal EagerBlackholeInfo)]+ emitAtomicStore platform MemOrderRelease+ node+ (CmmReg (CmmGlobal EagerBlackholeInfo))++emitAtomicStore :: Platform -> MemoryOrdering -> CmmExpr -> CmmExpr -> FCode ()+emitAtomicStore platform mord addr val =+ emitPrimCall [] (MO_AtomicWrite w mord) [addr, val]+ where+ w = typeWidth $ cmmExprType platform val setupUpdate :: ClosureInfo -> LocalReg -> FCode () -> FCode () -- Nota Bene: this function does not change Node (even if it's a CAF),
compiler/GHC/StgToCmm/CgUtils.hs view
@@ -173,15 +173,18 @@ BaseReg -> baseAddr _other -> CmmLoad baseAddr (globalRegType platform reg) NaturallyAligned - CmmRegOff (CmmGlobal reg) offset ->+ CmmRegOff greg@(CmmGlobal reg) offset -> -- RegOf leaves are just a shorthand form. If the reg maps -- to a real reg, we keep the shorthand, otherwise, we just -- expand it and defer to the above code.+ -- NB: to ensure type correctness we need to ensure the Add+ -- as well as the Int need to be of the same size as the+ -- register. case reg `elem` activeStgRegs platform of True -> expr- False -> CmmMachOp (MO_Add (wordWidth platform)) [- fixExpr (CmmReg (CmmGlobal reg)),+ False -> CmmMachOp (MO_Add (cmmRegWidth platform greg)) [+ fixExpr (CmmReg greg), CmmLit (CmmInt (fromIntegral offset)- (wordWidth platform))]+ (cmmRegWidth platform greg))] other_expr -> other_expr
compiler/GHC/StgToJS/Linker/Utils.hs view
@@ -137,6 +137,10 @@ then "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM))\n" else "#define MK_PTR(val,offset) (h$c2(h$baseZCGHCziPtrziPtr_con_e, (val), (offset)))\n" + -- Put Addr# in ByteArray# or at Addr# (same thing)+ , "#define PUT_ADDR(a,o,va,vo) if (!(a).arr) (a).arr = []; (a).arr[o] = va; (a).dv.setInt32(o,vo,true);\n"+ , "#define GET_ADDR(a,o,ra,ro) var ra = (((a).arr && (a).arr[o]) ? (a).arr[o] : null_); var ro = (a).dv.getInt32(o,true);\n"+ -- Data.Maybe.Maybe , "#define HS_NOTHING h$baseZCGHCziMaybeziNothing\n" , "#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziMaybeziNothing_con_e)\n"
compiler/GHC/StgToJS/Prim.hs view
@@ -29,1449 +29,1527 @@ import GHC.Data.FastString import GHC.Utils.Outputable (renderWithContext, defaultSDocContext, ppr)-import Data.Maybe---genPrim :: Bool -- ^ Profiling (cost-centres) enabled- -> Bool -- ^ Array bounds-checking enabled- -> Type- -> PrimOp -- ^ the primitive operation- -> [JExpr] -- ^ where to store the result- -> [JExpr] -- ^ arguments- -> PrimRes-genPrim prof bound ty op = case op of- CharGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)- CharGeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)- CharEqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)- CharNeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)- CharLtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)- CharLeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)- OrdOp -> \[r] [x] -> PrimInline $ r |= x-- Int8ToWord8Op -> \[r] [x] -> PrimInline $ r |= mask8 x- Word8ToInt8Op -> \[r] [x] -> PrimInline $ r |= signExtend8 x- Int16ToWord16Op -> \[r] [x] -> PrimInline $ r |= mask16 x- Word16ToInt16Op -> \[r] [x] -> PrimInline $ r |= signExtend16 x- Int32ToWord32Op -> \[r] [x] -> PrimInline $ r |= x .>>>. zero_- Word32ToInt32Op -> \[r] [x] -> PrimInline $ r |= toI32 x-------------------------------- Int ------------------------------------------------ IntAddOp -> \[r] [x,y] -> PrimInline $ r |= toI32 (Add x y)- IntSubOp -> \[r] [x,y] -> PrimInline $ r |= toI32 (Sub x y)- IntMulOp -> \[r] [x,y] -> PrimInline $ r |= app "h$mulInt32" [x, y]- IntMul2Op -> \[c,hr,lr] [x,y] -> PrimInline $ appT [c,hr,lr] "h$hs_timesInt2" [x, y]- IntMulMayOfloOp -> \[r] [x,y] -> PrimInline $ jVar \tmp -> mconcat- [ tmp |= Mul x y- , r |= if01 (tmp .===. toI32 tmp)- ]- IntQuotOp -> \[r] [x,y] -> PrimInline $ r |= toI32 (Div x y)- IntRemOp -> \[r] [x,y] -> PrimInline $ r |= Mod x y- IntQuotRemOp -> \[q,r] [x,y] -> PrimInline $ mconcat- [ q |= toI32 (Div x y)- , r |= x `Sub` (Mul y q)- ]- IntAndOp -> \[r] [x,y] -> PrimInline $ r |= BAnd x y- IntOrOp -> \[r] [x,y] -> PrimInline $ r |= BOr x y- IntXorOp -> \[r] [x,y] -> PrimInline $ r |= BXor x y- IntNotOp -> \[r] [x] -> PrimInline $ r |= BNot x-- IntNegOp -> \[r] [x] -> PrimInline $ r |= toI32 (Negate x)--- add with carry: overflow == 0 iff no overflow- IntAddCOp -> \[r,overf] [x,y] ->- PrimInline $ jVar \rt -> mconcat- [ rt |= Add x y- , r |= toI32 rt- , overf |= if10 (r .!=. rt)- ]- IntSubCOp -> \[r,overf] [x,y] ->- PrimInline $ jVar \rt -> mconcat- [ rt |= Sub x y- , r |= toI32 rt- , overf |= if10 (r .!=. rt)- ]- IntGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)- IntGeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)- IntEqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)- IntNeOp -> \[r] [x,y] -> PrimInline $ r |= if10(x .!==. y)- IntLtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)- IntLeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)- ChrOp -> \[r] [x] -> PrimInline $ r |= x- IntToWordOp -> \[r] [x] -> PrimInline $ r |= x .>>>. 0- IntToFloatOp -> \[r] [x] -> PrimInline $ r |= x- IntToDoubleOp -> \[r] [x] -> PrimInline $ r |= x- IntSllOp -> \[r] [x,y] -> PrimInline $ r |= x .<<. y- IntSraOp -> \[r] [x,y] -> PrimInline $ r |= x .>>. y- IntSrlOp -> \[r] [x,y] -> PrimInline $ r |= toI32 (x .>>>. y)-------------------------------- Int8 ----------------------------------------------- Int8ToIntOp -> \[r] [x] -> PrimInline $ r |= x- IntToInt8Op -> \[r] [x] -> PrimInline $ r |= signExtend8 x- Int8NegOp -> \[r] [x] -> PrimInline $ r |= signExtend8 (Negate x)- Int8AddOp -> \[r] [x,y] -> PrimInline $ r |= signExtend8 (Add x y)- Int8SubOp -> \[r] [x,y] -> PrimInline $ r |= signExtend8 (Sub x y)- Int8MulOp -> \[r] [x,y] -> PrimInline $ r |= signExtend8 (Mul x y)- Int8QuotOp -> \[r] [x,y] -> PrimInline $ r |= signExtend8 (quotShortInt 8 x y)- Int8RemOp -> \[r] [x,y] -> PrimInline $ r |= signExtend8 (remShortInt 8 x y)- Int8QuotRemOp -> \[r1,r2] [x,y] -> PrimInline $ mconcat- [ r1 |= signExtend8 (quotShortInt 8 x y)- , r2 |= signExtend8 (remShortInt 8 x y)- ]- Int8EqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)- Int8GeOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 24)) .>=. (y .<<. (Int 24)))- Int8GtOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 24)) .>. (y .<<. (Int 24)))- Int8LeOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 24)) .<=. (y .<<. (Int 24)))- Int8LtOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 24)) .<. (y .<<. (Int 24)))- Int8NeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)-- Int8SraOp -> \[r] [x,i] -> PrimInline $ r |= x .>>. i- Int8SrlOp -> \[r] [x,i] -> PrimInline $ r |= signExtend8 (mask8 x .>>>. i)- Int8SllOp -> \[r] [x,i] -> PrimInline $ r |= signExtend8 (mask8 (x .<<. i))-------------------------------- Word8 ---------------------------------------------- Word8ToWordOp -> \[r] [x] -> PrimInline $ r |= mask8 x- WordToWord8Op -> \[r] [x] -> PrimInline $ r |= mask8 x-- Word8AddOp -> \[r] [x,y] -> PrimInline $ r |= mask8 (Add x y)- Word8SubOp -> \[r] [x,y] -> PrimInline $ r |= mask8 (Sub x y)- Word8MulOp -> \[r] [x,y] -> PrimInline $ r |= mask8 (Mul x y)- Word8QuotOp -> \[r] [x,y] -> PrimInline $ r |= mask8 (Div x y)- Word8RemOp -> \[r] [x,y] -> PrimInline $ r |= Mod x y- Word8QuotRemOp -> \[r1,r2] [x,y] -> PrimInline $ mconcat- [ r1 |= toI32 (Div x y)- , r2 |= Mod x y- ]- Word8EqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)- Word8GeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)- Word8GtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)- Word8LeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)- Word8LtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)- Word8NeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)-- Word8AndOp -> \[r] [x,y] -> PrimInline $ r |= BAnd x y- Word8OrOp -> \[r] [x,y] -> PrimInline $ r |= BOr x y- Word8XorOp -> \[r] [x,y] -> PrimInline $ r |= BXor x y- Word8NotOp -> \[r] [x] -> PrimInline $ r |= BXor x (Int 0xff)-- Word8SllOp -> \[r] [x,i] -> PrimInline $ r |= mask8 (x .<<. i)- Word8SrlOp -> \[r] [x,i] -> PrimInline $ r |= x .>>>. i-------------------------------- Int16 --------------------------------------------- Int16ToIntOp -> \[r] [x] -> PrimInline $ r |= x- IntToInt16Op -> \[r] [x] -> PrimInline $ r |= signExtend16 x-- Int16NegOp -> \[r] [x] -> PrimInline $ r |= signExtend16 (Negate x)- Int16AddOp -> \[r] [x,y] -> PrimInline $ r |= signExtend16 (Add x y)- Int16SubOp -> \[r] [x,y] -> PrimInline $ r |= signExtend16 (Sub x y)- Int16MulOp -> \[r] [x,y] -> PrimInline $ r |= signExtend16 (Mul x y)- Int16QuotOp -> \[r] [x,y] -> PrimInline $ r |= signExtend16 (quotShortInt 16 x y)- Int16RemOp -> \[r] [x,y] -> PrimInline $ r |= signExtend16 (remShortInt 16 x y)- Int16QuotRemOp -> \[r1,r2] [x,y] -> PrimInline $ mconcat- [ r1 |= signExtend16 (quotShortInt 16 x y)- , r2 |= signExtend16 (remShortInt 16 x y)- ]- Int16EqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)- Int16GeOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 16)) .>=. (y .<<. (Int 16)))- Int16GtOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 16)) .>. (y .<<. (Int 16)))- Int16LeOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 16)) .<=. (y .<<. (Int 16)))- Int16LtOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 16)) .<. (y .<<. (Int 16)))- Int16NeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)-- Int16SraOp -> \[r] [x,i] -> PrimInline $ r |= x .>>. i- Int16SrlOp -> \[r] [x,i] -> PrimInline $ r |= signExtend16 (mask16 x .>>>. i)- Int16SllOp -> \[r] [x,i] -> PrimInline $ r |= signExtend16 (x .<<. i)-------------------------------- Word16 -------------------------------------------- Word16ToWordOp -> \[r] [x] -> PrimInline $ r |= x- WordToWord16Op -> \[r] [x] -> PrimInline $ r |= mask16 x-- Word16AddOp -> \[r] [x,y] -> PrimInline $ r |= mask16 (Add x y)- Word16SubOp -> \[r] [x,y] -> PrimInline $ r |= mask16 (Sub x y)- Word16MulOp -> \[r] [x,y] -> PrimInline $ r |= mask16 (Mul x y)- Word16QuotOp -> \[r] [x,y] -> PrimInline $ r |= mask16 (Div x y)- Word16RemOp -> \[r] [x,y] -> PrimInline $ r |= Mod x y- Word16QuotRemOp -> \[r1,r2] [x,y] -> PrimInline $ mconcat- [ r1 |= toI32 (Div x y)- , r2 |= Mod x y- ]- Word16EqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)- Word16GeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)- Word16GtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)- Word16LeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)- Word16LtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)- Word16NeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)-- Word16AndOp -> \[r] [x,y] -> PrimInline $ r |= BAnd x y- Word16OrOp -> \[r] [x,y] -> PrimInline $ r |= BOr x y- Word16XorOp -> \[r] [x,y] -> PrimInline $ r |= BXor x y- Word16NotOp -> \[r] [x] -> PrimInline $ r |= BXor x (Int 0xffff)-- Word16SllOp -> \[r] [x,i] -> PrimInline $ r |= mask16 (x .<<. i)- Word16SrlOp -> \[r] [x,i] -> PrimInline $ r |= x .>>>. i-------------------------------- Int32 ---------------------------------------------- Int32ToIntOp -> \[r] [x] -> PrimInline $ r |= x- IntToInt32Op -> \[r] [x] -> PrimInline $ r |= x-- Int32NegOp -> \rs xs -> genPrim prof bound ty IntNegOp rs xs- Int32AddOp -> \rs xs -> genPrim prof bound ty IntAddOp rs xs- Int32SubOp -> \rs xs -> genPrim prof bound ty IntSubOp rs xs- Int32MulOp -> \rs xs -> genPrim prof bound ty IntMulOp rs xs- Int32QuotOp -> \rs xs -> genPrim prof bound ty IntQuotOp rs xs- Int32RemOp -> \rs xs -> genPrim prof bound ty IntRemOp rs xs- Int32QuotRemOp -> \rs xs -> genPrim prof bound ty IntQuotRemOp rs xs-- Int32EqOp -> \rs xs -> genPrim prof bound ty IntEqOp rs xs- Int32GeOp -> \rs xs -> genPrim prof bound ty IntGeOp rs xs- Int32GtOp -> \rs xs -> genPrim prof bound ty IntGtOp rs xs- Int32LeOp -> \rs xs -> genPrim prof bound ty IntLeOp rs xs- Int32LtOp -> \rs xs -> genPrim prof bound ty IntLtOp rs xs- Int32NeOp -> \rs xs -> genPrim prof bound ty IntNeOp rs xs-- Int32SraOp -> \rs xs -> genPrim prof bound ty IntSraOp rs xs- Int32SrlOp -> \rs xs -> genPrim prof bound ty IntSrlOp rs xs- Int32SllOp -> \rs xs -> genPrim prof bound ty IntSllOp rs xs-------------------------------- Word32 --------------------------------------------- Word32ToWordOp -> \[r] [x] -> PrimInline $ r |= x- WordToWord32Op -> \[r] [x] -> PrimInline $ r |= x-- Word32AddOp -> \rs xs -> genPrim prof bound ty WordAddOp rs xs- Word32SubOp -> \rs xs -> genPrim prof bound ty WordSubOp rs xs- Word32MulOp -> \rs xs -> genPrim prof bound ty WordMulOp rs xs- Word32QuotOp -> \rs xs -> genPrim prof bound ty WordQuotOp rs xs- Word32RemOp -> \rs xs -> genPrim prof bound ty WordRemOp rs xs- Word32QuotRemOp -> \rs xs -> genPrim prof bound ty WordQuotRemOp rs xs-- Word32EqOp -> \rs xs -> genPrim prof bound ty WordEqOp rs xs- Word32GeOp -> \rs xs -> genPrim prof bound ty WordGeOp rs xs- Word32GtOp -> \rs xs -> genPrim prof bound ty WordGtOp rs xs- Word32LeOp -> \rs xs -> genPrim prof bound ty WordLeOp rs xs- Word32LtOp -> \rs xs -> genPrim prof bound ty WordLtOp rs xs- Word32NeOp -> \rs xs -> genPrim prof bound ty WordNeOp rs xs-- Word32AndOp -> \rs xs -> genPrim prof bound ty WordAndOp rs xs- Word32OrOp -> \rs xs -> genPrim prof bound ty WordOrOp rs xs- Word32XorOp -> \rs xs -> genPrim prof bound ty WordXorOp rs xs- Word32NotOp -> \rs xs -> genPrim prof bound ty WordNotOp rs xs-- Word32SllOp -> \rs xs -> genPrim prof bound ty WordSllOp rs xs- Word32SrlOp -> \rs xs -> genPrim prof bound ty WordSrlOp rs xs-------------------------------- Int64 ---------------------------------------------- Int64ToIntOp -> \[r] [_h,l] -> PrimInline $ r |= toI32 l-- Int64NegOp -> \[r_h,r_l] [h,l] ->- PrimInline $ mconcat- [ r_l |= toU32 (BNot l + 1)- , r_h |= toI32 (BNot h + Not r_l)- ]-- Int64AddOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_plusInt64" [h0,l0,h1,l1]- Int64SubOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_minusInt64" [h0,l0,h1,l1]- Int64MulOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_timesInt64" [h0,l0,h1,l1]- Int64QuotOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_quotInt64" [h0,l0,h1,l1]- Int64RemOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_remInt64" [h0,l0,h1,l1]-- Int64SllOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftLLInt64" [h,l,n]- Int64SraOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftRAInt64" [h,l,n]- Int64SrlOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftRLInt64" [h,l,n]-- Int64ToWord64Op -> \[r1,r2] [x1,x2] ->- PrimInline $ mconcat- [ r1 |= toU32 x1- , r2 |= x2- ]- IntToInt64Op -> \[r1,r2] [x] ->- PrimInline $ mconcat- [ r1 |= if_ (x .<. 0) (-1) 0 -- sign-extension- , r2 |= toU32 x- ]-- Int64EqOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LAnd (l0 .===. l1) (h0 .===. h1))- Int64NeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (l0 .!==. l1) (h0 .!==. h1))- Int64GeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .>. h1) (LAnd (h0 .===. h1) (l0 .>=. l1)))- Int64GtOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .>. h1) (LAnd (h0 .===. h1) (l0 .>. l1)))- Int64LeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .<. h1) (LAnd (h0 .===. h1) (l0 .<=. l1)))- Int64LtOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .<. h1) (LAnd (h0 .===. h1) (l0 .<. l1)))-------------------------------- Word64 --------------------------------------------- Word64ToWordOp -> \[r] [_x1,x2] -> PrimInline $ r |= x2-- WordToWord64Op -> \[rh,rl] [x] ->- PrimInline $ mconcat- [ rh |= 0- , rl |= x- ]-- Word64ToInt64Op -> \[r1,r2] [x1,x2] ->- PrimInline $ mconcat- [ r1 |= toI32 x1- , r2 |= x2- ]-- Word64EqOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LAnd (l0 .===. l1) (h0 .===. h1))- Word64NeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (l0 .!==. l1) (h0 .!==. h1))- Word64GeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .>. h1) (LAnd (h0 .===. h1) (l0 .>=. l1)))- Word64GtOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .>. h1) (LAnd (h0 .===. h1) (l0 .>. l1)))- Word64LeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .<. h1) (LAnd (h0 .===. h1) (l0 .<=. l1)))- Word64LtOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .<. h1) (LAnd (h0 .===. h1) (l0 .<. l1)))-- Word64SllOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftLWord64" [h,l,n]- Word64SrlOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftRWord64" [h,l,n]-- Word64OrOp -> \[hr,hl] [h0, l0, h1, l1] ->- PrimInline $ mconcat- [ hr |= toU32 (BOr h0 h1)- , hl |= toU32 (BOr l0 l1)- ]-- Word64AndOp -> \[hr,hl] [h0, l0, h1, l1] ->- PrimInline $ mconcat- [ hr |= toU32 (BAnd h0 h1)- , hl |= toU32 (BAnd l0 l1)- ]-- Word64XorOp -> \[hr,hl] [h0, l0, h1, l1] ->- PrimInline $ mconcat- [ hr |= toU32 (BXor h0 h1)- , hl |= toU32 (BXor l0 l1)- ]-- Word64NotOp -> \[hr,hl] [h, l] ->- PrimInline $ mconcat- [ hr |= toU32 (BNot h)- , hl |= toU32 (BNot l)- ]-- Word64AddOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_plusWord64" [h0,l0,h1,l1]- Word64SubOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_minusWord64" [h0,l0,h1,l1]- Word64MulOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_timesWord64" [h0,l0,h1,l1]- Word64QuotOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_quotWord64" [h0,l0,h1,l1]- Word64RemOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_remWord64" [h0,l0,h1,l1]-------------------------------- Word ----------------------------------------------- WordAddOp -> \[r] [x,y] -> PrimInline $ r |= (x `Add` y) .>>>. zero_- WordAddCOp -> \[r,c] [x,y] -> PrimInline $- jVar \t -> mconcat- [ t |= x `Add` y- , r |= toU32 t- , c |= if10 (t .!==. r)- ]- WordSubCOp -> \[r,c] [x,y] ->- PrimInline $ mconcat- [ r |= toU32 (Sub x y)- , c |= if10 (y .>. x)- ]- WordAdd2Op -> \[h,l] [x,y] -> PrimInline $ appT [h,l] "h$wordAdd2" [x,y]- WordSubOp -> \ [r] [x,y] -> PrimInline $ r |= toU32 (Sub x y)- WordMulOp -> \ [r] [x,y] -> PrimInline $ r |= app "h$mulWord32" [x, y]- WordMul2Op -> \[h,l] [x,y] -> PrimInline $ appT [h,l] "h$mul2Word32" [x,y]- WordQuotOp -> \ [q] [x,y] -> PrimInline $ q |= app "h$quotWord32" [x,y]- WordRemOp -> \ [r] [x,y] -> PrimInline $ r |= app "h$remWord32" [x,y]- WordQuotRemOp -> \[q,r] [x,y] -> PrimInline $ appT [q,r] "h$quotRemWord32" [x,y]- WordQuotRem2Op -> \[q,r] [xh,xl,y] -> PrimInline $ appT [q,r] "h$quotRem2Word32" [xh,xl,y]- WordAndOp -> \[r] [x,y] -> PrimInline $ r |= toU32 (BAnd x y)- WordOrOp -> \[r] [x,y] -> PrimInline $ r |= toU32 (BOr x y)- WordXorOp -> \[r] [x,y] -> PrimInline $ r |= toU32 (BXor x y)- WordNotOp -> \[r] [x] -> PrimInline $ r |= toU32 (BNot x)- WordSllOp -> \[r] [x,y] -> PrimInline $ r |= toU32 (x .<<. y)- WordSrlOp -> \[r] [x,y] -> PrimInline $ r |= x .>>>. y- WordToIntOp -> \[r] [x] -> PrimInline $ r |= toI32 x- WordGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)- WordGeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)- WordEqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)- WordNeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)- WordLtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)- WordLeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)- WordToDoubleOp -> \[r] [x] -> PrimInline $ r |= x- WordToFloatOp -> \[r] [x] -> PrimInline $ r |= math_fround [x]- PopCnt8Op -> \[r] [x] -> PrimInline $ r |= var "h$popCntTab" .! (mask8 x)- PopCnt16Op -> \[r] [x] -> PrimInline $ r |= Add (var "h$popCntTab" .! (mask8 x))- (var "h$popCntTab" .! (mask8 (x .>>>. Int 8)))-- PopCnt32Op -> \[r] [x] -> PrimInline $ r |= app "h$popCnt32" [x]- PopCnt64Op -> \[r] [x1,x2] -> PrimInline $ r |= app "h$popCnt64" [x1,x2]- PopCntOp -> \[r] [x] -> genPrim prof bound ty PopCnt32Op [r] [x]- Pdep8Op -> \[r] [s,m] -> PrimInline $ r |= app "h$pdep8" [s,m]- Pdep16Op -> \[r] [s,m] -> PrimInline $ r |= app "h$pdep16" [s,m]- Pdep32Op -> \[r] [s,m] -> PrimInline $ r |= app "h$pdep32" [s,m]- Pdep64Op -> \[ra,rb] [sa,sb,ma,mb] -> PrimInline $ appT [ra,rb] "h$pdep64" [sa,sb,ma,mb]- PdepOp -> \rs xs -> genPrim prof bound ty Pdep32Op rs xs- Pext8Op -> \[r] [s,m] -> PrimInline $ r |= app "h$pext8" [s,m]- Pext16Op -> \[r] [s,m] -> PrimInline $ r |= app "h$pext16" [s,m]- Pext32Op -> \[r] [s,m] -> PrimInline $ r |= app "h$pext32" [s,m]- Pext64Op -> \[ra,rb] [sa,sb,ma,mb] -> PrimInline $ appT [ra,rb] "h$pext64" [sa,sb,ma,mb]- PextOp -> \rs xs -> genPrim prof bound ty Pext32Op rs xs-- ClzOp -> \[r] [x] -> PrimInline $ r |= app "h$clz32" [x]- Clz8Op -> \[r] [x] -> PrimInline $ r |= app "h$clz8" [x]- Clz16Op -> \[r] [x] -> PrimInline $ r |= app "h$clz16" [x]- Clz32Op -> \[r] [x] -> PrimInline $ r |= app "h$clz32" [x]- Clz64Op -> \[r] [x1,x2] -> PrimInline $ r |= app "h$clz64" [x1,x2]- CtzOp -> \[r] [x] -> PrimInline $ r |= app "h$ctz32" [x]- Ctz8Op -> \[r] [x] -> PrimInline $ r |= app "h$ctz8" [x]- Ctz16Op -> \[r] [x] -> PrimInline $ r |= app "h$ctz16" [x]- Ctz32Op -> \[r] [x] -> PrimInline $ r |= app "h$ctz32" [x]- Ctz64Op -> \[r] [x1,x2] -> PrimInline $ r |= app "h$ctz64" [x1,x2]-- BSwap16Op -> \[r] [x] -> PrimInline $- r |= BOr ((mask8 x) .<<. (Int 8))- (mask8 (x .>>>. (Int 8)))- BSwap32Op -> \[r] [x] -> PrimInline $- r |= toU32 ((x .<<. (Int 24))- `BOr` ((BAnd x (Int 0xFF00)) .<<. (Int 8))- `BOr` ((BAnd x (Int 0xFF0000)) .>>. (Int 8))- `BOr` (x .>>>. (Int 24)))- BSwap64Op -> \[r1,r2] [x,y] -> PrimInline $ appT [r1,r2] "h$bswap64" [x,y]- BSwapOp -> \[r] [x] -> genPrim prof bound ty BSwap32Op [r] [x]-- BRevOp -> \[r] [w] -> genPrim prof bound ty BRev32Op [r] [w]- BRev8Op -> \[r] [w] -> PrimInline $ r |= (app "h$reverseWord" [w] .>>>. 24)- BRev16Op -> \[r] [w] -> PrimInline $ r |= (app "h$reverseWord" [w] .>>>. 16)- BRev32Op -> \[r] [w] -> PrimInline $ r |= app "h$reverseWord" [w]- BRev64Op -> \[rh,rl] [h,l] -> PrimInline $ mconcat [ rl |= app "h$reverseWord" [h]- , rh |= app "h$reverseWord" [l]- ]-------------------------------- Narrow --------------------------------------------- Narrow8IntOp -> \[r] [x] -> PrimInline $ r |= signExtend8 x- Narrow16IntOp -> \[r] [x] -> PrimInline $ r |= signExtend16 x- Narrow32IntOp -> \[r] [x] -> PrimInline $ r |= toI32 x- Narrow8WordOp -> \[r] [x] -> PrimInline $ r |= mask8 x- Narrow16WordOp -> \[r] [x] -> PrimInline $ r |= mask16 x- Narrow32WordOp -> \[r] [x] -> PrimInline $ r |= toU32 x-------------------------------- Double --------------------------------------------- DoubleGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)- DoubleGeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)- DoubleEqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)- DoubleNeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)- DoubleLtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)- DoubleLeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)- DoubleAddOp -> \[r] [x,y] -> PrimInline $ r |= Add x y- DoubleSubOp -> \[r] [x,y] -> PrimInline $ r |= Sub x y- DoubleMulOp -> \[r] [x,y] -> PrimInline $ r |= Mul x y- DoubleDivOp -> \[r] [x,y] -> PrimInline $ r |= Div x y- DoubleNegOp -> \[r] [x] -> PrimInline $ r |= Negate x- DoubleFabsOp -> \[r] [x] -> PrimInline $ r |= math_abs [x]- DoubleToIntOp -> \[r] [x] -> PrimInline $ r |= toI32 x- DoubleToFloatOp -> \[r] [x] -> PrimInline $ r |= math_fround [x]- DoubleExpOp -> \[r] [x] -> PrimInline $ r |= math_exp [x]- DoubleExpM1Op -> \[r] [x] -> PrimInline $ r |= math_expm1 [x]- DoubleLogOp -> \[r] [x] -> PrimInline $ r |= math_log [x]- DoubleLog1POp -> \[r] [x] -> PrimInline $ r |= math_log1p [x]- DoubleSqrtOp -> \[r] [x] -> PrimInline $ r |= math_sqrt [x]- DoubleSinOp -> \[r] [x] -> PrimInline $ r |= math_sin [x]- DoubleCosOp -> \[r] [x] -> PrimInline $ r |= math_cos [x]- DoubleTanOp -> \[r] [x] -> PrimInline $ r |= math_tan [x]- DoubleAsinOp -> \[r] [x] -> PrimInline $ r |= math_asin [x]- DoubleAcosOp -> \[r] [x] -> PrimInline $ r |= math_acos [x]- DoubleAtanOp -> \[r] [x] -> PrimInline $ r |= math_atan [x]- DoubleSinhOp -> \[r] [x] -> PrimInline $ r |= math_sinh [x]- DoubleCoshOp -> \[r] [x] -> PrimInline $ r |= math_cosh [x]- DoubleTanhOp -> \[r] [x] -> PrimInline $ r |= math_tanh [x]- DoubleAsinhOp -> \[r] [x] -> PrimInline $ r |= math_asinh [x]- DoubleAcoshOp -> \[r] [x] -> PrimInline $ r |= math_acosh [x]- DoubleAtanhOp -> \[r] [x] -> PrimInline $ r |= math_atanh [x]- DoublePowerOp -> \[r] [x,y] -> PrimInline $ r |= math_pow [x,y]- DoubleDecode_2IntOp -> \[s,h,l,e] [x] -> PrimInline $ appT [s,h,l,e] "h$decodeDouble2Int" [x]- DoubleDecode_Int64Op -> \[s1,s2,e] [d] -> PrimInline $ appT [e,s1,s2] "h$decodeDoubleInt64" [d]-------------------------------- Float ---------------------------------------------- FloatGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)- FloatGeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)- FloatEqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)- FloatNeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)- FloatLtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)- FloatLeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)- FloatAddOp -> \[r] [x,y] -> PrimInline $ r |= math_fround [Add x y]- FloatSubOp -> \[r] [x,y] -> PrimInline $ r |= math_fround [Sub x y]- FloatMulOp -> \[r] [x,y] -> PrimInline $ r |= math_fround [Mul x y]- FloatDivOp -> \[r] [x,y] -> PrimInline $ r |= math_fround [Div x y]- FloatNegOp -> \[r] [x] -> PrimInline $ r |= Negate x- FloatFabsOp -> \[r] [x] -> PrimInline $ r |= math_abs [x]- FloatToIntOp -> \[r] [x] -> PrimInline $ r |= toI32 x- FloatExpOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_exp [x]]- FloatExpM1Op -> \[r] [x] -> PrimInline $ r |= math_fround [math_expm1 [x]]- FloatLogOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_log [x]]- FloatLog1POp -> \[r] [x] -> PrimInline $ r |= math_fround [math_log1p [x]]- FloatSqrtOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_sqrt [x]]- FloatSinOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_sin [x]]- FloatCosOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_cos [x]]- FloatTanOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_tan [x]]- FloatAsinOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_asin [x]]- FloatAcosOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_acos [x]]- FloatAtanOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_atan [x]]- FloatSinhOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_sinh [x]]- FloatCoshOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_cosh [x]]- FloatTanhOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_tanh [x]]- FloatAsinhOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_asinh [x]]- FloatAcoshOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_acosh [x]]- FloatAtanhOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_atanh [x]]- FloatPowerOp -> \[r] [x,y] -> PrimInline $ r |= math_fround [math_pow [x,y]]- FloatToDoubleOp -> \[r] [x] -> PrimInline $ r |= x- FloatDecode_IntOp -> \[s,e] [x] -> PrimInline $ appT [s,e] "h$decodeFloatInt" [x]-------------------------------- Arrays --------------------------------------------- NewArrayOp -> \[r] [l,e] -> PrimInline (newArray r l e)- ReadArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i)- WriteArrayOp -> \[] [a,i,v] -> PrimInline $ boundsChecked bound a i (a .! i |= v)- SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length"- SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length"- IndexArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i)- UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a- UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a- CopyArrayOp -> \[] [a,o1,ma,o2,n] ->- PrimInline $ loopBlockS (Int 0) (.<. n) \i ->- [ ma .! (Add i o2) |= a .! (Add i o1)- , preIncrS i- ]- CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] -> PrimInline $ appS "h$copyMutableArray" [a1,o1,a2,o2,n]- CloneArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n]- CloneMutableArrayOp -> \[r] [a,start,n] -> genPrim prof bound ty CloneArrayOp [r] [a,start,n]- FreezeArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n]- ThawArrayOp -> \[r] [a,start,n] -> PrimInline $ r |= app "h$sliceArray" [a,start,n]- CasArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $- jVar \x -> mconcat- [ x |= a .! i- , ifBlockS (x .===. old)- [ o |= new- , a .! i |= new- , s |= zero_- ]- [ s |= one_- , o |= x- ]- ]-------------------------------- Small Arrays --------------------------------------- NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e]- ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i)- WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ boundsChecked bound a i (a .! i |= e)- SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length"- SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length"- IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ boundsChecked bound a i (r |= a .! i)- UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a- UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a- CopySmallArrayOp -> \[] [s,si,d,di,n] -> PrimInline $- loopBlockS (Sub n one_) (.>=. zero_) \i ->- [ d .! (Add di i) |= s .! (Add si i)- , postDecrS i- ]- CopySmallMutableArrayOp -> \[] [s,si,d,di,n] -> PrimInline $ appS "h$copyMutableArray" [s,si,d,di,n]- CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n- CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n- FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n- ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray r a (Just o) n- CasSmallArrayOp -> \[s,o] [a,i,old,new] -> PrimInline $ jVar \x -> mconcat- [ x |= a .! i- , ifBlockS (x .===. old)- [ o |= new- , a .! i |= new- , s |= zero_- ]- [ s |= one_- , o |= x- ]- ]--------------------------------- Byte Arrays --------------------------------------- NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l)- NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l)- NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l)- MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_- ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_- ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_]- MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_]- ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n]- ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n]- UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b- SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len"- SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len"- GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len"- IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i- IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i- IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i- IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i- IndexByteArrayOp_Addr -> \[r1,r2] [a,i] ->- PrimInline . boundsChecked bound a i $ jVar \t -> mconcat- [ t |= a .^ "arr"- , ifBlockS (t .&&. t .! (i .<<. two_))- [ r1 |= t .! (i .<<. two_) .! zero_- , r2 |= t .! (i .<<. two_) .! one_- ]- [ r1 |= null_- , r2 |= zero_- ]- ]-- IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i- IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i- IndexByteArrayOp_StablePtr -> \[r1,r2] [a,i] ->- PrimInline . boundsChecked bound a (Add i 3) $ mconcat- [ r1 |= var "h$stablePtrBuf"- , r2 |= read_i32 a i- ]- IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i- IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i- IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i- IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat- [ h |= read_i32 a (Add (i .<<. one_) one_)- , l |= read_u32 a (i .<<. one_)- ]- IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i- IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i- IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i- IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ mconcat- [ h |= read_u32 a (Add (i .<<. one_) one_)- , l |= read_u32 a (i .<<. one_)- ]- ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i- ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i- ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i- ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i- ReadByteArrayOp_Addr -> \[r1,r2] [a,i] ->- PrimInline $ jVar \x -> mconcat- [ x |= i .<<. two_- , ifS (a .^ "arr" .&&. a .^ "arr" .! x)- (mconcat [ r1 |= a .^ "arr" .! x .! zero_- , r2 |= a .^ "arr" .! x .! one_- ])- (mconcat [r1 |= null_, r2 |= one_])- ]- ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_f32 a i- ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_f64 a i- ReadByteArrayOp_StablePtr -> \[r1,r2] [a,i] ->- PrimInline . boundsChecked bound a (Add i 3) $ mconcat- [ r1 |= var "h$stablePtrBuf"- , r2 |= read_i32 a i- ]- ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_i8 a i- ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_i16 a i- ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i- ReadByteArrayOp_Int64 -> \[h,l] [a,i] ->- PrimInline . boundsChecked bound a (Add i 7) $ mconcat- [ h |= read_i32 a (Add (i .<<. one_) one_)- , l |= read_u32 a (i .<<. one_)- ]- ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_u8 a i- ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_u16 a i- ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_u32 a i- ReadByteArrayOp_Word64 -> \[h,l] [a,i] ->- PrimInline . boundsChecked bound a (Add i 7) $ mconcat- [ h |= read_u32 a (Add (i .<<. one_) one_)- , l |= read_u32 a (i .<<. one_)- ]- WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e- WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e- WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e- WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e- WriteByteArrayOp_Addr -> \[] [a,i,e1,e2] ->- PrimInline $ mconcat- [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty- , a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2])- ]- WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_f32 a i e- WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_f64 a i e- WriteByteArrayOp_StablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e2-- WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_i8 a i e- WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_i16 a i e- WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i e- WriteByteArrayOp_Int64 -> \[] [a,i,e1,e2] ->- PrimInline . boundsChecked bound a (Add i 7) $ mconcat- [ write_i32 a (Add (i .<<. one_) one_) e1- , write_u32 a (i .<<. one_) e2- ]- WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_u8 a i e- WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_u16 a i e- WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_u32 a i e- WriteByteArrayOp_Word64 -> \[] [a,i,h,l] ->- PrimInline . boundsChecked bound a (Add i 7) $ mconcat- [ write_u32 a (Add (i .<<. one_) one_) h- , write_u32 a (i .<<. one_) l- ]- CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] ->- PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1))- . boundsChecked bound a2 (Add o2 (Sub n 1))- $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n]-- CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] ->- PrimInline . boundsChecked bound a1 (Add o1 (Sub n 1))- . boundsChecked bound a2 (Add o2 (Sub n 1))- $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n]- CopyMutableByteArrayOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs- CopyByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs- CopyMutableByteArrayToAddrOp -> \[] xs@[_a1,_o1,_a2,_o2,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs- CopyAddrToByteArrayOp -> \[] xs@[_ba,_bo,_aa,_ao,_n] -> genPrim prof bound ty CopyByteArrayOp [] xs-- SetByteArrayOp -> \[] [a,o,n,v] ->- PrimInline . boundsChecked bound a (Add o (Sub n 1)) $ loopBlockS zero_ (.<. n) \i ->- [ write_u8 a (Add o i) v- , postIncrS i- ]-- AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_i32 a i- AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ write_i32 a i v- FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Add r a i v- FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray Sub r a i v- FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BAnd r a i v- FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BOr r a i v- FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v- FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline . boundsChecked bound a (Add i 3) $ fetchOpByteArray BXor r a i v--------------------------------- Addr# -------------------------------------------- AddrAddOp -> \[a',o'] [a,o,i] -> PrimInline $ mconcat [a' |= a, o' |= Add o i]- AddrSubOp -> \[i] [_a1,o1,_a2,o2] -> PrimInline $ i |= Sub o1 o2- AddrRemOp -> \[r] [_a,o,i] -> PrimInline $ r |= Mod o i- AddrToIntOp -> \[i] [_a,o] -> PrimInline $ i |= o -- only usable for comparisons within one range- IntToAddrOp -> \[a,o] [i] -> PrimInline $ mconcat [a |= null_, o |= i]- AddrGtOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .>. zero_)- AddrGeOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .>=. zero_)- AddrEqOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .===. zero_)- AddrNeOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .!==. zero_)- AddrLtOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .<. zero_)- AddrLeOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .<=. zero_)--------------------------------- Addr Indexing: Unboxed Arrays --------------------- IndexOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i)- IndexOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i)- IndexOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i)- IndexOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i)- IndexOffAddrOp_Addr -> \[ca,co] [a,o,i] ->- PrimInline . boundsChecked bound (a .^ "arr") (off32 o i)- $ ifBlockS (a .^ "arr " .&&. a .^ "arr" .! (i .<<. two_))- [ ca |= a .^ "arr" .! (off32 o i) .! zero_- , co |= a .^ "arr" .! (off32 o i) .! one_- ]- [ ca |= null_- , co |= zero_- ]- IndexOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i)- IndexOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i)- IndexOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat- [ c1 |= var "h$stablePtrBuf"- , c2 |= read_boff_i32 a (off32 o i)- ]- IndexOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_i8 a (off8 o i)- IndexOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_i16 a (off16 o i)- IndexOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i)- IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] ->- PrimInline $ mconcat- [ h |= read_boff_i32 a (Add (off64 o i) (Int 4))- , l |= read_boff_u32 a (off64 o i)- ]- IndexOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i)- IndexOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ c |= read_boff_u16 a (off16 o i)- IndexOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i)- IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] ->- PrimInline $ mconcat- [ h |= read_boff_u32 a (Add (off64 o i) (Int 4))- , l |= read_boff_u32 a (off64 o i)- ]- ReadOffAddrOp_Char -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ c |= read_boff_u8 a (off8 o i)- ReadOffAddrOp_WideChar -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i)- ReadOffAddrOp_Int -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_i32 a (off32 o i)- ReadOffAddrOp_Word -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_u32 a (off32 o i)- ReadOffAddrOp_Addr -> \[c1,c2] [a,o,i] ->- PrimInline $ jVar \x -> mconcat- [ x |= i .<<. two_- , boundsChecked bound (a .^ "arr") (Add o x) $- ifBlockS (a .^ "arr" .&&. a .^ "arr" .! (Add o x))- [ c1 |= a .^ "arr" .! (Add o x) .! zero_- , c2 |= a .^ "arr" .! (Add o x) .! one_- ]- [ c1 |= null_- , c2 |= zero_- ]- ]- ReadOffAddrOp_Float -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ c |= read_boff_f32 a (off32 o i)- ReadOffAddrOp_Double -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off64 o i) $ c |= read_boff_f64 a (off64 o i)- ReadOffAddrOp_StablePtr -> \[c1,c2] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ mconcat- [ c1 |= var "h$stablePtrBuf"- , c2 |= read_boff_u32 a (off32 o i)- ]- ReadOffAddrOp_Int8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_i8 a (off8 o i)- ReadOffAddrOp_Int16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_i16 a (off16 o i)- ReadOffAddrOp_Int32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_i32 a (off32 o i)- ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] ->- PrimInline $ mconcat- [ h |= read_i32 a (Add (off64 o i) (Int 4))- , l |= read_u32 a (off64 o i)- ]- ReadOffAddrOp_Word8 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off8 o i) $ AssignStat c $ read_boff_u8 a (off8 o i)- ReadOffAddrOp_Word16 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off16 o i) $ AssignStat c $ read_boff_u16 a (off16 o i)- ReadOffAddrOp_Word32 -> \[c] [a,o,i] -> PrimInline . boundsChecked bound a (off32 o i) $ AssignStat c $ read_boff_u32 a (off32 o i)- ReadOffAddrOp_Word64 -> \[c1,c2] [a,o,i] ->- PrimInline $ mconcat- [ c1 |= read_boff_u32 a (Add (off64 o i) (Int 4))- , c2 |= read_boff_u32 a (off64 o i)- ]- WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v- WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v- WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v- WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v- WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] ->- PrimInline $ mconcat- [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty- , boundsChecked bound (a .^ "arr") (off32 o i) $- AssignStat (a .^ "arr" .! (off32 o i)) $ ValExpr (JList [va, vo])- ]- WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_f32 a (off32 o i) v- WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off64 o i) $ write_boff_f64 a (off64 o i) v- WriteOffAddrOp_StablePtr -> \[] [a,o,i,_v1,v2] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v2- WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_i8 a (off8 o i) v- WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_i16 a (off16 o i) v- WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_i32 a (off32 o i) v- WriteOffAddrOp_Int64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat- [ write_boff_i32 a (Add (off64 o i) (Int 4)) v1- , write_boff_u32 a (off64 o i) v2- ]- WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off8 o i) $ write_boff_u8 a (off8 o i) v- WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off16 o i) $ write_boff_u16 a (off16 o i) v- WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline . boundsChecked bound a (off32 o i) $ write_boff_u32 a (off32 o i) v- WriteOffAddrOp_Word64 -> \[] [a,o,i,v1,v2] -> PrimInline . boundsChecked bound a (off64 o i) $ mconcat- [ write_boff_u32 a (Add (off64 o i) (Int 4)) v1- , write_boff_u32 a (off64 o i) v2- ]--- Mutable variables- NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x])- ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val"- WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x- AtomicModifyMutVar2Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar2" [m,f]- AtomicModifyMutVar_Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar" [m,f]-- CasMutVarOp -> \[status,r] [mv,o,n] -> PrimInline $ ifS (mv .^ "val" .===. o)- (mconcat [status |= zero_, r |= n, mv .^ "val" |= n])- (mconcat [status |= one_ , r |= mv .^ "val"])--------------------------------- Exceptions ---------------------------------------- CatchOp -> \[_r] [a,handler] -> PRPrimCall $ returnS (app "h$catch" [a, handler])-- -- fully ignore the result arity as it can use 1 or 2- -- slots, depending on the return type.- RaiseOp -> \_r [a] -> PRPrimCall $ returnS (app "h$throw" [a, false_])- RaiseIOOp -> \_r [a] -> PRPrimCall $ returnS (app "h$throw" [a, false_])- RaiseUnderflowOp -> \_r [] -> PRPrimCall $ returnS (app "h$throw" [var "h$baseZCGHCziExceptionziTypeziunderflowException", false_])- RaiseOverflowOp -> \_r [] -> PRPrimCall $ returnS (app "h$throw" [var "h$baseZCGHCziExceptionziTypezioverflowException", false_])- RaiseDivZeroOp -> \_r [] -> PRPrimCall $ returnS (app "h$throw" [var "h$baseZCGHCziExceptionziTypezidivZZeroException", false_])- MaskAsyncExceptionsOp -> \_r [a] -> PRPrimCall $ returnS (app "h$maskAsync" [a])- MaskUninterruptibleOp -> \_r [a] -> PRPrimCall $ returnS (app "h$maskUnintAsync" [a])- UnmaskAsyncExceptionsOp -> \_r [a] -> PRPrimCall $ returnS (app "h$unmaskAsync" [a])-- MaskStatus -> \[r] [] -> PrimInline $ r |= app "h$maskStatus" []--------------------------------- STM-accessible Mutable Variables ---------------- AtomicallyOp -> \[_r] [a] -> PRPrimCall $ returnS (app "h$atomically" [a])- RetryOp -> \_r [] -> PRPrimCall $ returnS (app "h$stmRetry" [])- CatchRetryOp -> \[_r] [a,b] -> PRPrimCall $ returnS (app "h$stmCatchRetry" [a,b])- CatchSTMOp -> \[_r] [a,h] -> PRPrimCall $ returnS (app "h$catchStm" [a,h])- NewTVarOp -> \[tv] [v] -> PrimInline $ tv |= app "h$newTVar" [v]- ReadTVarOp -> \[r] [tv] -> PrimInline $ r |= app "h$readTVar" [tv]- ReadTVarIOOp -> \[r] [tv] -> PrimInline $ r |= app "h$readTVarIO" [tv]- WriteTVarOp -> \[] [tv,v] -> PrimInline $ appS "h$writeTVar" [tv,v]--------------------------------- Synchronized Mutable Variables -------------------- NewMVarOp -> \[r] [] -> PrimInline $ r |= New (app "h$MVar" [])- TakeMVarOp -> \[_r] [m] -> PRPrimCall $ returnS (app "h$takeMVar" [m])- TryTakeMVarOp -> \[r,v] [m] -> PrimInline $ appT [r,v] "h$tryTakeMVar" [m]- PutMVarOp -> \[] [m,v] -> PRPrimCall $ returnS (app "h$putMVar" [m,v])- TryPutMVarOp -> \[r] [m,v] -> PrimInline $ r |= app "h$tryPutMVar" [m,v]- ReadMVarOp -> \[_r] [m] -> PRPrimCall $ returnS (app "h$readMVar" [m])- TryReadMVarOp -> \[r,v] [m] -> PrimInline $ mconcat- [ v |= m .^ "val"- , r |= if01 (v .===. null_)- ]- IsEmptyMVarOp -> \[r] [m] -> PrimInline $ r |= if10 (m .^ "val" .===. null_)--------------------------------- Delay/Wait Ops ----------------------------------- DelayOp -> \[] [t] -> PRPrimCall $ returnS (app "h$delayThread" [t])- WaitReadOp -> \[] [fd] -> PRPrimCall $ returnS (app "h$waidRead" [fd])- WaitWriteOp -> \[] [fd] -> PRPrimCall $ returnS (app "h$waitWrite" [fd])--------------------------------- Concurrency Primitives --------------------------- ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_])- ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument- KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex])- YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" [])- MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread"- IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_- NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing- ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid]- ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" []- GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t]- LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l--------------------------------- Weak Pointers ------------------------------------- MkWeakOp -> \[r] [o,b,c] -> PrimInline $ r |= app "h$makeWeak" [o,b,c]- MkWeakNoFinalizerOp -> \[r] [o,b] -> PrimInline $ r |= app "h$makeWeakNoFinalizer" [o,b]- AddCFinalizerToWeakOp -> \[r] [_a1,_a1o,_a2,_a2o,_i,_a3,_a3o,_w] -> PrimInline $ r |= one_- DeRefWeakOp -> \[f,v] [w] -> PrimInline $ mconcat- [ v |= w .^ "val"- , f |= if01 (v .===. null_)- ]- FinalizeWeakOp -> \[fl,fin] [w] -> PrimInline $ appT [fin, fl] "h$finalizeWeak" [w]- TouchOp -> \[] [_e] -> PrimInline mempty- KeepAliveOp -> \[_r] [x, f] -> PRPrimCall $ ReturnStat (app "h$keepAlive" [x, f])--------------------------------- Stable pointers and names -------------------------- MakeStablePtrOp -> \[s1,s2] [a] -> PrimInline $ mconcat- [ s1 |= var "h$stablePtrBuf"- , s2 |= app "h$makeStablePtr" [a]- ]- DeRefStablePtrOp -> \[r] [_s1,s2] -> PrimInline $ r |= app "h$deRefStablePtr" [s2]- EqStablePtrOp -> \[r] [_sa1,sa2,_sb1,sb2] -> PrimInline $ r |= if10 (sa2 .===. sb2)-- MakeStableNameOp -> \[r] [a] -> PrimInline $ r |= app "h$makeStableName" [a]- StableNameToIntOp -> \[r] [s] -> PrimInline $ r |= app "h$stableNameInt" [s]-------------------------------- Compact normal form ------------------------------- CompactNewOp -> \[c] [s] -> PrimInline $ c |= app "h$compactNew" [s]- CompactResizeOp -> \[] [c,s] -> PrimInline $ appS "h$compactResize" [c,s]- CompactContainsOp -> \[r] [c,v] -> PrimInline $ r |= app "h$compactContains" [c,v]- CompactContainsAnyOp -> \[r] [v] -> PrimInline $ r |= app "h$compactContainsAny" [v]- CompactGetFirstBlockOp -> \[ra,ro,s] [c] ->- PrimInline $ appT [ra,ro,s] "h$compactGetFirstBlock" [c]- CompactGetNextBlockOp -> \[ra,ro,s] [c,a,o] ->- PrimInline $ appT [ra,ro,s] "h$compactGetNextBlock" [c,a,o]- CompactAllocateBlockOp -> \[ra,ro] [size,sa,so] ->- PrimInline $ appT [ra,ro] "h$compactAllocateBlock" [size,sa,so]- CompactFixupPointersOp -> \[c,newroota, newrooto] [blocka,blocko,roota,rooto] ->- PrimInline $ appT [c,newroota,newrooto] "h$compactFixupPointers" [blocka,blocko,roota,rooto]- CompactAdd -> \[_r] [c,o] ->- PRPrimCall $ returnS (app "h$compactAdd" [c,o])- CompactAddWithSharing -> \[_r] [c,o] ->- PRPrimCall $ returnS (app "h$compactAddWithSharing" [c,o])- CompactSize -> \[s] [c] ->- PrimInline $ s |= app "h$compactSize" [c]-------------------------------- Unsafe pointer equality ---------------------------- ReallyUnsafePtrEqualityOp -> \[r] [p1,p2] -> PrimInline $ r |= if10 (p1 .===. p2)-------------------------------- Parallelism ---------------------------------------- ParOp -> \[r] [_a] -> PrimInline $ r |= zero_- SparkOp -> \[r] [a] -> PrimInline $ r |= a- SeqOp -> \[_r] [e] -> PRPrimCall $ returnS (app "h$e" [e])- NumSparks -> \[r] [] -> PrimInline $ r |= zero_-------------------------------- Tag to enum stuff ---------------------------------- DataToTagOp -> \[_r] [d] -> PRPrimCall $ mconcat- [ stack .! PreInc sp |= var "h$dataToTag_e"- , returnS (app "h$e" [d])- ]- TagToEnumOp -> \[r] [tag] -> if- | isBoolTy ty -> PrimInline $ r |= IfExpr tag true_ false_- | otherwise -> PrimInline $ r |= app "h$tagToEnum" [tag]-------------------------------- Bytecode operations -------------------------------- AddrToAnyOp -> \[r] [d,_o] -> PrimInline $ r |= d-------------------------------- Profiling (CCS) -------------------------------- GetCCSOfOp -> \[a, o] [obj] -> if- | prof -> PrimInline $ mconcat- [ a |= if_ (isObject obj)- (app "h$buildCCSPtr" [obj .^ "cc"])- null_- , o |= zero_- ]- | otherwise -> PrimInline $ mconcat- [ a |= null_- , o |= zero_- ]-- GetCurrentCCSOp -> \[a, o] [_dummy_arg] ->- let ptr = if prof then app "h$buildCCSPtr" [jCurrentCCS]- else null_- in PrimInline $ mconcat- [ a |= ptr- , o |= zero_- ]-- ClearCCSOp -> \[_r] [x] -> PRPrimCall $ ReturnStat (app "h$clearCCS" [x])-------------------------------- Eventlog --------------------- TraceEventOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceEvent" [ed,eo]- TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len]- TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo]-- IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i- IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i- IndexByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] ->- PrimInline $ jVar \x -> mconcat- [ x |= i .<<. two_- , boundsChecked bound (a .^ "arr") x $- ifS (a .^ "arr" .&&. a .^ "arr" .! x)- (mconcat [ r1 |= a .^ "arr" .! x .! zero_- , r2 |= a .^ "arr" .! x .! one_- ])- (mconcat [r1 |= null_, r2 |= one_])- ]- IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i- IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i- IndexByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] ->- PrimInline $ mconcat- [ r1 |= var "h$stablePtrBuf"- , r2 |= read_boff_i32 a i- ]- IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i- IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i- IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] ->- PrimInline $ mconcat- [ h |= read_boff_i32 a (Add i (Int 4))- , l |= read_boff_u32 a i- ]- IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i- IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i- IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i- IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] ->- PrimInline . boundsChecked bound a (Add i 7) $ mconcat- [ h |= read_boff_u32 a (Add i (Int 4))- , l |= read_boff_u32 a i- ]- IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i-- ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a i $ r |= read_boff_u8 a i- ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i- ReadByteArrayOp_Word8AsAddr -> \[r1,r2] [a,i] ->- PrimInline $ jVar \x -> mconcat- [ x |= i .<<. two_- , boundsChecked bound (a .^ "arr") x $- ifS (a .^ "arr" .&&. a .^ "arr" .! x)- (mconcat [ r1 |= a .^ "arr" .! x .! zero_- , r2 |= a .^ "arr" .! x .! one_- ])- (mconcat [r1 |= null_, r2 |= one_])- ]- ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_f32 a i- ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 7) $ r |= read_boff_f64 a i- ReadByteArrayOp_Word8AsStablePtr -> \[r1,r2] [a,i] ->- PrimInline $ mconcat- [ r1 |= var "h$stablePtrBuf"- , r2 |= read_boff_i32 a i- ]- ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_i16 a i- ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i- ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] ->- PrimInline $ mconcat- [ h |= read_boff_i32 a (Add i (Int 4))- , l |= read_boff_u32 a i- ]- ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_i32 a i- ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 1) $ r |= read_boff_u16 a i- ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i- ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] ->- PrimInline . boundsChecked bound a (Add i 7) $ mconcat- [ h |= read_boff_u32 a (Add i (Int 4))- , l |= read_boff_u32 a i- ]- ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline . boundsChecked bound a (Add i 3) $ r |= read_boff_u32 a i-- WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a i $ write_boff_i8 a i e- WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e- WriteByteArrayOp_Word8AsAddr -> \[] [a,i,e1,e2] ->- PrimInline $ mconcat- [ ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty- , boundsChecked bound (a .^ "arr") (i .<<. two_) $- a .^ "arr" .! (i .<<. two_) |= ValExpr (JList [e1, e2])- ]-- WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_f32 a i e- WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 7) $ write_boff_f64 a i e- WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_e1,e2] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e2- WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_i16 a i e- WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e- WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] ->- -- JS Numbers are little-endian and 32-bit, so write the lower 4 bytes at i- -- then write the higher 4 bytes to i+4- PrimInline . boundsChecked bound a i- $ mconcat [ write_boff_i32 a (Add i (Int 4)) h- , write_boff_u32 a i l- ]- WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_i32 a i e- WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 1) $ write_boff_u16 a i e- WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e- WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] ->- PrimInline . boundsChecked bound a (Add i 7)- $ mconcat [ write_boff_u32 a (Add i (Int 4)) h- , write_boff_u32 a i l- ]- WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline . boundsChecked bound a (Add i 3) $ write_boff_u32 a i e-- CasByteArrayOp_Int -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new- CasByteArrayOp_Int8 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a i $ casOp read_i8 write_i8 r a i old new- CasByteArrayOp_Int16 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 1) $ casOp read_i16 write_i16 r a i old new- CasByteArrayOp_Int32 -> \[r] [a,i,old,new] -> PrimInline . boundsChecked bound a (Add i 3) $ casOp read_i32 write_i32 r a i old new-- CasByteArrayOp_Int64 -> \[r_h,r_l] [a,i,old_h,old_l,new_h,new_l] -> PrimInline . boundsChecked bound a (Add (i .<<. one_) one_) $- jVar \t_h t_l -> mconcat [ t_h |= read_i32 a (Add (i .<<. one_) one_)- , t_l |= read_u32 a (i .<<. one_)- , r_h |= t_h- , r_l |= t_l- , ifS (t_l .===. old_l) -- small optimization, check low bits first, fail fast- (ifBlockS (t_h .===. old_h)- -- Pre-Condition is good, do the write- [ write_i32 a (Add (i .<<. one_) one_) new_h- , write_u32 a (i .<<. one_) new_l- ]- -- no good, don't write- mempty)- mempty- ]-- CasAddrOp_Addr -> \[r_a,r_o] [a1,o1,a2,o2,a3,o3] -> PrimInline $- mconcat [ ifS (app "h$comparePointer" [a1,o1,a2,o2])- (appS "h$memcpy" [a3,o3,a1,o1,8])- mempty- , r_a |= a1- , r_o |= o1- ]- CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new- CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new- CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new- CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new- CasAddrOp_Word64 -> \[r_h,r_l] [a,o,old_h,old_l,new_h,new_l] -> PrimInline $- mconcat [ r_h |= read_u32 a (Add o (Int 4))- , r_l |= read_u32 a o- , ifS (r_l .===. old_l)- (ifBlockS (r_h .===. old_h)- [ write_u32 a (Add o (Int 4)) new_h- , write_u32 a o new_l- ]- mempty)- mempty- ]-- FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v- FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v- FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v- FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v- FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v- FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v-- InterlockedExchange_Addr -> \[r_a,r_o] [a1,o1,_a2,o2] -> PrimInline $- -- this primop can't be implemented- -- correctly because we don't store- -- the array reference part of an Addr#,- -- only the offset part.- --- -- So let's assume that all the array- -- references are the same...- --- -- Note: we could generate an assert- -- that checks that a1 === a2. However- -- we can't check that the Addr# read- -- at Addr# a2[o2] also comes from this- -- a1/a2 array.- mconcat [ r_a |= a1 -- might be wrong (see above)- , r_o |= read_boff_u32 a1 o1- -- TODO (see above)- -- assert that a1 === a2- , write_boff_u32 a1 o1 o2- ]- InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $- mconcat [ r |= read_boff_u32 a o- , write_boff_u32 a o w- ]-- ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n]- GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length"-- AtomicReadAddrOp_Word -> \[r] [a,o] -> PrimInline $ r |= read_boff_u32 a o- AtomicWriteAddrOp_Word -> \[] [a,o,w] -> PrimInline $ write_boff_u32 a o w--------------------------------- Unhandled primops --------------------- NewPromptTagOp -> unhandledPrimop op- PromptOp -> unhandledPrimop op- Control0Op -> unhandledPrimop op-- NewIOPortOp -> unhandledPrimop op- ReadIOPortOp -> unhandledPrimop op- WriteIOPortOp -> unhandledPrimop op-- GetSparkOp -> unhandledPrimop op- AnyToAddrOp -> unhandledPrimop op- MkApUpd0_Op -> unhandledPrimop op- NewBCOOp -> unhandledPrimop op- UnpackClosureOp -> unhandledPrimop op- ClosureSizeOp -> unhandledPrimop op- GetApStackValOp -> unhandledPrimop op- WhereFromOp -> unhandledPrimop op -- should be easily implementable with o.f.n-- SetThreadAllocationCounter -> unhandledPrimop op--------------------------------- Vector -------------------------------------------- For now, vectors are unsupported on the JS backend. Simply put, they do not--- make much sense to support given support for arrays and lack of SIMD support--- in JS. We could try to roll something special but we would not be able to--- give any performance guarentees to the user and so we leave these has--- unhandled for now.- VecBroadcastOp _ _ _ -> unhandledPrimop op- VecPackOp _ _ _ -> unhandledPrimop op- VecUnpackOp _ _ _ -> unhandledPrimop op- VecInsertOp _ _ _ -> unhandledPrimop op- VecAddOp _ _ _ -> unhandledPrimop op- VecSubOp _ _ _ -> unhandledPrimop op- VecMulOp _ _ _ -> unhandledPrimop op- VecDivOp _ _ _ -> unhandledPrimop op- VecQuotOp _ _ _ -> unhandledPrimop op- VecRemOp _ _ _ -> unhandledPrimop op- VecNegOp _ _ _ -> unhandledPrimop op- VecIndexByteArrayOp _ _ _ -> unhandledPrimop op- VecReadByteArrayOp _ _ _ -> unhandledPrimop op- VecWriteByteArrayOp _ _ _ -> unhandledPrimop op- VecIndexOffAddrOp _ _ _ -> unhandledPrimop op- VecReadOffAddrOp _ _ _ -> unhandledPrimop op- VecWriteOffAddrOp _ _ _ -> unhandledPrimop op-- VecIndexScalarByteArrayOp _ _ _ -> unhandledPrimop op- VecReadScalarByteArrayOp _ _ _ -> unhandledPrimop op- VecWriteScalarByteArrayOp _ _ _ -> unhandledPrimop op- VecIndexScalarOffAddrOp _ _ _ -> unhandledPrimop op- VecReadScalarOffAddrOp _ _ _ -> unhandledPrimop op- VecWriteScalarOffAddrOp _ _ _ -> unhandledPrimop op-- PrefetchByteArrayOp3 -> noOp- PrefetchMutableByteArrayOp3 -> noOp- PrefetchAddrOp3 -> noOp- PrefetchValueOp3 -> noOp- PrefetchByteArrayOp2 -> noOp- PrefetchMutableByteArrayOp2 -> noOp- PrefetchAddrOp2 -> noOp- PrefetchValueOp2 -> noOp- PrefetchByteArrayOp1 -> noOp- PrefetchMutableByteArrayOp1 -> noOp- PrefetchAddrOp1 -> noOp- PrefetchValueOp1 -> noOp- PrefetchByteArrayOp0 -> noOp- PrefetchMutableByteArrayOp0 -> noOp- PrefetchAddrOp0 -> noOp- PrefetchValueOp0 -> noOp--unhandledPrimop :: PrimOp -> [JExpr] -> [JExpr] -> PrimRes-unhandledPrimop op rs as = PrimInline $ mconcat- [ appS "h$log" [toJExpr $ mconcat- [ "warning, unhandled primop: "- , renderWithContext defaultSDocContext (ppr op)- , " "- , show (length rs, length as)- ]]- , appS (mkFastString $ "h$primop_" ++ zEncodeString (renderWithContext defaultSDocContext (ppr op))) as- -- copyRes- , mconcat $ zipWith (\r reg -> r |= toJExpr reg) rs (enumFrom Ret1)- ]---- | A No Op, used for primops the JS platform cannot or do not support. For--- example, the prefetching primops do not make sense on the JS platform because--- we do not have enough control over memory to provide any kind of prefetching--- mechanism. Hence, these are NoOps.-noOp :: Foldable f => f a -> f a -> PrimRes-noOp = const . const $ PrimInline mempty---- tuple returns-appT :: [JExpr] -> FastString -> [JExpr] -> JStat-appT [] f xs = appS f xs-appT (r:rs) f xs = mconcat- [ r |= app f xs- , mconcat (zipWith (\r ret -> r |= toJExpr ret) rs (enumFrom Ret1))- ]------------------------------------------------- ByteArray indexing------------------------------------------------- For every ByteArray, the RTS creates the following views:--- i3: Int32 view--- u8: Word8 view--- u1: Word16 view--- f3: Float32 view--- f6: Float64 view--- dv: generic DataView--- It seems a bit weird to mix Int and Word views like this, but perhaps they--- are the more common.------ See 'h$newByteArray' in 'ghc/rts/js/mem.js' for details.------ Note that *byte* indexing can only be done with the generic DataView. Use--- read_boff_* and write_boff_* for this.------ Other read_* and write_* helpers directly use the more specific views.--- Prefer using them over idx_* to make your intent clearer.--idx_i32, idx_u8, idx_u16, idx_f64, idx_f32 :: JExpr -> JExpr -> JExpr-idx_i32 a i = IdxExpr (a .^ "i3") i-idx_u8 a i = IdxExpr (a .^ "u8") i-idx_u16 a i = IdxExpr (a .^ "u1") i-idx_f64 a i = IdxExpr (a .^ "f6") i-idx_f32 a i = IdxExpr (a .^ "f3") i--read_u8 :: JExpr -> JExpr -> JExpr-read_u8 a i = idx_u8 a i--read_u16 :: JExpr -> JExpr -> JExpr-read_u16 a i = idx_u16 a i--read_u32 :: JExpr -> JExpr -> JExpr-read_u32 a i = toU32 (idx_i32 a i)--read_i8 :: JExpr -> JExpr -> JExpr-read_i8 a i = signExtend8 (idx_u8 a i)--read_i16 :: JExpr -> JExpr -> JExpr-read_i16 a i = signExtend16 (idx_u16 a i)--read_i32 :: JExpr -> JExpr -> JExpr-read_i32 a i = idx_i32 a i--read_f32 :: JExpr -> JExpr -> JExpr-read_f32 a i = idx_f32 a i--read_f64 :: JExpr -> JExpr -> JExpr-read_f64 a i = idx_f64 a i--write_u8 :: JExpr -> JExpr -> JExpr -> JStat-write_u8 a i v = idx_u8 a i |= v--write_u16 :: JExpr -> JExpr -> JExpr -> JStat-write_u16 a i v = idx_u16 a i |= v--write_u32 :: JExpr -> JExpr -> JExpr -> JStat-write_u32 a i v = idx_i32 a i |= v--write_i8 :: JExpr -> JExpr -> JExpr -> JStat-write_i8 a i v = idx_u8 a i |= v--write_i16 :: JExpr -> JExpr -> JExpr -> JStat-write_i16 a i v = idx_u16 a i |= v--write_i32 :: JExpr -> JExpr -> JExpr -> JStat-write_i32 a i v = idx_i32 a i |= v--write_f32 :: JExpr -> JExpr -> JExpr -> JStat-write_f32 a i v = idx_f32 a i |= v--write_f64 :: JExpr -> JExpr -> JExpr -> JStat-write_f64 a i v = idx_f64 a i |= v---- Data View helper functions: byte indexed!------ The argument list consists of the array @a@, the index @i@, and the new value--- to set (in the case of a setter) @v@.--write_boff_i8, write_boff_u8, write_boff_i16, write_boff_u16, write_boff_i32, write_boff_u32, write_boff_f32, write_boff_f64 :: JExpr -> JExpr -> JExpr -> JStat-write_boff_i8 a i v = write_i8 a i v-write_boff_u8 a i v = write_u8 a i v-write_boff_i16 a i v = ApplStat (a .^ "dv" .^ "setInt16" ) [i, v, true_]-write_boff_u16 a i v = ApplStat (a .^ "dv" .^ "setUint16" ) [i, v, true_]-write_boff_i32 a i v = ApplStat (a .^ "dv" .^ "setInt32" ) [i, v, true_]-write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_]-write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_]-write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_]--read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr-read_boff_i8 a i = read_i8 a i-read_boff_u8 a i = read_u8 a i-read_boff_i16 a i = ApplExpr (a .^ "dv" .^ "getInt16" ) [i, true_]-read_boff_u16 a i = ApplExpr (a .^ "dv" .^ "getUint16" ) [i, true_]-read_boff_i32 a i = ApplExpr (a .^ "dv" .^ "getInt32" ) [i, true_]-read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_]-read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_]-read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_]--fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat-fetchOpByteArray op tgt src i v = mconcat- [ tgt |= read_i32 src i- , write_i32 src i (op tgt v)- ]--fetchOpAddr :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat-fetchOpAddr op tgt src i v = mconcat- [ tgt |= read_boff_u32 src i- , write_boff_u32 src i (op tgt v)- ]--casOp- :: (JExpr -> JExpr -> JExpr) -- read- -> (JExpr -> JExpr -> JExpr -> JStat) -- write- -> JExpr -- target register to store result- -> JExpr -- source arrays- -> JExpr -- index- -> JExpr -- old value to compare- -> JExpr -- new value to write- -> JStat-casOp read write tgt src i old new = mconcat- [ tgt |= read src i- , ifS (tgt .===. old)- (write src i new)- mempty- ]------------------------------------------------------------------------------------- Lifted Arrays------------------------------------------------------------------------------------ | lifted arrays-cloneArray :: JExpr -> JExpr -> Maybe JExpr -> JExpr -> JStat-cloneArray tgt src mb_offset len = mconcat- [ tgt |= ApplExpr (src .^ "slice") [start, end]- , tgt .^ closureMeta_ |= zero_- , tgt .^ "__ghcjsArray" |= true_- ]- where- start = fromMaybe zero_ mb_offset- end = maybe len (Add len) mb_offset--newArray :: JExpr -> JExpr -> JExpr -> JStat-newArray tgt len elem =- tgt |= app "h$newArray" [len, elem]--newByteArray :: JExpr -> JExpr -> JStat-newByteArray tgt len =- tgt |= app "h$newByteArray" [len]--boundsChecked :: Bool -- ^ Should we do bounds checking?- -> JExpr -- ^ Array- -> JExpr -- ^ Index- -> JStat -- ^ Result- -> JStat-boundsChecked False _ _ r = r-boundsChecked True xs i r =- ifS ((i .<. xs .^ "length") .&&. (i .>=. zero_))- r- (returnS $ app "h$exitProcess" [Int 134])+++genPrim :: Bool -- ^ Profiling (cost-centres) enabled+ -> Bool -- ^ Array bounds-checking enabled+ -> Type+ -> PrimOp -- ^ the primitive operation+ -> [JExpr] -- ^ where to store the result+ -> [JExpr] -- ^ arguments+ -> PrimRes+genPrim prof bound ty op = case op of+ CharGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)+ CharGeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)+ CharEqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)+ CharNeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)+ CharLtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)+ CharLeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)+ OrdOp -> \[r] [x] -> PrimInline $ r |= x++ Int8ToWord8Op -> \[r] [x] -> PrimInline $ r |= mask8 x+ Word8ToInt8Op -> \[r] [x] -> PrimInline $ r |= signExtend8 x+ Int16ToWord16Op -> \[r] [x] -> PrimInline $ r |= mask16 x+ Word16ToInt16Op -> \[r] [x] -> PrimInline $ r |= signExtend16 x+ Int32ToWord32Op -> \[r] [x] -> PrimInline $ r |= x .>>>. zero_+ Word32ToInt32Op -> \[r] [x] -> PrimInline $ r |= toI32 x++------------------------------ Int ----------------------------------------------++ IntAddOp -> \[r] [x,y] -> PrimInline $ r |= toI32 (Add x y)+ IntSubOp -> \[r] [x,y] -> PrimInline $ r |= toI32 (Sub x y)+ IntMulOp -> \[r] [x,y] -> PrimInline $ r |= app "h$mulInt32" [x, y]+ IntMul2Op -> \[c,hr,lr] [x,y] -> PrimInline $ appT [c,hr,lr] "h$hs_timesInt2" [x, y]+ IntMulMayOfloOp -> \[r] [x,y] -> PrimInline $ jVar \tmp -> mconcat+ [ tmp |= Mul x y+ , r |= if01 (tmp .===. toI32 tmp)+ ]+ IntQuotOp -> \[r] [x,y] -> PrimInline $ r |= toI32 (Div x y)+ IntRemOp -> \[r] [x,y] -> PrimInline $ r |= Mod x y+ IntQuotRemOp -> \[q,r] [x,y] -> PrimInline $ mconcat+ [ q |= toI32 (Div x y)+ , r |= x `Sub` (Mul y q)+ ]+ IntAndOp -> \[r] [x,y] -> PrimInline $ r |= BAnd x y+ IntOrOp -> \[r] [x,y] -> PrimInline $ r |= BOr x y+ IntXorOp -> \[r] [x,y] -> PrimInline $ r |= BXor x y+ IntNotOp -> \[r] [x] -> PrimInline $ r |= BNot x++ IntNegOp -> \[r] [x] -> PrimInline $ r |= toI32 (Negate x)+-- add with carry: overflow == 0 iff no overflow+ IntAddCOp -> \[r,overf] [x,y] ->+ PrimInline $ jVar \rt -> mconcat+ [ rt |= Add x y+ , r |= toI32 rt+ , overf |= if10 (r .!=. rt)+ ]+ IntSubCOp -> \[r,overf] [x,y] ->+ PrimInline $ jVar \rt -> mconcat+ [ rt |= Sub x y+ , r |= toI32 rt+ , overf |= if10 (r .!=. rt)+ ]+ IntGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)+ IntGeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)+ IntEqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)+ IntNeOp -> \[r] [x,y] -> PrimInline $ r |= if10(x .!==. y)+ IntLtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)+ IntLeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)+ ChrOp -> \[r] [x] -> PrimInline $ r |= x+ IntToWordOp -> \[r] [x] -> PrimInline $ r |= x .>>>. 0+ IntToFloatOp -> \[r] [x] -> PrimInline $ r |= x+ IntToDoubleOp -> \[r] [x] -> PrimInline $ r |= x+ IntSllOp -> \[r] [x,y] -> PrimInline $ r |= x .<<. y+ IntSraOp -> \[r] [x,y] -> PrimInline $ r |= x .>>. y+ IntSrlOp -> \[r] [x,y] -> PrimInline $ r |= toI32 (x .>>>. y)++------------------------------ Int8 ---------------------------------------------++ Int8ToIntOp -> \[r] [x] -> PrimInline $ r |= x+ IntToInt8Op -> \[r] [x] -> PrimInline $ r |= signExtend8 x+ Int8NegOp -> \[r] [x] -> PrimInline $ r |= signExtend8 (Negate x)+ Int8AddOp -> \[r] [x,y] -> PrimInline $ r |= signExtend8 (Add x y)+ Int8SubOp -> \[r] [x,y] -> PrimInline $ r |= signExtend8 (Sub x y)+ Int8MulOp -> \[r] [x,y] -> PrimInline $ r |= signExtend8 (Mul x y)+ Int8QuotOp -> \[r] [x,y] -> PrimInline $ r |= signExtend8 (quotShortInt 8 x y)+ Int8RemOp -> \[r] [x,y] -> PrimInline $ r |= signExtend8 (remShortInt 8 x y)+ Int8QuotRemOp -> \[r1,r2] [x,y] -> PrimInline $ mconcat+ [ r1 |= signExtend8 (quotShortInt 8 x y)+ , r2 |= signExtend8 (remShortInt 8 x y)+ ]+ Int8EqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)+ Int8GeOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 24)) .>=. (y .<<. (Int 24)))+ Int8GtOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 24)) .>. (y .<<. (Int 24)))+ Int8LeOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 24)) .<=. (y .<<. (Int 24)))+ Int8LtOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 24)) .<. (y .<<. (Int 24)))+ Int8NeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)++ Int8SraOp -> \[r] [x,i] -> PrimInline $ r |= x .>>. i+ Int8SrlOp -> \[r] [x,i] -> PrimInline $ r |= signExtend8 (mask8 x .>>>. i)+ Int8SllOp -> \[r] [x,i] -> PrimInline $ r |= signExtend8 (mask8 (x .<<. i))++------------------------------ Word8 --------------------------------------------++ Word8ToWordOp -> \[r] [x] -> PrimInline $ r |= mask8 x+ WordToWord8Op -> \[r] [x] -> PrimInline $ r |= mask8 x++ Word8AddOp -> \[r] [x,y] -> PrimInline $ r |= mask8 (Add x y)+ Word8SubOp -> \[r] [x,y] -> PrimInline $ r |= mask8 (Sub x y)+ Word8MulOp -> \[r] [x,y] -> PrimInline $ r |= mask8 (Mul x y)+ Word8QuotOp -> \[r] [x,y] -> PrimInline $ r |= mask8 (Div x y)+ Word8RemOp -> \[r] [x,y] -> PrimInline $ r |= Mod x y+ Word8QuotRemOp -> \[r1,r2] [x,y] -> PrimInline $ mconcat+ [ r1 |= toI32 (Div x y)+ , r2 |= Mod x y+ ]+ Word8EqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)+ Word8GeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)+ Word8GtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)+ Word8LeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)+ Word8LtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)+ Word8NeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)++ Word8AndOp -> \[r] [x,y] -> PrimInline $ r |= BAnd x y+ Word8OrOp -> \[r] [x,y] -> PrimInline $ r |= BOr x y+ Word8XorOp -> \[r] [x,y] -> PrimInline $ r |= BXor x y+ Word8NotOp -> \[r] [x] -> PrimInline $ r |= BXor x (Int 0xff)++ Word8SllOp -> \[r] [x,i] -> PrimInline $ r |= mask8 (x .<<. i)+ Word8SrlOp -> \[r] [x,i] -> PrimInline $ r |= x .>>>. i++------------------------------ Int16 -------------------------------------------++ Int16ToIntOp -> \[r] [x] -> PrimInline $ r |= x+ IntToInt16Op -> \[r] [x] -> PrimInline $ r |= signExtend16 x++ Int16NegOp -> \[r] [x] -> PrimInline $ r |= signExtend16 (Negate x)+ Int16AddOp -> \[r] [x,y] -> PrimInline $ r |= signExtend16 (Add x y)+ Int16SubOp -> \[r] [x,y] -> PrimInline $ r |= signExtend16 (Sub x y)+ Int16MulOp -> \[r] [x,y] -> PrimInline $ r |= signExtend16 (Mul x y)+ Int16QuotOp -> \[r] [x,y] -> PrimInline $ r |= signExtend16 (quotShortInt 16 x y)+ Int16RemOp -> \[r] [x,y] -> PrimInline $ r |= signExtend16 (remShortInt 16 x y)+ Int16QuotRemOp -> \[r1,r2] [x,y] -> PrimInline $ mconcat+ [ r1 |= signExtend16 (quotShortInt 16 x y)+ , r2 |= signExtend16 (remShortInt 16 x y)+ ]+ Int16EqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)+ Int16GeOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 16)) .>=. (y .<<. (Int 16)))+ Int16GtOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 16)) .>. (y .<<. (Int 16)))+ Int16LeOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 16)) .<=. (y .<<. (Int 16)))+ Int16LtOp -> \[r] [x,y] -> PrimInline $ r |= if10 ((x .<<. (Int 16)) .<. (y .<<. (Int 16)))+ Int16NeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)++ Int16SraOp -> \[r] [x,i] -> PrimInline $ r |= x .>>. i+ Int16SrlOp -> \[r] [x,i] -> PrimInline $ r |= signExtend16 (mask16 x .>>>. i)+ Int16SllOp -> \[r] [x,i] -> PrimInline $ r |= signExtend16 (x .<<. i)++------------------------------ Word16 ------------------------------------------++ Word16ToWordOp -> \[r] [x] -> PrimInline $ r |= x+ WordToWord16Op -> \[r] [x] -> PrimInline $ r |= mask16 x++ Word16AddOp -> \[r] [x,y] -> PrimInline $ r |= mask16 (Add x y)+ Word16SubOp -> \[r] [x,y] -> PrimInline $ r |= mask16 (Sub x y)+ Word16MulOp -> \[r] [x,y] -> PrimInline $ r |= mask16 (Mul x y)+ Word16QuotOp -> \[r] [x,y] -> PrimInline $ r |= mask16 (Div x y)+ Word16RemOp -> \[r] [x,y] -> PrimInline $ r |= Mod x y+ Word16QuotRemOp -> \[r1,r2] [x,y] -> PrimInline $ mconcat+ [ r1 |= toI32 (Div x y)+ , r2 |= Mod x y+ ]+ Word16EqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)+ Word16GeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)+ Word16GtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)+ Word16LeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)+ Word16LtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)+ Word16NeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)++ Word16AndOp -> \[r] [x,y] -> PrimInline $ r |= BAnd x y+ Word16OrOp -> \[r] [x,y] -> PrimInline $ r |= BOr x y+ Word16XorOp -> \[r] [x,y] -> PrimInline $ r |= BXor x y+ Word16NotOp -> \[r] [x] -> PrimInline $ r |= BXor x (Int 0xffff)++ Word16SllOp -> \[r] [x,i] -> PrimInline $ r |= mask16 (x .<<. i)+ Word16SrlOp -> \[r] [x,i] -> PrimInline $ r |= x .>>>. i++------------------------------ Int32 --------------------------------------------++ Int32ToIntOp -> \[r] [x] -> PrimInline $ r |= x+ IntToInt32Op -> \[r] [x] -> PrimInline $ r |= x++ Int32NegOp -> \rs xs -> genPrim prof bound ty IntNegOp rs xs+ Int32AddOp -> \rs xs -> genPrim prof bound ty IntAddOp rs xs+ Int32SubOp -> \rs xs -> genPrim prof bound ty IntSubOp rs xs+ Int32MulOp -> \rs xs -> genPrim prof bound ty IntMulOp rs xs+ Int32QuotOp -> \rs xs -> genPrim prof bound ty IntQuotOp rs xs+ Int32RemOp -> \rs xs -> genPrim prof bound ty IntRemOp rs xs+ Int32QuotRemOp -> \rs xs -> genPrim prof bound ty IntQuotRemOp rs xs++ Int32EqOp -> \rs xs -> genPrim prof bound ty IntEqOp rs xs+ Int32GeOp -> \rs xs -> genPrim prof bound ty IntGeOp rs xs+ Int32GtOp -> \rs xs -> genPrim prof bound ty IntGtOp rs xs+ Int32LeOp -> \rs xs -> genPrim prof bound ty IntLeOp rs xs+ Int32LtOp -> \rs xs -> genPrim prof bound ty IntLtOp rs xs+ Int32NeOp -> \rs xs -> genPrim prof bound ty IntNeOp rs xs++ Int32SraOp -> \rs xs -> genPrim prof bound ty IntSraOp rs xs+ Int32SrlOp -> \rs xs -> genPrim prof bound ty IntSrlOp rs xs+ Int32SllOp -> \rs xs -> genPrim prof bound ty IntSllOp rs xs++------------------------------ Word32 -------------------------------------------++ Word32ToWordOp -> \[r] [x] -> PrimInline $ r |= x+ WordToWord32Op -> \[r] [x] -> PrimInline $ r |= x++ Word32AddOp -> \rs xs -> genPrim prof bound ty WordAddOp rs xs+ Word32SubOp -> \rs xs -> genPrim prof bound ty WordSubOp rs xs+ Word32MulOp -> \rs xs -> genPrim prof bound ty WordMulOp rs xs+ Word32QuotOp -> \rs xs -> genPrim prof bound ty WordQuotOp rs xs+ Word32RemOp -> \rs xs -> genPrim prof bound ty WordRemOp rs xs+ Word32QuotRemOp -> \rs xs -> genPrim prof bound ty WordQuotRemOp rs xs++ Word32EqOp -> \rs xs -> genPrim prof bound ty WordEqOp rs xs+ Word32GeOp -> \rs xs -> genPrim prof bound ty WordGeOp rs xs+ Word32GtOp -> \rs xs -> genPrim prof bound ty WordGtOp rs xs+ Word32LeOp -> \rs xs -> genPrim prof bound ty WordLeOp rs xs+ Word32LtOp -> \rs xs -> genPrim prof bound ty WordLtOp rs xs+ Word32NeOp -> \rs xs -> genPrim prof bound ty WordNeOp rs xs++ Word32AndOp -> \rs xs -> genPrim prof bound ty WordAndOp rs xs+ Word32OrOp -> \rs xs -> genPrim prof bound ty WordOrOp rs xs+ Word32XorOp -> \rs xs -> genPrim prof bound ty WordXorOp rs xs+ Word32NotOp -> \rs xs -> genPrim prof bound ty WordNotOp rs xs++ Word32SllOp -> \rs xs -> genPrim prof bound ty WordSllOp rs xs+ Word32SrlOp -> \rs xs -> genPrim prof bound ty WordSrlOp rs xs++------------------------------ Int64 --------------------------------------------++ Int64ToIntOp -> \[r] [_h,l] -> PrimInline $ r |= toI32 l++ Int64NegOp -> \[r_h,r_l] [h,l] ->+ PrimInline $ mconcat+ [ r_l |= toU32 (BNot l + 1)+ , r_h |= toI32 (BNot h + Not r_l)+ ]++ Int64AddOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_plusInt64" [h0,l0,h1,l1]+ Int64SubOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_minusInt64" [h0,l0,h1,l1]+ Int64MulOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_timesInt64" [h0,l0,h1,l1]+ Int64QuotOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_quotInt64" [h0,l0,h1,l1]+ Int64RemOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_remInt64" [h0,l0,h1,l1]++ Int64SllOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftLLInt64" [h,l,n]+ Int64SraOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftRAInt64" [h,l,n]+ Int64SrlOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftRLInt64" [h,l,n]++ Int64ToWord64Op -> \[r1,r2] [x1,x2] ->+ PrimInline $ mconcat+ [ r1 |= toU32 x1+ , r2 |= x2+ ]+ IntToInt64Op -> \[r1,r2] [x] ->+ PrimInline $ mconcat+ [ r1 |= if_ (x .<. 0) (-1) 0 -- sign-extension+ , r2 |= toU32 x+ ]++ Int64EqOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LAnd (l0 .===. l1) (h0 .===. h1))+ Int64NeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (l0 .!==. l1) (h0 .!==. h1))+ Int64GeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .>. h1) (LAnd (h0 .===. h1) (l0 .>=. l1)))+ Int64GtOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .>. h1) (LAnd (h0 .===. h1) (l0 .>. l1)))+ Int64LeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .<. h1) (LAnd (h0 .===. h1) (l0 .<=. l1)))+ Int64LtOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .<. h1) (LAnd (h0 .===. h1) (l0 .<. l1)))++------------------------------ Word64 -------------------------------------------++ Word64ToWordOp -> \[r] [_x1,x2] -> PrimInline $ r |= x2++ WordToWord64Op -> \[rh,rl] [x] ->+ PrimInline $ mconcat+ [ rh |= 0+ , rl |= x+ ]++ Word64ToInt64Op -> \[r1,r2] [x1,x2] ->+ PrimInline $ mconcat+ [ r1 |= toI32 x1+ , r2 |= x2+ ]++ Word64EqOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LAnd (l0 .===. l1) (h0 .===. h1))+ Word64NeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (l0 .!==. l1) (h0 .!==. h1))+ Word64GeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .>. h1) (LAnd (h0 .===. h1) (l0 .>=. l1)))+ Word64GtOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .>. h1) (LAnd (h0 .===. h1) (l0 .>. l1)))+ Word64LeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .<. h1) (LAnd (h0 .===. h1) (l0 .<=. l1)))+ Word64LtOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .<. h1) (LAnd (h0 .===. h1) (l0 .<. l1)))++ Word64SllOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftLWord64" [h,l,n]+ Word64SrlOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftRWord64" [h,l,n]++ Word64OrOp -> \[hr,hl] [h0, l0, h1, l1] ->+ PrimInline $ mconcat+ [ hr |= toU32 (BOr h0 h1)+ , hl |= toU32 (BOr l0 l1)+ ]++ Word64AndOp -> \[hr,hl] [h0, l0, h1, l1] ->+ PrimInline $ mconcat+ [ hr |= toU32 (BAnd h0 h1)+ , hl |= toU32 (BAnd l0 l1)+ ]++ Word64XorOp -> \[hr,hl] [h0, l0, h1, l1] ->+ PrimInline $ mconcat+ [ hr |= toU32 (BXor h0 h1)+ , hl |= toU32 (BXor l0 l1)+ ]++ Word64NotOp -> \[hr,hl] [h, l] ->+ PrimInline $ mconcat+ [ hr |= toU32 (BNot h)+ , hl |= toU32 (BNot l)+ ]++ Word64AddOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_plusWord64" [h0,l0,h1,l1]+ Word64SubOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_minusWord64" [h0,l0,h1,l1]+ Word64MulOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_timesWord64" [h0,l0,h1,l1]+ Word64QuotOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_quotWord64" [h0,l0,h1,l1]+ Word64RemOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_remWord64" [h0,l0,h1,l1]++------------------------------ Word ---------------------------------------------++ WordAddOp -> \[r] [x,y] -> PrimInline $ r |= (x `Add` y) .>>>. zero_+ WordAddCOp -> \[r,c] [x,y] -> PrimInline $+ jVar \t -> mconcat+ [ t |= x `Add` y+ , r |= toU32 t+ , c |= if10 (t .!==. r)+ ]+ WordSubCOp -> \[r,c] [x,y] ->+ PrimInline $ mconcat+ [ r |= toU32 (Sub x y)+ , c |= if10 (y .>. x)+ ]+ WordAdd2Op -> \[h,l] [x,y] -> PrimInline $ appT [h,l] "h$wordAdd2" [x,y]+ WordSubOp -> \ [r] [x,y] -> PrimInline $ r |= toU32 (Sub x y)+ WordMulOp -> \ [r] [x,y] -> PrimInline $ r |= app "h$mulWord32" [x, y]+ WordMul2Op -> \[h,l] [x,y] -> PrimInline $ appT [h,l] "h$mul2Word32" [x,y]+ WordQuotOp -> \ [q] [x,y] -> PrimInline $ q |= app "h$quotWord32" [x,y]+ WordRemOp -> \ [r] [x,y] -> PrimInline $ r |= app "h$remWord32" [x,y]+ WordQuotRemOp -> \[q,r] [x,y] -> PrimInline $ appT [q,r] "h$quotRemWord32" [x,y]+ WordQuotRem2Op -> \[q,r] [xh,xl,y] -> PrimInline $ appT [q,r] "h$quotRem2Word32" [xh,xl,y]+ WordAndOp -> \[r] [x,y] -> PrimInline $ r |= toU32 (BAnd x y)+ WordOrOp -> \[r] [x,y] -> PrimInline $ r |= toU32 (BOr x y)+ WordXorOp -> \[r] [x,y] -> PrimInline $ r |= toU32 (BXor x y)+ WordNotOp -> \[r] [x] -> PrimInline $ r |= toU32 (BNot x)+ WordSllOp -> \[r] [x,y] -> PrimInline $ r |= toU32 (x .<<. y)+ WordSrlOp -> \[r] [x,y] -> PrimInline $ r |= x .>>>. y+ WordToIntOp -> \[r] [x] -> PrimInline $ r |= toI32 x+ WordGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)+ WordGeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)+ WordEqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)+ WordNeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)+ WordLtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)+ WordLeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)+ WordToDoubleOp -> \[r] [x] -> PrimInline $ r |= x+ WordToFloatOp -> \[r] [x] -> PrimInline $ r |= math_fround [x]+ PopCnt8Op -> \[r] [x] -> PrimInline $ r |= var "h$popCntTab" .! (mask8 x)+ PopCnt16Op -> \[r] [x] -> PrimInline $ r |= Add (var "h$popCntTab" .! (mask8 x))+ (var "h$popCntTab" .! (mask8 (x .>>>. Int 8)))++ PopCnt32Op -> \[r] [x] -> PrimInline $ r |= app "h$popCnt32" [x]+ PopCnt64Op -> \[r] [x1,x2] -> PrimInline $ r |= app "h$popCnt64" [x1,x2]+ PopCntOp -> \[r] [x] -> genPrim prof bound ty PopCnt32Op [r] [x]+ Pdep8Op -> \[r] [s,m] -> PrimInline $ r |= app "h$pdep8" [s,m]+ Pdep16Op -> \[r] [s,m] -> PrimInline $ r |= app "h$pdep16" [s,m]+ Pdep32Op -> \[r] [s,m] -> PrimInline $ r |= app "h$pdep32" [s,m]+ Pdep64Op -> \[ra,rb] [sa,sb,ma,mb] -> PrimInline $ appT [ra,rb] "h$pdep64" [sa,sb,ma,mb]+ PdepOp -> \rs xs -> genPrim prof bound ty Pdep32Op rs xs+ Pext8Op -> \[r] [s,m] -> PrimInline $ r |= app "h$pext8" [s,m]+ Pext16Op -> \[r] [s,m] -> PrimInline $ r |= app "h$pext16" [s,m]+ Pext32Op -> \[r] [s,m] -> PrimInline $ r |= app "h$pext32" [s,m]+ Pext64Op -> \[ra,rb] [sa,sb,ma,mb] -> PrimInline $ appT [ra,rb] "h$pext64" [sa,sb,ma,mb]+ PextOp -> \rs xs -> genPrim prof bound ty Pext32Op rs xs++ ClzOp -> \[r] [x] -> PrimInline $ r |= app "h$clz32" [x]+ Clz8Op -> \[r] [x] -> PrimInline $ r |= app "h$clz8" [x]+ Clz16Op -> \[r] [x] -> PrimInline $ r |= app "h$clz16" [x]+ Clz32Op -> \[r] [x] -> PrimInline $ r |= app "h$clz32" [x]+ Clz64Op -> \[r] [x1,x2] -> PrimInline $ r |= app "h$clz64" [x1,x2]+ CtzOp -> \[r] [x] -> PrimInline $ r |= app "h$ctz32" [x]+ Ctz8Op -> \[r] [x] -> PrimInline $ r |= app "h$ctz8" [x]+ Ctz16Op -> \[r] [x] -> PrimInline $ r |= app "h$ctz16" [x]+ Ctz32Op -> \[r] [x] -> PrimInline $ r |= app "h$ctz32" [x]+ Ctz64Op -> \[r] [x1,x2] -> PrimInline $ r |= app "h$ctz64" [x1,x2]++ BSwap16Op -> \[r] [x] -> PrimInline $+ r |= BOr ((mask8 x) .<<. (Int 8))+ (mask8 (x .>>>. (Int 8)))+ BSwap32Op -> \[r] [x] -> PrimInline $+ r |= toU32 ((x .<<. (Int 24))+ `BOr` ((BAnd x (Int 0xFF00)) .<<. (Int 8))+ `BOr` ((BAnd x (Int 0xFF0000)) .>>. (Int 8))+ `BOr` (x .>>>. (Int 24)))+ BSwap64Op -> \[r1,r2] [x,y] -> PrimInline $ appT [r1,r2] "h$bswap64" [x,y]+ BSwapOp -> \[r] [x] -> genPrim prof bound ty BSwap32Op [r] [x]++ BRevOp -> \[r] [w] -> genPrim prof bound ty BRev32Op [r] [w]+ BRev8Op -> \[r] [w] -> PrimInline $ r |= (app "h$reverseWord" [w] .>>>. 24)+ BRev16Op -> \[r] [w] -> PrimInline $ r |= (app "h$reverseWord" [w] .>>>. 16)+ BRev32Op -> \[r] [w] -> PrimInline $ r |= app "h$reverseWord" [w]+ BRev64Op -> \[rh,rl] [h,l] -> PrimInline $ mconcat [ rl |= app "h$reverseWord" [h]+ , rh |= app "h$reverseWord" [l]+ ]++------------------------------ Narrow -------------------------------------------++ Narrow8IntOp -> \[r] [x] -> PrimInline $ r |= signExtend8 x+ Narrow16IntOp -> \[r] [x] -> PrimInline $ r |= signExtend16 x+ Narrow32IntOp -> \[r] [x] -> PrimInline $ r |= toI32 x+ Narrow8WordOp -> \[r] [x] -> PrimInline $ r |= mask8 x+ Narrow16WordOp -> \[r] [x] -> PrimInline $ r |= mask16 x+ Narrow32WordOp -> \[r] [x] -> PrimInline $ r |= toU32 x++------------------------------ Double -------------------------------------------++ DoubleGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)+ DoubleGeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)+ DoubleEqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)+ DoubleNeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)+ DoubleLtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)+ DoubleLeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)+ DoubleAddOp -> \[r] [x,y] -> PrimInline $ r |= Add x y+ DoubleSubOp -> \[r] [x,y] -> PrimInline $ r |= Sub x y+ DoubleMulOp -> \[r] [x,y] -> PrimInline $ r |= Mul x y+ DoubleDivOp -> \[r] [x,y] -> PrimInline $ r |= Div x y+ DoubleNegOp -> \[r] [x] -> PrimInline $ r |= Negate x+ DoubleFabsOp -> \[r] [x] -> PrimInline $ r |= math_abs [x]+ DoubleToIntOp -> \[r] [x] -> PrimInline $ r |= toI32 x+ DoubleToFloatOp -> \[r] [x] -> PrimInline $ r |= math_fround [x]+ DoubleExpOp -> \[r] [x] -> PrimInline $ r |= math_exp [x]+ DoubleExpM1Op -> \[r] [x] -> PrimInline $ r |= math_expm1 [x]+ DoubleLogOp -> \[r] [x] -> PrimInline $ r |= math_log [x]+ DoubleLog1POp -> \[r] [x] -> PrimInline $ r |= math_log1p [x]+ DoubleSqrtOp -> \[r] [x] -> PrimInline $ r |= math_sqrt [x]+ DoubleSinOp -> \[r] [x] -> PrimInline $ r |= math_sin [x]+ DoubleCosOp -> \[r] [x] -> PrimInline $ r |= math_cos [x]+ DoubleTanOp -> \[r] [x] -> PrimInline $ r |= math_tan [x]+ DoubleAsinOp -> \[r] [x] -> PrimInline $ r |= math_asin [x]+ DoubleAcosOp -> \[r] [x] -> PrimInline $ r |= math_acos [x]+ DoubleAtanOp -> \[r] [x] -> PrimInline $ r |= math_atan [x]+ DoubleSinhOp -> \[r] [x] -> PrimInline $ r |= math_sinh [x]+ DoubleCoshOp -> \[r] [x] -> PrimInline $ r |= math_cosh [x]+ DoubleTanhOp -> \[r] [x] -> PrimInline $ r |= math_tanh [x]+ DoubleAsinhOp -> \[r] [x] -> PrimInline $ r |= math_asinh [x]+ DoubleAcoshOp -> \[r] [x] -> PrimInline $ r |= math_acosh [x]+ DoubleAtanhOp -> \[r] [x] -> PrimInline $ r |= math_atanh [x]+ DoublePowerOp -> \[r] [x,y] -> PrimInline $ r |= math_pow [x,y]+ DoubleDecode_2IntOp -> \[s,h,l,e] [x] -> PrimInline $ appT [s,h,l,e] "h$decodeDouble2Int" [x]+ DoubleDecode_Int64Op -> \[s1,s2,e] [d] -> PrimInline $ appT [e,s1,s2] "h$decodeDoubleInt64" [d]++------------------------------ Float --------------------------------------------++ FloatGtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>. y)+ FloatGeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .>=. y)+ FloatEqOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .===. y)+ FloatNeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .!==. y)+ FloatLtOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<. y)+ FloatLeOp -> \[r] [x,y] -> PrimInline $ r |= if10 (x .<=. y)+ FloatAddOp -> \[r] [x,y] -> PrimInline $ r |= math_fround [Add x y]+ FloatSubOp -> \[r] [x,y] -> PrimInline $ r |= math_fround [Sub x y]+ FloatMulOp -> \[r] [x,y] -> PrimInline $ r |= math_fround [Mul x y]+ FloatDivOp -> \[r] [x,y] -> PrimInline $ r |= math_fround [Div x y]+ FloatNegOp -> \[r] [x] -> PrimInline $ r |= Negate x+ FloatFabsOp -> \[r] [x] -> PrimInline $ r |= math_abs [x]+ FloatToIntOp -> \[r] [x] -> PrimInline $ r |= toI32 x+ FloatExpOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_exp [x]]+ FloatExpM1Op -> \[r] [x] -> PrimInline $ r |= math_fround [math_expm1 [x]]+ FloatLogOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_log [x]]+ FloatLog1POp -> \[r] [x] -> PrimInline $ r |= math_fround [math_log1p [x]]+ FloatSqrtOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_sqrt [x]]+ FloatSinOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_sin [x]]+ FloatCosOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_cos [x]]+ FloatTanOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_tan [x]]+ FloatAsinOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_asin [x]]+ FloatAcosOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_acos [x]]+ FloatAtanOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_atan [x]]+ FloatSinhOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_sinh [x]]+ FloatCoshOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_cosh [x]]+ FloatTanhOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_tanh [x]]+ FloatAsinhOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_asinh [x]]+ FloatAcoshOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_acosh [x]]+ FloatAtanhOp -> \[r] [x] -> PrimInline $ r |= math_fround [math_atanh [x]]+ FloatPowerOp -> \[r] [x,y] -> PrimInline $ r |= math_fround [math_pow [x,y]]+ FloatToDoubleOp -> \[r] [x] -> PrimInline $ r |= x+ FloatDecode_IntOp -> \[s,e] [x] -> PrimInline $ appT [s,e] "h$decodeFloatInt" [x]++------------------------------ Arrays -------------------------------------------++ NewArrayOp -> \[r] [l,e] -> PrimInline $ r |= app "h$newArray" [l,e]+ ReadArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i)+ WriteArrayOp -> \[] [a,i,v] -> PrimInline $ bnd_arr bound a i (a .! i |= v)+ SizeofArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length"+ SizeofMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length"+ IndexArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i)+ UnsafeFreezeArrayOp -> \[r] [a] -> PrimInline $ r |= a+ UnsafeThawArrayOp -> \[r] [a] -> PrimInline $ r |= a+ CopyArrayOp -> \[] [a,o1,ma,o2,n] ->+ PrimInline+ $ bnd_arr_range bound a o1 n+ $ bnd_arr_range bound ma o2 n+ $ loopBlockS (Int 0) (.<. n) \i ->+ [ ma .! (Add i o2) |= a .! (Add i o1)+ , preIncrS i+ ]+ CopyMutableArrayOp -> \[] [a1,o1,a2,o2,n] ->+ PrimInline+ $ bnd_arr_range bound a1 o1 n+ $ bnd_arr_range bound a2 o2 n+ $ appS "h$copyMutableArray" [a1,o1,a2,o2,n]++ CloneArrayOp -> \[r] [a,start,n] ->+ PrimInline+ $ bnd_arr_range bound a start n+ $ r |= app "h$sliceArray" [a,start,n]++ CloneMutableArrayOp -> \[r] [a,start,n] ->+ PrimInline+ $ bnd_arr_range bound a start n+ $ r |= app "h$sliceArray" [a,start,n]++ FreezeArrayOp -> \[r] [a,start,n] ->+ PrimInline+ $ bnd_arr_range bound a start n+ $ r |= app "h$sliceArray" [a,start,n]++ ThawArrayOp -> \[r] [a,start,n] ->+ PrimInline+ $ bnd_arr_range bound a start n+ $ r |= app "h$sliceArray" [a,start,n]++ CasArrayOp -> \[s,o] [a,i,old,new] ->+ PrimInline+ $ bnd_arr bound a i+ $ jVar \x -> mconcat+ [ x |= a .! i+ , ifBlockS (x .===. old)+ [ o |= new+ , a .! i |= new+ , s |= zero_+ ]+ [ s |= one_+ , o |= x+ ]+ ]++------------------------------ Small Arrays -------------------------------------++ NewSmallArrayOp -> \[a] [n,e] -> PrimInline $ a |= app "h$newArray" [n,e]+ ReadSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i)+ WriteSmallArrayOp -> \[] [a,i,e] -> PrimInline $ bnd_arr bound a i (a .! i |= e)+ SizeofSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length"+ SizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length"+ IndexSmallArrayOp -> \[r] [a,i] -> PrimInline $ bnd_arr bound a i (r |= a .! i)+ UnsafeFreezeSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a+ UnsafeThawSmallArrayOp -> \[r] [a] -> PrimInline $ r |= a+ CopySmallArrayOp -> \[] [s,si,d,di,n] ->+ PrimInline+ $ bnd_arr_range bound s si n+ $ bnd_arr_range bound d di n+ $ loopBlockS (Sub n one_) (.>=. zero_) \i ->+ [ d .! (Add di i) |= s .! (Add si i)+ , postDecrS i+ ]+ CopySmallMutableArrayOp -> \[] [s,si,d,di,n] ->+ PrimInline+ $ bnd_arr_range bound s si n+ $ bnd_arr_range bound d di n+ $ appS "h$copyMutableArray" [s,si,d,di,n]++ CloneSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n+ CloneSmallMutableArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n+ FreezeSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n+ ThawSmallArrayOp -> \[r] [a,o,n] -> PrimInline $ cloneArray bound r a o n++ CasSmallArrayOp -> \[s,o] [a,i,old,new] ->+ PrimInline+ $ bnd_arr bound a i+ $ jVar \x -> mconcat+ [ x |= a .! i+ , ifBlockS (x .===. old)+ [ o |= new+ , a .! i |= new+ , s |= zero_+ ]+ [ s |= one_+ , o |= x+ ]+ ]++------------------------------- Byte Arrays -------------------------------------++ NewByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l)+ NewPinnedByteArrayOp_Char -> \[r] [l] -> PrimInline (newByteArray r l)+ NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> PrimInline (newByteArray r l)+ MutableByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_+ ByteArrayIsPinnedOp -> \[r] [_] -> PrimInline $ r |= one_+ ByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_]+ MutableByteArrayContents_Char -> \[a,o] [b] -> PrimInline $ mconcat [a |= b, o |= zero_]+ ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n]+ ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n]+ UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b+ SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len"+ SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len"+ GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len"++ IndexByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i+ IndexByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i+ IndexByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i+ IndexByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i+ IndexByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o+ IndexByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i+ IndexByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i+ IndexByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o+ IndexByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i+ IndexByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i+ IndexByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i+ IndexByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l+ IndexByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i+ IndexByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i+ IndexByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i+ IndexByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l++ ReadByteArrayOp_Char -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i+ ReadByteArrayOp_WideChar -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i+ ReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i+ ReadByteArrayOp_Word -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i+ ReadByteArrayOp_Addr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_addr a i r o+ ReadByteArrayOp_Float -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_f32 a i+ ReadByteArrayOp_Double -> \[r] [a,i] -> PrimInline $ bnd_ix64 bound a i $ r |= read_f64 a i+ ReadByteArrayOp_StablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ix32 bound a i $ read_stableptr a i r o+ ReadByteArrayOp_Int8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_i8 a i+ ReadByteArrayOp_Int16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_i16 a i+ ReadByteArrayOp_Int32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i+ ReadByteArrayOp_Int64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_i64 a i h l+ ReadByteArrayOp_Word8 -> \[r] [a,i] -> PrimInline $ bnd_ix8 bound a i $ r |= read_u8 a i+ ReadByteArrayOp_Word16 -> \[r] [a,i] -> PrimInline $ bnd_ix16 bound a i $ r |= read_u16 a i+ ReadByteArrayOp_Word32 -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_u32 a i+ ReadByteArrayOp_Word64 -> \[h,l] [a,i] -> PrimInline $ bnd_ix64 bound a i $ read_u64 a i h l++ WriteByteArrayOp_Char -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e+ WriteByteArrayOp_WideChar -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e+ WriteByteArrayOp_Int -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e+ WriteByteArrayOp_Word -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e+ WriteByteArrayOp_Addr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_addr a i r o+ WriteByteArrayOp_Float -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_f32 a i e+ WriteByteArrayOp_Double -> \[] [a,i,e] -> PrimInline $ bnd_ix64 bound a i $ write_f64 a i e+ WriteByteArrayOp_StablePtr -> \[] [a,i,r,o] -> PrimInline $ bnd_ix32 bound a i $ write_stableptr a i r o+ WriteByteArrayOp_Int8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_i8 a i e+ WriteByteArrayOp_Int16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_i16 a i e+ WriteByteArrayOp_Int32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i e+ WriteByteArrayOp_Int64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_i64 a i h l+ WriteByteArrayOp_Word8 -> \[] [a,i,e] -> PrimInline $ bnd_ix8 bound a i $ write_u8 a i e+ WriteByteArrayOp_Word16 -> \[] [a,i,e] -> PrimInline $ bnd_ix16 bound a i $ write_u16 a i e+ WriteByteArrayOp_Word32 -> \[] [a,i,e] -> PrimInline $ bnd_ix32 bound a i $ write_u32 a i e+ WriteByteArrayOp_Word64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ix64 bound a i $ write_u64 a i h l++ CompareByteArraysOp -> \[r] [a1,o1,a2,o2,n] ->+ PrimInline . bnd_ba_range bound a1 o1 n+ . bnd_ba_range bound a2 o2 n+ $ r |= app "h$compareByteArrays" [a1,o1,a2,o2,n]++ -- We assume the arrays aren't overlapping since they're of different types+ -- (ByteArray vs MutableByteArray, Addr# vs MutableByteArray#, [Mutable]ByteArray# vs Addr#)+ CopyByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n+ CopyAddrToByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n+ CopyMutableByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n+ CopyByteArrayToAddrOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray False bound a1 o1 a2 o2 n++ CopyMutableByteArrayOp -> \[] [a1,o1,a2,o2,n] -> copyByteArray True bound a1 o1 a2 o2 n++ SetByteArrayOp -> \[] [a,o,n,v] ->+ PrimInline . bnd_ba_range bound a o n $ loopBlockS zero_ (.<. n) \i ->+ [ write_u8 a (Add o i) v+ , postIncrS i+ ]++ AtomicReadByteArrayOp_Int -> \[r] [a,i] -> PrimInline $ bnd_ix32 bound a i $ r |= read_i32 a i+ AtomicWriteByteArrayOp_Int -> \[] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ write_i32 a i v+ FetchAddByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Add r a i v+ FetchSubByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray Sub r a i v+ FetchAndByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BAnd r a i v+ FetchOrByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BOr r a i v+ FetchNandByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray (\x y -> BNot (BAnd x y)) r a i v+ FetchXorByteArrayOp_Int -> \[r] [a,i,v] -> PrimInline $ bnd_ix32 bound a i $ fetchOpByteArray BXor r a i v++------------------------------- Addr# ------------------------------------------++ AddrAddOp -> \[a',o'] [a,o,i] -> PrimInline $ mconcat [a' |= a, o' |= Add o i]+ AddrSubOp -> \[i] [_a1,o1,_a2,o2] -> PrimInline $ i |= Sub o1 o2+ AddrRemOp -> \[r] [_a,o,i] -> PrimInline $ r |= Mod o i+ AddrToIntOp -> \[i] [_a,o] -> PrimInline $ i |= o -- only usable for comparisons within one range+ IntToAddrOp -> \[a,o] [i] -> PrimInline $ mconcat [a |= null_, o |= i]+ AddrGtOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .>. zero_)+ AddrGeOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .>=. zero_)+ AddrEqOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .===. zero_)+ AddrNeOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .!==. zero_)+ AddrLtOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .<. zero_)+ AddrLeOp -> \[r] [a1,o1,a2,o2] -> PrimInline $ r |= if10 (app "h$comparePointer" [a1,o1,a2,o2] .<=. zero_)++------------------------------- Addr Indexing: Unboxed Arrays -------------------++ IndexOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i)+ IndexOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i)+ IndexOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i)+ IndexOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i)+ IndexOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro+ IndexOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i)+ IndexOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i)+ IndexOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro+ IndexOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i)+ IndexOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i)+ IndexOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i)+ IndexOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l+ IndexOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i)+ IndexOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i)+ IndexOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i)+ IndexOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l++ ReadOffAddrOp_Char -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i)+ ReadOffAddrOp_WideChar -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i)+ ReadOffAddrOp_Int -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i)+ ReadOffAddrOp_Word -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i)+ ReadOffAddrOp_Addr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_addr a (off32 o i) ra ro+ ReadOffAddrOp_Float -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f32 a (off32 o i)+ ReadOffAddrOp_Double -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_f64 a (off64 o i)+ ReadOffAddrOp_StablePtr -> \[ra,ro] [a,o,i] -> PrimInline $ read_boff_stableptr a (off32 o i) ra ro+ ReadOffAddrOp_Int8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i8 a (off8 o i)+ ReadOffAddrOp_Int16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i16 a (off16 o i)+ ReadOffAddrOp_Int32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_i32 a (off32 o i)+ ReadOffAddrOp_Int64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_i64 a (off64 o i) h l+ ReadOffAddrOp_Word8 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u8 a (off8 o i)+ ReadOffAddrOp_Word16 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u16 a (off16 o i)+ ReadOffAddrOp_Word32 -> \[r] [a,o,i] -> PrimInline $ r |= read_boff_u32 a (off32 o i)+ ReadOffAddrOp_Word64 -> \[h,l] [a,o,i] -> PrimInline $ read_boff_u64 a (off64 o i) h l++ WriteOffAddrOp_Char -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v+ WriteOffAddrOp_WideChar -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v+ WriteOffAddrOp_Int -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v+ WriteOffAddrOp_Word -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v+ WriteOffAddrOp_Addr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_addr a (off32 o i) va vo+ WriteOffAddrOp_Float -> \[] [a,o,i,v] -> PrimInline $ write_boff_f32 a (off32 o i) v+ WriteOffAddrOp_Double -> \[] [a,o,i,v] -> PrimInline $ write_boff_f64 a (off64 o i) v+ WriteOffAddrOp_StablePtr -> \[] [a,o,i,va,vo] -> PrimInline $ write_boff_stableptr a (off32 o i) va vo+ WriteOffAddrOp_Int8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i8 a (off8 o i) v+ WriteOffAddrOp_Int16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i16 a (off16 o i) v+ WriteOffAddrOp_Int32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_i32 a (off32 o i) v+ WriteOffAddrOp_Int64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_i64 a (off64 o i) h l+ WriteOffAddrOp_Word8 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u8 a (off8 o i) v+ WriteOffAddrOp_Word16 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u16 a (off16 o i) v+ WriteOffAddrOp_Word32 -> \[] [a,o,i,v] -> PrimInline $ write_boff_u32 a (off32 o i) v+ WriteOffAddrOp_Word64 -> \[] [a,o,i,h,l] -> PrimInline $ write_boff_u64 a (off64 o i) h l++------------------------------- Mutable varialbes --------------------------------------+ NewMutVarOp -> \[r] [x] -> PrimInline $ r |= New (app "h$MutVar" [x])+ ReadMutVarOp -> \[r] [m] -> PrimInline $ r |= m .^ "val"+ WriteMutVarOp -> \[] [m,x] -> PrimInline $ m .^ "val" |= x+ AtomicModifyMutVar2Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar2" [m,f]+ AtomicModifyMutVar_Op -> \[r1,r2] [m,f] -> PrimInline $ appT [r1,r2] "h$atomicModifyMutVar" [m,f]++ CasMutVarOp -> \[status,r] [mv,o,n] -> PrimInline $ ifS (mv .^ "val" .===. o)+ (mconcat [status |= zero_, r |= n, mv .^ "val" |= n])+ (mconcat [status |= one_ , r |= mv .^ "val"])++------------------------------- Exceptions --------------------------------------++ CatchOp -> \[_r] [a,handler] -> PRPrimCall $ returnS (app "h$catch" [a, handler])++ -- fully ignore the result arity as it can use 1 or 2+ -- slots, depending on the return type.+ RaiseOp -> \_r [a] -> PRPrimCall $ returnS (app "h$throw" [a, false_])+ RaiseIOOp -> \_r [a] -> PRPrimCall $ returnS (app "h$throw" [a, false_])+ RaiseUnderflowOp -> \_r [] -> PRPrimCall $ returnS (app "h$throw" [var "h$baseZCGHCziExceptionziTypeziunderflowException", false_])+ RaiseOverflowOp -> \_r [] -> PRPrimCall $ returnS (app "h$throw" [var "h$baseZCGHCziExceptionziTypezioverflowException", false_])+ RaiseDivZeroOp -> \_r [] -> PRPrimCall $ returnS (app "h$throw" [var "h$baseZCGHCziExceptionziTypezidivZZeroException", false_])+ MaskAsyncExceptionsOp -> \_r [a] -> PRPrimCall $ returnS (app "h$maskAsync" [a])+ MaskUninterruptibleOp -> \_r [a] -> PRPrimCall $ returnS (app "h$maskUnintAsync" [a])+ UnmaskAsyncExceptionsOp -> \_r [a] -> PRPrimCall $ returnS (app "h$unmaskAsync" [a])++ MaskStatus -> \[r] [] -> PrimInline $ r |= app "h$maskStatus" []++------------------------------- STM-accessible Mutable Variables --------------++ AtomicallyOp -> \[_r] [a] -> PRPrimCall $ returnS (app "h$atomically" [a])+ RetryOp -> \_r [] -> PRPrimCall $ returnS (app "h$stmRetry" [])+ CatchRetryOp -> \[_r] [a,b] -> PRPrimCall $ returnS (app "h$stmCatchRetry" [a,b])+ CatchSTMOp -> \[_r] [a,h] -> PRPrimCall $ returnS (app "h$catchStm" [a,h])+ NewTVarOp -> \[tv] [v] -> PrimInline $ tv |= app "h$newTVar" [v]+ ReadTVarOp -> \[r] [tv] -> PrimInline $ r |= app "h$readTVar" [tv]+ ReadTVarIOOp -> \[r] [tv] -> PrimInline $ r |= app "h$readTVarIO" [tv]+ WriteTVarOp -> \[] [tv,v] -> PrimInline $ appS "h$writeTVar" [tv,v]++------------------------------- Synchronized Mutable Variables ------------------++ NewMVarOp -> \[r] [] -> PrimInline $ r |= New (app "h$MVar" [])+ TakeMVarOp -> \[_r] [m] -> PRPrimCall $ returnS (app "h$takeMVar" [m])+ TryTakeMVarOp -> \[r,v] [m] -> PrimInline $ appT [r,v] "h$tryTakeMVar" [m]+ PutMVarOp -> \[] [m,v] -> PRPrimCall $ returnS (app "h$putMVar" [m,v])+ TryPutMVarOp -> \[r] [m,v] -> PrimInline $ r |= app "h$tryPutMVar" [m,v]+ ReadMVarOp -> \[_r] [m] -> PRPrimCall $ returnS (app "h$readMVar" [m])+ TryReadMVarOp -> \[r,v] [m] -> PrimInline $ mconcat+ [ v |= m .^ "val"+ , r |= if01 (v .===. null_)+ ]+ IsEmptyMVarOp -> \[r] [m] -> PrimInline $ r |= if10 (m .^ "val" .===. null_)++------------------------------- Delay/Wait Ops ---------------------------------++ DelayOp -> \[] [t] -> PRPrimCall $ returnS (app "h$delayThread" [t])+ WaitReadOp -> \[] [fd] -> PRPrimCall $ returnS (app "h$waidRead" [fd])+ WaitWriteOp -> \[] [fd] -> PRPrimCall $ returnS (app "h$waitWrite" [fd])++------------------------------- Concurrency Primitives -------------------------++ ForkOp -> \[_tid] [x] -> PRPrimCall $ returnS (app "h$fork" [x, true_])+ ForkOnOp -> \[_tid] [_p,x] -> PRPrimCall $ returnS (app "h$fork" [x, true_]) -- ignore processor argument+ KillThreadOp -> \[] [tid,ex] -> PRPrimCall $ returnS (app "h$killThread" [tid,ex])+ YieldOp -> \[] [] -> PRPrimCall $ returnS (app "h$yield" [])+ MyThreadIdOp -> \[r] [] -> PrimInline $ r |= var "h$currentThread"+ IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_+ NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing+ ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid]+ ListThreadsOp -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" []+ GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t]+ LabelThreadOp -> \[] [t,l] -> PrimInline $ t .^ "label" |= l++------------------------------- Weak Pointers -----------------------------------++ MkWeakOp -> \[r] [o,b,c] -> PrimInline $ r |= app "h$makeWeak" [o,b,c]+ MkWeakNoFinalizerOp -> \[r] [o,b] -> PrimInline $ r |= app "h$makeWeakNoFinalizer" [o,b]+ AddCFinalizerToWeakOp -> \[r] [_a1,_a1o,_a2,_a2o,_i,_a3,_a3o,_w] -> PrimInline $ r |= one_+ DeRefWeakOp -> \[f,v] [w] -> PrimInline $ mconcat+ [ v |= w .^ "val"+ , f |= if01 (v .===. null_)+ ]+ FinalizeWeakOp -> \[fl,fin] [w] -> PrimInline $ appT [fin, fl] "h$finalizeWeak" [w]+ TouchOp -> \[] [_e] -> PrimInline mempty+ KeepAliveOp -> \[_r] [x, f] -> PRPrimCall $ ReturnStat (app "h$keepAlive" [x, f])+++------------------------------ Stable pointers and names ------------------------++ MakeStablePtrOp -> \[s1,s2] [a] -> PrimInline $ mconcat+ [ s1 |= var "h$stablePtrBuf"+ , s2 |= app "h$makeStablePtr" [a]+ ]+ DeRefStablePtrOp -> \[r] [_s1,s2] -> PrimInline $ r |= app "h$deRefStablePtr" [s2]+ EqStablePtrOp -> \[r] [_sa1,sa2,_sb1,sb2] -> PrimInline $ r |= if10 (sa2 .===. sb2)++ MakeStableNameOp -> \[r] [a] -> PrimInline $ r |= app "h$makeStableName" [a]+ StableNameToIntOp -> \[r] [s] -> PrimInline $ r |= app "h$stableNameInt" [s]++------------------------------ Compact normal form -----------------------------++ CompactNewOp -> \[c] [s] -> PrimInline $ c |= app "h$compactNew" [s]+ CompactResizeOp -> \[] [c,s] -> PrimInline $ appS "h$compactResize" [c,s]+ CompactContainsOp -> \[r] [c,v] -> PrimInline $ r |= app "h$compactContains" [c,v]+ CompactContainsAnyOp -> \[r] [v] -> PrimInline $ r |= app "h$compactContainsAny" [v]+ CompactGetFirstBlockOp -> \[ra,ro,s] [c] ->+ PrimInline $ appT [ra,ro,s] "h$compactGetFirstBlock" [c]+ CompactGetNextBlockOp -> \[ra,ro,s] [c,a,o] ->+ PrimInline $ appT [ra,ro,s] "h$compactGetNextBlock" [c,a,o]+ CompactAllocateBlockOp -> \[ra,ro] [size,sa,so] ->+ PrimInline $ appT [ra,ro] "h$compactAllocateBlock" [size,sa,so]+ CompactFixupPointersOp -> \[c,newroota, newrooto] [blocka,blocko,roota,rooto] ->+ PrimInline $ appT [c,newroota,newrooto] "h$compactFixupPointers" [blocka,blocko,roota,rooto]+ CompactAdd -> \[_r] [c,o] ->+ PRPrimCall $ returnS (app "h$compactAdd" [c,o])+ CompactAddWithSharing -> \[_r] [c,o] ->+ PRPrimCall $ returnS (app "h$compactAddWithSharing" [c,o])+ CompactSize -> \[s] [c] ->+ PrimInline $ s |= app "h$compactSize" [c]++------------------------------ Unsafe pointer equality --------------------------++ ReallyUnsafePtrEqualityOp -> \[r] [p1,p2] -> PrimInline $ r |= if10 (p1 .===. p2)++------------------------------ Parallelism --------------------------------------++ ParOp -> \[r] [_a] -> PrimInline $ r |= zero_+ SparkOp -> \[r] [a] -> PrimInline $ r |= a+ SeqOp -> \[_r] [e] -> PRPrimCall $ returnS (app "h$e" [e])+ NumSparks -> \[r] [] -> PrimInline $ r |= zero_++------------------------------ Tag to enum stuff --------------------------------++ DataToTagOp -> \[_r] [d] -> PRPrimCall $ mconcat+ [ stack .! PreInc sp |= var "h$dataToTag_e"+ , returnS (app "h$e" [d])+ ]+ TagToEnumOp -> \[r] [tag] -> if+ | isBoolTy ty -> PrimInline $ r |= IfExpr tag true_ false_+ | otherwise -> PrimInline $ r |= app "h$tagToEnum" [tag]++------------------------------ Bytecode operations ------------------------------++ AddrToAnyOp -> \[r] [d,_o] -> PrimInline $ r |= d++------------------------------ Profiling (CCS) ------------------------------++ GetCCSOfOp -> \[a, o] [obj] -> if+ | prof -> PrimInline $ mconcat+ [ a |= if_ (isObject obj)+ (app "h$buildCCSPtr" [obj .^ "cc"])+ null_+ , o |= zero_+ ]+ | otherwise -> PrimInline $ mconcat+ [ a |= null_+ , o |= zero_+ ]++ GetCurrentCCSOp -> \[a, o] [_dummy_arg] ->+ let ptr = if prof then app "h$buildCCSPtr" [jCurrentCCS]+ else null_+ in PrimInline $ mconcat+ [ a |= ptr+ , o |= zero_+ ]++ ClearCCSOp -> \[_r] [x] -> PRPrimCall $ ReturnStat (app "h$clearCCS" [x])++------------------------------ Eventlog -------------------++ TraceEventOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceEvent" [ed,eo]+ TraceEventBinaryOp -> \[] [ed,eo,len] -> PrimInline $ appS "h$traceEventBinary" [ed,eo,len]+ TraceMarkerOp -> \[] [ed,eo] -> PrimInline $ appS "h$traceMarker" [ed,eo]++------------------------------ ByteArray -------------------++ IndexByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i+ IndexByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i+ IndexByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o+ IndexByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i+ IndexByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i+ IndexByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o+ IndexByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i+ IndexByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i+ IndexByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l+ IndexByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i+ IndexByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i+ IndexByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i+ IndexByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l+ IndexByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i++ ReadByteArrayOp_Word8AsChar -> \[r] [a,i] -> PrimInline $ bnd_ba8 bound a i $ r |= read_boff_u8 a i+ ReadByteArrayOp_Word8AsWideChar -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i+ ReadByteArrayOp_Word8AsAddr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_addr a i r o+ ReadByteArrayOp_Word8AsFloat -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_f32 a i+ ReadByteArrayOp_Word8AsDouble -> \[r] [a,i] -> PrimInline $ bnd_ba64 bound a i $ r |= read_boff_f64 a i+ ReadByteArrayOp_Word8AsStablePtr -> \[r,o] [a,i] -> PrimInline $ bnd_ba32 bound a i $ read_boff_stableptr a i r o+ ReadByteArrayOp_Word8AsInt16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_i16 a i+ ReadByteArrayOp_Word8AsInt32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i+ ReadByteArrayOp_Word8AsInt64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_i64 a i h l+ ReadByteArrayOp_Word8AsInt -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_i32 a i+ ReadByteArrayOp_Word8AsWord16 -> \[r] [a,i] -> PrimInline $ bnd_ba16 bound a i $ r |= read_boff_u16 a i+ ReadByteArrayOp_Word8AsWord32 -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i+ ReadByteArrayOp_Word8AsWord64 -> \[h,l] [a,i] -> PrimInline $ bnd_ba64 bound a i $ read_boff_u64 a i h l+ ReadByteArrayOp_Word8AsWord -> \[r] [a,i] -> PrimInline $ bnd_ba32 bound a i $ r |= read_boff_u32 a i++ WriteByteArrayOp_Word8AsChar -> \[] [a,i,e] -> PrimInline $ bnd_ba8 bound a i $ write_boff_i8 a i e+ WriteByteArrayOp_Word8AsWideChar -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e+ WriteByteArrayOp_Word8AsAddr -> \[] [a,i,r,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_addr a i r o+ WriteByteArrayOp_Word8AsFloat -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_f32 a i e+ WriteByteArrayOp_Word8AsDouble -> \[] [a,i,e] -> PrimInline $ bnd_ba64 bound a i $ write_boff_f64 a i e+ WriteByteArrayOp_Word8AsStablePtr -> \[] [a,i,_,o] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i o+ WriteByteArrayOp_Word8AsInt16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_i16 a i e+ WriteByteArrayOp_Word8AsInt32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e+ WriteByteArrayOp_Word8AsInt64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_i64 a i h l+ WriteByteArrayOp_Word8AsInt -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_i32 a i e+ WriteByteArrayOp_Word8AsWord16 -> \[] [a,i,e] -> PrimInline $ bnd_ba16 bound a i $ write_boff_u16 a i e+ WriteByteArrayOp_Word8AsWord32 -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e+ WriteByteArrayOp_Word8AsWord64 -> \[] [a,i,h,l] -> PrimInline $ bnd_ba64 bound a i $ write_boff_u64 a i h l+ WriteByteArrayOp_Word8AsWord -> \[] [a,i,e] -> PrimInline $ bnd_ba32 bound a i $ write_boff_u32 a i e++ CasByteArrayOp_Int -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n+ CasByteArrayOp_Int8 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix8 bound a i $ casOp read_i8 write_i8 r a i o n+ CasByteArrayOp_Int16 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix16 bound a i $ casOp read_i16 write_i16 r a i o n+ CasByteArrayOp_Int32 -> \[r] [a,i,o,n] -> PrimInline $ bnd_ix32 bound a i $ casOp read_i32 write_i32 r a i o n++ CasByteArrayOp_Int64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ bnd_ix64 bound a i $ casOp2 read_i64 write_i64 (rh,rl) a i (oh,ol) (nh,nl)++ CasAddrOp_Addr -> \[ra,ro] [a,o,oa,oo,na,no] -> PrimInline $ casOp2 read_boff_addr write_boff_addr (ra,ro) a o (oa,oo) (na,no)+ CasAddrOp_Word -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new+ CasAddrOp_Word8 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u8 write_u8 r a o old new+ CasAddrOp_Word16 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u16 write_u16 r a o old new+ CasAddrOp_Word32 -> \[r] [a,o,old,new] -> PrimInline $ casOp read_u32 write_u32 r a o old new+ CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl)++ FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v+ FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v+ FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v+ FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v+ FetchOrAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BOr r a o v+ FetchXorAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BXor r a o v++ InterlockedExchange_Addr -> \[ra,ro] [a1,o1,a2,o2] -> PrimInline $ mconcat+ [ read_boff_addr a1 o1 ra ro+ , write_boff_addr a1 o1 a2 o2+ ]+ InterlockedExchange_Word -> \[r] [a,o,w] -> PrimInline $ mconcat+ [ r |= read_boff_u32 a o+ , write_boff_u32 a o w+ ]++ ShrinkSmallMutableArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableCharArray" [a,n]+ GetSizeofSmallMutableArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "length"++ AtomicReadAddrOp_Word -> \[r] [a,o] -> PrimInline $ r |= read_boff_u32 a o+ AtomicWriteAddrOp_Word -> \[] [a,o,w] -> PrimInline $ write_boff_u32 a o w+++------------------------------ Unhandled primops -------------------++ NewPromptTagOp -> unhandledPrimop op+ PromptOp -> unhandledPrimop op+ Control0Op -> unhandledPrimop op++ NewIOPortOp -> unhandledPrimop op+ ReadIOPortOp -> unhandledPrimop op+ WriteIOPortOp -> unhandledPrimop op++ GetSparkOp -> unhandledPrimop op+ AnyToAddrOp -> unhandledPrimop op+ MkApUpd0_Op -> unhandledPrimop op+ NewBCOOp -> unhandledPrimop op+ UnpackClosureOp -> unhandledPrimop op+ ClosureSizeOp -> unhandledPrimop op+ GetApStackValOp -> unhandledPrimop op+ WhereFromOp -> unhandledPrimop op -- should be easily implementable with o.f.n++ SetThreadAllocationCounter -> unhandledPrimop op++------------------------------- Vector -----------------------------------------+-- For now, vectors are unsupported on the JS backend. Simply put, they do not+-- make much sense to support given support for arrays and lack of SIMD support+-- in JS. We could try to roll something special but we would not be able to+-- give any performance guarentees to the user and so we leave these has+-- unhandled for now.+ VecBroadcastOp _ _ _ -> unhandledPrimop op+ VecPackOp _ _ _ -> unhandledPrimop op+ VecUnpackOp _ _ _ -> unhandledPrimop op+ VecInsertOp _ _ _ -> unhandledPrimop op+ VecAddOp _ _ _ -> unhandledPrimop op+ VecSubOp _ _ _ -> unhandledPrimop op+ VecMulOp _ _ _ -> unhandledPrimop op+ VecDivOp _ _ _ -> unhandledPrimop op+ VecQuotOp _ _ _ -> unhandledPrimop op+ VecRemOp _ _ _ -> unhandledPrimop op+ VecNegOp _ _ _ -> unhandledPrimop op+ VecIndexByteArrayOp _ _ _ -> unhandledPrimop op+ VecReadByteArrayOp _ _ _ -> unhandledPrimop op+ VecWriteByteArrayOp _ _ _ -> unhandledPrimop op+ VecIndexOffAddrOp _ _ _ -> unhandledPrimop op+ VecReadOffAddrOp _ _ _ -> unhandledPrimop op+ VecWriteOffAddrOp _ _ _ -> unhandledPrimop op++ VecIndexScalarByteArrayOp _ _ _ -> unhandledPrimop op+ VecReadScalarByteArrayOp _ _ _ -> unhandledPrimop op+ VecWriteScalarByteArrayOp _ _ _ -> unhandledPrimop op+ VecIndexScalarOffAddrOp _ _ _ -> unhandledPrimop op+ VecReadScalarOffAddrOp _ _ _ -> unhandledPrimop op+ VecWriteScalarOffAddrOp _ _ _ -> unhandledPrimop op++ PrefetchByteArrayOp3 -> noOp+ PrefetchMutableByteArrayOp3 -> noOp+ PrefetchAddrOp3 -> noOp+ PrefetchValueOp3 -> noOp+ PrefetchByteArrayOp2 -> noOp+ PrefetchMutableByteArrayOp2 -> noOp+ PrefetchAddrOp2 -> noOp+ PrefetchValueOp2 -> noOp+ PrefetchByteArrayOp1 -> noOp+ PrefetchMutableByteArrayOp1 -> noOp+ PrefetchAddrOp1 -> noOp+ PrefetchValueOp1 -> noOp+ PrefetchByteArrayOp0 -> noOp+ PrefetchMutableByteArrayOp0 -> noOp+ PrefetchAddrOp0 -> noOp+ PrefetchValueOp0 -> noOp++unhandledPrimop :: PrimOp -> [JExpr] -> [JExpr] -> PrimRes+unhandledPrimop op rs as = PrimInline $ mconcat+ [ appS "h$log" [toJExpr $ mconcat+ [ "warning, unhandled primop: "+ , renderWithContext defaultSDocContext (ppr op)+ , " "+ , show (length rs, length as)+ ]]+ , appS (mkFastString $ "h$primop_" ++ zEncodeString (renderWithContext defaultSDocContext (ppr op))) as+ -- copyRes+ , mconcat $ zipWith (\r reg -> r |= toJExpr reg) rs (enumFrom Ret1)+ ]++-- | A No Op, used for primops the JS platform cannot or do not support. For+-- example, the prefetching primops do not make sense on the JS platform because+-- we do not have enough control over memory to provide any kind of prefetching+-- mechanism. Hence, these are NoOps.+noOp :: Foldable f => f a -> f a -> PrimRes+noOp = const . const $ PrimInline mempty++-- tuple returns+appT :: [JExpr] -> FastString -> [JExpr] -> JStat+appT [] f xs = appS f xs+appT (r:rs) f xs = mconcat+ [ r |= app f xs+ , mconcat (zipWith (\r ret -> r |= toJExpr ret) rs (enumFrom Ret1))+ ]++--------------------------------------------+-- ByteArray indexing+--------------------------------------------++-- For every ByteArray, the RTS creates the following views:+-- i3: Int32 view+-- u8: Word8 view+-- u1: Word16 view+-- f3: Float32 view+-- f6: Float64 view+-- dv: generic DataView+-- It seems a bit weird to mix Int and Word views like this, but perhaps they+-- are the more common.+--+-- See 'h$newByteArray' in 'ghc/rts/js/mem.js' for details.+--+-- Note that *byte* indexing can only be done with the generic DataView. Use+-- read_boff_* and write_boff_* for this.+--+-- Other read_* and write_* helpers directly use the more specific views.+-- Prefer using them over idx_* to make your intent clearer.++idx_i32, idx_u8, idx_u16, idx_f64, idx_f32 :: JExpr -> JExpr -> JExpr+idx_i32 a i = IdxExpr (a .^ "i3") i+idx_u8 a i = IdxExpr (a .^ "u8") i+idx_u16 a i = IdxExpr (a .^ "u1") i+idx_f64 a i = IdxExpr (a .^ "f6") i+idx_f32 a i = IdxExpr (a .^ "f3") i++read_u8 :: JExpr -> JExpr -> JExpr+read_u8 a i = idx_u8 a i++read_u16 :: JExpr -> JExpr -> JExpr+read_u16 a i = idx_u16 a i++read_u32 :: JExpr -> JExpr -> JExpr+read_u32 a i = toU32 (idx_i32 a i)++read_i8 :: JExpr -> JExpr -> JExpr+read_i8 a i = signExtend8 (idx_u8 a i)++read_i16 :: JExpr -> JExpr -> JExpr+read_i16 a i = signExtend16 (idx_u16 a i)++read_i32 :: JExpr -> JExpr -> JExpr+read_i32 a i = idx_i32 a i++read_f32 :: JExpr -> JExpr -> JExpr+read_f32 a i = idx_f32 a i++read_f64 :: JExpr -> JExpr -> JExpr+read_f64 a i = idx_f64 a i++read_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat+read_u64 a i rh rl = mconcat+ [ rl |= read_u32 a (i .<<. 1)+ , rh |= read_u32 a (Add 1 (i .<<. 1))+ ]++read_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat+read_i64 a i rh rl = mconcat+ [ rl |= read_u32 a (i .<<. 1)+ , rh |= read_i32 a (Add 1 (i .<<. 1))+ ]++--------------------------------------+-- Addr#+--------------------------------------++write_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat+write_addr a i r o = mconcat+ [ write_i32 a i o+ -- create the hidden array for arrays if it doesn't exist+ , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty+ , a .^ "arr" .! (i .<<. 2) |= r+ ]++read_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat+read_addr a i r o = mconcat+ [ o |= read_i32 a i+ , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! (i .<<. 2)))+ (a .^ "arr" .! (i .<<. 2))+ null_+ ]++read_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat+read_boff_addr a i r o = mconcat+ [ o |= read_boff_i32 a i+ , r |= if_ ((a .^ "arr") .&&. (a .^ "arr" .! i))+ (a .^ "arr" .! i)+ null_+ ]++write_boff_addr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat+write_boff_addr a i r o = mconcat+ [ write_boff_i32 a i o+ -- create the hidden array for arrays if it doesn't exist+ , ifS (Not (a .^ "arr")) (a .^ "arr" |= ValExpr (JList [])) mempty+ , a .^ "arr" .! i |= r+ ]+++--------------------------------------+-- StablePtr+--------------------------------------++read_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat+read_stableptr a i r o = mconcat+ [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array+ , o |= read_i32 a i+ ]++read_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat+read_boff_stableptr a i r o = mconcat+ [ r |= var "h$stablePtrBuf" -- stable pointers are always in this array+ , o |= read_boff_i32 a i+ ]++write_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat+write_stableptr a i _r o = write_i32 a i o+ -- don't store "r" as it must be h$stablePtrBuf++write_boff_stableptr :: JExpr -> JExpr -> JExpr -> JExpr -> JStat+write_boff_stableptr a i _r o = write_boff_i32 a i o+ -- don't store "r" as it must be h$stablePtrBuf++write_u8 :: JExpr -> JExpr -> JExpr -> JStat+write_u8 a i v = idx_u8 a i |= v++write_u16 :: JExpr -> JExpr -> JExpr -> JStat+write_u16 a i v = idx_u16 a i |= v++write_u32 :: JExpr -> JExpr -> JExpr -> JStat+write_u32 a i v = idx_i32 a i |= v++write_i8 :: JExpr -> JExpr -> JExpr -> JStat+write_i8 a i v = idx_u8 a i |= v++write_i16 :: JExpr -> JExpr -> JExpr -> JStat+write_i16 a i v = idx_u16 a i |= v++write_i32 :: JExpr -> JExpr -> JExpr -> JStat+write_i32 a i v = idx_i32 a i |= v++write_f32 :: JExpr -> JExpr -> JExpr -> JStat+write_f32 a i v = idx_f32 a i |= v++write_f64 :: JExpr -> JExpr -> JExpr -> JStat+write_f64 a i v = idx_f64 a i |= v++write_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat+write_u64 a i h l = mconcat+ [ write_u32 a (i .<<. 1) l+ , write_u32 a (Add 1 (i .<<. 1)) h+ ]++write_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat+write_i64 a i h l = mconcat+ [ write_u32 a (i .<<. 1) l+ , write_i32 a (Add 1 (i .<<. 1)) h+ ]++-- Data View helper functions: byte indexed!+--+-- The argument list consists of the array @a@, the index @i@, and the new value+-- to set (in the case of a setter) @v@.++write_boff_i8, write_boff_u8, write_boff_i16, write_boff_u16, write_boff_i32, write_boff_u32, write_boff_f32, write_boff_f64 :: JExpr -> JExpr -> JExpr -> JStat+write_boff_i8 a i v = write_i8 a i v+write_boff_u8 a i v = write_u8 a i v+write_boff_i16 a i v = ApplStat (a .^ "dv" .^ "setInt16" ) [i, v, true_]+write_boff_u16 a i v = ApplStat (a .^ "dv" .^ "setUint16" ) [i, v, true_]+write_boff_i32 a i v = ApplStat (a .^ "dv" .^ "setInt32" ) [i, v, true_]+write_boff_u32 a i v = ApplStat (a .^ "dv" .^ "setUint32" ) [i, v, true_]+write_boff_f32 a i v = ApplStat (a .^ "dv" .^ "setFloat32") [i, v, true_]+write_boff_f64 a i v = ApplStat (a .^ "dv" .^ "setFloat64") [i, v, true_]++write_boff_i64, write_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat+write_boff_i64 a i h l = mconcat+ [ write_boff_i32 a (Add i (Int 4)) h+ , write_boff_u32 a i l+ ]+write_boff_u64 a i h l = mconcat+ [ write_boff_u32 a (Add i (Int 4)) h+ , write_boff_u32 a i l+ ]++read_boff_i8, read_boff_u8, read_boff_i16, read_boff_u16, read_boff_i32, read_boff_u32, read_boff_f32, read_boff_f64 :: JExpr -> JExpr -> JExpr+read_boff_i8 a i = read_i8 a i+read_boff_u8 a i = read_u8 a i+read_boff_i16 a i = ApplExpr (a .^ "dv" .^ "getInt16" ) [i, true_]+read_boff_u16 a i = ApplExpr (a .^ "dv" .^ "getUint16" ) [i, true_]+read_boff_i32 a i = ApplExpr (a .^ "dv" .^ "getInt32" ) [i, true_]+read_boff_u32 a i = ApplExpr (a .^ "dv" .^ "getUint32" ) [i, true_]+read_boff_f32 a i = ApplExpr (a .^ "dv" .^ "getFloat32") [i, true_]+read_boff_f64 a i = ApplExpr (a .^ "dv" .^ "getFloat64") [i, true_]++read_boff_i64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat+read_boff_i64 a i rh rl = mconcat+ [ rh |= read_boff_i32 a (Add i (Int 4))+ , rl |= read_boff_u32 a i+ ]++read_boff_u64 :: JExpr -> JExpr -> JExpr -> JExpr -> JStat+read_boff_u64 a i rh rl = mconcat+ [ rh |= read_boff_u32 a (Add i (Int 4))+ , rl |= read_boff_u32 a i+ ]++fetchOpByteArray :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat+fetchOpByteArray op tgt src i v = mconcat+ [ tgt |= read_i32 src i+ , write_i32 src i (op tgt v)+ ]++fetchOpAddr :: (JExpr -> JExpr -> JExpr) -> JExpr -> JExpr -> JExpr -> JExpr -> JStat+fetchOpAddr op tgt src i v = mconcat+ [ tgt |= read_boff_u32 src i+ , write_boff_u32 src i (op tgt v)+ ]++casOp+ :: (JExpr -> JExpr -> JExpr) -- read+ -> (JExpr -> JExpr -> JExpr -> JStat) -- write+ -> JExpr -- target register to store result+ -> JExpr -- source array+ -> JExpr -- index+ -> JExpr -- old value to compare+ -> JExpr -- new value to write+ -> JStat+casOp read write tgt src i old new = mconcat+ [ tgt |= read src i+ , ifS (tgt .===. old)+ (write src i new)+ mempty+ ]++casOp2+ :: (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- read+ -> (JExpr -> JExpr -> JExpr -> JExpr -> JStat) -- write+ -> (JExpr,JExpr) -- target registers to store result+ -> JExpr -- source array+ -> JExpr -- index+ -> (JExpr,JExpr) -- old value to compare+ -> (JExpr,JExpr) -- new value to write+ -> JStat+casOp2 read write (tgt1,tgt2) src i (old1,old2) (new1,new2) = mconcat+ [ read src i tgt1 tgt2+ , ifS ((tgt2 .===. old2) .&&. (tgt1 .===. old1))+ (write src i new1 new2)+ mempty+ ]++--------------------------------------------------------------------------------+-- Lifted Arrays+--------------------------------------------------------------------------------+-- | lifted arrays+cloneArray :: Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JStat+cloneArray bound_check tgt src start len =+ bnd_arr_range bound_check src start len+ $ mconcat+ [ tgt |= ApplExpr (src .^ "slice") [start, Add len start]+ , tgt .^ closureMeta_ |= zero_+ , tgt .^ "__ghcjsArray" |= true_+ ]++newByteArray :: JExpr -> JExpr -> JStat+newByteArray tgt len =+ tgt |= app "h$newByteArray" [len]++-- | Check that index is positive and below a max value. Halt the process with+-- error code 134 otherwise. This is used to implement -fcheck-prim-bounds+check_bound+ :: JExpr -- ^ Max index expression+ -> Bool -- ^ Should we do bounds checking?+ -> JExpr -- ^ Index+ -> JStat -- ^ Result+ -> JStat+check_bound _ False _ r = r+check_bound max_index True i r = mconcat+ [ jwhenS ((i .<. zero_) .||. (i .>=. max_index)) $+ returnS (app "h$exitProcess" [Int 134])+ , r+ ]++-- | Bounds checking using ".length" property (Arrays)+bnd_arr+ :: Bool -- ^ Should we do bounds checking?+ -> JExpr -- ^ Array+ -> JExpr -- ^ Index+ -> JStat -- ^ Result+ -> JStat+bnd_arr do_check arr = check_bound (arr .^ "length") do_check++-- | Range bounds checking using ".length" property (Arrays)+--+-- Empty ranges trivially pass the check+bnd_arr_range+ :: Bool -- ^ Should we do bounds checking?+ -> JExpr -- ^ Array+ -> JExpr -- ^ Index+ -> JExpr -- ^ Range size+ -> JStat -- ^ Result+ -> JStat+bnd_arr_range False _arr _i _n r = r+bnd_arr_range True arr i n r =+ ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $+ -- Empty ranges trivially pass the check+ ifS (n .===. zero_)+ r+ (bnd_arr True arr i $ bnd_arr True arr (Add i (Sub n 1)) r)++-- | Bounds checking using ".len" property (ByteArrays)+bnd_ba+ :: Bool -- ^ Should we do bounds checking?+ -> JExpr -- ^ Array+ -> JExpr -- ^ Index+ -> JStat -- ^ Result+ -> JStat+bnd_ba do_check arr = check_bound (arr .^ "len") do_check++-- | ByteArray bounds checking (byte offset, 8-bit value)+bnd_ba8 :: Bool -> JExpr -> JExpr -> JStat -> JStat+bnd_ba8 = bnd_ba++-- | ByteArray bounds checking (byte offset, 16-bit value)+bnd_ba16 :: Bool -> JExpr -> JExpr -> JStat -> JStat+bnd_ba16 do_check arr idx r =+ -- check that idx non incremented is in range:+ -- (idx + 1) may be in range while idx isn't+ bnd_ba do_check arr idx+ $ bnd_ba do_check arr (Add idx 1) r++-- | ByteArray bounds checking (byte offset, 32-bit value)+bnd_ba32 :: Bool -> JExpr -> JExpr -> JStat -> JStat+bnd_ba32 do_check arr idx r =+ -- check that idx non incremented is in range:+ -- (idx + 3) may be in range while idx isn't+ bnd_ba do_check arr idx+ $ bnd_ba do_check arr (Add idx 3) r++-- | ByteArray bounds checking (byte offset, 64-bit value)+bnd_ba64 :: Bool -> JExpr -> JExpr -> JStat -> JStat+bnd_ba64 do_check arr idx r =+ -- check that idx non incremented is in range:+ -- (idx + 7) may be in range while idx isn't+ bnd_ba do_check arr idx+ $ bnd_ba do_check arr (Add idx 7) r++-- | ByteArray bounds checking (8-bit offset, 8-bit value)+bnd_ix8 :: Bool -> JExpr -> JExpr -> JStat -> JStat+bnd_ix8 = bnd_ba8++-- | ByteArray bounds checking (16-bit offset, 16-bit value)+bnd_ix16 :: Bool -> JExpr -> JExpr -> JStat -> JStat+bnd_ix16 do_check arr idx r = bnd_ba16 do_check arr (idx .<<. 1) r++-- | ByteArray bounds checking (32-bit offset, 32-bit value)+bnd_ix32 :: Bool -> JExpr -> JExpr -> JStat -> JStat+bnd_ix32 do_check arr idx r = bnd_ba32 do_check arr (idx .<<. 2) r++-- | ByteArray bounds checking (64-bit offset, 64-bit value)+bnd_ix64 :: Bool -> JExpr -> JExpr -> JStat -> JStat+bnd_ix64 do_check arr idx r = bnd_ba64 do_check arr (idx .<<. 3) r++-- | Bounds checking on a range and using ".len" property (ByteArrays)+--+-- Empty ranges trivially pass the check+bnd_ba_range+ :: Bool -- ^ Should we do bounds checking?+ -> JExpr -- ^ Array+ -> JExpr -- ^ Index+ -> JExpr -- ^ Range size+ -> JStat -- ^ Result+ -> JStat+bnd_ba_range False _ _ _ r = r+bnd_ba_range True xs i n r =+ ifS (n .<. zero_) (returnS $ app "h$exitProcess" [Int 134]) $+ -- Empty ranges trivially pass the check+ ifS (n .===. zero_)+ r+ (bnd_ba True xs (Add i (Sub n 1)) (bnd_ba True xs i r))++checkOverlapByteArray+ :: Bool -- ^ Should we do bounds checking?+ -> JExpr -- ^ First array+ -> JExpr -- ^ First offset+ -> JExpr -- ^ Second array+ -> JExpr -- ^ Second offset+ -> JExpr -- ^ Range size+ -> JStat -- ^ Result+ -> JStat+checkOverlapByteArray False _ _ _ _ _ r = r+checkOverlapByteArray True a1 o1 a2 o2 n r =+ ifS (app "h$checkOverlapByteArray" [a1, o1, a2, o2, n])+ r+ (returnS $ app "h$exitProcess" [Int 134])++copyByteArray :: Bool -> Bool -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> PrimRes+copyByteArray allow_overlap bound a1 o1 a2 o2 n = PrimInline $ check $ appS "h$copyMutableByteArray" [a1,o1,a2,o2,n]+ where+ check = bnd_ba_range bound a1 o1 n+ . bnd_ba_range bound a2 o2 n+ . (if not allow_overlap then checkOverlapByteArray bound a1 o1 a2 o2 n else id) -- e|0 (32 bit signed integer truncation) required because of JS numbers. e|0 -- converts e to an Int32. Note that e|0 _is still a Double_ because JavaScript.
compiler/GHC/Tc/Gen/HsType.hs view
@@ -2535,13 +2535,14 @@ -- ^^^^^^^^^ -- We do it here because at this point the environment has been -- extended with both 'implicit_tcv_prs' and 'explicit_tv_prs'.- ; ctx_k <- kc_res_ki+ ; res_kind :: ContextKind <- kc_res_ki + -- Work out extra_arity, the number of extra invisible binders from -- the kind signature that should be part of the TyCon's arity. -- See Note [Arity inference in kcCheckDeclHeader_sig] ; let n_invis_tcbs = countWhile isInvisibleTyConBinder excess_sig_tcbs- invis_arity = case ctx_k of+ invis_arity = case res_kind of AnyKind -> n_invis_tcbs -- No kind signature, so make all the invisible binders -- the signature into part of the arity of the TyCon OpenKind -> n_invis_tcbs -- Result kind is (TYPE rr), so again make all the@@ -2555,12 +2556,9 @@ , ppr invis_arity, ppr invis_tcbs , ppr n_invis_tcbs ] - -- Unify res_ki (from the type declaration) with the residual kind from- -- the kind signature. Don't forget to apply the skolemising 'subst' first.- ; case ctx_k of- AnyKind -> return () -- No signature- _ -> do { res_ki <- newExpectedKind ctx_k- ; discardResult (unifyKind Nothing sig_res_kind' res_ki) }+ -- Unify res_ki (from the type declaration) with+ -- sig_res_kind', the residual kind from the kind signature.+ ; checkExpectedResKind sig_res_kind' res_kind -- Add more binders for data/newtype, so the result kind has no arrows -- See Note [Datatype return kinds]@@ -2583,6 +2581,7 @@ ; implicit_tvs <- zonkTcTyVarsToTcTyVars implicit_tvs ; let implicit_prs = implicit_nms `zip` implicit_tvs ; checkForDuplicateScopedTyVars implicit_prs+ ; checkForDisconnectedScopedTyVars flav all_tcbs implicit_prs -- Swizzle the Names so that the TyCon uses the user-declared implicit names -- E.g type T :: k -> Type@@ -2596,11 +2595,11 @@ all_tv_prs = mkTyVarNamePairs (binderVars swizzled_tcbs) ; traceTc "kcCheckDeclHeader swizzle" $ vcat- [ text "implicit_prs = " <+> ppr implicit_prs- , text "implicit_nms = " <+> ppr implicit_nms- , text "hs_tv_bndrs = " <+> ppr hs_tv_bndrs- , text "all_tcbs = " <+> pprTyVars (binderVars all_tcbs)- , text "swizzled_tcbs = " <+> pprTyVars (binderVars swizzled_tcbs)+ [ text "sig_tcbs =" <+> ppr sig_tcbs+ , text "implicit_prs =" <+> ppr implicit_prs+ , text "hs_tv_bndrs =" <+> ppr hs_tv_bndrs+ , text "all_tcbs =" <+> pprTyVars (binderVars all_tcbs)+ , text "swizzled_tcbs =" <+> pprTyVars (binderVars swizzled_tcbs) , text "tycon_res_kind =" <+> ppr tycon_res_kind , text "swizzled_kind =" <+> ppr swizzled_kind ] @@ -2619,6 +2618,27 @@ ] ; return tc } +-- | Check the result kind annotation on a type constructor against+-- the corresponding section of the standalone kind signature.+-- Drops invisible binders that interfere with unification.+checkExpectedResKind :: TcKind -- ^ the result kind from the separate kind signature+ -> ContextKind -- ^ the result kind from the declaration header+ -> TcM ()+checkExpectedResKind _ AnyKind+ = return () -- No signature in the declaration header+checkExpectedResKind sig_kind res_ki+ = do { actual_res_ki <- newExpectedKind res_ki++ ; let -- Drop invisible binders from sig_kind until they match up+ -- with res_ki. By analogy with checkExpectedKind.+ n_res_invis_bndrs = invisibleTyBndrCount actual_res_ki+ n_sig_invis_bndrs = invisibleTyBndrCount sig_kind+ n_to_inst = n_sig_invis_bndrs - n_res_invis_bndrs++ (_, sig_kind') = splitInvisPiTysN n_to_inst sig_kind++ ; discardResult $ unifyKind Nothing sig_kind' actual_res_ki }+ matchUpSigWithDecl :: [TcTyConBinder] -- TcTyConBinders (with skolem TcTyVars) from the separate kind signature -> TcKind -- The tail end of the kind signature@@ -2986,6 +3006,25 @@ * * ********************************************************************* -} +checkForDisconnectedScopedTyVars :: TyConFlavour -> [TcTyConBinder]+ -> [(Name,TcTyVar)] -> TcM ()+-- See Note [Disconnected type variables]+-- `scoped_prs` is the mapping gotten by unifying+-- - the standalone kind signature for T, with+-- - the header of the type/class declaration for T+checkForDisconnectedScopedTyVars flav sig_tcbs scoped_prs+ = when (needsEtaExpansion flav) $+ -- needsEtaExpansion: see wrinkle (DTV1) in Note [Disconnected type variables]+ mapM_ report_disconnected (filterOut ok scoped_prs)+ where+ sig_tvs = mkVarSet (binderVars sig_tcbs)+ ok (_, tc_tv) = tc_tv `elemVarSet` sig_tvs++ report_disconnected :: (Name,TcTyVar) -> TcM ()+ report_disconnected (nm, _)+ = setSrcSpan (getSrcSpan nm) $+ addErrTc $ TcRnDisconnectedTyVar nm+ checkForDuplicateScopedTyVars :: [(Name,TcTyVar)] -> TcM () -- Check for duplicates -- E.g. data SameKind (a::k) (b::k)@@ -3015,6 +3054,64 @@ = setSrcSpan (getSrcSpan n2) $ addErrTc $ TcRnDifferentNamesForTyVar n1 n2 ++{- Note [Disconnected type variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+This note applies when kind-checking the header of a type/class decl that has+a separate, standalone kind signature. See #24083.++Consider:+ type S a = Type++ type C :: forall k. S k -> Constraint+ class C (a :: S kk) where+ op :: ...kk...++Note that the class has a separate kind signature, so the elaborated decl should+look like+ class C @kk (a :: S kk) where ...++But how can we "connect up" the scoped variable `kk` with the skolem kind from the+standalone kind signature for `C`? In general we do this by unifying the two.+For example+ type T k = (k,Type)+ type W :: forall k. T k -> Type+ data W (a :: (x,Type)) = ..blah blah..++When we encounter (a :: (x,Type)) we unify the kind (x,Type) with the kind (T k)+from the standalone kind signature. Of course, unification looks through synonyms+so we end up with the mapping [x :-> k] that connects the scoped type variable `x`+with the kind from the signature.++But in our earlier example this unification is ineffective -- because `S` is a+phantom synonym that just discards its argument. So our plan is this:++ if matchUpSigWithDecl fails to connect `kk with `k`, by unification,+ we give up and complain about a "disconnected" type variable.++See #24083 for dicussion of alternatives, none satisfactory. Also the fix is+easy: just add an explicit `@kk` parameter to the declaration, to bind `kk`+explicitly, rather than binding it implicitly via unification.++(DTV1) We only want to make this check when there /are/ scoped type variables; and+ that is determined by needsEtaExpansion. Examples:++ type C :: x -> y -> Constraint+ class C a :: b -> Constraint where { ... }+ -- The a,b scope over the "..."++ type D :: forall k. k -> Type+ data family D :: kk -> Type+ -- Nothing for `kk` to scope over!++ In the latter data-family case, the match-up stuff in kcCheckDeclHeader_sig will+ return [] for `extra_tcbs`, and in fact `all_tcbs` will be empty. So if we do+ the check-for-disconnected-tyvars check we'll complain that `kk` is not bound+ to one of `all_tcbs` (see #24083, comments about the `singletons` package).++ The scoped-tyvar stuff is needed precisely for data/class/newtype declarations,+ where needsEtaExpansion is True.+-} {- ********************************************************************* * *
compiler/GHC/Unit/Finder.hs view
@@ -301,7 +301,7 @@ , fr_suggestions = [] }) LookupUnusable unusable -> let unusables' = map get_unusable unusable- get_unusable (m, ModUnusable r) = (moduleUnit m, r)+ get_unusable (_, ModUnusable r) = r get_unusable (_, r) = pprPanic "findLookupResult: unexpected origin" (ppr r) in return (NotFound{ fr_paths = [], fr_pkg = Nothing
ghc-lib.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 build-type: Simple name: ghc-lib-version: 9.6.3.20231121+version: 9.6.4.20240109 license: BSD-3-Clause license-file: LICENSE category: Development@@ -89,8 +89,8 @@ process >= 1 && < 1.7, stm, rts,- hpc == 0.6.*,- ghc-lib-parser == 9.6.3.20231121+ hpc >= 0.6 && < 0.8,+ ghc-lib-parser == 9.6.4.20240109 build-tool-depends: alex:alex >= 3.1, happy:happy >= 1.19.4 other-extensions: BangPatterns
ghc-lib/stage0/lib/settings view
@@ -3,7 +3,7 @@ ,("C compiler flags", "--target=x86_64-apple-darwin ") ,("C++ compiler command", "/usr/bin/g++") ,("C++ compiler flags", "--target=x86_64-apple-darwin ")-,("C compiler link flags", "--target=x86_64-apple-darwin -Wl,-no_fixup_chains")+,("C compiler link flags", "--target=x86_64-apple-darwin -Wl,-no_fixup_chains -Wl,-no_warn_duplicate_libraries") ,("C compiler supports -no-pie", "NO") ,("Haskell CPP command", "/usr/bin/gcc") ,("Haskell CPP flags", "-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs")@@ -12,6 +12,7 @@ ,("ld supports compact unwind", "YES") ,("ld supports filelist", "YES") ,("ld is GNU ld", "NO")+,("ld supports single module", "NO") ,("Merge objects command", "ld") ,("Merge objects flags", "-r") ,("ar command", "/usr/bin/ar")
ghc-lib/stage0/rts/build/include/GhclibDerivedConstants.h view
@@ -166,8 +166,8 @@ #define StgEntCounter_entry_count(__ptr__) REP_StgEntCounter_entry_count[__ptr__+OFFSET_StgEntCounter_entry_count] #define SIZEOF_StgUpdateFrame_NoHdr 8 #define SIZEOF_StgUpdateFrame (SIZEOF_StgHeader+8)-#define SIZEOF_StgCatchFrame_NoHdr 16-#define SIZEOF_StgCatchFrame (SIZEOF_StgHeader+16)+#define SIZEOF_StgCatchFrame_NoHdr 8+#define SIZEOF_StgCatchFrame (SIZEOF_StgHeader+8) #define SIZEOF_StgStopFrame_NoHdr 0 #define SIZEOF_StgStopFrame (SIZEOF_StgHeader+0) #define SIZEOF_StgDeadThreadFrame_NoHdr 8@@ -260,12 +260,9 @@ #define OFFSET_StgUpdateFrame_updatee 0 #define REP_StgUpdateFrame_updatee b64 #define StgUpdateFrame_updatee(__ptr__) REP_StgUpdateFrame_updatee[__ptr__+SIZEOF_StgHeader+OFFSET_StgUpdateFrame_updatee]-#define OFFSET_StgCatchFrame_handler 8+#define OFFSET_StgCatchFrame_handler 0 #define REP_StgCatchFrame_handler b64 #define StgCatchFrame_handler(__ptr__) REP_StgCatchFrame_handler[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchFrame_handler]-#define OFFSET_StgCatchFrame_exceptions_blocked 0-#define REP_StgCatchFrame_exceptions_blocked b64-#define StgCatchFrame_exceptions_blocked(__ptr__) REP_StgCatchFrame_exceptions_blocked[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchFrame_exceptions_blocked] #define SIZEOF_StgPAP_NoHdr 16 #define SIZEOF_StgPAP (SIZEOF_StgHeader+16) #define OFFSET_StgPAP_n_args 4