ghc 9.6.3 → 9.6.4

raw patch · 45 files changed

+2285/−1736 lines, 45 filesdep ~ghc-bootdep ~ghc-heapdep ~ghciPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: ghc-boot, ghc-heap, ghci

API changes (from Hackage documentation)

Files

• GHC/Cmm/Lexer.hs +2/−2
• GHC/CmmToAsm.hs +12/−10
• GHC/CmmToAsm/AArch64.hs +2/−2
• GHC/CmmToAsm/AArch64/CodeGen.hs +193/−7
• GHC/CmmToAsm/AArch64/Cond.hs +8/−2
• GHC/CmmToAsm/AArch64/Instr.hs +1/−0
• GHC/CmmToAsm/AArch64/Ppr.hs +6/−3
• GHC/CmmToAsm/BlockLayout.hs +23/−19
• GHC/CmmToAsm/Monad.hs +3/−2
• GHC/CmmToAsm/PPC/Instr.hs +6/−5
• GHC/CmmToAsm/Ppr.hs +3/−2
• GHC/CmmToAsm/X86.hs +1/−1
• GHC/CmmToLlvm/Data.hs +1/−0
• GHC/Core/Opt/CprAnal.hs +40/−4
• GHC/Core/Opt/Simplify/Env.hs +39/−22
• GHC/Core/Type.hs +2/−1
• GHC/Data/Bag.hs +7/−0
• GHC/Driver/Flags.hs +1/−1
• GHC/Driver/Make.hs +27/−23
• GHC/Driver/Session.hs +110/−113
• GHC/Iface/Errors.hs +4/−3
• GHC/Linker/Dynamic.hs +9/−2
• GHC/Parser/HaddockLex.hs +2/−2
• GHC/Parser/Lexer.hs +2/−2
• GHC/Settings.hs +1/−0
• GHC/Settings/IO.hs +2/−0
• GHC/Stg/Debug.hs +20/−16
• GHC/StgToCmm/Bind.hs +12/−3
• GHC/StgToCmm/CgUtils.hs +7/−4
• GHC/StgToJS/Linker/Utils.hs +4/−0
• GHC/StgToJS/Prim.hs +1521/−1443
• GHC/Tc/Errors/Ppr.hs +10/−0
• GHC/Tc/Errors/Types.hs +8/−1
• GHC/Tc/Gen/HsType.hs +110/−13
• GHC/Types/Error/Codes.hs +1/−0
• GHC/Types/Hint.hs +3/−0
• GHC/Types/Hint/Ppr.hs +3/−0
• GHC/Types/Name/Occurrence.hs +7/−0
• GHC/Types/Name/Reader.hs +21/−9
• GHC/Types/Var.hs +7/−1
• GHC/Unit/Finder.hs +1/−1
• GHC/Unit/Finder/Types.hs +1/−1
• GHC/Unit/Module/ModIface.hs +1/−1
• GHC/Unit/State.hs +37/−11
• ghc.cabal +4/−4

@@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}-{-# LINE 13 "_build/source-dist/ghc-9.6.3-src/ghc-9.6.3/compiler/GHC/Cmm/Lexer.x" #-}+{-# LINE 13 "_build/source-dist/ghc-9.6.4-src/ghc-9.6.4/compiler/GHC/Cmm/Lexer.x" #-} module GHC.Cmm.Lexer (    CmmToken(..), cmmlex,   ) where@@ -385,7 +385,7 @@   , (0,alex_action_20)   ] -{-# LINE 133 "_build/source-dist/ghc-9.6.3-src/ghc-9.6.3/compiler/GHC/Cmm/Lexer.x" #-}+{-# LINE 133 "_build/source-dist/ghc-9.6.4-src/ghc-9.6.4/compiler/GHC/Cmm/Lexer.x" #-} data CmmToken   = CmmT_SpecChar  Char   | CmmT_DotDot

@@ -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

@@ -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

@@ -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

@@ -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

@@ -721,6 +721,7 @@     = TBlock BlockId     | TLabel CLabel     | TReg   Reg+    deriving (Eq, Ord)   -- Extension

@@ -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 

@@ -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

@@ -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,

@@ -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

@@ -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

@@ -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    }

@@ -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

@@ -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:

