ghc-lib 9.4.3.20221104 → 9.4.4.20221225

raw patch · 27 files changed

+949/−322 lines, 27 filesdep ~ghc-lib-parserPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: ghc-lib-parser

API changes (from Hackage documentation)

Files

• compiler/GHC/Builtin/PrimOps/Casts.hs +212/−0
• compiler/GHC/Cmm/ContFlowOpt.hs +1/−1
• compiler/GHC/Cmm/Lexer.x +8/−0
• compiler/GHC/Cmm/Lint.hs +15/−3
• compiler/GHC/Cmm/Parser.y +81/−33
• compiler/GHC/Cmm/Utils.hs +2/−1
• compiler/GHC/CmmToAsm/AArch64/CodeGen.hs +2/−2
• compiler/GHC/CmmToAsm/PPC/CodeGen.hs +4/−4
• compiler/GHC/CmmToAsm/X86/CodeGen.hs +12/−7
• compiler/GHC/CmmToC.hs +3/−2
• compiler/GHC/CmmToLlvm/CodeGen.hs +20/−12
• compiler/GHC/Core/Opt/DmdAnal.hs +128/−61
• compiler/GHC/CoreToStg/Prep.hs +4/−0
• compiler/GHC/Driver/Make.hs +2/−2
• compiler/GHC/HsToCore/Expr.hs +2/−1
• compiler/GHC/Linker/Windows.hs +1/−3
• compiler/GHC/Settings/IO.hs +5/−5
• compiler/GHC/Stg/Lift/Analysis.hs +1/−1
• compiler/GHC/Stg/Lint.hs +40/−12
• compiler/GHC/Stg/Unarise.hs +327/−67
• compiler/GHC/StgToCmm/ExtCode.hs +6/−2
• compiler/GHC/StgToCmm/Prim.hs +27/−67
• compiler/GHC/SysTools/Process.hs +0/−4
• compiler/GHC/Tc/Instance/Typeable.hs +17/−4
• compiler/GHC/Unit/Finder.hs +2/−2
• ghc-lib.cabal +3/−2
• ghc-lib/stage0/compiler/build/primop-primop-info.hs-incl +24/−24

