diff --git a/GHC/Cmm/Lexer.hs b/GHC/Cmm/Lexer.hs
--- a/GHC/Cmm/Lexer.hs
+++ b/GHC/Cmm/Lexer.hs
@@ -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
diff --git a/GHC/CmmToAsm.hs b/GHC/CmmToAsm.hs
--- a/GHC/CmmToAsm.hs
+++ b/GHC/CmmToAsm.hs
@@ -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
diff --git a/GHC/CmmToAsm/AArch64.hs b/GHC/CmmToAsm/AArch64.hs
--- a/GHC/CmmToAsm/AArch64.hs
+++ b/GHC/CmmToAsm/AArch64.hs
@@ -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
diff --git a/GHC/CmmToAsm/AArch64/CodeGen.hs b/GHC/CmmToAsm/AArch64/CodeGen.hs
--- a/GHC/CmmToAsm/AArch64/CodeGen.hs
+++ b/GHC/CmmToAsm/AArch64/CodeGen.hs
@@ -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
diff --git a/GHC/CmmToAsm/AArch64/Cond.hs b/GHC/CmmToAsm/AArch64/Cond.hs
--- a/GHC/CmmToAsm/AArch64/Cond.hs
+++ b/GHC/CmmToAsm/AArch64/Cond.hs
@@ -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
diff --git a/GHC/CmmToAsm/AArch64/Instr.hs b/GHC/CmmToAsm/AArch64/Instr.hs
--- a/GHC/CmmToAsm/AArch64/Instr.hs
+++ b/GHC/CmmToAsm/AArch64/Instr.hs
@@ -721,6 +721,7 @@
     = TBlock BlockId
     | TLabel CLabel
     | TReg   Reg
+    deriving (Eq, Ord)
 
 
 -- Extension
diff --git a/GHC/CmmToAsm/AArch64/Ppr.hs b/GHC/CmmToAsm/AArch64/Ppr.hs
--- a/GHC/CmmToAsm/AArch64/Ppr.hs
+++ b/GHC/CmmToAsm/AArch64/Ppr.hs
@@ -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
 
diff --git a/GHC/CmmToAsm/BlockLayout.hs b/GHC/CmmToAsm/BlockLayout.hs
--- a/GHC/CmmToAsm/BlockLayout.hs
+++ b/GHC/CmmToAsm/BlockLayout.hs
@@ -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
diff --git a/GHC/CmmToAsm/Monad.hs b/GHC/CmmToAsm/Monad.hs
--- a/GHC/CmmToAsm/Monad.hs
+++ b/GHC/CmmToAsm/Monad.hs
@@ -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,
diff --git a/GHC/CmmToAsm/PPC/Instr.hs b/GHC/CmmToAsm/PPC/Instr.hs
--- a/GHC/CmmToAsm/PPC/Instr.hs
+++ b/GHC/CmmToAsm/PPC/Instr.hs
@@ -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
diff --git a/GHC/CmmToAsm/Ppr.hs b/GHC/CmmToAsm/Ppr.hs
--- a/GHC/CmmToAsm/Ppr.hs
+++ b/GHC/CmmToAsm/Ppr.hs
@@ -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
diff --git a/GHC/CmmToAsm/X86.hs b/GHC/CmmToAsm/X86.hs
--- a/GHC/CmmToAsm/X86.hs
+++ b/GHC/CmmToAsm/X86.hs
@@ -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
    }
diff --git a/GHC/CmmToLlvm/Data.hs b/GHC/CmmToLlvm/Data.hs
--- a/GHC/CmmToLlvm/Data.hs
+++ b/GHC/CmmToLlvm/Data.hs
@@ -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
diff --git a/GHC/Core/Opt/CprAnal.hs b/GHC/Core/Opt/CprAnal.hs
--- a/GHC/Core/Opt/CprAnal.hs
+++ b/GHC/Core/Opt/CprAnal.hs
@@ -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:
diff --git a/GHC/Core/Opt/Simplify/Env.hs b/GHC/Core/Opt/Simplify/Env.hs
--- a/GHC/Core/Opt/Simplify/Env.hs
+++ b/GHC/Core/Opt/Simplify/Env.hs
@@ -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]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/GHC/Core/Type.hs b/GHC/Core/Type.hs
--- a/GHC/Core/Type.hs
+++ b/GHC/Core/Type.hs
@@ -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
diff --git a/GHC/Data/Bag.hs b/GHC/Data/Bag.hs
--- a/GHC/Data/Bag.hs
+++ b/GHC/Data/Bag.hs
@@ -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
diff --git a/GHC/Driver/Flags.hs b/GHC/Driver/Flags.hs
--- a/GHC/Driver/Flags.hs
+++ b/GHC/Driver/Flags.hs
@@ -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
 --