@@ -58,30 +58,34 @@ import GHC.Core.Rules.Config ( RuleOpts(..) ) import GHC.Core import GHC.Core.Utils-import GHC.Core.Multiplicity     ( scaleScaled ) import GHC.Core.Unfold import GHC.Core.TyCo.Subst (emptyIdSubstEnv)+import GHC.Core.Multiplicity( Scaled(..), mkMultMul )+import GHC.Core.Make            ( mkWildValBinder, mkCoreLet )+import GHC.Core.Type hiding     ( substTy, substTyVar, substTyVarBndr, substCo+                                , extendTvSubst, extendCvSubst )+import qualified GHC.Core.Coercion as Coercion+import GHC.Core.Coercion hiding ( substCo, substCoVar, substCoVarBndr )+import qualified GHC.Core.Type as Type+ import GHC.Types.Var import GHC.Types.Var.Env import GHC.Types.Var.Set+import GHC.Types.Id as Id+import GHC.Types.Basic+import GHC.Types.Unique.FM      ( pprUniqFM )+ import GHC.Data.OrdList import GHC.Data.Graph.UnVar-import GHC.Types.Id as Id-import GHC.Core.Make            ( mkWildValBinder, mkCoreLet )+ import GHC.Builtin.Types-import qualified GHC.Core.Type as Type-import GHC.Core.Type hiding     ( substTy, substTyVar, substTyVarBndr, substCo-                                , extendTvSubst, extendCvSubst )-import qualified GHC.Core.Coercion as Coercion-import GHC.Core.Coercion hiding ( substCo, substCoVar, substCoVarBndr ) import GHC.Platform ( Platform )-import GHC.Types.Basic+ import GHC.Utils.Monad import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Utils.Misc-import GHC.Types.Unique.FM      ( pprUniqFM )  import Data.List ( intersperse, mapAccumL ) @@ -1171,21 +1175,34 @@   = assert (isJoinId join_id) $     setIdType join_id new_join_ty   where-    orig_ar = idJoinArity join_id-    orig_ty = idType join_id+    join_arity = idJoinArity join_id+    orig_ty    = idType join_id+    res_torc   = typeTypeOrConstraint new_res_ty :: TypeOrConstraint -    new_join_ty = go orig_ar orig_ty :: Type+    new_join_ty = go join_arity orig_ty :: Type -    go 0 _  = new_res_ty-    go n ty | Just (arg_bndr, res_ty) <- splitPiTy_maybe ty-            = mkPiTy (scale_bndr arg_bndr) $-              go (n-1) res_ty-            | otherwise-            = pprPanic "adjustJoinPointType" (ppr orig_ar <+> ppr orig_ty)+    go :: JoinArity -> Type -> Type+    go n ty+      | n == 0+      = new_res_ty -    -- See Note [Bangs in the Simplifier]-    scale_bndr (Anon t af) = (Anon $! (scaleScaled mult t)) af-    scale_bndr b@(Named _) = b+      | Just (arg_bndr, body_ty) <- splitPiTy_maybe ty+      , let body_ty' = go (n-1) body_ty+      = case arg_bndr of+          Named b                          -> mkForAllTy b body_ty'+          Anon (Scaled arg_mult arg_ty) af -> mkFunTy af' arg_mult' arg_ty body_ty'+              where+                -- Using "!": See Note [Bangs in the Simplifier]+                -- mkMultMul: see Note [Scaling join point arguments]+                !arg_mult' = arg_mult `mkMultMul` mult++                -- the new_res_ty might be ConstraintLike while the original+                -- one was TypeLike.  So we may need to adjust the FunTyFlag.+                -- (see #23952)+                !af' = mkFunTyFlag (funTyFlagArgTypeOrConstraint af) res_torc++      | otherwise+      = pprPanic "adjustJoinPointType" (ppr join_arity <+> ppr orig_ty)  {- Note [Scaling join point arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

@@ -2491,10 +2491,11 @@           ty : body_torc rep           bndr_torc is Type or Constraint           ki : bndr_torc+          ki : Type           `a` is a type variable           `a` is not free in rep (FORALL1) ------------------------          forall (a::ki). ty : torc rep+          forall (a::ki). ty : body_torc rep            torc is TYPE or CONSTRAINT           ty : body_torc rep

@@ -38,6 +38,7 @@ import Data.List.NonEmpty ( NonEmpty(..) ) import qualified Data.List.NonEmpty as NE import qualified Data.Semigroup ( (<>) )+import Control.DeepSeq  infixr 3 `consBag` infixl 3 `snocBag`@@ -48,6 +49,12 @@   | TwoBags (Bag a) (Bag a) -- INVARIANT: neither branch is empty   | ListBag (NonEmpty a)   deriving (Foldable, Functor, Traversable)++instance NFData a => NFData (Bag a) where+  rnf EmptyBag = ()+  rnf (UnitBag a) = rnf a+  rnf (TwoBags a b) = rnf a `seq` rnf b+  rnf (ListBag a) = rnf a  emptyBag :: Bag a emptyBag = EmptyBag

@@ -667,7 +667,7 @@    | Opt_WarnTypeEqualityOutOfScope                  -- Since 9.4    | Opt_WarnTypeEqualityRequiresOperators           -- Since 9.4    | Opt_WarnLoopySuperclassSolve                    -- Since 9.6-   deriving (Eq, Ord, Show, Enum)+   deriving (Eq, Ord, Show, Enum, Bounded)  -- | Return the names of a WarningFlag --

@@ -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

@@ -3208,122 +3208,119 @@ wWarningFlags = map snd (sortBy (comparing fst) wWarningFlagsDeps)  wWarningFlagsDeps :: [(Deprecation, FlagSpec WarningFlag)]-wWarningFlagsDeps = mconcat [+wWarningFlagsDeps = [minBound..maxBound] >>= \x -> case x of -- See Note [Updating flag description in the User's Guide] -- See Note [Supporting CLI completion] -- Please keep the list of flags below sorted alphabetically-  warnSpec    Opt_WarnAlternativeLayoutRuleTransitional,-  warnSpec    Opt_WarnAmbiguousFields,-  depWarnSpec Opt_WarnAutoOrphans-              "it has no effect",-  warnSpec    Opt_WarnCPPUndef,-  warnSpec    Opt_WarnUnbangedStrictPatterns,-  warnSpec    Opt_WarnDeferredTypeErrors,-  warnSpec    Opt_WarnDeferredOutOfScopeVariables,-  warnSpec    Opt_WarnWarningsDeprecations,-  warnSpec    Opt_WarnDeprecatedFlags,-  warnSpec    Opt_WarnDerivingDefaults,-  warnSpec    Opt_WarnDerivingTypeable,-  warnSpec    Opt_WarnDodgyExports,-  warnSpec    Opt_WarnDodgyForeignImports,-  warnSpec    Opt_WarnDodgyImports,-  warnSpec    Opt_WarnEmptyEnumerations,-  subWarnSpec "duplicate-constraints"-              Opt_WarnDuplicateConstraints-              "it is subsumed by -Wredundant-constraints",-  warnSpec    Opt_WarnRedundantConstraints,-  warnSpec    Opt_WarnDuplicateExports,-  depWarnSpec Opt_WarnHiShadows-              "it is not used, and was never implemented",-  warnSpec    Opt_WarnInaccessibleCode,-  warnSpec    Opt_WarnImplicitPrelude,-  depWarnSpec Opt_WarnImplicitKindVars-              "it is now an error",-  warnSpec    Opt_WarnIncompletePatterns,-  warnSpec    Opt_WarnIncompletePatternsRecUpd,-  warnSpec    Opt_WarnIncompleteUniPatterns,-  warnSpec    Opt_WarnInlineRuleShadowing,-  warnSpec    Opt_WarnIdentities,-  warnSpec    Opt_WarnMissingFields,-  warnSpec    Opt_WarnMissingImportList,-  warnSpec    Opt_WarnMissingExportList,-  subWarnSpec "missing-local-sigs"-              Opt_WarnMissingLocalSignatures-              "it is replaced by -Wmissing-local-signatures",-  warnSpec    Opt_WarnMissingLocalSignatures,-  warnSpec    Opt_WarnMissingMethods,-  depWarnSpec Opt_WarnMissingMonadFailInstances-              "fail is no longer a method of Monad",-  warnSpec    Opt_WarnSemigroup,-  warnSpec    Opt_WarnMissingSignatures,-  warnSpec    Opt_WarnMissingKindSignatures,-  subWarnSpec "missing-exported-sigs"-              Opt_WarnMissingExportedSignatures-              "it is replaced by -Wmissing-exported-signatures",-  warnSpec    Opt_WarnMissingExportedSignatures,-  warnSpec    Opt_WarnMonomorphism,-  warnSpec    Opt_WarnNameShadowing,-  warnSpec    Opt_WarnNonCanonicalMonadInstances,-  depWarnSpec Opt_WarnNonCanonicalMonadFailInstances-              "fail is no longer a method of Monad",-  warnSpec    Opt_WarnNonCanonicalMonoidInstances,-  warnSpec    Opt_WarnOrphans,-  warnSpec    Opt_WarnOverflowedLiterals,-  warnSpec    Opt_WarnOverlappingPatterns,-  warnSpec    Opt_WarnMissedSpecs,-  warnSpec    Opt_WarnAllMissedSpecs,-  warnSpec'   Opt_WarnSafe setWarnSafe,-  warnSpec    Opt_WarnTrustworthySafe,-  warnSpec    Opt_WarnInferredSafeImports,-  warnSpec    Opt_WarnMissingSafeHaskellMode,-  warnSpec    Opt_WarnTabs,-  warnSpec    Opt_WarnTypeDefaults,-  warnSpec    Opt_WarnTypedHoles,-  warnSpec    Opt_WarnPartialTypeSignatures,-  warnSpec    Opt_WarnUnrecognisedPragmas,-  warnSpec    Opt_WarnMisplacedPragmas,-  warnSpec'   Opt_WarnUnsafe setWarnUnsafe,-  warnSpec    Opt_WarnUnsupportedCallingConventions,-  warnSpec    Opt_WarnUnsupportedLlvmVersion,-  warnSpec    Opt_WarnMissedExtraSharedLib,-  warnSpec    Opt_WarnUntickedPromotedConstructors,-  warnSpec    Opt_WarnUnusedDoBind,-  warnSpec    Opt_WarnUnusedForalls,-  warnSpec    Opt_WarnUnusedImports,-  warnSpec    Opt_WarnUnusedLocalBinds,-  warnSpec    Opt_WarnUnusedMatches,-  warnSpec    Opt_WarnUnusedPatternBinds,-  warnSpec    Opt_WarnUnusedTopBinds,-  warnSpec    Opt_WarnUnusedTypePatterns,-  warnSpec    Opt_WarnUnusedRecordWildcards,-  warnSpec    Opt_WarnRedundantBangPatterns,-  warnSpec    Opt_WarnRedundantRecordWildcards,-  warnSpec    Opt_WarnRedundantStrictnessFlags,-  warnSpec    Opt_WarnWrongDoBind,-  warnSpec    Opt_WarnMissingPatternSynonymSignatures,-  warnSpec    Opt_WarnMissingDerivingStrategies,-  warnSpec    Opt_WarnSimplifiableClassConstraints,-  warnSpec    Opt_WarnMissingHomeModules,-  warnSpec    Opt_WarnUnrecognisedWarningFlags,-  warnSpec    Opt_WarnStarBinder,-  warnSpec    Opt_WarnStarIsType,-  depWarnSpec Opt_WarnSpaceAfterBang-              "bang patterns can no longer be written with a space",-  warnSpec    Opt_WarnPartialFields,-  warnSpec    Opt_WarnPrepositiveQualifiedModule,-  warnSpec    Opt_WarnUnusedPackages,-  warnSpec    Opt_WarnCompatUnqualifiedImports,-  warnSpec    Opt_WarnInvalidHaddock,-  warnSpec    Opt_WarnOperatorWhitespaceExtConflict,-  warnSpec    Opt_WarnOperatorWhitespace,-  warnSpec    Opt_WarnImplicitLift,-  warnSpec    Opt_WarnMissingExportedPatternSynonymSignatures,-  warnSpec    Opt_WarnForallIdentifier,-  warnSpec    Opt_WarnUnicodeBidirectionalFormatCharacters,-  warnSpec    Opt_WarnGADTMonoLocalBinds,-  warnSpec    Opt_WarnTypeEqualityOutOfScope,-  warnSpec    Opt_WarnTypeEqualityRequiresOperators- ]+  Opt_WarnAlternativeLayoutRuleTransitional -> warnSpec x+  Opt_WarnAmbiguousFields -> warnSpec x+  Opt_WarnAutoOrphans+    -> depWarnSpec x "it has no effect"+  Opt_WarnCPPUndef -> warnSpec x+  Opt_WarnUnbangedStrictPatterns -> warnSpec x+  Opt_WarnDeferredTypeErrors -> warnSpec x+  Opt_WarnDeferredOutOfScopeVariables -> warnSpec x+  Opt_WarnWarningsDeprecations -> warnSpec x+  Opt_WarnDeprecatedFlags -> warnSpec x+  Opt_WarnDerivingDefaults -> warnSpec x+  Opt_WarnDerivingTypeable -> warnSpec x+  Opt_WarnDodgyExports -> warnSpec x+  Opt_WarnDodgyForeignImports -> warnSpec x+  Opt_WarnDodgyImports -> warnSpec x+  Opt_WarnEmptyEnumerations -> warnSpec x+  Opt_WarnDuplicateConstraints+    -> subWarnSpec "duplicate-constraints" x "it is subsumed by -Wredundant-constraints"+  Opt_WarnRedundantConstraints -> warnSpec x+  Opt_WarnDuplicateExports -> warnSpec x+  Opt_WarnHiShadows+    -> depWarnSpec x "it is not used and was never implemented"+  Opt_WarnInaccessibleCode -> warnSpec x+  Opt_WarnImplicitPrelude -> warnSpec x+  Opt_WarnImplicitKindVars+    -> depWarnSpec x "it is now an error"+  Opt_WarnIncompletePatterns -> warnSpec x+  Opt_WarnIncompletePatternsRecUpd -> warnSpec x+  Opt_WarnIncompleteUniPatterns -> warnSpec x+  Opt_WarnInlineRuleShadowing -> warnSpec x+  Opt_WarnIdentities -> warnSpec x+  Opt_WarnLoopySuperclassSolve -> warnSpec x+  Opt_WarnMissingFields -> warnSpec x+  Opt_WarnMissingImportList -> warnSpec x+  Opt_WarnMissingExportList -> warnSpec x+  Opt_WarnMissingLocalSignatures+    -> subWarnSpec "missing-local-sigs" x "it is replaced by -Wmissing-local-signatures"+       ++ warnSpec x+  Opt_WarnMissingMethods -> warnSpec x+  Opt_WarnMissingMonadFailInstances+    -> depWarnSpec x "fail is no longer a method of Monad"+  Opt_WarnSemigroup -> warnSpec x+  Opt_WarnMissingSignatures -> warnSpec x+  Opt_WarnMissingKindSignatures -> warnSpec x+  Opt_WarnMissingExportedSignatures+    -> subWarnSpec "missing-exported-sigs" x "it is replaced by -Wmissing-exported-signatures"+       ++ warnSpec x+  Opt_WarnMonomorphism -> warnSpec x+  Opt_WarnNameShadowing -> warnSpec x+  Opt_WarnNonCanonicalMonadInstances -> warnSpec x+  Opt_WarnNonCanonicalMonadFailInstances+    -> depWarnSpec x "fail is no longer a method of Monad"+  Opt_WarnNonCanonicalMonoidInstances -> warnSpec x+  Opt_WarnOrphans -> warnSpec x+  Opt_WarnOverflowedLiterals -> warnSpec x+  Opt_WarnOverlappingPatterns -> warnSpec x+  Opt_WarnMissedSpecs -> warnSpec x+  Opt_WarnAllMissedSpecs -> warnSpec x+  Opt_WarnSafe -> warnSpec' x setWarnSafe+  Opt_WarnTrustworthySafe -> warnSpec x+  Opt_WarnInferredSafeImports -> warnSpec x+  Opt_WarnMissingSafeHaskellMode -> warnSpec x+  Opt_WarnTabs -> warnSpec x+  Opt_WarnTypeDefaults -> warnSpec x+  Opt_WarnTypedHoles -> warnSpec x+  Opt_WarnPartialTypeSignatures -> warnSpec x+  Opt_WarnUnrecognisedPragmas -> warnSpec x+  Opt_WarnMisplacedPragmas -> warnSpec x+  Opt_WarnUnsafe -> warnSpec' x setWarnUnsafe+  Opt_WarnUnsupportedCallingConventions -> warnSpec x+  Opt_WarnUnsupportedLlvmVersion -> warnSpec x+  Opt_WarnMissedExtraSharedLib -> warnSpec x+  Opt_WarnUntickedPromotedConstructors -> warnSpec x+  Opt_WarnUnusedDoBind -> warnSpec x+  Opt_WarnUnusedForalls -> warnSpec x+  Opt_WarnUnusedImports -> warnSpec x+  Opt_WarnUnusedLocalBinds -> warnSpec x+  Opt_WarnUnusedMatches -> warnSpec x+  Opt_WarnUnusedPatternBinds -> warnSpec x+  Opt_WarnUnusedTopBinds -> warnSpec x+  Opt_WarnUnusedTypePatterns -> warnSpec x+  Opt_WarnUnusedRecordWildcards -> warnSpec x+  Opt_WarnRedundantBangPatterns -> warnSpec x+  Opt_WarnRedundantRecordWildcards -> warnSpec x+  Opt_WarnRedundantStrictnessFlags -> warnSpec x+  Opt_WarnWrongDoBind -> warnSpec x+  Opt_WarnMissingPatternSynonymSignatures -> warnSpec x+  Opt_WarnMissingDerivingStrategies -> warnSpec x+  Opt_WarnSimplifiableClassConstraints -> warnSpec x+  Opt_WarnMissingHomeModules -> warnSpec x+  Opt_WarnUnrecognisedWarningFlags -> warnSpec x+  Opt_WarnStarBinder -> warnSpec x+  Opt_WarnStarIsType -> warnSpec x+  Opt_WarnSpaceAfterBang+    -> depWarnSpec x "bang patterns can no longer be written with a space"+  Opt_WarnPartialFields -> warnSpec x+  Opt_WarnPrepositiveQualifiedModule -> warnSpec x+  Opt_WarnUnusedPackages -> warnSpec x+  Opt_WarnCompatUnqualifiedImports -> warnSpec x+  Opt_WarnInvalidHaddock -> warnSpec x+  Opt_WarnOperatorWhitespaceExtConflict -> warnSpec x+  Opt_WarnOperatorWhitespace -> warnSpec x+  Opt_WarnImplicitLift -> warnSpec x+  Opt_WarnMissingExportedPatternSynonymSignatures -> warnSpec x+  Opt_WarnForallIdentifier -> warnSpec x+  Opt_WarnUnicodeBidirectionalFormatCharacters -> warnSpec x+  Opt_WarnGADTMonoLocalBinds -> warnSpec x+  Opt_WarnTypeEqualityOutOfScope -> warnSpec x+  Opt_WarnTypeEqualityRequiresOperators -> warnSpec x  -- | These @-\<blah\>@ flags can all be reversed with @-no-\<blah\>@ negatableFlagsDeps :: [(Deprecation, FlagSpec GeneralFlag)]

@@ -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

@@ -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" ])

@@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}-{-# LINE 1 "_build/source-dist/ghc-9.6.3-src/ghc-9.6.3/compiler/GHC/Parser/HaddockLex.x" #-}+{-# LINE 1 "_build/source-dist/ghc-9.6.4-src/ghc-9.6.4/compiler/GHC/Parser/HaddockLex.x" #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -funbox-strict-fields #-}@@ -110,7 +110,7 @@   , (0,alex_action_1)   ] -{-# LINE 87 "_build/source-dist/ghc-9.6.3-src/ghc-9.6.3/compiler/GHC/Parser/HaddockLex.x" #-}+{-# LINE 87 "_build/source-dist/ghc-9.6.4-src/ghc-9.6.4/compiler/GHC/Parser/HaddockLex.x" #-} data AlexInput = AlexInput   { alexInput_position     :: !RealSrcLoc   , alexInput_string       :: !ByteString

@@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}-{-# LINE 43 "_build/source-dist/ghc-9.6.3-src/ghc-9.6.3/compiler/GHC/Parser/Lexer.x" #-}+{-# LINE 43 "_build/source-dist/ghc-9.6.4-src/ghc-9.6.4/compiler/GHC/Parser/Lexer.x" #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-}@@ -592,7 +592,7 @@   , (0,alex_action_86)   ] -{-# LINE 704 "_build/source-dist/ghc-9.6.3-src/ghc-9.6.3/compiler/GHC/Parser/Lexer.x" #-}+{-# LINE 704 "_build/source-dist/ghc-9.6.4-src/ghc-9.6.4/compiler/GHC/Parser/Lexer.x" #-} -- Operator whitespace occurrence. See Note [Whitespace-sensitive operator parsing]. data OpWs   = OpWsPrefix         -- a !b

@@ -87,6 +87,7 @@ data ToolSettings = ToolSettings   { toolSettings_ldSupportsCompactUnwind :: Bool   , toolSettings_ldSupportsFilelist      :: Bool+  , toolSettings_ldSupportsSingleModule  :: Bool   , toolSettings_ldIsGnuLd               :: Bool   , toolSettings_ccSupportsNoPie         :: Bool   , toolSettings_useInplaceMinGW         :: Bool

@@ -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

@@ -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

@@ -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),

@@ -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

@@ -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"

@@ -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.

@@ -890,6 +890,12 @@                             -- Note [Swizzling the tyvars before generaliseTcTyCon]                 = vcat [ quotes (ppr n1) <+> text "bound at" <+> ppr (getSrcLoc n1)                        , quotes (ppr n2) <+> text "bound at" <+> ppr (getSrcLoc n2) ]++    TcRnDisconnectedTyVar n+      -> mkSimpleDecorated $+           hang (text "Scoped type variable only appears non-injectively in declaration header:")+              2 (quotes (ppr n) <+> text "bound at" <+> ppr (getSrcLoc n))+     TcRnInvalidReturnKind data_sort allowed_kind kind _suggested_ext       -> mkSimpleDecorated $            sep [ ppDataSort data_sort <+>@@ -1535,6 +1541,8 @@       -> ErrorWithoutFlag     TcRnDifferentNamesForTyVar{}       -> ErrorWithoutFlag+    TcRnDisconnectedTyVar{}+      -> ErrorWithoutFlag     TcRnInvalidReturnKind{}       -> ErrorWithoutFlag     TcRnClassKindNotConstraint{}@@ -1944,6 +1952,8 @@       -> noHints     TcRnDifferentNamesForTyVar{}       -> noHints+    TcRnDisconnectedTyVar n+      -> [SuggestBindTyVarExplicitly n]     TcRnInvalidReturnKind _ _ _ mb_suggest_unlifted_ext       -> case mb_suggest_unlifted_ext of            Nothing -> noHints

@@ -2029,7 +2029,14 @@   -}   TcRnDifferentNamesForTyVar :: !Name -> !Name -> TcRnMessage -  {- TcRnInvalidReturnKind is an error for a data declaration that has a kind signature+  {-| TcRnDisconnectedTyVar is an error for a data declaration that has a kind signature,+      where the implicitly-bound type type variables can't be matched up unambiguously+      with the ones from the signature. See Note [Disconnected type variables] in+      GHC.Tc.Gen.HsType.+  -}+  TcRnDisconnectedTyVar :: !Name -> TcRnMessage++  {-| TcRnInvalidReturnKind is an error for a data declaration that has a kind signature      with an invalid result kind.       Example(s):

@@ -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.+-}  {- ********************************************************************* *                                                                      *

@@ -456,6 +456,7 @@   GhcDiagnosticCode "TcRnInvalidVisibleKindArgument"                = 20967   GhcDiagnosticCode "TcRnTooManyBinders"                            = 05989   GhcDiagnosticCode "TcRnDifferentNamesForTyVar"                    = 17370+  GhcDiagnosticCode "TcRnDisconnectedTyVar"                         = 59738   GhcDiagnosticCode "TcRnInvalidReturnKind"                         = 55233   GhcDiagnosticCode "TcRnClassKindNotConstraint"                    = 80768   GhcDiagnosticCode "TcRnUnpromotableThing"                         = 88634

@@ -422,6 +422,9 @@    | LoopySuperclassSolveHint PredType ClsInstOrQC +  {-| Suggest binding explicitly; e.g   data T @k (a :: F k) = .... -}+  | SuggestBindTyVarExplicitly Name+ -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way -- to instantiate a particular signature, where the first argument is

@@ -215,6 +215,9 @@           what = case cls_or_qc of             IsClsInst -> text "instance context"             IsQC {}   -> text "context of the quantified constraint"+    SuggestBindTyVarExplicitly tv+      -> text "bind" <+> quotes (ppr tv)+         <+> text "explicitly with" <+> quotes (char '@' <> ppr tv)  perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"

@@ -429,6 +429,13 @@ pprOccEnv :: (a -> SDoc) -> OccEnv a -> SDoc pprOccEnv ppr_elt (A env) = pprUniqFM ppr_elt env +instance NFData a => NFData (OccEnv a) where+  rnf = forceOccEnv rnf++-- | Force an 'OccEnv' with the provided function.+forceOccEnv :: (a -> ()) -> OccEnv a -> ()+forceOccEnv nf (A fs) = seqEltsUFM nf fs+ type OccSet = UniqSet OccName  emptyOccSet       :: OccSet

@@ -98,6 +98,7 @@ import Data.Data import Data.List( sortBy ) import qualified Data.Semigroup as S+import Control.DeepSeq import GHC.Data.Bag  {-@@ -494,15 +495,23 @@          -- INVARIANT: either gre_lcl = True or gre_imp is non-empty          -- See Note [GlobalRdrElt provenance] +instance NFData GlobalRdrElt where+  rnf (GRE name par _ imp) = rnf name `seq` rnf par `seq` rnf imp++ -- | See Note [Parents] data Parent = NoParent-            | ParentIs  { par_is :: Name }+            | ParentIs  { par_is :: !Name }             deriving (Eq, Data)  instance Outputable Parent where    ppr NoParent        = empty    ppr (ParentIs n)    = text "parent:" <> ppr n +instance NFData Parent where+  rnf NoParent = ()+  rnf (ParentIs n) = rnf n+ plusParent :: Parent -> Parent -> Parent -- See Note [Combining parents] plusParent p1@(ParentIs _)    p2 = hasParent p1 p2@@ -1190,25 +1199,28 @@ -- -- The 'ImportSpec' of something says how it came to be imported -- It's quite elaborate so that we can give accurate unused-name warnings.-data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,-                            is_item :: ImpItemSpec }+data ImportSpec = ImpSpec { is_decl :: !ImpDeclSpec,+                            is_item :: !ImpItemSpec }                 deriving( Eq, Data ) +instance NFData ImportSpec where+  rnf = rwhnf -- All fields are strict, so we don't need to do anything+ -- | Import Declaration Specification -- -- Describes a particular import declaration and is -- shared among all the 'Provenance's for that decl data ImpDeclSpec   = ImpDeclSpec {-        is_mod      :: ModuleName, -- ^ Module imported, e.g. @import Muggle@+        is_mod      :: !ModuleName, -- ^ Module imported, e.g. @import Muggle@                                    -- Note the @Muggle@ may well not be                                    -- the defining module for this thing!                                     -- TODO: either should be Module, or there                                    -- should be a Maybe UnitId here too.-        is_as       :: ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)-        is_qual     :: Bool,       -- ^ Was this import qualified?-        is_dloc     :: SrcSpan     -- ^ The location of the entire import declaration+        is_as       :: !ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)+        is_qual     :: !Bool,       -- ^ Was this import qualified?+        is_dloc     :: !SrcSpan     -- ^ The location of the entire import declaration     } deriving (Eq, Data)  -- | Import Item Specification@@ -1219,8 +1231,8 @@                         -- or had a hiding list    | ImpSome {-        is_explicit :: Bool,-        is_iloc     :: SrcSpan  -- Location of the import item+        is_explicit :: !Bool,+        is_iloc     :: !SrcSpan  -- Location of the import item     }   -- ^ The import had an import list.         -- The 'is_explicit' field is @True@ iff the thing was named         -- /explicitly/ in the import specs rather

@@ -75,7 +75,7 @@         mkFunTyFlag, visArg, invisArg,         visArgTypeLike, visArgConstraintLike,         invisArgTypeLike, invisArgConstraintLike,-        funTyFlagResultTypeOrConstraint,+        funTyFlagArgTypeOrConstraint, funTyFlagResultTypeOrConstraint,         TypeOrConstraint(..),  -- Re-export this: it's an argument of FunTyFlag          -- * PiTyBinder@@ -588,6 +588,12 @@ -- This one, FUN, or (->), has an extra multiplicity argument isFUNArg FTF_T_T = True isFUNArg _       = False++funTyFlagArgTypeOrConstraint :: FunTyFlag -> TypeOrConstraint+-- Whether it /takes/ a type or a constraint+funTyFlagArgTypeOrConstraint FTF_T_T = TypeLike+funTyFlagArgTypeOrConstraint FTF_T_C = TypeLike+funTyFlagArgTypeOrConstraint _       = ConstraintLike  funTyFlagResultTypeOrConstraint :: FunTyFlag -> TypeOrConstraint -- Whether it /returns/ a type or a constraint

@@ -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

@@ -61,7 +61,7 @@                                            --   but the *unit* is hidden          -- | Module is in these units, but it is unusable-      , fr_unusables   :: [(Unit, UnusableUnitReason)]+      , fr_unusables   :: [UnusableUnit]        , fr_suggestions :: [ModuleSuggestion] -- ^ Possible mis-spelled modules       }

@@ -553,7 +553,7 @@   rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12                 f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24) =     rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq`-    f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` f13 `seq` rnf f14 `seq` rnf f15 `seq` rnf f16 `seq`+    f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` rnf f13 `seq` rnf f14 `seq` rnf f15 `seq` rnf f16 `seq`     rnf f17 `seq` f18 `seq` rnf f19 `seq` rnf f20 `seq` rnf f21 `seq` f22 `seq` f23 `seq` rnf f24     `seq` () 

@@ -43,6 +43,7 @@         LookupResult(..),         ModuleSuggestion(..),         ModuleOrigin(..),+        UnusableUnit(..),         UnusableUnitReason(..),         pprReason, @@ -174,8 +175,10 @@     -- (But maybe the user didn't realize), so we'll still keep track     -- of these modules.)     ModHidden-    -- | Module is unavailable because the package is unusable.-  | ModUnusable UnusableUnitReason++    -- | Module is unavailable because the unit is unusable.+  | ModUnusable !UnusableUnit+     -- | Module is public, and could have come from some places.   | ModOrigin {         -- | @Just False@ means that this module is in@@ -193,6 +196,13 @@       , fromPackageFlag :: Bool       } +-- | A unusable unit module origin+data UnusableUnit = UnusableUnit+  { uuUnit        :: !Unit               -- ^ Unusable unit+  , uuReason      :: !UnusableUnitReason -- ^ Reason+  , uuIsReexport  :: !Bool               -- ^ Is the "module" a reexport?+  }+ instance Outputable ModuleOrigin where     ppr ModHidden = text "hidden module"     ppr (ModUnusable _) = text "unusable module"@@ -237,7 +247,8 @@                     text "x: " <> ppr x $$ text "y: " <> ppr y             g Nothing x = x             g x Nothing = x-    x <> y = pprPanic "ModOrigin: hidden module redefined" $++    x <> y = pprPanic "ModOrigin: module origin mismatch" $                  text "x: " <> ppr x $$ text "y: " <> ppr y  instance Monoid ModuleOrigin where@@ -1816,21 +1827,36 @@ mkUnusableModuleNameProvidersMap unusables =     Map.foldl' extend_modmap Map.empty unusables  where-    extend_modmap modmap (pkg, reason) = addListTo modmap bindings+    extend_modmap modmap (unit_info, reason) = addListTo modmap bindings       where bindings :: [(ModuleName, Map Module ModuleOrigin)]             bindings = exposed ++ hidden -            origin = ModUnusable reason-            pkg_id = mkUnit pkg+            origin_reexport =  ModUnusable (UnusableUnit unit reason True)+            origin_normal   =  ModUnusable (UnusableUnit unit reason False)+            unit = mkUnit unit_info              exposed = map get_exposed exposed_mods-            hidden = [(m, mkModMap pkg_id m origin) | m <- hidden_mods]+            hidden = [(m, mkModMap unit m origin_normal) | m <- hidden_mods] -            get_exposed (mod, Just mod') = (mod, Map.singleton mod' origin)-            get_exposed (mod, _)         = (mod, mkModMap pkg_id mod origin)+            -- with re-exports, c:Foo can be reexported from two (or more)+            -- unusable packages:+            --  Foo -> a:Foo (unusable reason A) -> c:Foo+            --      -> b:Foo (unusable reason B) -> c:Foo+            --+            -- We must be careful to not record the following (#21097):+            --  Foo -> c:Foo (unusable reason A)+            --      -> c:Foo (unusable reason B)+            -- But:+            --  Foo -> a:Foo (unusable reason A)+            --      -> b:Foo (unusable reason B)+            --+            get_exposed (mod, Just _) = (mod, mkModMap unit mod origin_reexport)+            get_exposed (mod, _) = (mod, mkModMap unit mod origin_normal)+              -- in the reexport case, we create a virtual module that doesn't+              -- exist but we don't care as it's only used as a key in the map. -            exposed_mods = unitExposedModules pkg-            hidden_mods  = unitHiddenModules pkg+            exposed_mods = unitExposedModules unit_info+            hidden_mods  = unitHiddenModules  unit_info  -- | Add a list of key/value pairs to a nested map. --

@@ -3,7 +3,7 @@ -- ./configure.  Make sure you are editing ghc.cabal.in, not ghc.cabal.  Name: ghc-Version: 9.6.3+Version: 9.6.4 License: BSD-3-Clause License-File: LICENSE Author: The GHC Team@@ -86,9 +86,9 @@                    transformers >= 0.5 && < 0.7,                    exceptions == 0.10.*,                    stm,-                   ghc-boot   == 9.6.3,-                   ghc-heap   == 9.6.3,-                   ghci == 9.6.3+                   ghc-boot   == 9.6.4,+                   ghc-heap   == 9.6.4,+                   ghci == 9.6.4      if os(windows)         Build-Depends: Win32  >= 2.3 && < 2.14