@@ -0,0 +1,212 @@+{-+This module contains helpers to cast variables+between different Int/WordReps in StgLand.++-}++module GHC.Builtin.PrimOps.Casts+    ( getCasts )+where++import GHC.Prelude++import GHC.Core.TyCon+import GHC.Utils.Outputable+import GHC.Utils.Panic+import GHC.Utils.Panic.Plain+import GHC.Types.RepType+import GHC.Core.Type+import GHC.Builtin.Types.Prim++import GHC.Builtin.PrimOps+import GHC.Plugins (HasDebugCallStack)++{- Note [PrimRep based casting]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+This module contains a number of utility functions useful when+converting between variables of differing PrimReps.++The general pattern is:+* We have two primReps `from_rep` and `to_rep`.+* We want a list of PrimOps we can apply to a variable of rep `from_rep`.+Applying the list of primOps in order takes us to `to_rep` from `from_rep` giving+us a variable of the returned type at each step.++E.g. we call `getCasts from_rep to_rep` and get back [(op1#,ty1),(op2#,ty2)].+We can use this result to construct a function of type+`StgExpr -> StgExpr` by construction an expression++    case op1# <from> of (x' :: ty1) -> case op2# x' of x' -> <rhs_hole>++Ideally backends will compile the sequence of PrimOps to a no-op. E.g. by reusing+the same register but just relabeling it as another width.+However this is might not always be possible or the required optimizations+simply not implemented in the backend. This means currently many of these casts+will be cheap but not all of them will be completely zero-cost.++-}++-- | `getCasts from_rep to_rep` gives us a list of primops which when applied in order convert from_rep to to_rep.+-- See Note [PrimRep based casting]+getCasts :: PrimRep -> PrimRep -> [(PrimOp,Type)]+getCasts from_rep to_rep+  -- No-op+  | -- pprTrace "getCasts" (ppr (from_rep,to_rep)) $+    to_rep == from_rep+  = []++  -- Float <-> Double+  | to_rep == FloatRep =+    assertPpr (from_rep == DoubleRep) (ppr from_rep <+> ppr to_rep) $+    [(DoubleToFloatOp,floatPrimTy)]+  | to_rep == DoubleRep =+    assertPpr (from_rep == FloatRep) (ppr from_rep <+> ppr to_rep) $+    [(FloatToDoubleOp,doublePrimTy)]++  -- Addr <-> Word/Int+  | to_rep == AddrRep = wordOrIntToAddrRep from_rep+  | from_rep == AddrRep = addrToWordOrIntRep to_rep++  -- Int* -> Int*+  | primRepIsInt from_rep+  , primRepIsInt to_rep+  = sizedIntToSizedInt from_rep to_rep++  -- Word* -> Word*+  | primRepIsWord from_rep+  , primRepIsWord to_rep+  = sizedWordToSizedWord from_rep to_rep++  -- Word* -> Int*+  | primRepIsWord from_rep+  , primRepIsInt to_rep+  = let (op1,r1) = wordToIntRep from_rep+    in (op1,primRepToType r1):sizedIntToSizedInt r1 to_rep++  -- Int* -> Word*+  | primRepIsInt from_rep+  , primRepIsWord to_rep+  = let (op1,r1) = intToWordRep from_rep+    in (op1,primRepToType r1):sizedWordToSizedWord r1 to_rep++  | otherwise = pprPanic "getCasts:Unexpect rep combination"+                          (ppr (from_rep,to_rep))++wordOrIntToAddrRep :: HasDebugCallStack => PrimRep -> [(PrimOp,Type)]+wordOrIntToAddrRep AddrRep = [] -- No-op argument is already AddrRep+wordOrIntToAddrRep IntRep = [(IntToAddrOp, addrPrimTy)]+wordOrIntToAddrRep WordRep = [(WordToIntOp,intPrimTy), (IntToAddrOp,addrPrimTy)]+wordOrIntToAddrRep r+    | primRepIsInt r = (intToMachineInt r,intPrimTy):[(IntToAddrOp,addrPrimTy)]+    | primRepIsWord r =+        let (op1,r1) = wordToIntRep r+        in (op1, primRepToType r1):[(intToMachineInt r1,intPrimTy), (IntToAddrOp,addrPrimTy)]+    | otherwise = pprPanic "Rep not word or int rep" (ppr r)++addrToWordOrIntRep :: HasDebugCallStack => PrimRep -> [(PrimOp,Type)]+-- Machine sizes+addrToWordOrIntRep IntRep = [(AddrToIntOp, intPrimTy)]+addrToWordOrIntRep WordRep = [(AddrToIntOp,intPrimTy), (IntToWordOp,wordPrimTy)]+-- Explicitly sized reps+addrToWordOrIntRep r+    | primRepIsWord r = (AddrToIntOp,intPrimTy) : (IntToWordOp,wordPrimTy) : sizedWordToSizedWord WordRep r+    | primRepIsInt r = (AddrToIntOp,intPrimTy) : sizedIntToSizedInt IntRep r+    | otherwise = pprPanic "Target rep not word or int rep" (ppr r)+++-- WordX# -> IntX# (same size), argument is source rep+wordToIntRep :: HasDebugCallStack => PrimRep -> (PrimOp,PrimRep)+wordToIntRep rep+    = case rep of+        (WordRep) -> (WordToIntOp, IntRep)+        (Word8Rep) -> (Word8ToInt8Op, Int8Rep)+        (Word16Rep) -> (Word16ToInt16Op, Int16Rep)+        (Word32Rep) -> (Word32ToInt32Op, Int32Rep)+        (Word64Rep) -> (Word64ToInt64Op, Int64Rep)+        _ -> pprPanic "Rep not a wordRep" (ppr rep)++-- IntX# -> WordX#, argument is source rep+intToWordRep :: HasDebugCallStack => PrimRep -> (PrimOp,PrimRep)+intToWordRep rep+    = case rep of+        (IntRep) -> (IntToWordOp, WordRep)+        (Int8Rep) -> (Int8ToWord8Op, Word8Rep)+        (Int16Rep) -> (Int16ToWord16Op, Word16Rep)+        (Int32Rep) -> (Int32ToWord32Op, Word32Rep)+        (Int64Rep) -> (Int64ToWord64Op, Word64Rep)+        _ -> pprPanic "Rep not a wordRep" (ppr rep)++-- Casts between any size int to any other size of int+sizedIntToSizedInt :: HasDebugCallStack => PrimRep -> PrimRep -> [(PrimOp,Type)]+sizedIntToSizedInt r1 r2+    | r1 == r2 = []+-- Cast to Int#+sizedIntToSizedInt r IntRep = [(intToMachineInt r,intPrimTy)]+-- Cast from Int#+sizedIntToSizedInt IntRep r = [(intFromMachineInt r,primRepToType r)]+-- Sized to differently sized must go over machine word.+sizedIntToSizedInt r1 r2 = (intToMachineInt r1,intPrimTy) : [(intFromMachineInt r2,primRepToType r2)]++-- Casts between any size Word to any other size of Word+sizedWordToSizedWord :: HasDebugCallStack => PrimRep -> PrimRep -> [(PrimOp,Type)]+sizedWordToSizedWord r1 r2+    | r1 == r2 = []+-- Cast to Word#+sizedWordToSizedWord r WordRep = [(wordToMachineWord r,wordPrimTy)]+-- Cast from Word#+sizedWordToSizedWord WordRep r = [(wordFromMachineWord r, primRepToType r)]+-- Conversion between different non-machine sizes must go via machine word.+sizedWordToSizedWord r1 r2 = (wordToMachineWord r1,wordPrimTy) : [(wordFromMachineWord r2, primRepToType r2)]+++-- Prefer the definitions above this line if possible+----------------------+++-- Int*# to Int#+{-# INLINE intToMachineInt #-}+intToMachineInt :: HasDebugCallStack => PrimRep -> PrimOp+intToMachineInt r =+    assertPpr (primRepIsInt r) (ppr r) $+    case r of+        (Int8Rep) -> Int8ToIntOp+        (Int16Rep) -> Int16ToIntOp+        (Int32Rep) -> Int32ToIntOp+        (Int64Rep) -> Int64ToIntOp+        _ -> pprPanic "Source rep not int" $ ppr r++-- Int# to Int*#+{-# INLINE intFromMachineInt #-}+intFromMachineInt :: HasDebugCallStack => PrimRep -> PrimOp+intFromMachineInt r =+    assertPpr (primRepIsInt r) (ppr r) $+    case r of+        Int8Rep -> IntToInt8Op+        Int16Rep -> IntToInt16Op+        Int32Rep -> IntToInt32Op+        Int64Rep -> IntToInt64Op+        _ -> pprPanic "Dest rep not sized int" $ ppr r++-- Word# to Word*#+{-# INLINE wordFromMachineWord #-}+wordFromMachineWord :: HasDebugCallStack => PrimRep -> PrimOp+wordFromMachineWord r =+    assert (primRepIsWord r) $+    case r of+        Word8Rep -> WordToWord8Op+        Word16Rep -> WordToWord16Op+        Word32Rep -> WordToWord32Op+        Word64Rep -> WordToWord64Op+        _ -> pprPanic "Dest rep not sized word" $ ppr r++-- Word*# to Word#+{-# INLINE wordToMachineWord #-}+wordToMachineWord :: HasDebugCallStack => PrimRep -> PrimOp+wordToMachineWord r =+    assertPpr (primRepIsWord r) (text "Not a word rep:" <> ppr r) $+    case r of+        Word8Rep -> Word8ToWordOp+        Word16Rep -> Word16ToWordOp+        Word32Rep -> Word32ToWordOp+        Word64Rep -> Word64ToWordOp+        _ -> pprPanic "Dest rep not sized word" $ ppr r

@@ -12,7 +12,7 @@  import GHC.Prelude hiding (succ, unzip, zip) -import GHC.Cmm.Dataflow.Block+import GHC.Cmm.Dataflow.Block hiding (blockConcat) import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow.Graph import GHC.Cmm.Dataflow.Label

@@ -94,6 +94,10 @@   "!="                  { kw CmmT_Ne }   "&&"                  { kw CmmT_BoolAnd }   "||"                  { kw CmmT_BoolOr }+  "%relaxed"            { kw CmmT_Relaxed }+  "%acquire"            { kw CmmT_Acquire }+  "%release"            { kw CmmT_Release }+  "%seq_cst"            { kw CmmT_SeqCst  }    "True"                { kw CmmT_True  }   "False"               { kw CmmT_False }@@ -183,6 +187,10 @@   | CmmT_False   | CmmT_True   | CmmT_likely+  | CmmT_Relaxed+  | CmmT_Acquire+  | CmmT_Release+  | CmmT_SeqCst   deriving (Show)  -- -----------------------------------------------------------------------------

@@ -170,9 +170,21 @@             platform <- getPlatform             erep <- lintCmmExpr expr             let reg_ty = cmmRegType platform reg-            if (erep `cmmEqType_ignoring_ptrhood` reg_ty)-                then return ()-                else cmmLintAssignErr (CmmAssign reg expr) erep reg_ty+            unless (compat_regs erep reg_ty) $+              cmmLintAssignErr (CmmAssign reg expr) erep reg_ty+    where+      compat_regs :: CmmType -> CmmType -> Bool+      compat_regs ty1 ty2+        -- As noted in #22297, SIMD vector registers can be used for+        -- multiple different purposes, e.g. xmm1 can be used to hold 4 Floats,+        -- or 4 Int32s, or 2 Word64s, ...+        -- To allow this, we relax the check: we only ensure that the widths+        -- match, until we can find a more robust solution.+        | isVecType ty1+        , isVecType ty2+        = typeWidth ty1 == typeWidth ty2+        | otherwise+        = cmmEqType_ignoring_ptrhood ty1 ty2    CmmStore l r _alignment -> do             _ <- lintCmmExpr l

@@ -194,7 +194,28 @@ a 32-bit machine) then the call will push as many words as necessary to the stack to accommodate it (e.g. 2). +Memory ordering+--------------- +Cmm respects the C11 memory model and distinguishes between non-atomic and+atomic memory accesses. In C11 fashion, atomic accesses can provide a number of+memory ordering guarantees. These are supported in Cmm syntax as follows:++    W_[ptr] = ...;            // a non-atomic store+    %relaxed W_[ptr] = ...;   // an atomic store with relaxed ordering semantics+    %release W_[ptr] = ...;   // an atomic store with release ordering semantics++    x = W_(ptr);              // a non-atomic load+    x = %relaxed W_[ptr];     // an atomic load with relaxed ordering+    x = %acquire W_[ptr];     // an atomic load with acquire ordering+    // or equivalently...+    x = prim %load_acquire64(ptr);++Here we used W_ as an example but these operations can be used on all Cmm+types.++See Note [Heap memory barriers] in SMP.h for details.+ ----------------------------------------------------------------------------- -}  {@@ -317,6 +338,10 @@         'True'  { L _ (CmmT_True ) }         'False' { L _ (CmmT_False) }         'likely'{ L _ (CmmT_likely)}+        'relaxed'{ L _ (CmmT_Relaxed)}+        'acquire'{ L _ (CmmT_Acquire)}+        'release'{ L _ (CmmT_Release)}+        'seq_cst'{ L _ (CmmT_SeqCst)}          'CLOSURE'       { L _ (CmmT_CLOSURE) }         'INFO_TABLE'    { L _ (CmmT_INFO_TABLE) }@@ -632,8 +657,23 @@          | lreg '=' expr ';'                 { do reg <- $1; e <- $3; withSourceNote $2 $4 (emitAssign reg e) }++        -- Use lreg instead of local_reg to avoid ambiguity+        | lreg '=' mem_ordering type '[' expr ']' ';'+                { do reg <- $1;+                     let lreg = case reg of+                                  { CmmLocal r -> r+                                  ; other -> pprPanic "CmmParse:" (ppr reg <> text "not a local register")+                                  } ;+                     mord <- $3;+                     let { ty = $4; w = typeWidth ty };+                     e <- $6;+                     let op = MO_AtomicRead w mord;+                     withSourceNote $2 $7 $ code (emitPrimCall [lreg] op [e]) }+        | mem_ordering type '[' expr ']' '=' expr ';'+                { do mord <- $1; withSourceNote $3 $8 (doStore (Just mord) $2 $4 $7) }         | type '[' expr ']' '=' expr ';'-                { withSourceNote $2 $7 (doStore $1 $3 $6) }+                { withSourceNote $2 $7 (doStore Nothing $1 $3 $6) }          -- Gah! We really want to say "foreign_results" but that causes         -- a shift/reduce conflict with assignment.  We either@@ -683,6 +723,14 @@         | GLOBALREG '=' expr_or_unknown                 { do e <- $3; return [($1, e)] } +-- | A memory ordering+mem_ordering :: { CmmParse MemoryOrdering }+mem_ordering+        : 'relaxed' { do return MemOrderRelaxed }+        | 'release' { do return MemOrderRelease }+        | 'acquire' { do return MemOrderAcquire }+        | 'seq_cst' { do return MemOrderSeqCst }+ -- | Used by unwind to indicate unknown unwinding values. expr_or_unknown         :: { CmmParse (Maybe CmmExpr) }@@ -957,6 +1005,7 @@     platform = profilePlatform profile  -- we understand a subset of C-- primitives:+machOps :: UniqFM FastString (Width -> MachOp) machOps = listToUFM $         map (\(x, y) -> (mkFastString x, y)) [         ( "add",        MO_Add ),@@ -1078,37 +1127,32 @@         ( "suspendThread", (MO_SuspendThread,) ),         ( "resumeThread",  (MO_ResumeThread,) ), -        ("prefetch0", (MO_Prefetch_Data 0,)),-        ("prefetch1", (MO_Prefetch_Data 1,)),-        ("prefetch2", (MO_Prefetch_Data 2,)),-        ("prefetch3", (MO_Prefetch_Data 3,)),--        ( "popcnt8",  (MO_PopCnt W8,)),-        ( "popcnt16", (MO_PopCnt W16,)),-        ( "popcnt32", (MO_PopCnt W32,)),-        ( "popcnt64", (MO_PopCnt W64,)),--        ( "pdep8",  (MO_Pdep W8,)),-        ( "pdep16", (MO_Pdep W16,)),-        ( "pdep32", (MO_Pdep W32,)),-        ( "pdep64", (MO_Pdep W64,)),--        ( "pext8",  (MO_Pext W8,)),-        ( "pext16", (MO_Pext W16,)),-        ( "pext32", (MO_Pext W32,)),-        ( "pext64", (MO_Pext W64,)),--        ( "cmpxchg8",  (MO_Cmpxchg W8,)),-        ( "cmpxchg16", (MO_Cmpxchg W16,)),-        ( "cmpxchg32", (MO_Cmpxchg W32,)),-        ( "cmpxchg64", (MO_Cmpxchg W64,)),--        ( "xchg8",  (MO_Xchg W8,)),-        ( "xchg16", (MO_Xchg W16,)),-        ( "xchg32", (MO_Xchg W32,)),-        ( "xchg64", (MO_Xchg W64,))+        ( "prefetch0", (MO_Prefetch_Data 0,)),+        ( "prefetch1", (MO_Prefetch_Data 1,)),+        ( "prefetch2", (MO_Prefetch_Data 2,)),+        ( "prefetch3", (MO_Prefetch_Data 3,))+    ] ++ concat+    [ allWidths "popcnt" MO_PopCnt+    , allWidths "pdep" MO_Pdep+    , allWidths "pext" MO_Pext+    , allWidths "cmpxchg" MO_Cmpxchg+    , allWidths "xchg" MO_Xchg+    , allWidths "load_relaxed" (\w -> MO_AtomicRead w MemOrderAcquire)+    , allWidths "load_acquire" (\w -> MO_AtomicRead w MemOrderAcquire)+    , allWidths "load_seqcst" (\w -> MO_AtomicRead w MemOrderSeqCst)+    , allWidths "store_release" (\w -> MO_AtomicWrite w MemOrderRelease)+    , allWidths "store_seqcst" (\w -> MO_AtomicWrite w MemOrderSeqCst)     ]   where+    allWidths+        :: String+        -> (Width -> CallishMachOp)+        -> [(FastString, a -> (CallishMachOp, a))]+    allWidths name f =+        [ (mkFastString $ name ++ show (widthInBits w), (f w,))+        | w <- [W8, W16, W32, W64]+        ]+     memcpyLikeTweakArgs :: (Int -> CallishMachOp) -> [CmmExpr] -> (CallishMachOp, [CmmExpr])     memcpyLikeTweakArgs op [] = pgmError "memcpy-like function requires at least one argument"     memcpyLikeTweakArgs op args@(_:_) =@@ -1352,8 +1396,12 @@                 let (p, args') = f args                 code (emitPrimCall (map fst results) p args') -doStore :: CmmType -> CmmParse CmmExpr  -> CmmParse CmmExpr -> CmmParse ()-doStore rep addr_code val_code+doStore :: Maybe MemoryOrdering+        -> CmmType+        -> CmmParse CmmExpr   -- ^ address+        -> CmmParse CmmExpr   -- ^ value+        -> CmmParse ()+doStore mem_ord rep addr_code val_code   = do platform <- getPlatform        addr <- addr_code        val <- val_code@@ -1367,7 +1415,7 @@        let coerce_val                 | val_width /= rep_width = CmmMachOp (MO_UU_Conv val_width rep_width) [val]                 | otherwise              = val-       emitStore addr coerce_val+       emitStore mem_ord addr coerce_val  -- ----------------------------------------------------------------------------- -- If-then-else and boolean expressions

@@ -115,7 +115,7 @@    AddrRep          -> bWord platform    FloatRep         -> f32    DoubleRep        -> f64-   (VecRep len rep) -> vec len (primElemRepCmmType rep)+   VecRep len rep   -> vec len (primElemRepCmmType rep)  slotCmmType :: Platform -> SlotTy -> CmmType slotCmmType platform = \case@@ -125,6 +125,7 @@    Word64Slot      -> b64    FloatSlot       -> f32    DoubleSlot      -> f64+   VecSlot l e     -> vec l (primElemRepCmmType e)  primElemRepCmmType :: PrimElemRep -> CmmType primElemRepCmmType Int8ElemRep   = b8

@@ -1535,8 +1535,8 @@          -- -- Atomic read-modify-write.         MO_AtomicRMW w amop -> mkCCall (atomicRMWLabel w amop)-        MO_AtomicRead w     -> mkCCall (atomicReadLabel w)-        MO_AtomicWrite w    -> mkCCall (atomicWriteLabel w)+        MO_AtomicRead w _   -> mkCCall (atomicReadLabel w)+        MO_AtomicWrite w _  -> mkCCall (atomicWriteLabel w)         MO_Cmpxchg w        -> mkCCall (cmpxchgLabel w)         -- -- Should be an AtomicRMW variant eventually.         -- -- Sequential consistent.

@@ -1174,7 +1174,7 @@                           (n_reg, n_code) <- getSomeReg n                           return  (op dst dst (RIReg n_reg), n_code) -genCCall (PrimTarget (MO_AtomicRead width)) [dst] [addr]+genCCall (PrimTarget (MO_AtomicRead width _)) [dst] [addr]  = do let fmt      = intFormat width           reg_dst  = getLocalRegReg dst           form     = if widthInBits width == 64 then DS else D@@ -1201,7 +1201,7 @@ -- This is also what gcc does.  -genCCall (PrimTarget (MO_AtomicWrite width)) [] [addr, val] = do+genCCall (PrimTarget (MO_AtomicWrite width _)) [] [addr, val] = do     code <- assignMem_IntCode (intFormat width) addr val     return $ unitOL HWSYNC `appOL` code @@ -2068,8 +2068,8 @@                     MO_AtomicRMW {} -> unsupported                     MO_Cmpxchg w -> (cmpxchgLabel w, False)                     MO_Xchg w    -> (xchgLabel w, False)-                    MO_AtomicRead _  -> unsupported-                    MO_AtomicWrite _ -> unsupported+                    MO_AtomicRead _ _  -> unsupported+                    MO_AtomicWrite _ _ -> unsupported                      MO_S_Mul2    {}  -> unsupported                     MO_S_QuotRem {}  -> unsupported

@@ -2167,8 +2167,8 @@ genSimplePrim bid (MO_Pext width)      [dst]   [src,mask]     = genPext bid width dst src mask genSimplePrim bid (MO_Clz width)       [dst]   [src]          = genClz bid width dst src genSimplePrim bid (MO_UF_Conv width)   [dst]   [src]          = genWordToFloat bid width dst src-genSimplePrim _   (MO_AtomicRead w)    [dst]   [addr]         = genAtomicRead w dst addr-genSimplePrim _   (MO_AtomicWrite w)   []      [addr,val]     = genAtomicWrite w addr val+genSimplePrim _   (MO_AtomicRead w mo)  [dst]  [addr]         = genAtomicRead w mo dst addr+genSimplePrim _   (MO_AtomicWrite w mo) []     [addr,val]     = genAtomicWrite w mo addr val genSimplePrim bid (MO_Cmpxchg width)   [dst]   [addr,old,new] = genCmpXchg bid width dst addr old new genSimplePrim _   (MO_Xchg width)      [dst]   [addr, value]  = genXchg width dst addr value genSimplePrim _   (MO_AddWordC w)      [r,c]   [x,y]          = genAddSubRetCarry w ADD_CC (const Nothing) CARRY r c x y@@ -3941,15 +3941,20 @@   -- TODO: generate assembly instead   genPrimCCall bid (word2FloatLabel width) [dst] [src] -genAtomicRead :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock-genAtomicRead width dst addr = do+genAtomicRead :: Width -> MemoryOrdering -> LocalReg -> CmmExpr -> NatM InstrBlock+genAtomicRead width _mord dst addr = do   load_code <- intLoadCode (MOV (intFormat width)) addr   return (load_code (getLocalRegReg dst)) -genAtomicWrite :: Width -> CmmExpr -> CmmExpr -> NatM InstrBlock-genAtomicWrite width addr val = do+genAtomicWrite :: Width -> MemoryOrdering -> CmmExpr -> CmmExpr -> NatM InstrBlock+genAtomicWrite width mord addr val = do   code <- assignMem_IntCode (intFormat width) addr val-  return $ code `snocOL` MFENCE+  let needs_fence = case mord of+        MemOrderSeqCst  -> True+        MemOrderRelease -> True+        MemOrderAcquire -> pprPanic "genAtomicWrite: acquire ordering on write" empty+        MemOrderRelaxed -> False+  return $ if needs_fence then code `snocOL` MFENCE else code  genCmpXchg   :: BlockId

@@ -949,8 +949,9 @@         MO_AtomicRMW w amop -> ftext (atomicRMWLabel w amop)         MO_Cmpxchg w        -> ftext (cmpxchgLabel w)         MO_Xchg w           -> ftext (xchgLabel w)-        MO_AtomicRead w     -> ftext (atomicReadLabel w)-        MO_AtomicWrite w    -> ftext (atomicWriteLabel w)+        -- TODO: handle orderings+        MO_AtomicRead w _   -> ftext (atomicReadLabel w)+        MO_AtomicWrite w _  -> ftext (atomicWriteLabel w)         MO_UF_Conv w        -> ftext (word2FloatLabel w)          MO_S_Mul2     {} -> unsupported

@@ -46,7 +46,7 @@ import Data.List ( nub ) import Data.Maybe ( catMaybes ) -type Atomic = Bool+type Atomic = Maybe MemoryOrdering type LlvmStatements = OrdList LlvmStatement  data Signage = Signed | Unsigned deriving (Eq, Show)@@ -266,9 +266,9 @@     retVar <- doExprW targetTy $ AtomicRMW op ptrVar nVar SyncSeqCst     statement $ Store retVar dstVar Nothing -genCall (PrimTarget (MO_AtomicRead _)) [dst] [addr] = runStmtsDecls $ do+genCall (PrimTarget (MO_AtomicRead _ mem_ord)) [dst] [addr] = runStmtsDecls $ do     dstV <- getCmmRegW (CmmLocal dst)-    v1 <- genLoadW True addr (localRegType dst) NaturallyAligned+    v1 <- genLoadW (Just mem_ord) addr (localRegType dst) NaturallyAligned     statement $ Store v1 dstV Nothing  genCall (PrimTarget (MO_Cmpxchg _width))@@ -295,13 +295,14 @@     resVar <- doExprW (getVarType valVar) (AtomicRMW LAO_Xchg ptrVar valVar SyncSeqCst)     statement $ Store resVar dstV Nothing -genCall (PrimTarget (MO_AtomicWrite _width)) [] [addr, val] = runStmtsDecls $ do+genCall (PrimTarget (MO_AtomicWrite _width mem_ord)) [] [addr, val] = runStmtsDecls $ do     addrVar <- exprToVarW addr     valVar <- exprToVarW val     let ptrTy = pLift $ getVarType valVar         ptrExpr = Cast LM_Inttoptr addrVar ptrTy     ptrVar <- doExprW ptrTy ptrExpr-    statement $ Expr $ AtomicRMW LAO_Xchg ptrVar valVar SyncSeqCst+    let ordering = convertMemoryOrdering mem_ord+    statement $ Expr $ AtomicRMW LAO_Xchg ptrVar valVar ordering  -- Handle memcpy function specifically since llvm's intrinsic version takes -- some extra parameters.@@ -1013,11 +1014,11 @@     MO_Touch         -> unsupported     MO_UF_Conv _     -> unsupported -    MO_AtomicRead _  -> unsupported-    MO_AtomicRMW _ _ -> unsupported-    MO_AtomicWrite _ -> unsupported-    MO_Cmpxchg _     -> unsupported-    MO_Xchg _        -> unsupported+    MO_AtomicRead _ _  -> unsupported+    MO_AtomicRMW _ _   -> unsupported+    MO_AtomicWrite _ _ -> unsupported+    MO_Cmpxchg _       -> unsupported+    MO_Xchg _          -> unsupported      MO_I64_ToI       -> dontReach64     MO_I64_FromI     -> dontReach64@@ -1369,7 +1370,7 @@         -> genLit opt lit      CmmLoad e' ty align-        -> genLoad False e' ty align+        -> genLoad Nothing e' ty align      -- Cmmreg in expression is the value, so must load. If you want actual     -- reg pointer, call getCmmReg directly.@@ -1901,7 +1902,8 @@  mkLoad :: Atomic -> LlvmVar -> AlignmentSpec -> LlvmExpression mkLoad atomic vptr alignment-  | atomic      = ALoad SyncSeqCst False vptr+  | Just mem_ord <- atomic+                = ALoad (convertMemoryOrdering mem_ord) False vptr   | otherwise   = Load vptr align   where     ty = pLower (getVarType vptr)@@ -2037,6 +2039,12 @@ -- ----------------------------------------------------------------------------- -- * Misc --++convertMemoryOrdering :: MemoryOrdering -> LlvmSyncOrdering+convertMemoryOrdering MemOrderRelaxed = SyncMonotonic+convertMemoryOrdering MemOrderAcquire = SyncAcquire+convertMemoryOrdering MemOrderRelease = SyncRelease+convertMemoryOrdering MemOrderSeqCst  = SyncSeqCst  -- | Find CmmRegs that get assigned and allocate them on the stack --

@@ -248,8 +248,10 @@ dmdAnalBind top_lvl env dmd bind anal_body = case bind of   NonRec id rhs     | useLetUp top_lvl id-    -> dmdAnalBindLetUp   top_lvl env     id rhs anal_body-  _ -> dmdAnalBindLetDown top_lvl env dmd bind   anal_body+    -> dmdAnalBindLetUp   top_lvl env_rhs     id rhs anal_body+  _ -> dmdAnalBindLetDown top_lvl env_rhs dmd bind   anal_body+  where+    env_rhs = enterDFun bind env  -- | Annotates uninteresting top level functions ('isInterestingTopLevelFn') -- with 'topDmd', the rest with the given demand.@@ -448,8 +450,9 @@         !(!bndrs', !scrut_sd)           | DataAlt _ <- alt           -- See Note [Demand on the scrutinee of a product case]+          , let !scrut_sd = scrutSubDmd case_bndr_sd fld_dmds           -- See Note [Demand on case-alternative binders]-          , (!scrut_sd, fld_dmds') <- addCaseBndrDmd case_bndr_sd fld_dmds+          , let !fld_dmds' = fieldBndrDmds scrut_sd (length fld_dmds)           , let !bndrs' = setBndrsDemandInfo bndrs fld_dmds'           = (bndrs', scrut_sd)           | otherwise@@ -559,7 +562,7 @@   | otherwise   = False -dmdAnalSumAlt :: AnalEnv -> SubDemand -> Id -> Alt Var -> WithDmdType (Alt Var)+dmdAnalSumAlt :: AnalEnv -> SubDemand -> Id -> Alt Var -> WithDmdType CoreAlt dmdAnalSumAlt env dmd case_bndr (Alt con bndrs rhs)   | WithDmdType rhs_ty rhs' <- dmdAnal env dmd rhs   , WithDmdType alt_ty dmds <- findBndrsDmds env rhs_ty bndrs@@ -567,27 +570,29 @@         -- See Note [Demand on case-alternative binders]         -- we can't use the scrut_sd, because it says 'Prod' and we'll use         -- topSubDmd anyway for scrutinees of sum types.-        (!_scrut_sd, dmds') = addCaseBndrDmd case_bndr_sd dmds+        scrut_sd = scrutSubDmd case_bndr_sd dmds+        dmds' = fieldBndrDmds scrut_sd (length dmds)         -- Do not put a thunk into the Alt         !new_ids            = setBndrsDemandInfo bndrs dmds'   = WithDmdType alt_ty (Alt con new_ids rhs') --- Precondition: The SubDemand is not a Call -- See Note [Demand on the scrutinee of a product case]--- and Note [Demand on case-alternative binders]-addCaseBndrDmd :: SubDemand -- On the case binder-               -> [Demand]  -- On the fields of the constructor-               -> (SubDemand, [Demand])-                            -- SubDemand on the case binder incl. field demands-                            -- and final demands for the components of the constructor-addCaseBndrDmd case_sd fld_dmds-  | Just (_, ds) <- viewProd (length fld_dmds) scrut_sd-  = (scrut_sd, ds)-  | otherwise-  = pprPanic "was a call demand" (ppr case_sd $$ ppr fld_dmds) -- See the Precondition-  where-    scrut_sd = case_sd `plusSubDmd` mkProd Unboxed fld_dmds+scrutSubDmd :: SubDemand -> [Demand] -> SubDemand+scrutSubDmd case_sd fld_dmds =+  -- pprTraceWith "scrutSubDmd" (\scrut_sd -> ppr case_sd $$ ppr fld_dmds $$ ppr scrut_sd) $+  case_sd `plusSubDmd` mkProd Unboxed fld_dmds +-- See Note [Demand on case-alternative binders]+fieldBndrDmds :: SubDemand -- on the scrutinee+              -> Arity+              -> [Demand]  -- Final demands for the components of the DataCon+fieldBndrDmds scrut_sd n_flds =+  case viewProd n_flds scrut_sd of+    Just (_, ds) -> ds+    Nothing      -> replicate n_flds topDmd+                      -- Either an arity mismatch or scrut_sd was a call demand.+                      -- See Note [Untyped demand on case-alternative binders]+ {- Note [Analysing with absent demand] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -769,6 +774,44 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. +Note [Untyped demand on case-alternative binders]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+With unsafeCoerce, #8037 and #22039 taught us that the demand on the case binder+may be a call demand or have a different number of fields than the constructor+of the case alternative it is used in. From T22039:++  blarg :: (Int, Int) -> Int+  blarg (x,y) = x+y+  -- blarg :: <1!P(1L,1L)>++  f :: Either Int Int -> Int+  f Left{} = 0+  f e = blarg (unsafeCoerce e)+  ==> { desugars to }+  f = \ (ds_d1nV :: Either Int Int) ->+      case ds_d1nV of wild_X1 {+        Left ds_d1oV -> lvl_s1Q6;+        Right ipv_s1Pl ->+          blarg+            (case unsafeEqualityProof @(*) @(Either Int Int) @(Int, Int) of+             { UnsafeRefl co_a1oT ->+             wild_X1 `cast` (Sub (Sym co_a1oT) :: Either Int Int ~R# (Int, Int))+             })+      }++The case binder `e`/`wild_X1` has demand 1!P(1L,1L), with two fields, from the call+to `blarg`, but `Right` only has one field. Although the code will crash when+executed, we must be able to analyse it in 'fieldBndrDmds' and conservatively+approximate with Top instead of panicking because of the mismatch.+In #22039, this kind of code was guarded behind a safe `cast` and thus dead+code, but nevertheless led to a panic of the compiler.++You might wonder why the same problem doesn't come up when scrutinising a+product type instead of a sum type. It appears that for products, `wild_X1`+will be inlined before DmdAnal.++See also Note [mkWWstr and unsafeCoerce] for a related issue.+ Note [Aggregated demand for cardinality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FIXME: This Note should be named [LetUp vs. LetDown] and probably predates@@ -829,8 +872,9 @@ -- See Note [What are demand signatures?] in "GHC.Types.Demand" dmdTransform env var sd   -- Data constructors-  | isDataConWorkId var-  = dmdTransformDataConSig (idArity var) sd+  | Just con <- isDataConWorkId_maybe var+  = -- pprTraceWith "dmdTransform:DataCon" (\ty -> ppr con $$ ppr sd $$ ppr ty) $+    dmdTransformDataConSig (dataConRepStrictness con) sd   -- Dictionary component selectors   -- Used to be controlled by a flag.   -- See #18429 for some perf measurements.@@ -1492,13 +1536,18 @@  Historical note: #14955 describes how I got this fix wrong the first time. -Note that the simplicity of this fix implies that INLINE functions (such as-wrapper functions after the WW run) will never say that they unbox class-dictionaries. That's not ideal, but not worth losing sleep over, as INLINE-functions will have been inlined by the time we run demand analysis so we'll-see the unboxing around the worker in client modules. I got aware of the issue-in T5075 by the change in boxity of loop between demand analysis runs.+2. -fspecialise-aggressively.  As #21286 shows, the same phenomenon can occur+   occur without INLINABLE, when we use -fexpose-all-unfoldings and+   -fspecialise-aggressively to do vigorous cross-module specialisation. +3. #18421 found that unboxing a dictionary can also make the worker less likely+   to inline; the inlining heuristics seem to prefer to inline a function+   applied to a dictionary over a function applied to a bunch of functions.++TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing+a raft of higher-order functions isn't a huge win anyway -- you really want to+specialise the function.+ Note [Worker argument budget] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In 'finaliseArgBoxities' we don't want to generate workers with zillions of@@ -1842,14 +1891,6 @@         -- L demand doesn't get both'd with the Bot coming up from the inner         -- call to f.  So we just get an L demand for x for g. -{--Note [Do not strictify the argument dictionaries of a dfun]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-The typechecker can tie recursive knots involving dfuns, so we do the-conservative thing and refrain from strictifying a dfun's argument-dictionaries.--}- setBndrsDemandInfo :: HasCallStack => [Var] -> [Demand] -> [Var] setBndrsDemandInfo (b:bs) ds   | isTyVar b = b : setBndrsDemandInfo bs ds@@ -1988,6 +2029,16 @@          , ae_rec_dc       = memoiseUniqueFun (isRecDataCon fam_envs 3)          } +-- | Unset the 'dmd_strict_dicts' flag if any of the given bindings is a DFun+-- binding. Part of the mechanism that detects+-- Note [Do not strictify a DFun's parameter dictionaries].+enterDFun :: CoreBind -> AnalEnv -> AnalEnv+enterDFun bind env+  | any isDFunId (bindersOf bind)+  = env { ae_opts = (ae_opts env) { dmd_strict_dicts = False } }+  | otherwise+  = env+ emptySigEnv :: SigEnv emptySigEnv = emptyVarEnv @@ -2039,58 +2090,74 @@     id_ty = idType id      strictify dmd-      -- See Note [Making dictionaries strict]+      -- See Note [Making dictionary parameters strict]+      -- and Note [Do not strictify a DFun's parameter dictionaries]       | dmd_strict_dicts (ae_opts env)-             -- We never want to strictify a recursive let. At the moment-             -- findBndrDmd is never called for recursive lets; if that-             -- changes, we need a RecFlag parameter and another guard here.       = strictifyDictDmd id_ty dmd       | otherwise       = dmd      fam_envs = ae_fam_envs env -{- Note [Making dictionaries strict]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+{- Note [Making dictionary parameters strict]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The Opt_DictsStrict flag makes GHC use call-by-value for dictionaries.  Why?  * Generally CBV is more efficient. -* Dictionaries are always non-bottom; and never take much work to-  compute.  E.g. a dfun from an instance decl always returns a dicionary+* A datatype dictionary is always non-bottom and never takes much work to+  compute.  E.g. a DFun from an instance decl always returns a dictionary   record immediately.  See DFunUnfolding in CoreSyn.   See also Note [Recursive superclasses] in TcInstDcls. -* The strictness analyser will then unbox dictionaries and pass the-  methods individually, rather than in a bundle.  If there are a lot of-  methods that might be bad; but worker/wrapper already does throttling.+See #17758 for more background and perf numbers. +Wrinkles:+ * A newtype dictionary is *not* always non-bottom.  E.g.       class C a where op :: a -> a       instance C Int where op = error "urk"   Now a value of type (C Int) is just a newtype wrapper (a cast) around   the error thunk.  Don't strictify these! -See #17758 for more background and perf numbers.+* Strictifying DFuns risks destroying the invariant that DFuns never take much+  work to compute, so we don't do it.+  See Note [Do not strictify a DFun's parameter dictionaries] for details. +* Although worker/wrapper *could* unbox strictly used dictionaries, we do not do+  so; see Note [Do not unbox class dictionaries].+ The implementation is extremly simple: just make the strictness analyser strictify the demand on a dictionary binder in-'findBndrDmd'.+'findBndrDmd' if the binder does not belong to a DFun. -However there is one case where this can make performance worse.-For the principle consider some function at the core level:-    myEq :: Eq a => a -> a -> Bool-    myEq eqDict x y = ((==) eqDict) x y-If we make the dictionary strict then WW can fire turning this into:-    $wmyEq :: (a -> a -> Bool) -> a -> a -> Bool-    $wmyEq eq x y = eq x y-Which *usually* performs better. However if the dictionary is known we-are far more likely to inline a function applied to the dictionary than-to inline one applied to a function. Sometimes this makes just enough-of a difference to stop a function from inlining. This is documented in #18421.+Note [Do not strictify a DFun's parameter dictionaries]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The typechecker can tie recursive knots involving (non-recursive) DFuns, so+we must not strictify a DFun's parameter dictionaries (#22549).+T22549 has an example involving undecidable instances that <<loop>>s when we+strictify the DFun of, e.g., `$fEqSeqT`: -It's somewhat similar to Note [Do not unbox class dictionaries] although-here our problem is with the inliner, not the specializer.+  Main.$fEqSeqT+    = \@m @a ($dEq :: Eq (m (ViewT m a))) ($dMonad :: Monad m) ->+        GHC.Classes.C:Eq @(SeqT m a) ($c== @m @a $dEq $dMonad)+                                     ($c/= @m @a $dEq $dMonad)++  Rec {+    $dEq_a = Main.$fEqSeqT @Identity @Int $dEq_b Main.$fMonadIdentity+    $dEq_b = ... $dEq_a ... <another strict context due to DFun>+  }++If we make `$fEqSeqT` strict in `$dEq`, we'll collapse the Rec group into a+giant, <<loop>>ing thunk.++To prevent that, we never strictify dictionary params when inside a DFun.+That is implemented by unsetting 'dmd_strict_dicts' when entering a DFun.++See also Note [Speculative evaluation] in GHC.CoreToStg.Prep which has a rather+similar example in #20836. We may never speculate *arguments* of (recursive)+DFun calls, likewise we should not mark *formal parameters* of recursive DFuns+as strict.  Note [Initialising strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

@@ -1733,6 +1733,10 @@ The problem is very similar to Note [Eta reduction in recursive RHSs]. Here as well as there it is *unsound* to change the termination properties of the very function whose termination properties we are exploiting.++It is also similar to Note [Do not strictify a DFun's parameter dictionaries],+where marking recursive DFuns (of undecidable *instances*) strict in dictionary+*parameters* leads to quite the same change in termination as above. -}  data FloatingBind

@@ -727,8 +727,8 @@                     Just n  -> return n      setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env-    hsc_env <- getSession-    (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $+    (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $ do+      hsc_env <- getSession       liftIO $ upsweep n_jobs hsc_env mhmi_cache mHscMessage (toCache pruned_cache) build_plan     setSession hsc_env1     case upsweep_ok of

@@ -945,7 +945,8 @@            ; body' <- dsLExpr $ noLocA $ HsDo body_ty ctx (noLocA stmts)             ; let match_args (pat, fail_op) (vs,body)-                   = do { var   <- selectSimpleMatchVarL Many pat+                   = putSrcSpanDs (getLocA pat) $+                     do { var   <- selectSimpleMatchVarL Many pat                         ; match <- matchSinglePatVar var Nothing (StmtCtxt (HsDoStmt ctx)) pat                                    body_ty (cantFailMatchResult body)                         ; match_code <- dsHandleMonadicFailure ctx pat match fail_op

@@ -50,10 +50,8 @@            newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession (objectSuf dflags)           writeFile rc_filename $-             "1 24 MOVEABLE PURE " ++ show manifest_filename ++ "\n"+             "1 24 MOVEABLE PURE \"" ++ manifest_filename ++ "\"\n"                -- magic numbers :-)-               -- show is a bit hackish above, but we need to escape the-               -- backslashes in the path.           runWindres logger dflags $ map GHC.SysTools.Option $                ["--input="++rc_filename,

@@ -79,11 +79,11 @@   myExtraGccViaCFlags <- getSetting "GCC extra via C opts"   cc_prog <- getToolSetting "C compiler command"   cxx_prog <- getToolSetting "C++ compiler command"-  cc_args_str <- getSetting "C compiler flags"-  cxx_args_str <- getSetting "C++ compiler flags"+  cc_args_str <- getToolSetting "C compiler flags"+  cxx_args_str <- getToolSetting "C++ compiler flags"   gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie"   cpp_prog <- getToolSetting "Haskell CPP command"-  cpp_args_str <- getSetting "Haskell CPP flags"+  cpp_args_str <- getToolSetting "Haskell CPP flags"    platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings @@ -125,13 +125,13 @@     -- Other things being equal, as and ld are simply gcc-  cc_link_args_str <- getSetting "C compiler link flags"+  cc_link_args_str <- getToolSetting "C compiler link flags"   let   as_prog  = cc_prog         as_args  = map Option cc_args         ld_prog  = cc_prog         ld_args  = map Option (cc_args ++ words cc_link_args_str)   ld_r_prog <- getToolSetting "Merge objects command"-  ld_r_args <- getSetting "Merge objects flags"+  ld_r_args <- getToolSetting "Merge objects flags"   let ld_r         | null ld_r_prog = Nothing         | otherwise      = Just (ld_r_prog, map Option $ words ld_r_args)

@@ -326,7 +326,7 @@ rhsCard :: Id -> Card rhsCard bndr   | is_thunk  = oneifyCard n-  | otherwise = peelManyCalls (idArity bndr) cd+  | otherwise = fst (peelManyCalls (idArity bndr) cd)   where     is_thunk = idArity bndr == 0     -- Let's pray idDemandInfo is still OK after unarise...

@@ -46,10 +46,19 @@   t_1 :: TYPE r_1, ..., t_n :: TYPE r_n   s_1 :: TYPE p_1, ..., a_n :: TYPE p_n -Then we must check that each r_i is compatible with s_i. Compatibility-is weaker than on-the-nose equality: for example, IntRep and WordRep are-compatible. See Note [Bad unsafe coercion] in GHC.Core.Lint.+Before unarisation, we must check that each r_i is compatible with s_i.+Compatibility is weaker than on-the-nose equality: for example,+IntRep and WordRep are compatible. See Note [Bad unsafe coercion] in GHC.Core.Lint. +After unarisation, a single type might correspond to multiple arguments, e.g.++  (# Int# | Bool #) :: TYPE (SumRep '[ IntRep, LiftedRep ])++will result in two arguments: [Int# :: TYPE 'IntRep, Bool :: TYPE LiftedRep]+This means post unarise we potentially have to match up multiple arguments with+the reps of a single argument in the type's definition, because the type of the function+is *not* in unarised form.+ Wrinkle: it can sometimes happen that an argument type in the type of the function does not have a fixed runtime representation, i.e. there is an r_i such that runtimeRepPrimRep r_i crashes.@@ -122,7 +131,7 @@ import GHC.Utils.Misc import GHC.Core.Multiplicity (scaledThing) import GHC.Settings (Platform)-import GHC.Core.TyCon (primRepCompatible)+import GHC.Core.TyCon (primRepCompatible, primRepsCompatible) import GHC.Utils.Panic.Plain (panic)  lintStgTopBindings :: forall a . (OutputablePass a, BinderP a ~ Id)@@ -332,14 +341,18 @@ lintStgAppReps fun args = do   lf <- getLintFlags   let platform = lf_platform lf+       (fun_arg_tys, _res) = splitFunTys (idType fun)-      fun_arg_tys' = map (scaledThing ) fun_arg_tys :: [Type]+      fun_arg_tys' = map scaledThing fun_arg_tys :: [Type]++      -- Might be "wrongly" typed as polymorphic. See #21399+      -- In these cases typePrimRep_maybe will return Nothing+      -- and we abort kind checking.       fun_arg_tys_reps, actual_arg_reps :: [Maybe [PrimRep]]       fun_arg_tys_reps = map typePrimRep_maybe fun_arg_tys'       actual_arg_reps = map (typePrimRep_maybe . stgArgType) args        match_args :: [Maybe [PrimRep]] -> [Maybe [PrimRep]] -> LintM ()-      -- Might be wrongly typed as polymorphic. See #21399       match_args (Nothing:_) _   = return ()       match_args (_) (Nothing:_) = return ()       match_args (Just actual_rep:actual_reps_left) (Just expected_rep:expected_reps_left)@@ -353,21 +366,36 @@          -- Some reps are compatible *even* if they are not the same. E.g. IntRep and WordRep.         -- We check for that here with primRepCompatible-        | and $ zipWith (primRepCompatible platform) actual_rep expected_rep+        | primRepsCompatible platform actual_rep expected_rep         = match_args actual_reps_left expected_reps_left -        | otherwise = addErrL $ hang (text "Function type reps and function argument reps missmatched") 2 $+        -- We might distribute args from within one unboxed sum over multiple+        -- single rep args. This means we might need to match up things like:+        -- [Just [WordRep, LiftedRep]] with [Just [WordRep],Just [LiftedRep]]+        -- which happens here.+        -- See Note [Linting StgApp].+        | Just (actual,actuals) <- getOneRep actual_rep actual_reps_left+        , Just (expected,expecteds) <- getOneRep expected_rep expected_reps_left+        , primRepCompatible platform actual expected+        = match_args actuals expecteds++        | otherwise = addErrL $ hang (text "Function type reps and function argument reps mismatched") 2 $             (text "In application " <> ppr fun <+> ppr args $$-              text "argument rep:" <> ppr actual_rep $$-              text "expected rep:" <> ppr expected_rep $$+              text "argument rep:" <> ppr actual_arg_reps $$+              text "expected rep:" <> ppr fun_arg_tys_reps $$               -- text "expected reps:" <> ppr arg_ty_reps $$               text "unarised?:" <> ppr (lf_unarised lf))         where           isVoidRep [] = True           isVoidRep [VoidRep] = True           isVoidRep _ = False--          -- n_arg_ty_reps = length arg_ty_reps+          -- Try to strip one non-void arg rep from the current argument type returning+          -- the remaining list of arguments. We return Nothing for invalid input which+          -- will result in a lint failure in match_args.+          getOneRep :: [PrimRep] -> [Maybe [PrimRep]] -> Maybe (PrimRep, [Maybe [PrimRep]])+          getOneRep [] _rest = Nothing -- Void rep args are invalid at this point.+          getOneRep [rep] rest = Just (rep,rest) -- A single arg rep arg+          getOneRep (rep:reps) rest = Just (rep,Just reps:rest) -- Multi rep arg.        match_args _ _ = return () -- Functions are allowed to be over/under applied. 

@@ -186,6 +186,129 @@ layout to use. Note that unlifted values can't be let-bound, so we don't need types in StgRhsCon. +Note [Casting slot arguments]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider this function which selects between Int32# and Int64# from a unboxed sum.++    foo ::  (# Int32# | Int64#  #) -> FD+    foo x = case x of+        (# x1 | #) -> F x1+        (# | x2 #) -> D x2++Naturally we would expect x1 to have a PrimRep of Int32Rep and x2 of DoubleRep.+However we used to generate this (bogus) code after Unarise giving rise to #22208:++    M.foo :: (# GHC.Prim.Int32# | GHC.Prim.Int64# #) -> M.FD+    [GblId, Arity=1, Unf=OtherCon []] =+        {} \r [sum_tag sum_field]+            case sum_tag of tag_gsc {+              __DEFAULT -> M.F [sum_field];+              2# -> M.D [sum_field];+            };++Where sum_field is used both as Int32# and Int64# depending on the branch+because they share the same SlotTy.+This usually works out since we put all int's in the same sort of register.+So even if the reps where wrong (x :: bits32) = (y :: bits64) would produce+correct code in the most cases.+However there are cases where this goes wrong, causing lint errors,in the case of #22208+compiler panics or in some cases incorrect results in the C backend.+For now our solution is to construct proper casts between the PrimRep of the slot and+the variables we want to store in, or read out of these slots.++This means when we have a sum (# Int32# | Int64# #) if we want to store a Int32+we convert it to a Int64 on construction of the tuple value, and convert it back+to a Int32 once when want to use the field. On most backends these coversions should+be no-ops at runtime so this seems reasonable.++Conversion for values coming out of a strict field happen in mapSumIdBinders. While+conversion during the construction of sums happen inside mkUbxSum.++------------- A full example of casting during sum construction ----------------++To compile a constructor application of a unboxed sum of type (# Int32# | Int64# )+in an expression like  `let sum = (# x | #)` we will call mkUbxSum to determine+which binders we have to replace sum with at use sites during unarise.+See also Note [Translating unboxed sums to unboxed tuples].++Int32# and Int64# in this case will share the same slot in the unboxed sum. This means+the sum after unarise will be represented by two binders. One for the tag and one for+the field. The later having Int64Rep.+However our input for the field is of Int32Rep. So in order to soundly construct+`(# x | #) :: (# Int32# | Int64# )` we must upcast `x` to Int64#.+To do this mkUbxSum will produce an expression with a hole for constructor application+to go into. That is the call to mkUbxSum and it's result will look something like:++  >>> mkUbxSum (#|#) [Int32#, Int64#] (x::Int32#) us (x')+  ([1#::Int#, x'::Int64#], \rhs -> case int32ToInt# x of x' -> rhs )++We will use the returned arguments to construct an application to an unboxed tuple:++  >>> mkTuple [tag::Int#, x'::Int64#]+  (# tag, x' #)++Which we will then use as the rhs to pass into the casting wrapper to+construct an expression that casts `x` to the right type before constructing the+tuple++  >>> (\rhs -> case int32ToInt# x of x' -> rhs ) (# tag, x' #)+  case int32ToInt# x of x' -> (# #) 1# x'++Which results in the this definition for `sum` after all is said and done:++  let sum = case int32ToInt# x of { x' -> (# #) 1# x' }++Not that the renaming is not optional. Cmm requires binders of different uniques+to have at least different types. See Note [CorePrep Overview]: 6. Clone all local Ids++------------- A full example of casting during sum matching --------------------++When matching on an unboxed sum constructor we start out with+something like this the pre-unarise:++    f :: (# Int32 | Int64# ) -> ...+    f sum = case sum of+        (# x |#) -> alt_rhs+        ...++We unarise the function arguments and get:++    f sum_tag sum_slot1 = case sum_tag of+        1# -> ???++Now we need to match up the original alternative binders with the sum slots passed+to the function. This is done by mapSumIdBinders which we we call for our+example alternative like this:++    >>> mapSumIdBinders [x] [sum_slot1] alt_rhs env+    (env', alt_rhs')++mapSumIdBinders first matches up the list of binders with the slots passed to+the function which is trivial in this case. Then we check if the slot and the+variable residing inside it agree on their Rep. If alternative binders and+the function arguments agree in their slot reps we we just extend the environment+with a mapping from `x` to `sum_slot1` and we return the rhs as is.++If the reps of the sum_slots do not agree with alternative binders they represent+then we need to wrap the whole RHS in nested cases which cast the sum_slot<n>+variables to the correct rep. Here `x` is of Int32Rep while `sum_slot1` will be+of Int64Rep. This means instead of retuning the original alt_rhs we will return:++  >>> mapSumIdBinders [x] [sum_slot1] alt_rhs env+  ( env'[x=x']+  , case int64ToInt32# (sum_slot1 :: Int64#) of+      (x' :: Int32#) -> alt_rhs+  )++We then run unarise on alt_rhs within that expression, which will replace the first occurence+of `x` with sum_slot_arg_1 giving us post-unarise:++    f sum_tag sum_slot1 =+      case sum_tag of+        1# -> case int64ToInt32# sum_slot1 of+          x' -> ... x' ...+        ...+ Note [UnariseEnv] ~~~~~~~~~~~~~~~~~~ At any variable occurrence 'v',@@ -258,8 +381,8 @@ import GHC.Types.Basic import GHC.Core import GHC.Core.DataCon-import GHC.Core.TyCon ( isVoidRep )-import GHC.Data.FastString (FastString, mkFastString)+import GHC.Core.TyCon+import GHC.Data.FastString (FastString, mkFastString, fsLit) import GHC.Types.Id import GHC.Types.Literal import GHC.Core.Make (aBSENT_SUM_FIELD_ERROR_ID)@@ -268,20 +391,25 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain-import GHC.Types.RepType import GHC.Stg.Syntax import GHC.Stg.Utils import GHC.Core.Type import GHC.Builtin.Types.Prim (intPrimTy) import GHC.Builtin.Types import GHC.Types.Unique.Supply+import GHC.Types.Unique import GHC.Utils.Misc import GHC.Types.Var.Env+import GHC.Types.RepType  import Data.Bifunctor (second) import Data.Maybe (mapMaybe) import qualified Data.IntMap as IM+import GHC.Builtin.PrimOps+import GHC.Builtin.PrimOps.Casts+import Data.List (mapAccumL) +-- import GHC.Utils.Trace --------------------------------------------------------------------------------  -- | A mapping from binders to the Ids they were expanded/renamed to.@@ -306,8 +434,10 @@ -- INVARIANT: OutStgArgs in the range only have NvUnaryTypes --            (i.e. no unboxed tuples, sums or voids) ---type UnariseEnv = VarEnv UnariseVal+newtype UnariseEnv = UnariseEnv  { ue_rho :: (VarEnv UnariseVal) } +initUnariseEnv :: VarEnv UnariseVal -> UnariseEnv+initUnariseEnv = UnariseEnv data UnariseVal   = MultiVal [OutStgArg] -- MultiVal to tuple. Can be empty list (void).   | UnaryVal OutStgArg   -- See NOTE [Renaming during unarisation].@@ -320,25 +450,27 @@ -- The id is mapped to one or more things. -- See Note [UnariseEnv] extendRho :: UnariseEnv -> Id -> UnariseVal -> UnariseEnv-extendRho rho x (MultiVal args)+extendRho env x (MultiVal args)   = assert (all (isNvUnaryType . stgArgType) args)-    extendVarEnv rho x (MultiVal args)-extendRho rho x (UnaryVal val)+    env { ue_rho = extendVarEnv (ue_rho env) x (MultiVal args) }+extendRho env x (UnaryVal val)   = assert (isNvUnaryType (stgArgType val))-    extendVarEnv rho x (UnaryVal val)+    env { ue_rho = extendVarEnv (ue_rho env) x (UnaryVal val) } -- Properly shadow things from an outer scope. -- See Note [UnariseEnv]  -- The id stands for itself so we don't record a mapping. -- See Note [UnariseEnv] extendRhoWithoutValue :: UnariseEnv -> Id -> UnariseEnv-extendRhoWithoutValue rho x = delVarEnv rho x+extendRhoWithoutValue env x = env { ue_rho = delVarEnv (ue_rho env) x } +lookupRho :: UnariseEnv -> Id -> Maybe UnariseVal+lookupRho env v = lookupVarEnv (ue_rho env) v  --------------------------------------------------------------------------------  unarise :: UniqSupply -> [StgTopBinding] -> [StgTopBinding]-unarise us binds = initUs_ us (mapM (unariseTopBinding emptyVarEnv) binds)+unarise us binds = initUs_ us (mapM (unariseTopBinding (initUnariseEnv emptyVarEnv)) binds)  unariseTopBinding :: UnariseEnv -> StgTopBinding -> UniqSM StgTopBinding unariseTopBinding rho (StgTopLifted bind)@@ -366,7 +498,7 @@ unariseExpr :: UnariseEnv -> StgExpr -> UniqSM StgExpr  unariseExpr rho e@(StgApp f [])-  = case lookupVarEnv rho f of+  = case lookupRho rho f of       Just (MultiVal args)  -- Including empty tuples         -> return (mkTuple args)       Just (UnaryVal (StgVarArg f'))@@ -379,7 +511,7 @@ unariseExpr rho e@(StgApp f args)   = return (StgApp f' (unariseFunArgs rho args))   where-    f' = case lookupVarEnv rho f of+    f' = case lookupRho rho f of            Just (UnaryVal (StgVarArg f')) -> f'            Nothing -> f            err -> pprPanic "unariseExpr - app2" (pprStgExpr panicStgPprOpts e $$ ppr err)@@ -390,12 +522,17 @@   = return (StgLit l)  unariseExpr rho (StgConApp dc n args ty_args)-  | Just args' <- unariseMulti_maybe rho dc args ty_args-  = return (mkTuple args')--  | otherwise-  , let args' = unariseConArgs rho args-  = return (StgConApp dc n args' (map stgArgType args'))+  | isUnboxedSumDataCon dc || isUnboxedTupleDataCon dc+  = do+      us <- getUniqueSupplyM+      case unariseUbxSumOrTupleArgs rho us dc args ty_args of+        (args', Just cast_wrapper)+          -> return $ cast_wrapper (mkTuple args')+        (args', Nothing)+          -> return $ (mkTuple args')+  | otherwise =+      let args' = unariseConArgs rho args in+      return $ (StgConApp dc n args' (map stgArgType args'))  unariseExpr rho (StgOpApp op args ty)   = return (StgOpApp op (unariseFunArgs rho args) ty)@@ -403,15 +540,19 @@ unariseExpr rho (StgCase scrut bndr alt_ty alts)   -- tuple/sum binders in the scrutinee can always be eliminated   | StgApp v [] <- scrut-  , Just (MultiVal xs) <- lookupVarEnv rho v+  , Just (MultiVal xs) <- lookupRho rho v   = elimCase rho xs bndr alt_ty alts    -- Handle strict lets for tuples and sums:   --   case (# a,b #) of r -> rhs   -- and analogously for sums   | StgConApp dc _n args ty_args <- scrut-  , Just args' <- unariseMulti_maybe rho dc args ty_args-  = elimCase rho args' bndr alt_ty alts+  , isUnboxedSumDataCon dc || isUnboxedTupleDataCon dc+  = do+    us <- getUniqueSupplyM+    case unariseUbxSumOrTupleArgs rho us dc args ty_args of+      (args',Just wrapper) -> wrapper <$> elimCase rho args' bndr alt_ty alts+      (args',Nothing) -> elimCase rho args' bndr alt_ty alts    -- See (3) of Note [Rubbish literals] in GHC.Types.Literal   | StgLit lit <- scrut@@ -436,17 +577,21 @@   = StgTick tick <$> unariseExpr rho e  -- Doesn't return void args.-unariseMulti_maybe :: UnariseEnv -> DataCon -> [InStgArg] -> [Type] -> Maybe [OutStgArg]-unariseMulti_maybe rho dc args ty_args+unariseUbxSumOrTupleArgs :: UnariseEnv -> UniqSupply -> DataCon -> [InStgArg] -> [Type]+                   -> ( [OutStgArg]           -- Arguments representing the unboxed sum+                      , Maybe (StgExpr -> StgExpr)) -- Transformation to apply to the arguments, to bring them+                                                    -- into the right Rep+unariseUbxSumOrTupleArgs rho us dc args ty_args   | isUnboxedTupleDataCon dc-  = Just (unariseConArgs rho args)+  = (unariseConArgs rho args, Nothing)    | isUnboxedSumDataCon dc   , let args1 = assert (isSingleton args) (unariseConArgs rho args)-  = Just (mkUbxSum dc ty_args args1)+  = let (args2, cast_wrapper) = mkUbxSum dc ty_args args1 us+    in (args2, Just cast_wrapper)    | otherwise-  = Nothing+  = panic "unariseUbxSumOrTupleArgs: Constructor not a unboxed sum or tuple"  -- Doesn't return void args. unariseRubbish_maybe :: Literal -> Maybe [OutStgArg]@@ -473,15 +618,19 @@                                                  , alt_bndrs = bndrs                                                  , alt_rhs   = rhs}]   = do let rho1 = extendRho rho bndr (MultiVal args)-           rho2+       (rho2, rhs') <- case () of+           _              | isUnboxedTupleBndr bndr-             = mapTupleIdBinders bndrs args rho1+             -> return (mapTupleIdBinders bndrs args rho1, rhs)              | otherwise-             = assert (isUnboxedSumBndr bndr) $-               if null bndrs then rho1-                             else mapSumIdBinders bndrs args rho1+             -> assert (isUnboxedSumBndr bndr) $+               case bndrs of+                -- Sum with a void-type binder?+                [] -> return (rho1, rhs)+                [alt_bndr] -> mapSumIdBinders alt_bndr args rhs rho1+                _ -> pprPanic "mapSumIdBinders" (ppr bndrs $$ ppr args) -       unariseExpr rho2 rhs+       unariseExpr rho2 rhs'  elimCase rho args bndr (MultiValAlt _) alts   | isUnboxedSumBndr bndr@@ -572,18 +721,23 @@ unariseSumAlt rho _ GenStgAlt{alt_con=DEFAULT,alt_bndrs=_,alt_rhs=e}   = GenStgAlt DEFAULT mempty <$> unariseExpr rho e -unariseSumAlt rho args GenStgAlt{ alt_con   = DataAlt sumCon+unariseSumAlt rho args alt@GenStgAlt{ alt_con   = DataAlt sumCon                                 , alt_bndrs = bs                                 , alt_rhs   = e                                 }-  = do let rho'     = mapSumIdBinders bs args rho-           lit_case = LitAlt (LitNumber LitNumInt (fromIntegral (dataConTag sumCon)))-       GenStgAlt lit_case mempty <$> unariseExpr rho' e +  = do (rho',e') <- case bs of+              [b] -> mapSumIdBinders b args e rho+              -- Sums must have one binder+              _ -> pprPanic "unariseSumAlt2" (ppr args $$ pprPanicAlt alt)+       let lit_case   = LitAlt (LitNumber LitNumInt (fromIntegral (dataConTag sumCon)))+       GenStgAlt lit_case mempty <$> unariseExpr rho' e'+ unariseSumAlt _ scrt alt-  = pprPanic "unariseSumAlt" (ppr scrt $$ pprPanicAlt alt)+  = pprPanic "unariseSumAlt3" (ppr scrt $$ pprPanicAlt alt)  --------------------------------------------------------------------------------+-- Mapping binders when matching und a unboxed sum/tuple  mapTupleIdBinders   :: [InId]       -- Un-processed binders of a tuple alternative.@@ -619,28 +773,91 @@       map_ids rho0 ids_unarised args0  mapSumIdBinders-  :: [InId]      -- Binder of a sum alternative (remember that sum patterns-                 -- only have one binder, so this list should be a singleton)+  :: InId        -- Binder (in the case alternative).   -> [OutStgArg] -- Arguments that form the sum (NOT including the tag).                  -- Can't have void args.-  -> UnariseEnv+  -> InStgExpr   -> UnariseEnv+  -> UniqSM (UnariseEnv, OutStgExpr) -mapSumIdBinders [id] args rho0-  = assert (not (any (isZeroBitTy . stgArgType) args)) $+mapSumIdBinders alt_bndr args rhs rho0+  = assert (not (any (isZeroBitTy . stgArgType) args)) $ do+    uss <- listSplitUniqSupply <$> getUniqueSupplyM     let+      fld_reps = typePrimRep (idType alt_bndr)++      -- Slots representing the whole sum       arg_slots = map primRepSlot $ concatMap (typePrimRep . stgArgType) args-      id_slots  = map primRepSlot $ typePrimRep (idType id)+      -- The slots representing the field of the sum we bind.+      id_slots  = map primRepSlot $ fld_reps       layout1   = layoutUbxSum arg_slots id_slots-    in-      if isMultiValBndr id-        then extendRho rho0 id (MultiVal [ args !! i | i <- layout1 ])-        else assert (layout1 `lengthIs` 1)-             extendRho rho0 id (UnaryVal (args !! head layout1)) -mapSumIdBinders ids sum_args _-  = pprPanic "mapSumIdBinders" (ppr ids $$ ppr sum_args)+      -- See Note [Casting slot arguments]+      -- Most of the code here is just to make sure our binders are of the+      -- right type.+      -- Select only the args which contain parts of the current field.+      id_arg_exprs   = [ args !! i | i <- layout1 ]+      id_vars   = [v | StgVarArg v <- id_arg_exprs]+      -- Output types for the field binders based on their rep+      id_tys    = map primRepToType fld_reps +      typed_id_arg_input = assert (equalLength id_vars id_tys) $+                           zip3 id_vars id_tys uss++      mkCastInput :: (Id,Type,UniqSupply) -> ([(PrimOp,Type,Unique)],Id,Id)+      mkCastInput (id,tar_type,bndr_us) =+        let (ops,types) = unzip $ getCasts (typePrimRep1 $ idType id) (typePrimRep1 tar_type)+            cst_opts = zip3 ops types $ uniqsFromSupply bndr_us+            out_id = case cst_opts of+              [] -> id+              _ ->  let (_,ty,uq) = last cst_opts+                    in mkCastVar uq ty+        in (cst_opts,id,out_id)++      cast_inputs = map mkCastInput typed_id_arg_input+      (rhs_with_casts,typed_ids) = mapAccumL cast_arg (\x->x) cast_inputs+        where+          cast_arg rhs_in (cast_ops,in_id,out_id) =+            let rhs_out = castArgRename cast_ops (StgVarArg in_id)+            in (rhs_in . rhs_out, out_id)++      typed_id_args = map StgVarArg typed_ids++      -- pprTrace "mapSumIdBinders"+      --           (text "id_tys" <+> ppr id_tys $$+      --           text "id_args" <+> ppr id_arg_exprs $$+      --           text "rhs" <+> ppr rhs $$+      --           text "rhs_with_casts" <+> ppr rhs_with_casts+      --           ) $+    if isMultiValBndr alt_bndr+      then return (extendRho rho0 alt_bndr (MultiVal typed_id_args), rhs_with_casts rhs)+      else assert (typed_id_args `lengthIs` 1) $+            return (extendRho rho0 alt_bndr (UnaryVal (head typed_id_args)), rhs_with_casts rhs)++-- Convert the argument to the given type, and wrap the conversion+-- around the given expression. Use the given Id as a name for the+-- converted value.+castArgRename :: [(PrimOp,Type,Unique)] -> StgArg -> StgExpr -> StgExpr+castArgRename ops in_arg rhs =+  case ops of+    [] -> rhs+    ((op,ty,uq):rest_ops) ->+      let out_id' = mkCastVar uq ty -- out_name `setIdUnique` uq `setIdType` ty+          sub_cast = castArgRename rest_ops (StgVarArg out_id')+      in mkCast in_arg op out_id' ty $ sub_cast rhs++-- Construct a case binder used when casting sums, of a given type and unique.+mkCastVar :: Unique -> Type -> Id+mkCastVar uq ty = mkSysLocal (fsLit "cst_sum") uq Many ty++mkCast :: StgArg -> PrimOp -> OutId -> Type -> StgExpr -> StgExpr+mkCast arg_in cast_op out_id out_ty in_rhs =+  let r2 = typePrimRep1 out_ty+      scrut = StgOpApp (StgPrimOp cast_op) [arg_in] out_ty+      alt = GenStgAlt { alt_con = DEFAULT, alt_bndrs = [], alt_rhs = in_rhs}+      alt_ty = PrimAlt r2+  in (StgCase scrut out_id alt_ty [alt])+ -- | Build a unboxed sum term from arguments of an alternative. -- -- Example, for (# x | #) :: (# (# #) | Int #) we call@@ -652,31 +869,72 @@ --   [ 1#, rubbish ] -- mkUbxSum-  :: DataCon      -- Sum data con+  :: HasDebugCallStack+  => DataCon      -- Sum data con   -> [Type]       -- Type arguments of the sum data con   -> [OutStgArg]  -- Actual arguments of the alternative.-  -> [OutStgArg]  -- Final tuple arguments-mkUbxSum dc ty_args args0+  -> UniqSupply+  -> ([OutStgArg] -- Final tuple arguments+     ,(StgExpr->StgExpr) -- We might need to cast the args first+     )+mkUbxSum dc ty_args args0 us   = let       (_ : sum_slots) = ubxSumRepType (map typePrimRep ty_args)-        -- drop tag slot-+      -- drop tag slot+      field_slots = (mapMaybe (typeSlotTy . stgArgType) args0)       tag = dataConTag dc+      layout'  = layoutUbxSum sum_slots field_slots -      layout'  = layoutUbxSum sum_slots (mapMaybe (typeSlotTy . stgArgType) args0)       tag_arg  = StgLitArg (LitNumber LitNumInt (fromIntegral tag))       arg_idxs = IM.fromList (zipEqual "mkUbxSum" layout' args0) -      mkTupArgs :: Int -> [SlotTy] -> IM.IntMap StgArg -> [StgArg]-      mkTupArgs _ [] _-        = []-      mkTupArgs arg_idx (slot : slots_left) arg_map-        | Just stg_arg <- IM.lookup arg_idx arg_map-        = stg_arg : mkTupArgs (arg_idx + 1) slots_left arg_map-        | otherwise-        = ubxSumRubbishArg slot : mkTupArgs (arg_idx + 1) slots_left arg_map+      ((_idx,_idx_map,_us,wrapper),slot_args)+        = assert (length arg_idxs <= length sum_slots ) $+          mapAccumL mkTupArg (0,arg_idxs,us,id) sum_slots++      mkTupArg  :: (Int, IM.IntMap StgArg,UniqSupply,StgExpr->StgExpr)+                -> SlotTy+                -> ((Int,IM.IntMap StgArg,UniqSupply,StgExpr->StgExpr), StgArg)+      mkTupArg (arg_idx, arg_map, us, wrapper) slot+         | Just stg_arg <- IM.lookup arg_idx arg_map+         =  case castArg us slot stg_arg of+              -- Slot and arg type missmatched, do a cast+              Just (casted_arg,us',wrapper') ->+                ( (arg_idx+1, arg_map, us', wrapper . wrapper')+                , casted_arg)+              -- Use the arg as-is+              Nothing ->+                ( (arg_idx+1, arg_map, us, wrapper)+                , stg_arg)+         -- Garbage slot, fill with rubbish+         | otherwise+         =  ( (arg_idx+1, arg_map, us, wrapper)+            , ubxSumRubbishArg slot)++      castArg :: UniqSupply -> SlotTy -> StgArg -> Maybe (StgArg,UniqSupply,StgExpr -> StgExpr)+      castArg us slot_ty arg+        -- Cast the argument to the type of the slot if required+        | slotPrimRep slot_ty /= typePrimRep1 (stgArgType arg)+        , out_ty <- primRepToType $ slotPrimRep slot_ty+        , (ops,types) <- unzip $ getCasts (typePrimRep1 $ stgArgType arg) $ typePrimRep1 out_ty+        , not . null $ ops+        = let (us1,us2) = splitUniqSupply us+              cast_uqs = uniqsFromSupply us1+              cast_opts = zip3 ops types cast_uqs+              (_op,out_ty,out_uq) = last cast_opts+              casts = castArgRename cast_opts arg :: StgExpr -> StgExpr+          in Just (StgVarArg (mkCastVar out_uq out_ty),us2,casts)+        -- No need for casting+        | otherwise = Nothing++      tup_args = tag_arg : slot_args     in-      tag_arg : mkTupArgs 0 sum_slots arg_idxs+      -- pprTrace "mkUbxSum" (+      --   text "ty_args (slots)" <+> ppr ty_args $$+      --   text "args0" <+> ppr args0 $$+      --   text "wrapper" <+>+      --       (ppr $ wrapper $ StgLit $ LitChar '_'))+      (tup_args, wrapper)   -- | Return a rubbish value for the given slot type.@@ -694,6 +952,8 @@ ubxSumRubbishArg Word64Slot = StgLitArg (LitNumber LitNumWord64 0) ubxSumRubbishArg FloatSlot  = StgLitArg (LitFloat 0) ubxSumRubbishArg DoubleSlot = StgLitArg (LitDouble 0)+ubxSumRubbishArg (VecSlot n e) = StgLitArg (LitRubbish vec_rep)+  where vec_rep = primRepToRuntimeRep (VecRep n e)  -------------------------------------------------------------------------------- @@ -787,7 +1047,7 @@ -- | MultiVal a function argument. Never returns an empty list. unariseFunArg :: UnariseEnv -> StgArg -> [StgArg] unariseFunArg rho (StgVarArg x) =-  case lookupVarEnv rho x of+  case lookupRho rho x of     Just (MultiVal [])  -> [voidArg]   -- NB: do not remove void args     Just (MultiVal as)  -> as     Just (UnaryVal arg) -> [arg]@@ -809,7 +1069,7 @@ -- | MultiVal a DataCon argument. Returns an empty list when argument is void. unariseConArg :: UnariseEnv -> InStgArg -> [OutStgArg] unariseConArg rho (StgVarArg x) =-  case lookupVarEnv rho x of+  case lookupRho rho x of     Just (UnaryVal arg) -> [arg]     Just (MultiVal as) -> as      -- 'as' can be empty     Nothing

@@ -231,8 +231,12 @@ emitAssign :: CmmReg  -> CmmExpr -> CmmParse () emitAssign l r = code (F.emitAssign l r) -emitStore :: CmmExpr  -> CmmExpr -> CmmParse ()-emitStore l r = code (F.emitStore l r)+emitStore :: Maybe MemoryOrdering -> CmmExpr  -> CmmExpr -> CmmParse ()+emitStore (Just mem_ord) l r = do+  platform <- getPlatform+  let w = typeWidth $ cmmExprType platform r+  emit $ mkUnsafeCall (PrimTarget $ MO_AtomicWrite w mem_ord) [] [l,r]+emitStore Nothing l r = code (F.emitStore l r)  getCode :: CmmParse a -> CmmParse CmmAGraph getCode (EC ec) = EC $ \c e s -> do

@@ -283,9 +283,10 @@     emitAssign (CmmLocal res) currentTSOExpr    ReadMutVarOp -> \[mutv] -> opIntoRegs $ \[res] ->-    emitAssign (CmmLocal res) (cmmLoadIndexW platform mutv (fixedHdrSizeW profile) (gcWord platform))+    emitPrimCall [res] (MO_AtomicRead (wordWidth platform) MemOrderAcquire)+        [ cmmOffsetW platform mutv (fixedHdrSizeW profile) ] -  WriteMutVarOp -> \[mutv, var] -> opIntoRegs $ \res@[] -> do+  WriteMutVarOp -> \[mutv, var] -> opIntoRegs $ \[] -> do     old_val <- CmmLocal <$> newTemp (cmmExprType platform var)     emitAssign old_val (cmmLoadIndexW platform mutv (fixedHdrSizeW profile) (gcWord platform)) @@ -294,8 +295,8 @@     -- Note that this also must come after we read the old value to ensure     -- that the read of old_val comes before another core's write to the     -- MutVar's value.-    emitPrimCall res MO_WriteBarrier []-    emitStore (cmmOffsetW platform mutv (fixedHdrSizeW profile)) var+    emitPrimCall [] (MO_AtomicWrite (wordWidth platform) MemOrderRelease)+        [ cmmOffsetW platform mutv (fixedHdrSizeW profile), var ]      platform <- getPlatform     mkdirtyMutVarCCall <- getCode $! emitCCall@@ -853,7 +854,7 @@ -- SIMD primops   (VecBroadcastOp vcat n w) -> \[e] -> opIntoRegs $ \[res] -> do     checkVecCompatibility cfg vcat n w-    doVecPackOp (vecElemInjectCast platform vcat w) ty zeros (replicate n e) res+    doVecPackOp ty zeros (replicate n e) res    where     zeros :: CmmExpr     zeros = CmmLit $ CmmVec (replicate n zero)@@ -871,7 +872,7 @@     checkVecCompatibility cfg vcat n w     when (es `lengthIsNot` n) $         panic "emitPrimOp: VecPackOp has wrong number of arguments"-    doVecPackOp (vecElemInjectCast platform vcat w) ty zeros es res+    doVecPackOp ty zeros es res    where     zeros :: CmmExpr     zeros = CmmLit $ CmmVec (replicate n zero)@@ -889,14 +890,14 @@     checkVecCompatibility cfg vcat n w     when (res `lengthIsNot` n) $         panic "emitPrimOp: VecUnpackOp has wrong number of results"-    doVecUnpackOp (vecElemProjectCast platform vcat w) ty arg res+    doVecUnpackOp ty arg res    where     ty :: CmmType     ty = vecVmmType vcat n w    (VecInsertOp vcat n w) -> \[v,e,i] -> opIntoRegs $ \[res] -> do     checkVecCompatibility cfg vcat n w-    doVecInsertOp (vecElemInjectCast platform vcat w) ty v e i res+    doVecInsertOp ty v e i res    where     ty :: CmmType     ty = vecVmmType vcat n w@@ -2247,32 +2248,8 @@ vecCmmCat WordVec  = cmmBits vecCmmCat FloatVec = cmmFloat -vecElemInjectCast :: Platform -> PrimOpVecCat -> Width -> Maybe MachOp-vecElemInjectCast _        FloatVec _   =  Nothing-vecElemInjectCast platform   IntVec   W8  =  Just (mo_WordTo8  platform)-vecElemInjectCast platform   IntVec   W16 =  Just (mo_WordTo16 platform)-vecElemInjectCast platform   IntVec   W32 =  Just (mo_WordTo32 platform)-vecElemInjectCast _        IntVec   W64 =  Nothing-vecElemInjectCast platform   WordVec  W8  =  Just (mo_WordTo8  platform)-vecElemInjectCast platform   WordVec  W16 =  Just (mo_WordTo16 platform)-vecElemInjectCast platform   WordVec  W32 =  Just (mo_WordTo32 platform)-vecElemInjectCast _        WordVec  W64 =  Nothing-vecElemInjectCast _        _        _   =  Nothing--vecElemProjectCast :: Platform -> PrimOpVecCat -> Width -> Maybe MachOp-vecElemProjectCast _        FloatVec _   =  Nothing-vecElemProjectCast platform   IntVec   W8  =  Just (mo_s_8ToWord  platform)-vecElemProjectCast platform   IntVec   W16 =  Just (mo_s_16ToWord platform)-vecElemProjectCast platform   IntVec   W32 =  Just (mo_s_32ToWord platform)-vecElemProjectCast _        IntVec   W64 =  Nothing-vecElemProjectCast platform   WordVec  W8  =  Just (mo_u_8ToWord  platform)-vecElemProjectCast platform   WordVec  W16 =  Just (mo_u_16ToWord platform)-vecElemProjectCast platform   WordVec  W32 =  Just (mo_u_32ToWord platform)-vecElemProjectCast _        WordVec  W64 =  Nothing-vecElemProjectCast _        _        _   =  Nothing----- NOTE [SIMD Design for the future]+-- Note [SIMD Design for the future]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Check to make sure that we can generate code for the specified vector type -- given the current set of dynamic flags. -- Currently these checks are specific to x86 and x86_64 architecture.@@ -2333,13 +2310,12 @@ ------------------------------------------------------------------------------ -- Helpers for translating vector packing and unpacking. -doVecPackOp :: Maybe MachOp  -- Cast from element to vector component-            -> CmmType       -- Type of vector+doVecPackOp :: CmmType       -- Type of vector             -> CmmExpr       -- Initial vector             -> [CmmExpr]     -- Elements             -> CmmFormal     -- Destination for result             -> FCode ()-doVecPackOp maybe_pre_write_cast ty z es res = do+doVecPackOp ty z es res = do     dst <- newTemp ty     emitAssign (CmmLocal dst) z     vecPack dst es 0@@ -2352,31 +2328,25 @@         dst <- newTemp ty         if isFloatType (vecElemType ty)           then emitAssign (CmmLocal dst) (CmmMachOp (MO_VF_Insert len wid)-                                                    [CmmReg (CmmLocal src), cast e, iLit])+                                                    [CmmReg (CmmLocal src), e, iLit])           else emitAssign (CmmLocal dst) (CmmMachOp (MO_V_Insert len wid)-                                                    [CmmReg (CmmLocal src), cast e, iLit])+                                                    [CmmReg (CmmLocal src), e, iLit])         vecPack dst es (i + 1)       where         -- vector indices are always 32-bits         iLit = CmmLit (CmmInt (toInteger i) W32) -    cast :: CmmExpr -> CmmExpr-    cast val = case maybe_pre_write_cast of-                 Nothing   -> val-                 Just cast -> CmmMachOp cast [val]-     len :: Length     len = vecLength ty      wid :: Width     wid = typeWidth (vecElemType ty) -doVecUnpackOp :: Maybe MachOp  -- Cast from vector component to element result-              -> CmmType       -- Type of vector+doVecUnpackOp :: CmmType       -- Type of vector               -> CmmExpr       -- Vector               -> [CmmFormal]   -- Element results               -> FCode ()-doVecUnpackOp maybe_post_read_cast ty e res =+doVecUnpackOp ty e res =     vecUnpack res 0   where     vecUnpack :: [CmmFormal] -> Int -> FCode ()@@ -2385,46 +2355,36 @@      vecUnpack (r : rs) i = do         if isFloatType (vecElemType ty)-          then emitAssign (CmmLocal r) (cast (CmmMachOp (MO_VF_Extract len wid)-                                             [e, iLit]))-          else emitAssign (CmmLocal r) (cast (CmmMachOp (MO_V_Extract len wid)-                                             [e, iLit]))+          then emitAssign (CmmLocal r) (CmmMachOp (MO_VF_Extract len wid)+                                             [e, iLit])+          else emitAssign (CmmLocal r) (CmmMachOp (MO_V_Extract len wid)+                                             [e, iLit])         vecUnpack rs (i + 1)       where         -- vector indices are always 32-bits         iLit = CmmLit (CmmInt (toInteger i) W32) -    cast :: CmmExpr -> CmmExpr-    cast val = case maybe_post_read_cast of-                 Nothing   -> val-                 Just cast -> CmmMachOp cast [val]-     len :: Length     len = vecLength ty      wid :: Width     wid = typeWidth (vecElemType ty) -doVecInsertOp :: Maybe MachOp  -- Cast from element to vector component-              -> CmmType       -- Vector type+doVecInsertOp :: CmmType       -- Vector type               -> CmmExpr       -- Source vector               -> CmmExpr       -- Element               -> CmmExpr       -- Index at which to insert element               -> CmmFormal     -- Destination for result               -> FCode ()-doVecInsertOp maybe_pre_write_cast ty src e idx res = do+doVecInsertOp ty src e idx res = do     platform <- getPlatform     -- vector indices are always 32-bits     let idx' :: CmmExpr         idx' = CmmMachOp (MO_SS_Conv (wordWidth platform) W32) [idx]     if isFloatType (vecElemType ty)-      then emitAssign (CmmLocal res) (CmmMachOp (MO_VF_Insert len wid) [src, cast e, idx'])-      else emitAssign (CmmLocal res) (CmmMachOp (MO_V_Insert len wid) [src, cast e, idx'])+      then emitAssign (CmmLocal res) (CmmMachOp (MO_VF_Insert len wid) [src, e, idx'])+      else emitAssign (CmmLocal res) (CmmMachOp (MO_V_Insert len wid) [src, e, idx'])   where-    cast :: CmmExpr -> CmmExpr-    cast val = case maybe_pre_write_cast of-                 Nothing   -> val-                 Just cast -> CmmMachOp cast [val]      len :: Length     len = vecLength ty@@ -3081,7 +3041,7 @@ doAtomicReadAddr res addr ty =     emitPrimCall         [ res ]-        (MO_AtomicRead (typeWidth ty))+        (MO_AtomicRead (typeWidth ty) MemOrderSeqCst)         [ addr ]  -- | Emit an atomic write to a byte array that acts as a memory barrier.@@ -3109,7 +3069,7 @@ doAtomicWriteAddr addr ty val =     emitPrimCall         [ {- no results -} ]-        (MO_AtomicWrite (typeWidth ty))+        (MO_AtomicWrite (typeWidth ty) MemOrderSeqCst)         [ addr, val ]  doCasByteArray

@@ -170,11 +170,7 @@     getResponseFile args = do       fp <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "rsp"       withFile fp WriteMode $ \h -> do-#if defined(mingw32_HOST_OS)-          hSetEncoding h latin1-#else           hSetEncoding h utf8-#endif           hPutStr h $ unlines $ map escape args       return fp 

@@ -172,7 +172,7 @@        } } }   where     needs_typeable_binds tc-      | tc `elem` [runtimeRepTyCon, levityTyCon, vecCountTyCon, vecElemTyCon]+      | tc `elem` ghcTypesTypeableTyCons       = False       | otherwise =           isAlgTyCon tc@@ -333,7 +333,14 @@                      -- Build TypeRepTodos for types in GHC.Prim                    ; todo2 <- todoForTyCons gHC_PRIM ghc_prim_module_id                                             ghcPrimTypeableTyCons-                   ; return ( gbl_env' , [todo1, todo2])+                   ; tcg_env <- getGblEnv+                   ; let mod_id = case tcg_tr_module tcg_env of  -- Should be set by now+                                   Just mod_id -> mod_id+                                   Nothing     -> pprPanic "tcMkTypeableBinds" empty++                   ; todo3 <- todoForTyCons gHC_TYPES mod_id ghcTypesTypeableTyCons++                   ; return ( gbl_env' , [todo1, todo2, todo3])                    }            else do gbl_env <- getGblEnv                    return (gbl_env, [])@@ -348,11 +355,17 @@ -- Note [Built-in syntax and the OrigNameCache] in "GHC.Iface.Env" for more. ghcPrimTypeableTyCons :: [TyCon] ghcPrimTypeableTyCons = concat-    [ [ runtimeRepTyCon, levityTyCon, vecCountTyCon, vecElemTyCon ]-    , map (tupleTyCon Unboxed) [0..mAX_TUPLE_SIZE]+    [ map (tupleTyCon Unboxed) [0..mAX_TUPLE_SIZE]     , map sumTyCon [2..mAX_SUM_SIZE]     , primTyCons     ]++-- | These are types which are defined in GHC.Types but are needed in order to+-- typecheck the other generated bindings, therefore to avoid ordering issues we+-- generate them up-front along with the bindings from GHC.Prim.+ghcTypesTypeableTyCons :: [TyCon]+ghcTypesTypeableTyCons = [ runtimeRepTyCon, levityTyCon+                         , vecCountTyCon, vecElemTyCon ]  data TypeableStuff     = Stuff { platform       :: Platform        -- ^ Target platform

@@ -136,13 +136,13 @@ -- that package is searched for the module.  findImportedModule :: HscEnv -> ModuleName -> PkgQual -> IO FindResult-findImportedModule hsc_env mod fs =+findImportedModule hsc_env mod pkg_qual =   let fc        = hsc_FC hsc_env       mhome_unit = hsc_home_unit_maybe hsc_env       dflags    = hsc_dflags hsc_env       fopts     = initFinderOpts dflags   in do-    findImportedModuleNoHsc fc fopts (hsc_unit_env hsc_env) mhome_unit mod fs+    findImportedModuleNoHsc fc fopts (hsc_unit_env hsc_env) mhome_unit mod pkg_qual  findImportedModuleNoHsc   :: FinderCache

@@ -1,7 +1,7 @@ cabal-version: 2.0 build-type: Simple name: ghc-lib-version: 9.4.3.20221104+version: 9.4.4.20221225 license: BSD3 license-file: LICENSE category: Development@@ -83,7 +83,7 @@         stm,         rts,         hpc == 0.6.*,-        ghc-lib-parser == 9.4.3.20221104+        ghc-lib-parser == 9.4.4.20221225     build-tool-depends: alex:alex >= 3.1, happy:happy >= 1.19.4     other-extensions:         BangPatterns@@ -477,6 +477,7 @@         Paths_ghc_lib         GHC         GHC.Builtin.Names.TH+        GHC.Builtin.PrimOps.Casts         GHC.Builtin.Types.Literals         GHC.Builtin.Utils         GHC.ByteCode.Asm

@@ -656,16 +656,16 @@ primOpInfo (VecBroadcastOp IntVec 32 W16) = mkGenPrimOp (fsLit "broadcastInt16X32#")  [] [int16PrimTy] (int16X32PrimTy) primOpInfo (VecBroadcastOp IntVec 16 W32) = mkGenPrimOp (fsLit "broadcastInt32X16#")  [] [int32PrimTy] (int32X16PrimTy) primOpInfo (VecBroadcastOp IntVec 8 W64) = mkGenPrimOp (fsLit "broadcastInt64X8#")  [] [int64PrimTy] (int64X8PrimTy)-primOpInfo (VecBroadcastOp WordVec 16 W8) = mkGenPrimOp (fsLit "broadcastWord8X16#")  [] [wordPrimTy] (word8X16PrimTy)-primOpInfo (VecBroadcastOp WordVec 8 W16) = mkGenPrimOp (fsLit "broadcastWord16X8#")  [] [wordPrimTy] (word16X8PrimTy)+primOpInfo (VecBroadcastOp WordVec 16 W8) = mkGenPrimOp (fsLit "broadcastWord8X16#")  [] [word8PrimTy] (word8X16PrimTy)+primOpInfo (VecBroadcastOp WordVec 8 W16) = mkGenPrimOp (fsLit "broadcastWord16X8#")  [] [word16PrimTy] (word16X8PrimTy) primOpInfo (VecBroadcastOp WordVec 4 W32) = mkGenPrimOp (fsLit "broadcastWord32X4#")  [] [word32PrimTy] (word32X4PrimTy) primOpInfo (VecBroadcastOp WordVec 2 W64) = mkGenPrimOp (fsLit "broadcastWord64X2#")  [] [word64PrimTy] (word64X2PrimTy)-primOpInfo (VecBroadcastOp WordVec 32 W8) = mkGenPrimOp (fsLit "broadcastWord8X32#")  [] [wordPrimTy] (word8X32PrimTy)-primOpInfo (VecBroadcastOp WordVec 16 W16) = mkGenPrimOp (fsLit "broadcastWord16X16#")  [] [wordPrimTy] (word16X16PrimTy)+primOpInfo (VecBroadcastOp WordVec 32 W8) = mkGenPrimOp (fsLit "broadcastWord8X32#")  [] [word8PrimTy] (word8X32PrimTy)+primOpInfo (VecBroadcastOp WordVec 16 W16) = mkGenPrimOp (fsLit "broadcastWord16X16#")  [] [word16PrimTy] (word16X16PrimTy) primOpInfo (VecBroadcastOp WordVec 8 W32) = mkGenPrimOp (fsLit "broadcastWord32X8#")  [] [word32PrimTy] (word32X8PrimTy) primOpInfo (VecBroadcastOp WordVec 4 W64) = mkGenPrimOp (fsLit "broadcastWord64X4#")  [] [word64PrimTy] (word64X4PrimTy)-primOpInfo (VecBroadcastOp WordVec 64 W8) = mkGenPrimOp (fsLit "broadcastWord8X64#")  [] [wordPrimTy] (word8X64PrimTy)-primOpInfo (VecBroadcastOp WordVec 32 W16) = mkGenPrimOp (fsLit "broadcastWord16X32#")  [] [wordPrimTy] (word16X32PrimTy)+primOpInfo (VecBroadcastOp WordVec 64 W8) = mkGenPrimOp (fsLit "broadcastWord8X64#")  [] [word8PrimTy] (word8X64PrimTy)+primOpInfo (VecBroadcastOp WordVec 32 W16) = mkGenPrimOp (fsLit "broadcastWord16X32#")  [] [word16PrimTy] (word16X32PrimTy) primOpInfo (VecBroadcastOp WordVec 16 W32) = mkGenPrimOp (fsLit "broadcastWord32X16#")  [] [word32PrimTy] (word32X16PrimTy) primOpInfo (VecBroadcastOp WordVec 8 W64) = mkGenPrimOp (fsLit "broadcastWord64X8#")  [] [word64PrimTy] (word64X8PrimTy) primOpInfo (VecBroadcastOp FloatVec 4 W32) = mkGenPrimOp (fsLit "broadcastFloatX4#")  [] [floatPrimTy] (floatX4PrimTy)@@ -686,16 +686,16 @@ primOpInfo (VecPackOp IntVec 32 W16) = mkGenPrimOp (fsLit "packInt16X32#")  [] [(mkTupleTy Unboxed [int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy])] (int16X32PrimTy) primOpInfo (VecPackOp IntVec 16 W32) = mkGenPrimOp (fsLit "packInt32X16#")  [] [(mkTupleTy Unboxed [int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy])] (int32X16PrimTy) primOpInfo (VecPackOp IntVec 8 W64) = mkGenPrimOp (fsLit "packInt64X8#")  [] [(mkTupleTy Unboxed [int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy])] (int64X8PrimTy)-primOpInfo (VecPackOp WordVec 16 W8) = mkGenPrimOp (fsLit "packWord8X16#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word8X16PrimTy)-primOpInfo (VecPackOp WordVec 8 W16) = mkGenPrimOp (fsLit "packWord16X8#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word16X8PrimTy)+primOpInfo (VecPackOp WordVec 16 W8) = mkGenPrimOp (fsLit "packWord8X16#")  [] [(mkTupleTy Unboxed [word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy])] (word8X16PrimTy)+primOpInfo (VecPackOp WordVec 8 W16) = mkGenPrimOp (fsLit "packWord16X8#")  [] [(mkTupleTy Unboxed [word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy])] (word16X8PrimTy) primOpInfo (VecPackOp WordVec 4 W32) = mkGenPrimOp (fsLit "packWord32X4#")  [] [(mkTupleTy Unboxed [word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy])] (word32X4PrimTy) primOpInfo (VecPackOp WordVec 2 W64) = mkGenPrimOp (fsLit "packWord64X2#")  [] [(mkTupleTy Unboxed [word64PrimTy, word64PrimTy])] (word64X2PrimTy)-primOpInfo (VecPackOp WordVec 32 W8) = mkGenPrimOp (fsLit "packWord8X32#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word8X32PrimTy)-primOpInfo (VecPackOp WordVec 16 W16) = mkGenPrimOp (fsLit "packWord16X16#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word16X16PrimTy)+primOpInfo (VecPackOp WordVec 32 W8) = mkGenPrimOp (fsLit "packWord8X32#")  [] [(mkTupleTy Unboxed [word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy])] (word8X32PrimTy)+primOpInfo (VecPackOp WordVec 16 W16) = mkGenPrimOp (fsLit "packWord16X16#")  [] [(mkTupleTy Unboxed [word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy])] (word16X16PrimTy) primOpInfo (VecPackOp WordVec 8 W32) = mkGenPrimOp (fsLit "packWord32X8#")  [] [(mkTupleTy Unboxed [word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy])] (word32X8PrimTy) primOpInfo (VecPackOp WordVec 4 W64) = mkGenPrimOp (fsLit "packWord64X4#")  [] [(mkTupleTy Unboxed [word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy])] (word64X4PrimTy)-primOpInfo (VecPackOp WordVec 64 W8) = mkGenPrimOp (fsLit "packWord8X64#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word8X64PrimTy)-primOpInfo (VecPackOp WordVec 32 W16) = mkGenPrimOp (fsLit "packWord16X32#")  [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word16X32PrimTy)+primOpInfo (VecPackOp WordVec 64 W8) = mkGenPrimOp (fsLit "packWord8X64#")  [] [(mkTupleTy Unboxed [word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy])] (word8X64PrimTy)+primOpInfo (VecPackOp WordVec 32 W16) = mkGenPrimOp (fsLit "packWord16X32#")  [] [(mkTupleTy Unboxed [word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy])] (word16X32PrimTy) primOpInfo (VecPackOp WordVec 16 W32) = mkGenPrimOp (fsLit "packWord32X16#")  [] [(mkTupleTy Unboxed [word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy])] (word32X16PrimTy) primOpInfo (VecPackOp WordVec 8 W64) = mkGenPrimOp (fsLit "packWord64X8#")  [] [(mkTupleTy Unboxed [word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy])] (word64X8PrimTy) primOpInfo (VecPackOp FloatVec 4 W32) = mkGenPrimOp (fsLit "packFloatX4#")  [] [(mkTupleTy Unboxed [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])] (floatX4PrimTy)@@ -716,16 +716,16 @@ primOpInfo (VecUnpackOp IntVec 32 W16) = mkGenPrimOp (fsLit "unpackInt16X32#")  [] [int16X32PrimTy] ((mkTupleTy Unboxed [int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy])) primOpInfo (VecUnpackOp IntVec 16 W32) = mkGenPrimOp (fsLit "unpackInt32X16#")  [] [int32X16PrimTy] ((mkTupleTy Unboxed [int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy])) primOpInfo (VecUnpackOp IntVec 8 W64) = mkGenPrimOp (fsLit "unpackInt64X8#")  [] [int64X8PrimTy] ((mkTupleTy Unboxed [int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy]))-primOpInfo (VecUnpackOp WordVec 16 W8) = mkGenPrimOp (fsLit "unpackWord8X16#")  [] [word8X16PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy]))-primOpInfo (VecUnpackOp WordVec 8 W16) = mkGenPrimOp (fsLit "unpackWord16X8#")  [] [word16X8PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy]))+primOpInfo (VecUnpackOp WordVec 16 W8) = mkGenPrimOp (fsLit "unpackWord8X16#")  [] [word8X16PrimTy] ((mkTupleTy Unboxed [word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy]))+primOpInfo (VecUnpackOp WordVec 8 W16) = mkGenPrimOp (fsLit "unpackWord16X8#")  [] [word16X8PrimTy] ((mkTupleTy Unboxed [word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy])) primOpInfo (VecUnpackOp WordVec 4 W32) = mkGenPrimOp (fsLit "unpackWord32X4#")  [] [word32X4PrimTy] ((mkTupleTy Unboxed [word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy])) primOpInfo (VecUnpackOp WordVec 2 W64) = mkGenPrimOp (fsLit "unpackWord64X2#")  [] [word64X2PrimTy] ((mkTupleTy Unboxed [word64PrimTy, word64PrimTy]))-primOpInfo (VecUnpackOp WordVec 32 W8) = mkGenPrimOp (fsLit "unpackWord8X32#")  [] [word8X32PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy]))-primOpInfo (VecUnpackOp WordVec 16 W16) = mkGenPrimOp (fsLit "unpackWord16X16#")  [] [word16X16PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy]))+primOpInfo (VecUnpackOp WordVec 32 W8) = mkGenPrimOp (fsLit "unpackWord8X32#")  [] [word8X32PrimTy] ((mkTupleTy Unboxed [word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy]))+primOpInfo (VecUnpackOp WordVec 16 W16) = mkGenPrimOp (fsLit "unpackWord16X16#")  [] [word16X16PrimTy] ((mkTupleTy Unboxed [word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy])) primOpInfo (VecUnpackOp WordVec 8 W32) = mkGenPrimOp (fsLit "unpackWord32X8#")  [] [word32X8PrimTy] ((mkTupleTy Unboxed [word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy])) primOpInfo (VecUnpackOp WordVec 4 W64) = mkGenPrimOp (fsLit "unpackWord64X4#")  [] [word64X4PrimTy] ((mkTupleTy Unboxed [word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy]))-primOpInfo (VecUnpackOp WordVec 64 W8) = mkGenPrimOp (fsLit "unpackWord8X64#")  [] [word8X64PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy]))-primOpInfo (VecUnpackOp WordVec 32 W16) = mkGenPrimOp (fsLit "unpackWord16X32#")  [] [word16X32PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy]))+primOpInfo (VecUnpackOp WordVec 64 W8) = mkGenPrimOp (fsLit "unpackWord8X64#")  [] [word8X64PrimTy] ((mkTupleTy Unboxed [word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy]))+primOpInfo (VecUnpackOp WordVec 32 W16) = mkGenPrimOp (fsLit "unpackWord16X32#")  [] [word16X32PrimTy] ((mkTupleTy Unboxed [word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy])) primOpInfo (VecUnpackOp WordVec 16 W32) = mkGenPrimOp (fsLit "unpackWord32X16#")  [] [word32X16PrimTy] ((mkTupleTy Unboxed [word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy])) primOpInfo (VecUnpackOp WordVec 8 W64) = mkGenPrimOp (fsLit "unpackWord64X8#")  [] [word64X8PrimTy] ((mkTupleTy Unboxed [word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy])) primOpInfo (VecUnpackOp FloatVec 4 W32) = mkGenPrimOp (fsLit "unpackFloatX4#")  [] [floatX4PrimTy] ((mkTupleTy Unboxed [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy]))@@ -746,16 +746,16 @@ primOpInfo (VecInsertOp IntVec 32 W16) = mkGenPrimOp (fsLit "insertInt16X32#")  [] [int16X32PrimTy, int16PrimTy, intPrimTy] (int16X32PrimTy) primOpInfo (VecInsertOp IntVec 16 W32) = mkGenPrimOp (fsLit "insertInt32X16#")  [] [int32X16PrimTy, int32PrimTy, intPrimTy] (int32X16PrimTy) primOpInfo (VecInsertOp IntVec 8 W64) = mkGenPrimOp (fsLit "insertInt64X8#")  [] [int64X8PrimTy, int64PrimTy, intPrimTy] (int64X8PrimTy)-primOpInfo (VecInsertOp WordVec 16 W8) = mkGenPrimOp (fsLit "insertWord8X16#")  [] [word8X16PrimTy, wordPrimTy, intPrimTy] (word8X16PrimTy)-primOpInfo (VecInsertOp WordVec 8 W16) = mkGenPrimOp (fsLit "insertWord16X8#")  [] [word16X8PrimTy, wordPrimTy, intPrimTy] (word16X8PrimTy)+primOpInfo (VecInsertOp WordVec 16 W8) = mkGenPrimOp (fsLit "insertWord8X16#")  [] [word8X16PrimTy, word8PrimTy, intPrimTy] (word8X16PrimTy)+primOpInfo (VecInsertOp WordVec 8 W16) = mkGenPrimOp (fsLit "insertWord16X8#")  [] [word16X8PrimTy, word16PrimTy, intPrimTy] (word16X8PrimTy) primOpInfo (VecInsertOp WordVec 4 W32) = mkGenPrimOp (fsLit "insertWord32X4#")  [] [word32X4PrimTy, word32PrimTy, intPrimTy] (word32X4PrimTy) primOpInfo (VecInsertOp WordVec 2 W64) = mkGenPrimOp (fsLit "insertWord64X2#")  [] [word64X2PrimTy, word64PrimTy, intPrimTy] (word64X2PrimTy)-primOpInfo (VecInsertOp WordVec 32 W8) = mkGenPrimOp (fsLit "insertWord8X32#")  [] [word8X32PrimTy, wordPrimTy, intPrimTy] (word8X32PrimTy)-primOpInfo (VecInsertOp WordVec 16 W16) = mkGenPrimOp (fsLit "insertWord16X16#")  [] [word16X16PrimTy, wordPrimTy, intPrimTy] (word16X16PrimTy)+primOpInfo (VecInsertOp WordVec 32 W8) = mkGenPrimOp (fsLit "insertWord8X32#")  [] [word8X32PrimTy, word8PrimTy, intPrimTy] (word8X32PrimTy)+primOpInfo (VecInsertOp WordVec 16 W16) = mkGenPrimOp (fsLit "insertWord16X16#")  [] [word16X16PrimTy, word16PrimTy, intPrimTy] (word16X16PrimTy) primOpInfo (VecInsertOp WordVec 8 W32) = mkGenPrimOp (fsLit "insertWord32X8#")  [] [word32X8PrimTy, word32PrimTy, intPrimTy] (word32X8PrimTy) primOpInfo (VecInsertOp WordVec 4 W64) = mkGenPrimOp (fsLit "insertWord64X4#")  [] [word64X4PrimTy, word64PrimTy, intPrimTy] (word64X4PrimTy)-primOpInfo (VecInsertOp WordVec 64 W8) = mkGenPrimOp (fsLit "insertWord8X64#")  [] [word8X64PrimTy, wordPrimTy, intPrimTy] (word8X64PrimTy)-primOpInfo (VecInsertOp WordVec 32 W16) = mkGenPrimOp (fsLit "insertWord16X32#")  [] [word16X32PrimTy, wordPrimTy, intPrimTy] (word16X32PrimTy)+primOpInfo (VecInsertOp WordVec 64 W8) = mkGenPrimOp (fsLit "insertWord8X64#")  [] [word8X64PrimTy, word8PrimTy, intPrimTy] (word8X64PrimTy)+primOpInfo (VecInsertOp WordVec 32 W16) = mkGenPrimOp (fsLit "insertWord16X32#")  [] [word16X32PrimTy, word16PrimTy, intPrimTy] (word16X32PrimTy) primOpInfo (VecInsertOp WordVec 16 W32) = mkGenPrimOp (fsLit "insertWord32X16#")  [] [word32X16PrimTy, word32PrimTy, intPrimTy] (word32X16PrimTy) primOpInfo (VecInsertOp WordVec 8 W64) = mkGenPrimOp (fsLit "insertWord64X8#")  [] [word64X8PrimTy, word64PrimTy, intPrimTy] (word64X8PrimTy) primOpInfo (VecInsertOp FloatVec 4 W32) = mkGenPrimOp (fsLit "insertFloatX4#")  [] [floatX4PrimTy, floatPrimTy, intPrimTy] (floatX4PrimTy)