diff --git a/GHC/Driver/Make.hs b/GHC/Driver/Make.hs
--- a/GHC/Driver/Make.hs
+++ b/GHC/Driver/Make.hs
@@ -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
diff --git a/GHC/Driver/Session.hs b/GHC/Driver/Session.hs
--- a/GHC/Driver/Session.hs
+++ b/GHC/Driver/Session.hs
@@ -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)]
diff --git a/GHC/Iface/Errors.hs b/GHC/Iface/Errors.hs
--- a/GHC/Iface/Errors.hs
+++ b/GHC/Iface/Errors.hs
@@ -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
diff --git a/GHC/Linker/Dynamic.hs b/GHC/Linker/Dynamic.hs
--- a/GHC/Linker/Dynamic.hs
+++ b/GHC/Linker/Dynamic.hs
@@ -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" ])
diff --git a/GHC/Parser/HaddockLex.hs b/GHC/Parser/HaddockLex.hs
--- a/GHC/Parser/HaddockLex.hs
+++ b/GHC/Parser/HaddockLex.hs
@@ -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
diff --git a/GHC/Parser/Lexer.hs b/GHC/Parser/Lexer.hs
--- a/GHC/Parser/Lexer.hs
+++ b/GHC/Parser/Lexer.hs
@@ -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
diff --git a/GHC/Settings.hs b/GHC/Settings.hs
--- a/GHC/Settings.hs
+++ b/GHC/Settings.hs
@@ -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
diff --git a/GHC/Settings/IO.hs b/GHC/Settings/IO.hs
--- a/GHC/Settings/IO.hs
+++ b/GHC/Settings/IO.hs
@@ -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
diff --git a/GHC/Stg/Debug.hs b/GHC/Stg/Debug.hs
--- a/GHC/Stg/Debug.hs
+++ b/GHC/Stg/Debug.hs
@@ -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
diff --git a/GHC/StgToCmm/Bind.hs b/GHC/StgToCmm/Bind.hs
--- a/GHC/StgToCmm/Bind.hs
+++ b/GHC/StgToCmm/Bind.hs
@@ -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),
diff --git a/GHC/StgToCmm/CgUtils.hs b/GHC/StgToCmm/CgUtils.hs
--- a/GHC/StgToCmm/CgUtils.hs
+++ b/GHC/StgToCmm/CgUtils.hs
@@ -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
diff --git a/GHC/StgToJS/Linker/Utils.hs b/GHC/StgToJS/Linker/Utils.hs
--- a/GHC/StgToJS/Linker/Utils.hs
+++ b/GHC/StgToJS/Linker/Utils.hs
@@ -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"
diff --git a/GHC/StgToJS/Prim.hs b/GHC/StgToJS/Prim.hs
--- a/GHC/StgToJS/Prim.hs
+++ b/GHC/StgToJS/Prim.hs
@@ -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.
diff --git a/GHC/Tc/Errors/Ppr.hs b/GHC/Tc/Errors/Ppr.hs
--- a/GHC/Tc/Errors/Ppr.hs
+++ b/GHC/Tc/Errors/Ppr.hs
@@ -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
diff --git a/GHC/Tc/Errors/Types.hs b/GHC/Tc/Errors/Types.hs
--- a/GHC/Tc/Errors/Types.hs
+++ b/GHC/Tc/Errors/Types.hs
@@ -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):
diff --git a/GHC/Tc/Gen/HsType.hs b/GHC/Tc/Gen/HsType.hs
--- a/GHC/Tc/Gen/HsType.hs
+++ b/GHC/Tc/Gen/HsType.hs
@@ -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.
+-}
 
 {- *********************************************************************
 *                                                                      *
diff --git a/GHC/Types/Error/Codes.hs b/GHC/Types/Error/Codes.hs
--- a/GHC/Types/Error/Codes.hs
+++ b/GHC/Types/Error/Codes.hs
@@ -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
diff --git a/GHC/Types/Hint.hs b/GHC/Types/Hint.hs
--- a/GHC/Types/Hint.hs
+++ b/GHC/Types/Hint.hs
@@ -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
diff --git a/GHC/Types/Hint/Ppr.hs b/GHC/Types/Hint/Ppr.hs
--- a/GHC/Types/Hint/Ppr.hs
+++ b/GHC/Types/Hint/Ppr.hs
@@ -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"
diff --git a/GHC/Types/Name/Occurrence.hs b/GHC/Types/Name/Occurrence.hs
--- a/GHC/Types/Name/Occurrence.hs
+++ b/GHC/Types/Name/Occurrence.hs
@@ -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
diff --git a/GHC/Types/Name/Reader.hs b/GHC/Types/Name/Reader.hs
--- a/GHC/Types/Name/Reader.hs
+++ b/GHC/Types/Name/Reader.hs
@@ -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
diff --git a/GHC/Types/Var.hs b/GHC/Types/Var.hs
--- a/GHC/Types/Var.hs
+++ b/GHC/Types/Var.hs
@@ -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
diff --git a/GHC/Unit/Finder.hs b/GHC/Unit/Finder.hs
--- a/GHC/Unit/Finder.hs
+++ b/GHC/Unit/Finder.hs
@@ -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
diff --git a/GHC/Unit/Finder/Types.hs b/GHC/Unit/Finder/Types.hs
--- a/GHC/Unit/Finder/Types.hs
+++ b/GHC/Unit/Finder/Types.hs
@@ -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
       }
diff --git a/GHC/Unit/Module/ModIface.hs b/GHC/Unit/Module/ModIface.hs
--- a/GHC/Unit/Module/ModIface.hs
+++ b/GHC/Unit/Module/ModIface.hs
@@ -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` ()
 
diff --git a/GHC/Unit/State.hs b/GHC/Unit/State.hs
--- a/GHC/Unit/State.hs
+++ b/GHC/Unit/State.hs
@@ -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.
 --
diff --git a/ghc.cabal b/ghc.cabal
--- a/ghc.cabal
+++ b/ghc.cabal
@@ -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