Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC

Commits:

30 changed files:

Changes:

  • compiler/GHC/CmmToAsm/LA64/CodeGen.hs
    ... ... @@ -1805,6 +1805,49 @@ genCCall target dest_regs arg_regs = do
    1805 1805 
           where
    1806 1806 
             shift = (widthToInt w)
    1807 1807
    1808 
    +    PrimTarget (MO_BSwap w)
    1809 
    +      | w `elem` [W16, W32, W64],
    1810 
    +      [arg_reg] <- arg_regs,
    1811 
    +      [dest_reg] <- dest_regs -> do
    1812 
    +      platform <- getPlatform
    1813 
    +      (reg_x, _, code_x) <- getSomeReg arg_reg
    1814 
    +      let dst_reg = getRegisterReg platform (CmmLocal dest_reg)
    1815 
    +      case w of
    1816 
    +        W64 -> return ( code_x `appOL` toOL
    1817 
    +                      [
    1818 
    +                        REVBD (OpReg w dst_reg) (OpReg w reg_x)
    1819 
    +                      ])
    1820 
    +        W32 -> return ( code_x `appOL` toOL
    1821 
    +                      [
    1822 
    +                        REVB2W (OpReg w dst_reg) (OpReg w reg_x)
    1823 
    +                      ])
    1824 
    +        _ -> return ( code_x `appOL` toOL
    1825 
    +                      [
    1826 
    +                        REVB2H (OpReg w dst_reg) (OpReg w reg_x)
    1827 
    +                      ])
    1828 
    +      | otherwise -> unsupported (MO_BSwap w)
    1829 
    +
    1830 
    +    PrimTarget (MO_BRev w)
    1831 
    +      | w `elem` [W8, W16, W32, W64],
    1832 
    +      [arg_reg] <- arg_regs,
    1833 
    +      [dest_reg] <- dest_regs -> do
    1834 
    +      platform <- getPlatform
    1835 
    +      (reg_x, _, code_x) <- getSomeReg arg_reg
    1836 
    +      let dst_reg = getRegisterReg platform (CmmLocal dest_reg)
    1837 
    +      case w of
    1838 
    +        W8 -> return ( code_x `appOL` toOL
    1839 
    +                     [
    1840 
    +                       BITREV4B (OpReg W32 reg_x) (OpReg W32 reg_x),
    1841 
    +                       AND (OpReg W64 dst_reg) (OpReg W64 reg_x) (OpImm (ImmInt 255))
    1842 
    +                     ])
    1843 
    +        W16 -> return ( code_x `appOL` toOL
    1844 
    +                      [
    1845 
    +                        BITREV (OpReg W64 reg_x) (OpReg W64 reg_x),
    1846 
    +                        SRL (OpReg W64 dst_reg) (OpReg W64 reg_x) (OpImm (ImmInt 48))
    1847 
    +                      ])
    1848 
    +        _ -> return ( code_x `snocOL` BITREV (OpReg w dst_reg) (OpReg w reg_x))
    1849 
    +      | otherwise -> unsupported (MO_BRev w)
    1850 
    +
    1808 1851 
         -- mop :: CallishMachOp (see GHC.Cmm.MachOp)
    1809 1852 
         PrimTarget mop -> do
    1810 1853 
           -- We'll need config to construct forien targets
    ... ... @@ -1939,8 +1982,6 @@ genCCall target dest_regs arg_regs = do
    1939 1982 
             MO_PopCnt w         -> mkCCall (popCntLabel w)
    1940 1983 
             MO_Pdep w           -> mkCCall (pdepLabel w)
    1941 1984 
             MO_Pext w           -> mkCCall (pextLabel w)
    1942 
    -        MO_BSwap w          -> mkCCall (bSwapLabel w)
    1943 
    -        MO_BRev w           -> mkCCall (bRevLabel w)
    1944 1985
    1945 1986 
         -- or a possibly side-effecting machine operation
    1946 1987 
             mo@(MO_AtomicRead w ord)

  • compiler/GHC/CmmToAsm/LA64/Instr.hs
    ... ... @@ -126,8 +126,7 @@ regUsageOfInstr platform instr = case instr of
    126 126 
       REVHD  dst src1          -> usage (regOp src1, regOp dst)
    127 127 
       BITREV4B dst src1        -> usage (regOp src1, regOp dst)
    128 128 
       BITREV8B dst src1        -> usage (regOp src1, regOp dst)
    129 
    -  BITREVW dst src1         -> usage (regOp src1, regOp dst)
    130 
    -  BITREVD dst src1         -> usage (regOp src1, regOp dst)
    129 
    +  BITREV dst src1          -> usage (regOp src1, regOp dst)
    131 130 
       BSTRINS _ dst src1 src2 src3  -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst)
    132 131 
       BSTRPICK _ dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst)
    133 132 
       MASKEQZ dst src1 src2         -> usage (regOp src1 ++ regOp src2, regOp dst)
    ... ... @@ -309,8 +308,7 @@ patchRegsOfInstr instr env = case instr of
    309 308 
         REVHD  o1 o2          -> REVHD  (patchOp o1)  (patchOp o2)
    310 309 
         BITREV4B o1 o2         -> BITREV4B  (patchOp o1)  (patchOp o2)
    311 310 
         BITREV8B o1 o2         -> BITREV8B  (patchOp o1)  (patchOp o2)
    312 
    -    BITREVW o1 o2          -> BITREVW  (patchOp o1)  (patchOp o2)
    313 
    -    BITREVD o1 o2          -> BITREVD  (patchOp o1)  (patchOp o2)
    311 
    +    BITREV o1 o2           -> BITREV  (patchOp o1)  (patchOp o2)
    314 312 
         BSTRINS f o1 o2 o3 o4  -> BSTRINS f (patchOp o1)  (patchOp o2)  (patchOp o3)  (patchOp o4)
    315 313 
         BSTRPICK f o1 o2 o3 o4 -> BSTRPICK f (patchOp o1)  (patchOp o2)  (patchOp o3)  (patchOp o4)
    316 314 
         MASKEQZ o1 o2 o3       -> MASKEQZ  (patchOp o1)  (patchOp o2)  (patchOp o3)
    ... ... @@ -700,8 +698,7 @@ data Instr
    700 698 
         | REVHD Operand Operand
    701 699 
         | BITREV4B Operand Operand
    702 700 
         | BITREV8B Operand Operand
    703 
    -    | BITREVW Operand Operand
    704 
    -    | BITREVD Operand Operand
    701 
    +    | BITREV Operand Operand
    705 702 
         | BSTRINS Format Operand Operand Operand Operand
    706 703 
         | BSTRPICK Format Operand Operand Operand Operand
    707 704 
         | MASKEQZ Operand Operand Operand
    ... ... @@ -824,8 +821,7 @@ instrCon i =
    824 821 
           REVHD{} -> "REVHD"
    825 822 
           BITREV4B{} -> "BITREV4B"
    826 823 
           BITREV8B{} -> "BITREV8B"
    827 
    -      BITREVW{} -> "BITREVW"
    828 
    -      BITREVD{} -> "BITREVD"
    824 
    +      BITREV{} -> "BITREV"
    829 825 
           BSTRINS{} -> "BSTRINS"
    830 826 
           BSTRPICK{} -> "BSTRPICK"
    831 827 
           MASKEQZ{} -> "MASKEQZ"

  • compiler/GHC/CmmToAsm/LA64/Ppr.hs
    ... ... @@ -802,8 +802,9 @@ pprInstr platform instr = case instr of
    802 802 
         -- BITREV.{W/D}
    803 803 
       BITREV4B o1 o2 -> op2 (text "\tbitrev.4b") o1 o2
    804 804 
       BITREV8B o1 o2 -> op2 (text "\tbitrev.8b") o1 o2
    805 
    -  BITREVW o1 o2 -> op2 (text "\tbitrev.w") o1 o2
    806 
    -  BITREVD o1 o2 -> op2 (text "\tbitrev.d") o1 o2
    805 
    +  BITREV o1 o2
    806 
    +    | OpReg W32 _ <- o2 -> op2 (text "\tbitrev.w") o1 o2
    807 
    +    | OpReg W64 _ <- o2 -> op2 (text "\tbitrev.d") o1 o2
    807 808 
         -- BSTRINS.{W/D}
    808 809 
       BSTRINS II64 o1 o2 o3 o4 -> op4 (text "\tbstrins.d") o1 o2 o3 o4
    809 810 
       BSTRINS II32 o1 o2 o3 o4 -> op4 (text "\tbstrins.w") o1 o2 o3 o4

  • compiler/GHC/CmmToAsm/RV64/CodeGen.hs
    ... ... @@ -874,46 +874,18 @@ getRegister' config plat expr =
    874 874 
               )
    875 875
    876 876 
         -- 2. Shifts. x << n, x >> n.
    877 
    -    CmmMachOp (MO_Shl w) [x, CmmLit (CmmInt n _)]
    878 
    -      | w == W32,
    879 
    -        0 <= n,
    880 
    -        n < 32 -> do
    881 
    -          (reg_x, _format_x, code_x) <- getSomeReg x
    882 
    -          return
    883 
    -            $ Any
    884 
    -              (intFormat w)
    885 
    -              ( \dst ->
    886 
    -                  code_x
    887 
    -                    `snocOL` annExpr expr (SLL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
    888 
    -                    `appOL` truncateReg w w dst
    889 
    -              )
    890 
    -    CmmMachOp (MO_Shl w) [x, CmmLit (CmmInt n _)]
    891 
    -      | w == W64,
    892 
    -        0 <= n,
    893 
    -        n < 64 -> do
    894 
    -          (reg_x, _format_x, code_x) <- getSomeReg x
    895 
    -          return
    896 
    -            $ Any
    897 
    -              (intFormat w)
    898 
    -              ( \dst ->
    899 
    -                  code_x
    900 
    -                    `snocOL` annExpr expr (SLL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
    901 
    -                    `appOL` truncateReg w w dst
    902 
    -              )
    903 
    -    CmmMachOp (MO_S_Shr w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> do
    904 
    -      (reg_x, format_x, code_x) <- getSomeReg x
    905 
    -      (reg_x', code_x') <- signExtendReg (formatToWidth format_x) w reg_x
    877 
    +    CmmMachOp (MO_Shl w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> do
    878 
    +      (reg_x, _format_x, code_x) <- getSomeReg x
    906 879 
           return
    907 880 
             $ Any
    908 881 
               (intFormat w)
    909 882 
               ( \dst ->
    910 883 
                   code_x
    911 
    -                `appOL` code_x'
    912 
    -                `snocOL` annExpr expr (SRA (OpReg w dst) (OpReg w reg_x') (OpImm (ImmInteger n)))
    884 
    +                `snocOL` annExpr expr (SLL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
    885 
    +                `appOL` truncateReg w w dst
    913 886 
               )
    914 
    -    CmmMachOp (MO_S_Shr w) [x, y] -> do
    887 
    +    CmmMachOp (MO_S_Shr w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> do
    915 888 
           (reg_x, format_x, code_x) <- getSomeReg x
    916 
    -      (reg_y, _format_y, code_y) <- getSomeReg y
    917 889 
           (reg_x', code_x') <- signExtendReg (formatToWidth format_x) w reg_x
    918 890 
           return
    919 891 
             $ Any
    ... ... @@ -921,72 +893,20 @@ getRegister' config plat expr =
    921 893 
               ( \dst ->
    922 894 
                   code_x
    923 895 
                     `appOL` code_x'
    924 
    -                `appOL` code_y
    925 
    -                `snocOL` annExpr expr (SRA (OpReg w dst) (OpReg w reg_x') (OpReg w reg_y))
    896 
    +                `snocOL` annExpr expr (SRA (OpReg w dst) (OpReg w reg_x') (OpImm (ImmInteger n)))
    897 
    +                `appOL` truncateReg w w dst
    926 898 
               )
    927 
    -    CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)]
    928 
    -      | w == W8,
    929 
    -        0 <= n,
    930 
    -        n < 8 -> do
    931 
    -          (reg_x, format_x, code_x) <- getSomeReg x
    932 
    -          return
    933 
    -            $ Any
    934 
    -              (intFormat w)
    935 
    -              ( \dst ->
    936 
    -                  code_x
    937 
    -                    `appOL` truncateReg (formatToWidth format_x) w reg_x
    938 
    -                    `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
    939 
    -              )
    940 
    -    CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)]
    941 
    -      | w == W16,
    942 
    -        0 <= n,
    943 
    -        n < 16 -> do
    944 
    -          (reg_x, format_x, code_x) <- getSomeReg x
    945 
    -          return
    946 
    -            $ Any
    947 
    -              (intFormat w)
    948 
    -              ( \dst ->
    949 
    -                  code_x
    950 
    -                    `appOL` truncateReg (formatToWidth format_x) w reg_x
    951 
    -                    `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
    952 
    -              )
    953 
    -    CmmMachOp (MO_U_Shr w) [x, y] | w == W8 || w == W16 -> do
    899 
    +    CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> do
    954 900 
           (reg_x, format_x, code_x) <- getSomeReg x
    955 
    -      (reg_y, _format_y, code_y) <- getSomeReg y
    956 901 
           return
    957 902 
             $ Any
    958 903 
               (intFormat w)
    959 904 
               ( \dst ->
    960 905 
                   code_x
    961 
    -                `appOL` code_y
    962 906 
                     `appOL` truncateReg (formatToWidth format_x) w reg_x
    963 
    -                `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))
    907 
    +                `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
    908 
    +                `appOL` truncateReg w w dst
    964 909 
               )
    965 
    -    CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)]
    966 
    -      | w == W32,
    967 
    -        0 <= n,
    968 
    -        n < 32 -> do
    969 
    -          (reg_x, _format_x, code_x) <- getSomeReg x
    970 
    -          return
    971 
    -            $ Any
    972 
    -              (intFormat w)
    973 
    -              ( \dst ->
    974 
    -                  code_x
    975 
    -                    `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
    976 
    -              )
    977 
    -    CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)]
    978 
    -      | w == W64,
    979 
    -        0 <= n,
    980 
    -        n < 64 -> do
    981 
    -          (reg_x, _format_x, code_x) <- getSomeReg x
    982 
    -          return
    983 
    -            $ Any
    984 
    -              (intFormat w)
    985 
    -              ( \dst ->
    986 
    -                  code_x
    987 
    -                    `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))
    988 
    -              )
    989 
    -
    990 910 
         -- 3. Logic &&, ||
    991 911 
         CmmMachOp (MO_And w) [CmmReg reg, CmmLit (CmmInt n _)]
    992 912 
           | fitsIn12bitImm n ->

  • compiler/GHC/CmmToLlvm/CodeGen.hs
    ... ... @@ -240,12 +240,25 @@ genCall (PrimTarget op@(MO_BRev w)) [dst] args =
    240 240 
         genCallSimpleCast w op dst args
    241 241 
     genCall (PrimTarget op@(MO_BSwap w)) [dst] args =
    242 242 
         genCallSimpleCast w op dst args
    243 
    -genCall (PrimTarget op@(MO_Pdep w)) [dst] args =
    244 
    -    genCallSimpleCast w op dst args
    245 
    -genCall (PrimTarget op@(MO_Pext w)) [dst] args =
    246 
    -    genCallSimpleCast w op dst args
    247 243 
     genCall (PrimTarget op@(MO_PopCnt w)) [dst] args =
    248 244 
         genCallSimpleCast w op dst args
    245 
    +{- Note [LLVM PDep/PExt intrinsics]
    246 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    247 
    +Since x86 PDep/PExt instructions only exist for 32/64 bit widths
    248 
    +we use the 32bit variant to compute the 8/16bit primops.
    249 
    +To do so we extend/truncate the argument/result around the
    250 
    +call.
    251 
    +-}
    252 
    +genCall (PrimTarget op@(MO_Pdep w)) [dst] args = do
    253 
    +    cfg <- getConfig
    254 
    +    if  llvmCgBmiVersion cfg >= Just BMI2
    255 
    +        then genCallMinimumTruncationCast W32 w op dst args
    256 
    +        else genCallSimpleCast w op dst args
    257 
    +genCall (PrimTarget op@(MO_Pext w)) [dst] args = do
    258 
    +    cfg <- getConfig
    259 
    +    if  llvmCgBmiVersion cfg >= Just BMI2
    260 
    +        then genCallMinimumTruncationCast W32 w op dst args
    261 
    +        else genCallSimpleCast w op dst args
    249 262
    250 263 
     genCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = runStmtsDecls $ do
    251 264 
         addrVar <- exprToVarW addr
    ... ... @@ -641,8 +654,15 @@ genCallExtract _ _ _ _ =
    641 654 
     -- from i32 to i8 explicitly as LLVM is strict about types.
    642 655 
     genCallSimpleCast :: Width -> CallishMachOp -> CmmFormal -> [CmmActual]
    643 656 
                       -> LlvmM StmtData
    644 
    -genCallSimpleCast specW op dst args = do
    645 
    -    let width   = widthToLlvmInt specW
    657 
    +genCallSimpleCast w = genCallMinimumTruncationCast w w
    658 
    +
    659 
    +-- Given the minimum machine bit-width to use and the logical bit-width of the
    660 
    +-- value range, perform a type-cast truncation and extension before and after the
    661 
    +-- specified operation, respectively.
    662 
    +genCallMinimumTruncationCast :: Width -> Width -> CallishMachOp -> CmmFormal
    663 
    +                             -> [CmmActual] -> LlvmM StmtData
    664 
    +genCallMinimumTruncationCast minW specW op dst args = do
    665 
    +    let width   = widthToLlvmInt $ max minW specW
    646 666 
             argsW   = const width <$> args
    647 667 
             dstType = cmmToLlvmType $ localRegType dst
    648 668 
             signage = cmmPrimOpRetValSignage op
    ... ... @@ -945,9 +965,10 @@ cmmPrimOpFunctions mop = do
    945 965 
           W256 -> fsLit "llvm.cttz.i256"
    946 966 
           W512 -> fsLit "llvm.cttz.i512"
    947 967 
         MO_Pdep w
    968 
    +      -- See Note [LLVM PDep/PExt intrinsics]
    948 969 
           | isBmi2Enabled -> case w of
    949 
    -          W8   -> fsLit "llvm.x86.bmi.pdep.8"
    950 
    -          W16  -> fsLit "llvm.x86.bmi.pdep.16"
    970 
    +          W8   -> fsLit "llvm.x86.bmi.pdep.32"
    971 
    +          W16  -> fsLit "llvm.x86.bmi.pdep.32"
    951 972 
               W32  -> fsLit "llvm.x86.bmi.pdep.32"
    952 973 
               W64  -> fsLit "llvm.x86.bmi.pdep.64"
    953 974 
               W128 -> fsLit "llvm.x86.bmi.pdep.128"
    ... ... @@ -963,8 +984,9 @@ cmmPrimOpFunctions mop = do
    963 984 
               W512 -> fsLit "hs_pdep512"
    964 985 
         MO_Pext w
    965 986 
           | isBmi2Enabled -> case w of
    966 
    -          W8   -> fsLit "llvm.x86.bmi.pext.8"
    967 
    -          W16  -> fsLit "llvm.x86.bmi.pext.16"
    987 
    +          -- See Note [LLVM PDep/PExt intrinsics]
    988 
    +          W8   -> fsLit "llvm.x86.bmi.pext.32"
    989 
    +          W16  -> fsLit "llvm.x86.bmi.pext.32"
    968 990 
               W32  -> fsLit "llvm.x86.bmi.pext.32"
    969 991 
               W64  -> fsLit "llvm.x86.bmi.pext.64"
    970 992 
               W128 -> fsLit "llvm.x86.bmi.pext.128"

  • compiler/GHC/Core/Opt/Pipeline.hs
    ... ... @@ -13,6 +13,7 @@ import GHC.Prelude
    13 13 
     import GHC.Driver.DynFlags
    14 14 
     import GHC.Driver.Plugins ( withPlugins, installCoreToDos )
    15 15 
     import GHC.Driver.Env
    16 
    +import GHC.Driver.Config (initSimpleOpts)
    16 17 
     import GHC.Driver.Config.Core.Lint ( endPass )
    17 18 
     import GHC.Driver.Config.Core.Opt.LiberateCase ( initLiberateCaseOpts )
    18 19 
     import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode, initGentleSimplMode )
    ... ... @@ -21,9 +22,10 @@ import GHC.Driver.Config.Core.Rules ( initRuleOpts )
    21 22 
     import GHC.Platform.Ways  ( hasWay, Way(WayProf) )
    22 23
    23 24 
     import GHC.Core
    25 
    +import GHC.Core.SimpleOpt (simpleOptPgm)
    24 26 
     import GHC.Core.Opt.CSE  ( cseProgram )
    25 27 
     import GHC.Core.Rules   ( RuleBase, ruleCheckProgram, getRules )
    26 
    -import GHC.Core.Ppr     ( pprCoreBindings )
    28 
    +import GHC.Core.Ppr     ( pprCoreBindings, pprRules )
    27 29 
     import GHC.Core.Utils   ( dumpIdInfoOfProgram )
    28 30 
     import GHC.Core.Lint    ( lintAnnots )
    29 31 
     import GHC.Core.Lint.Interactive ( interactiveInScope )
    ... ... @@ -202,10 +204,14 @@ getCoreToDo dflags hpt_rule_base extra_vars
    202 204
    203 205 
         core_todo =
    204 206 
          [
    205 
    -    -- We want to do the static argument transform before full laziness as it
    206 
    -    -- may expose extra opportunities to float things outwards. However, to fix
    207 
    -    -- up the output of the transformation we need at do at least one simplify
    208 
    -    -- after this before anything else
    207 
    +        -- We always perform a run of the simple optimizer after desugaring to
    208 
    +        -- remove really bad code
    209 
    +        CoreDesugarOpt,
    210 
    +
    211 
    +        -- We want to do the static argument transform before full laziness as it
    212 
    +        -- may expose extra opportunities to float things outwards. However, to fix
    213 
    +        -- up the output of the transformation we need at do at least one simplify
    214 
    +        -- after this before anything else
    209 215 
             runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]),
    210 216
    211 217 
             -- initial simplify: mk specialiser happy: minimum effort please
    ... ... @@ -467,6 +473,7 @@ doCorePass pass guts = do
    467 473 
       let fam_envs = (p_fam_env, mg_fam_inst_env guts)
    468 474 
       let updateBinds  f = return $ guts { mg_binds = f (mg_binds guts) }
    469 475 
       let updateBindsM f = f (mg_binds guts) >>= \b' -> return $ guts { mg_binds = b' }
    476 
    +  let updateBindsAndRulesM f = f (mg_binds guts) (mg_rules guts) >>= \(b',r') -> return $ guts { mg_binds = b', mg_rules = r' }
    470 477 
       -- Important to force this now as name_ppr_ctx lives through an entire phase in
    471 478 
       -- the optimiser and if it's not forced then the entire previous `ModGuts` will
    472 479 
       -- be retained until the end of the phase. (See #24328 for more analysis)
    ... ... @@ -479,6 +486,9 @@ doCorePass pass guts = do
    479 486
    480 487
    481 488 
       case pass of
    489 
    +    CoreDesugarOpt            -> {-# SCC "DesugarOpt" #-}
    490 
    +                                 updateBindsAndRulesM (desugarOpt dflags logger (mg_module guts))
    491 
    +
    482 492 
         CoreDoSimplify opts       -> {-# SCC "Simplify" #-}
    483 493 
                                      liftIOWithCount $ simplifyPgm logger (hsc_unit_env hsc_env) name_ppr_ctx opts guts
    484 494
    ... ... @@ -537,7 +547,6 @@ doCorePass pass guts = do
    537 547 
         CoreDoPluginPass _ p      -> {-# SCC "Plugin" #-} p guts
    538 548
    539 549 
         CoreDesugar               -> pprPanic "doCorePass" (ppr pass)
    540 
    -    CoreDesugarOpt            -> pprPanic "doCorePass" (ppr pass)
    541 550 
         CoreTidy                  -> pprPanic "doCorePass" (ppr pass)
    542 551 
         CorePrep                  -> pprPanic "doCorePass" (ppr pass)
    543 552
    ... ... @@ -580,3 +589,22 @@ dmdAnal logger before_ww dflags fam_envs rules binds = do
    580 589 
         dumpIdInfoOfProgram (hasPprDebug dflags) (ppr . zapDmdEnvSig . dmdSigInfo) binds_plus_dmds
    581 590 
       -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal
    582 591 
       seqBinds binds_plus_dmds `seq` return binds_plus_dmds
    592 
    +
    593 
    +
    594 
    +-- | Simple optimization after desugaring.
    595 
    +--
    596 
    +-- This performs some quick basic optimizations even with -O0.
    597 
    +-- See Note [The simple optimiser] for details.
    598 
    +--
    599 
    +-- We could call it directly in the desugarer but we implement it as the first
    600 
    +-- Core-to-Core pass to accomodate Core plugins that want to see Core even
    601 
    +-- before the first (simple) optimization took place. See #23337
    602 
    +desugarOpt :: DynFlags -> Logger -> Module -> CoreProgram -> [CoreRule] -> CoreM (CoreProgram,[CoreRule])
    603 
    +desugarOpt dflags logger mod binds rules = liftIO $ do
    604 
    +  let simpl_opts = initSimpleOpts dflags
    605 
    +  let !(ds_binds, ds_rules_for_imps, occ_anald_binds) = simpleOptPgm simpl_opts mod binds rules
    606 
    +
    607 
    +  putDumpFileMaybe logger Opt_D_dump_occur_anal "Occurrence analysis"
    608 
    +    FormatCore (pprCoreBindings occ_anald_binds $$ pprRules ds_rules_for_imps )
    609 
    +
    610 
    +  pure (ds_binds, ds_rules_for_imps)

  • compiler/GHC/Core/Opt/Pipeline/Types.hs
    ... ... @@ -58,8 +58,7 @@ data CoreToDo -- These are diff core-to-core passes,
    58 58 
       | CoreDoPasses [CoreToDo]      -- lists of these things
    59 59
    60 60 
       | CoreDesugar    -- Right after desugaring, no simple optimisation yet!
    61 
    -  | CoreDesugarOpt -- CoreDesugarXXX: Not strictly a core-to-core pass, but produces
    62 
    -                       --                 Core output, and hence useful to pass to endPass
    61 
    +  | CoreDesugarOpt -- Simple optimisation after desugaring
    63 62
    64 63 
       | CoreTidy
    65 64 
       | CorePrep

  • compiler/GHC/HsToCore.hs
    ... ... @@ -48,7 +48,7 @@ import GHC.Core.TyCo.Compare( eqType )
    48 48 
     import GHC.Core.TyCon       ( tyConDataCons )
    49 49 
     import GHC.Core
    50 50 
     import GHC.Core.FVs       ( exprsSomeFreeVarsList, exprFreeVars )
    51 
    -import GHC.Core.SimpleOpt ( simpleOptPgm, simpleOptExpr )
    51 
    +import GHC.Core.SimpleOpt ( simpleOptExpr )
    52 52 
     import GHC.Core.Utils
    53 53 
     import GHC.Core.Unfold.Make
    54 54 
     import GHC.Core.Coercion
    ... ... @@ -200,27 +200,18 @@ deSugar hsc_env
    200 200
    201 201 
          do {       -- Add export flags to bindings
    202 202 
               keep_alive <- readIORef keep_var
    203 
    -        ; let (rules_for_locals, rules_for_imps) = partition isLocalRule all_rules
    203 
    +        ; let (rules_for_locals, ds_rules_for_imps) = partition isLocalRule all_rules
    204 204 
                   final_prs = addExportFlagsAndRules bcknd export_set keep_alive
    205 205 
                                                      rules_for_locals (fromOL all_prs)
    206 206
    207 
    -              final_pgm = combineEvBinds ds_ev_binds final_prs
    207 
    +              ds_binds = combineEvBinds ds_ev_binds final_prs
    208 208 
             -- Notice that we put the whole lot in a big Rec, even the foreign binds
    209 209 
             -- When compiling PrelFloat, which defines data Float = F# Float#
    210 210 
             -- we want F# to be in scope in the foreign marshalling code!
    211 211 
             -- You might think it doesn't matter, but the simplifier brings all top-level
    212 212 
             -- things into the in-scope set before simplifying; so we get no unfolding for F#!
    213 213
    214 
    -        ; endPassHscEnvIO hsc_env name_ppr_ctx CoreDesugar final_pgm rules_for_imps
    215 
    -        ; let simpl_opts = initSimpleOpts dflags
    216 
    -        ; let (ds_binds, ds_rules_for_imps, occ_anald_binds)
    217 
    -                = simpleOptPgm simpl_opts mod final_pgm rules_for_imps
    218 
    -                         -- The simpleOptPgm gets rid of type
    219 
    -                         -- bindings plus any stupid dead code
    220 
    -        ; putDumpFileMaybe logger Opt_D_dump_occur_anal "Occurrence analysis"
    221 
    -            FormatCore (pprCoreBindings occ_anald_binds $$ pprRules ds_rules_for_imps )
    222 
    -
    223 
    -        ; endPassHscEnvIO hsc_env name_ppr_ctx CoreDesugarOpt ds_binds ds_rules_for_imps
    214 
    +        ; endPassHscEnvIO hsc_env name_ppr_ctx CoreDesugar ds_binds ds_rules_for_imps
    224 215
    225 216 
             ; let pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env))
    226 217 
                   home_unit = hsc_home_unit hsc_env

  • docs/users_guide/exts/pragmas.rst
    ... ... @@ -486,17 +486,18 @@ behaviour:
    486 486 
        optimisation level etc.
    487 487
    488 488 
     -  Like ``INLINE``, the ``INLINABLE`` pragma retains a copy of the
    489 
    -   original RHS for inlining purposes, and persists it in the interface
    489 
    +   RHS for inlining purposes, and persists it in the interface
    490 490 
        file, regardless of the size of the RHS.
    491 
    +   The RHS will be carefully optimised so that, when the function
    492 
    +   inlines, GHC behaves as if the original RHS had been inlined.
    491 493
    492 494 
     -  One way to use ``INLINABLE`` is in conjunction with the special
    493 495 
        function ``inline`` (:ref:`special-ids`). The call ``inline f`` tries
    494 496 
        very hard to inline ``f``. To make sure that ``f`` can be inlined, it
    495 497 
        is a good idea to mark the definition of ``f`` as ``INLINABLE``, so
    496 498 
        that GHC guarantees to expose an unfolding regardless of how big it
    497 
    -   is. Moreover, by annotating ``f`` as ``INLINABLE``, you ensure that
    498 
    -   ``f``\'s original RHS is inlined, rather than whatever random
    499 
    -   optimised version of ``f`` GHC's optimiser has produced.
    499 
    +   is. You can also provide an explicit :ref:`phase-control` on the
    500 
    +   ``INLINABLE`` pragma to ensure that RULES have a chance of firing first.
    500 501
    501 502 
     -  The ``INLINABLE`` pragma also works with ``SPECIALISE``: if you mark
    502 503 
        function ``f`` as ``INLINABLE``, then you can subsequently

  • docs/users_guide/exts/scoped_type_variables.rst
    ... ... @@ -6,7 +6,7 @@ Lexically scoped type variables
    6 6 
     ===============================
    7 7
    8 8 
     .. extension:: ScopedTypeVariables
    9 
    -    :shortdesc: Lexically scope explicitly-introduced type variables.
    9 
    +    :shortdesc: Lexically scoped explicitly-introduced type variables.
    10 10
    11 11 
         :implies: :extension:`ExplicitForAll`
    12 12

  • libraries/ghci/GHCi/Message.hs
    ... ... @@ -525,7 +525,7 @@ instance Binary (FunPtr a) where
    525 525 
       put = put . castFunPtrToPtr
    526 526 
       get = castPtrToFunPtr <$> get
    527 527
    528 
    -#if MIN_VERSION_ghc_internal(9,1500,0)
    528 
    +#if MIN_VERSION_GLASGOW_HASKELL(9,12,2,20250919)
    529 529 
     instance Binary Heap.HalfWord where
    530 530 
       put x = put (fromIntegral x :: Word32)
    531 531 
       get = fromIntegral <$> (get :: Get Word32)

  • rts/CloneStack.h
    ... ... @@ -8,8 +8,8 @@
    8 8
    9 9 
     #pragma once
    10 10
    11 
    -extern StgClosure DLL_IMPORT_DATA_VARNAME(ghczminternal_GHCziInternalziStackziCloneStack_StackSnapshot_closure);
    12 
    -#define StackSnapshot_constructor_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziStackziCloneStack_StackSnapshot_closure)
    11 
    +extern StgClosure ghczminternal_GHCziInternalziStackziCloneStack_StackSnapshot_closure;
    12 
    +#define StackSnapshot_constructor_closure (&(ghczminternal_GHCziInternalziStackziCloneStack_StackSnapshot_closure))
    13 13
    14 14 
     StgStack* cloneStack(Capability* capability, const StgStack* stack);
    15 15

  • rts/Prelude.h
    ... ... @@ -15,8 +15,8 @@
    15 15 
     #define PRELUDE_INFO(i)       extern W_(i)[]
    16 16 
     #define PRELUDE_CLOSURE(i)    extern W_(i)[]
    17 17 
     #else
    18 
    -#define PRELUDE_INFO(i)       extern const StgInfoTable DLL_IMPORT_DATA_VARNAME(i)
    19 
    -#define PRELUDE_CLOSURE(i)    extern StgClosure DLL_IMPORT_DATA_VARNAME(i)
    18 
    +#define PRELUDE_INFO(i)       extern const StgInfoTable (i)
    19 
    +#define PRELUDE_CLOSURE(i)    extern StgClosure (i)
    20 20 
     #endif
    21 21
    22 22 
     /* See Note [Wired-in exceptions are not CAFfy] in GHC.Core.Make. */
    ... ... @@ -87,58 +87,58 @@ PRELUDE_INFO(ghczminternal_GHCziInternalziWord_W32zh_con_info);
    87 87 
     PRELUDE_INFO(ghczminternal_GHCziInternalziWord_W64zh_con_info);
    88 88 
     PRELUDE_INFO(ghczminternal_GHCziInternalziStable_StablePtr_con_info);
    89 89
    90 
    -#define Unit_closure              DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTuple_Z0T_closure)
    91 
    -#define True_closure              DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_True_closure)
    92 
    -#define False_closure             DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_False_closure)
    93 
    -#define unpackCString_closure     DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziPack_unpackCString_closure)
    94 
    -#define runFinalizerBatch_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWeakziFinalizze_runFinalizzerBatch_closure)
    90 
    +#define Unit_closure              (&(ghczminternal_GHCziInternalziTuple_Z0T_closure))
    91 
    +#define True_closure              (&(ghczminternal_GHCziInternalziTypes_True_closure))
    92 
    +#define False_closure             (&(ghczminternal_GHCziInternalziTypes_False_closure))
    93 
    +#define unpackCString_closure     (&(ghczminternal_GHCziInternalziPack_unpackCString_closure))
    94 
    +#define runFinalizerBatch_closure (&(ghczminternal_GHCziInternalziWeakziFinalizze_runFinalizzerBatch_closure))
    95 95 
     #define mainIO_closure            (&ZCMain_main_closure)
    96 96
    97 
    -#define runSparks_closure         DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziSync_runSparks_closure)
    98 
    -#define ensureIOManagerIsRunning_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziIO_ensureIOManagerIsRunning_closure)
    99 
    -#define interruptIOManager_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziIO_interruptIOManager_closure)
    100 
    -#define ioManagerCapabilitiesChanged_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziIO_ioManagerCapabilitiesChanged_closure)
    101 
    -#define runHandlersPtr_closure       DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziSignal_runHandlersPtr_closure)
    97 
    +#define runSparks_closure         (&(ghczminternal_GHCziInternalziConcziSync_runSparks_closure))
    98 
    +#define ensureIOManagerIsRunning_closure (&(ghczminternal_GHCziInternalziConcziIO_ensureIOManagerIsRunning_closure))
    99 
    +#define interruptIOManager_closure (&(ghczminternal_GHCziInternalziConcziIO_interruptIOManager_closure))
    100 
    +#define ioManagerCapabilitiesChanged_closure (&(ghczminternal_GHCziInternalziConcziIO_ioManagerCapabilitiesChanged_closure))
    101 
    +#define runHandlersPtr_closure       (&(ghczminternal_GHCziInternalziConcziSignal_runHandlersPtr_closure))
    102 102 
     #if defined(mingw32_HOST_OS)
    103 
    -#define processRemoteCompletion_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziEventziWindows_processRemoteCompletion_closure)
    103 
    +#define processRemoteCompletion_closure (&(ghczminternal_GHCziInternalziEventziWindows_processRemoteCompletion_closure))
    104 104 
     #endif
    105 
    -#define runAllocationLimitHandler_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziAllocationLimitHandler_runAllocationLimitHandler_closure)
    106 
    -
    107 
    -#define flushStdHandles_closure   DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTopHandler_flushStdHandles_closure)
    108 
    -#define runMainIO_closure   DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTopHandler_runMainIO_closure)
    109 
    -
    110 
    -#define stackOverflow_closure     DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_stackOverflow_closure)
    111 
    -#define heapOverflow_closure      DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure)
    112 
    -#define allocationLimitExceeded_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_allocationLimitExceeded_closure)
    113 
    -#define blockedIndefinitelyOnMVar_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnMVar_closure)
    114 
    -#define blockedIndefinitelyOnSTM_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnSTM_closure)
    115 
    -#define cannotCompactFunction_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_cannotCompactFunction_closure)
    116 
    -#define cannotCompactPinned_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_cannotCompactPinned_closure)
    117 
    -#define cannotCompactMutable_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_cannotCompactMutable_closure)
    118 
    -#define nonTermination_closure    DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziControlziExceptionziBase_nonTermination_closure)
    119 
    -#define nestedAtomically_closure  DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziControlziExceptionziBase_nestedAtomically_closure)
    120 
    -#define absentSumFieldError_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziPrimziPanic_absentSumFieldError_closure)
    121 
    -#define underflowException_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziExceptionziType_underflowException_closure)
    122 
    -#define overflowException_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziExceptionziType_overflowException_closure)
    123 
    -#define divZeroException_closure  DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziExceptionziType_divZZeroException_closure)
    124 
    -
    125 
    -#define blockedOnBadFD_closure    DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziEventziThread_blockedOnBadFD_closure)
    126 
    -
    127 
    -#define Czh_con_info              DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Czh_con_info)
    128 
    -#define Izh_con_info              DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Izh_con_info)
    129 
    -#define Fzh_con_info              DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Fzh_con_info)
    130 
    -#define Dzh_con_info              DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Dzh_con_info)
    131 
    -#define Wzh_con_info              DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Wzh_con_info)
    132 
    -#define W8zh_con_info             DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWord_W8zh_con_info)
    133 
    -#define W16zh_con_info            DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWord_W16zh_con_info)
    134 
    -#define W32zh_con_info            DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWord_W32zh_con_info)
    135 
    -#define W64zh_con_info            DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWord_W64zh_con_info)
    136 
    -#define I8zh_con_info             DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I8zh_con_info)
    137 
    -#define I16zh_con_info            DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I16zh_con_info)
    138 
    -#define I32zh_con_info            DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I32zh_con_info)
    139 
    -#define I64zh_con_info            DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I64zh_con_info)
    140 
    -#define I64zh_con_info            DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I64zh_con_info)
    141 
    -#define Ptr_con_info              DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziPtr_Ptr_con_info)
    142 
    -#define FunPtr_con_info           DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziPtr_FunPtr_con_info)
    143 
    -#define StablePtr_static_info     DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziStable_StablePtr_static_info)
    144 
    -#define StablePtr_con_info        DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziStable_StablePtr_con_info)
    105 
    +#define runAllocationLimitHandler_closure (&(ghczminternal_GHCziInternalziAllocationLimitHandler_runAllocationLimitHandler_closure))
    106 
    +
    107 
    +#define flushStdHandles_closure   (&(ghczminternal_GHCziInternalziTopHandler_flushStdHandles_closure))
    108 
    +#define runMainIO_closure   (&(ghczminternal_GHCziInternalziTopHandler_runMainIO_closure))
    109 
    +
    110 
    +#define stackOverflow_closure     (&(ghczminternal_GHCziInternalziIOziException_stackOverflow_closure))
    111 
    +#define heapOverflow_closure      (&(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure))
    112 
    +#define allocationLimitExceeded_closure (&(ghczminternal_GHCziInternalziIOziException_allocationLimitExceeded_closure))
    113 
    +#define blockedIndefinitelyOnMVar_closure (&(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnMVar_closure))
    114 
    +#define blockedIndefinitelyOnSTM_closure (&(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnSTM_closure))
    115 
    +#define cannotCompactFunction_closure (&(ghczminternal_GHCziInternalziIOziException_cannotCompactFunction_closure))
    116 
    +#define cannotCompactPinned_closure (&(ghczminternal_GHCziInternalziIOziException_cannotCompactPinned_closure))
    117 
    +#define cannotCompactMutable_closure (&(ghczminternal_GHCziInternalziIOziException_cannotCompactMutable_closure))
    118 
    +#define nonTermination_closure    (&(ghczminternal_GHCziInternalziControlziExceptionziBase_nonTermination_closure))
    119 
    +#define nestedAtomically_closure  (&(ghczminternal_GHCziInternalziControlziExceptionziBase_nestedAtomically_closure))
    120 
    +#define absentSumFieldError_closure (&(ghczminternal_GHCziInternalziPrimziPanic_absentSumFieldError_closure))
    121 
    +#define underflowException_closure (&(ghczminternal_GHCziInternalziExceptionziType_underflowException_closure))
    122 
    +#define overflowException_closure (&(ghczminternal_GHCziInternalziExceptionziType_overflowException_closure))
    123 
    +#define divZeroException_closure  (&(ghczminternal_GHCziInternalziExceptionziType_divZZeroException_closure))
    124 
    +
    125 
    +#define blockedOnBadFD_closure    (&(ghczminternal_GHCziInternalziEventziThread_blockedOnBadFD_closure))
    126 
    +
    127 
    +#define Czh_con_info              (&(ghczminternal_GHCziInternalziTypes_Czh_con_info))
    128 
    +#define Izh_con_info              (&(ghczminternal_GHCziInternalziTypes_Izh_con_info))
    129 
    +#define Fzh_con_info              (&(ghczminternal_GHCziInternalziTypes_Fzh_con_info))
    130 
    +#define Dzh_con_info              (&(ghczminternal_GHCziInternalziTypes_Dzh_con_info))
    131 
    +#define Wzh_con_info              (&(ghczminternal_GHCziInternalziTypes_Wzh_con_info))
    132 
    +#define W8zh_con_info             (&(ghczminternal_GHCziInternalziWord_W8zh_con_info))
    133 
    +#define W16zh_con_info            (&(ghczminternal_GHCziInternalziWord_W16zh_con_info))
    134 
    +#define W32zh_con_info            (&(ghczminternal_GHCziInternalziWord_W32zh_con_info))
    135 
    +#define W64zh_con_info            (&(ghczminternal_GHCziInternalziWord_W64zh_con_info))
    136 
    +#define I8zh_con_info             (&(ghczminternal_GHCziInternalziInt_I8zh_con_info))
    137 
    +#define I16zh_con_info            (&(ghczminternal_GHCziInternalziInt_I16zh_con_info))
    138 
    +#define I32zh_con_info            (&(ghczminternal_GHCziInternalziInt_I32zh_con_info))
    139 
    +#define I64zh_con_info            (&(ghczminternal_GHCziInternalziInt_I64zh_con_info))
    140 
    +#define I64zh_con_info            (&(ghczminternal_GHCziInternalziInt_I64zh_con_info))
    141 
    +#define Ptr_con_info              (&(ghczminternal_GHCziInternalziPtr_Ptr_con_info))
    142 
    +#define FunPtr_con_info           (&(ghczminternal_GHCziInternalziPtr_FunPtr_con_info))
    143 
    +#define StablePtr_static_info     (&(ghczminternal_GHCziInternalziStable_StablePtr_static_info))
    144 
    +#define StablePtr_con_info        (&(ghczminternal_GHCziInternalziStable_StablePtr_con_info))

  • rts/RtsSymbols.c
    ... ... @@ -1054,9 +1054,9 @@ RTS_ARM_OUTLINE_ATOMIC_SYMBOLS
    1054 1054 
     #define SymI_HasDataProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
    1055 1055 
                         (void*)(&(vvv)), STRENGTH_NORMAL, SYM_TYPE_DATA },
    1056 1056 
     #define SymE_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
    1057 
    -            (void*)DLL_IMPORT_DATA_REF(vvv), STRENGTH_NORMAL, SYM_TYPE_CODE },
    1057 
    +            (void*)(&(vvv)), STRENGTH_NORMAL, SYM_TYPE_CODE },
    1058 1058 
     #define SymE_HasDataProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
    1059 
    -            (void*)DLL_IMPORT_DATA_REF(vvv), STRENGTH_NORMAL, SYM_TYPE_DATA },
    1059 
    +            (void*)(&(vvv)), STRENGTH_NORMAL, SYM_TYPE_DATA },
    1060 1060
    1061 1061 
     #define SymI_NeedsProto(vvv) SymI_HasProto(vvv)
    1062 1062 
     #define SymI_NeedsDataProto(vvv) SymI_HasDataProto(vvv)

  • rts/include/Rts.h
    ... ... @@ -265,9 +265,9 @@ void _warnFail(const char *filename, unsigned int linenum);
    265 265 
     #include "rts/LibdwPool.h"
    266 266
    267 267 
     /* Misc stuff without a home */
    268 
    -DLL_IMPORT_RTS extern char **prog_argv; /* so we can get at these from Haskell */
    269 
    -DLL_IMPORT_RTS extern int    prog_argc;
    270 
    -DLL_IMPORT_RTS extern char  *prog_name;
    268 
    +extern char **prog_argv; /* so we can get at these from Haskell */
    269 
    +extern int    prog_argc;
    270 
    +extern char  *prog_name;
    271 271
    272 272 
     void reportStackOverflow(StgTSO* tso);
    273 273 
     void reportHeapOverflow(void);

  • rts/include/RtsAPI.h
    ... ... @@ -587,8 +587,8 @@ void rts_done (void);
    587 587 
     extern StgClosure ghczminternal_GHCziInternalziTopHandler_runIO_closure;
    588 588 
     extern StgClosure ghczminternal_GHCziInternalziTopHandler_runNonIO_closure;
    589 589
    590 
    -#define runIO_closure     DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTopHandler_runIO_closure)
    591 
    -#define runNonIO_closure  DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTopHandler_runNonIO_closure)
    590 
    +#define runIO_closure     (&(ghczminternal_GHCziInternalziTopHandler_runIO_closure))
    591 
    +#define runNonIO_closure  (&(ghczminternal_GHCziInternalziTopHandler_runNonIO_closure))
    592 592
    593 593 
     /* ------------------------------------------------------------------------ */
    594 594

  • rts/include/Stg.h
    ... ... @@ -332,7 +332,6 @@ external prototype return neither of these types to workaround #11395.
    332 332 
        Other Stg stuff...
    333 333 
        -------------------------------------------------------------------------- */
    334 334
    335 
    -#include "stg/DLL.h"
    336 335 
     #include "stg/MachRegsForHost.h"
    337 336 
     #include "stg/Regs.h"
    338 337 
     #include "stg/Ticky.h"

  • rts/include/rts/Flags.h
    ... ... @@ -358,7 +358,7 @@ typedef struct _RTS_FLAGS {
    358 358 
     } RTS_FLAGS;
    359 359
    360 360 
     #if defined(COMPILING_RTS_MAIN)
    361 
    -extern DLLIMPORT RTS_FLAGS RtsFlags;
    361 
    +extern RTS_FLAGS RtsFlags;
    362 362 
     #elif IN_STG_CODE
    363 363 
     /* Note [RtsFlags is a pointer in STG code]
    364 364 
      * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  • rts/include/rts/NonMoving.h
    ... ... @@ -19,10 +19,10 @@ struct StgThunk_;
    19 19 
     struct Capability_;
    20 20
    21 21 
     /* This is called by the code generator */
    22 
    -extern DLL_IMPORT_RTS
    22 
    +extern
    23 23 
     void updateRemembSetPushClosure_(StgRegTable *reg, struct StgClosure_ *p);
    24 24
    25 
    -extern DLL_IMPORT_RTS
    25 
    +extern
    26 26 
     void updateRemembSetPushThunk_(StgRegTable *reg, struct StgThunk_ *p);
    27 27
    28 28 
     // Forward declaration for unregisterised backend.
    ... ... @@ -31,7 +31,7 @@ EF_(stg_copyArray_barrier);
    31 31 
     // Note that RTS code should not condition on this directly by rather
    32 32 
     // use the IF_NONMOVING_WRITE_BARRIER_ENABLED macro to ensure that
    33 33 
     // the barrier is eliminated in the non-threaded RTS.
    34 
    -extern StgWord DLL_IMPORT_DATA_VAR(nonmoving_write_barrier_enabled);
    34 
    +extern StgWord nonmoving_write_barrier_enabled;
    35 35
    36 36 
     // A similar macro is defined in rts/include/Cmm.h for C-- code.
    37 37 
     #if defined(THREADED_RTS)

  • rts/include/rts/StableName.h
    ... ... @@ -29,4 +29,4 @@ typedef struct {
    29 29 
                              // free
    30 30 
     } snEntry;
    31 31
    32 
    -extern DLL_IMPORT_RTS snEntry *stable_name_table;
    32 
    +extern snEntry *stable_name_table;

  • rts/include/rts/StablePtr.h
    ... ... @@ -26,7 +26,7 @@ typedef struct {
    26 26 
                              // otherwise.
    27 27 
     } spEntry;
    28 28
    29 
    -extern DLL_IMPORT_RTS spEntry *stable_ptr_table;
    29 
    +extern spEntry *stable_ptr_table;
    30 30
    31 31 
     ATTR_ALWAYS_INLINE EXTERN_INLINE
    32 32 
     StgPtr deRefStablePtr(StgStablePtr sp)

  • rts/include/stg/DLL.h deleted
    1 
    -/* -----------------------------------------------------------------------------
    2 
    - *
    3 
    - * (c) The GHC Team, 1998-2009
    4 
    - *
    5 
    - * Support for Windows DLLs.
    6 
    - *
    7 
    - * Do not #include this file directly: #include "Rts.h" instead.
    8 
    - *
    9 
    - * To understand the structure of the RTS headers, see the wiki:
    10 
    - *   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes
    11 
    - *
    12 
    - * ---------------------------------------------------------------------------*/
    13 
    -
    14 
    -#pragma once
    15 
    -
    16 
    -#  define DLL_IMPORT_DATA_REF(x) (&(x))
    17 
    -#  define DLL_IMPORT_DATA_VARNAME(x) x
    18 
    -#  define DLLIMPORT
    19 
    -
    20 
    -/* The view of the rts/include/ header files differ ever so
    21 
    -   slightly depending on whether the RTS is being compiled
    22 
    -   or not - so we're forced to distinguish between two.
    23 
    -   [oh, you want details :) : Data symbols defined by the RTS
    24 
    -    have to be accessed through an extra level of indirection
    25 
    -    when compiling generated .hc code compared to when the RTS
    26 
    -    sources are being processed. This is only the case when
    27 
    -    using Win32 DLLs. ]
    28 
    -*/
    29 
    -#if defined(COMPILING_RTS)
    30 
    -#define DLL_IMPORT_RTS
    31 
    -#define DLL_IMPORT_DATA_VAR(x) x
    32 
    -#else
    33 
    -#define DLL_IMPORT_RTS DLLIMPORT
    34 
    -#define DLL_IMPORT_DATA_VAR(x) x
    35 
    -#endif

  • rts/include/stg/MiscClosures.h
    ... ... @@ -25,14 +25,14 @@
    25 25 
     #  define RTS_THUNK_INFO(i) extern const W_(i)[]
    26 26 
     #  define RTS_INFO(i)       extern const W_(i)[]
    27 27 
     #  define RTS_CLOSURE(i)    extern W_(i)[]
    28 
    -#  define RTS_FUN_DECL(f)   extern DLL_IMPORT_RTS StgFunPtr f(void)
    28 
    +#  define RTS_FUN_DECL(f)   extern StgFunPtr f(void)
    29 29 
     #else
    30 
    -#  define RTS_RET_INFO(i)   extern DLL_IMPORT_RTS const StgRetInfoTable i
    31 
    -#  define RTS_FUN_INFO(i)   extern DLL_IMPORT_RTS const StgFunInfoTable i
    32 
    -#  define RTS_THUNK_INFO(i) extern DLL_IMPORT_RTS const StgThunkInfoTable i
    33 
    -#  define RTS_INFO(i)       extern DLL_IMPORT_RTS const StgInfoTable i
    34 
    -#  define RTS_CLOSURE(i)    extern DLL_IMPORT_RTS StgClosure i
    35 
    -#  define RTS_FUN_DECL(f)   extern DLL_IMPORT_RTS StgFunPtr f(void)
    30 
    +#  define RTS_RET_INFO(i)   extern const StgRetInfoTable i
    31 
    +#  define RTS_FUN_INFO(i)   extern const StgFunInfoTable i
    32 
    +#  define RTS_THUNK_INFO(i) extern const StgThunkInfoTable i
    33 
    +#  define RTS_INFO(i)       extern const StgInfoTable i
    34 
    +#  define RTS_CLOSURE(i)    extern StgClosure i
    35 
    +#  define RTS_FUN_DECL(f)   extern StgFunPtr f(void)
    36 36 
     #endif
    37 37
    38 38 
     #if defined(TABLES_NEXT_TO_CODE)
    ... ... @@ -274,11 +274,11 @@ RTS_CLOSURE(stg_NO_TREC_closure);
    274 274 
     RTS_ENTRY(stg_NO_FINALIZER);
    275 275
    276 276 
     #if IN_STG_CODE
    277 
    -extern DLL_IMPORT_RTS StgWordArray stg_CHARLIKE_closure;
    278 
    -extern DLL_IMPORT_RTS StgWordArray stg_INTLIKE_closure;
    277 
    +extern StgWordArray stg_CHARLIKE_closure;
    278 
    +extern StgWordArray stg_INTLIKE_closure;
    279 279 
     #else
    280 
    -extern DLL_IMPORT_RTS StgIntCharlikeClosure stg_CHARLIKE_closure[];
    281 
    -extern DLL_IMPORT_RTS StgIntCharlikeClosure stg_INTLIKE_closure[];
    280 
    +extern StgIntCharlikeClosure stg_CHARLIKE_closure[];
    281 
    +extern StgIntCharlikeClosure stg_INTLIKE_closure[];
    282 282 
     #endif
    283 283
    284 284 
     /* StgStartup */

  • rts/rts.cabal
    ... ... @@ -334,7 +334,6 @@ library
    334 334 
                             rts/storage/InfoTables.h
    335 335 
                             rts/storage/MBlock.h
    336 336 
                             rts/storage/TSO.h
    337 
    -                        stg/DLL.h
    338 337 
                             stg/MachRegs.h
    339 338 
                             stg/MachRegs/arm32.h
    340 339 
                             stg/MachRegs/arm64.h

  • testsuite/tests/llvm/should_run/T26065.hs
    1 
    +{-# LANGUAGE MagicHash #-}
    2 
    +{-# LANGUAGE ScopedTypeVariables #-}
    3 
    +import Data.Char (toUpper)
    4 
    +import GHC.Exts
    5 
    +import GHC.Word
    6 
    +import Numeric (showHex)
    7 
    +
    8 
    +pdep8 :: Word8 -> Word8 -> Word8
    9 
    +pdep8 (W8# a) (W8# b) = W8# (wordToWord8# (pdep8# (word8ToWord# a) (word8ToWord# b)))
    10 
    +{-# NOINLINE pdep8 #-}
    11 
    +
    12 
    +pdep16 :: Word16 -> Word16 -> Word16
    13 
    +pdep16 (W16# a) (W16# b) = W16# (wordToWord16# (pdep16# (word16ToWord# a) (word16ToWord# b)))
    14 
    +{-# NOINLINE pdep16 #-}
    15 
    +
    16 
    +pdep32 :: Word32 -> Word32 -> Word32
    17 
    +pdep32 (W32# a) (W32# b) = W32# (wordToWord32# (pdep32# (word32ToWord# a) (word32ToWord# b)))
    18 
    +{-# NOINLINE pdep32 #-}
    19 
    +
    20 
    +pdep64 :: Word64 -> Word64 -> Word64
    21 
    +pdep64 (W64# a) (W64# b) = W64# (pdep64# a b)
    22 
    +{-# NOINLINE pdep64 #-}
    23 
    +
    24 
    +pext8 :: Word8 -> Word8 -> Word8
    25 
    +pext8 (W8# a) (W8# b) = W8# (wordToWord8# (pext8# (word8ToWord# a) (word8ToWord# b)))
    26 
    +{-# NOINLINE pext8 #-}
    27 
    +
    28 
    +pext16 :: Word16 -> Word16 -> Word16
    29 
    +pext16 (W16# a) (W16# b) = W16# (wordToWord16# (pext16# (word16ToWord# a) (word16ToWord# b)))
    30 
    +{-# NOINLINE pext16 #-}
    31 
    +
    32 
    +pext32 :: Word32 -> Word32 -> Word32
    33 
    +pext32 (W32# a) (W32# b) = W32# (wordToWord32# (pext32# (word32ToWord# a) (word32ToWord# b)))
    34 
    +{-# NOINLINE pext32 #-}
    35 
    +
    36 
    +pext64 :: Word64 -> Word64 -> Word64
    37 
    +pext64 (W64# a) (W64# b) = W64# (pext64# a b)
    38 
    +{-# NOINLINE pext64 #-}
    39 
    +
    40 
    +valueSource :: Integral i => i
    41 
    +valueSource = fromInteger 0xA7F7A7F7A7F7A7F7
    42 
    +
    43 
    +valueMask   :: Integral i => i
    44 
    +valueMask   = fromInteger 0x5555555555555555
    45 
    +
    46 
    +printIntrinsicCall :: forall i. Integral i => String -> (i -> i -> i) -> IO ()
    47 
    +printIntrinsicCall label f =
    48 
    +  let op1 = valueSource
    49 
    +      op2 = valueMask
    50 
    +      pad s =
    51 
    +          let hex :: Integral a => a -> String
    52 
    +              hex = flip showHex ""
    53 
    +              str = toUpper <$> hex s
    54 
    +              len = length $ hex (maxBound :: Word64)
    55 
    +              n   = length str
    56 
    +          in  "0x" <> replicate (len - n) '0' <> str
    57 
    +  in  putStrLn $ unwords [ label, pad op1, pad op2, "=", pad (f op1 op2) ]
    58 
    +
    59 
    +main :: IO ()
    60 
    +main = do
    61 
    +  printIntrinsicCall "pdep8 " pdep8
    62 
    +  printIntrinsicCall "pdep16" pdep16
    63 
    +  printIntrinsicCall "pdep32" pdep32
    64 
    +  printIntrinsicCall "pdep64" pdep64
    65 
    +  printIntrinsicCall "pext8 " pext8
    66 
    +  printIntrinsicCall "pext16" pext16
    67 
    +  printIntrinsicCall "pext32" pext32
    68 
    +  printIntrinsicCall "pext64" pext64

  • testsuite/tests/llvm/should_run/T26065.stdout
    1 
    +pdep8  0x00000000000000F7 0x0000000000000055 = 0x0000000000000015
    2 
    +pdep16 0x000000000000A7F7 0x0000000000005555 = 0x0000000000005515
    3 
    +pdep32 0x00000000A7F7A7F7 0x0000000055555555 = 0x0000000044155515
    4 
    +pdep64 0xA7F7A7F7A7F7A7F7 0x5555555555555555 = 0x4415551544155515
    5 
    +pext8  0x00000000000000F7 0x0000000000000055 = 0x000000000000000F
    6 
    +pext16 0x000000000000A7F7 0x0000000000005555 = 0x000000000000003F
    7 
    +pext32 0x00000000A7F7A7F7 0x0000000055555555 = 0x0000000000003F3F
    8 
    +pext64 0xA7F7A7F7A7F7A7F7 0x5555555555555555 = 0x000000003F3F3F3F

  • testsuite/tests/llvm/should_run/all.T
    ... ... @@ -18,3 +18,8 @@ test('T22033', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex)], compile_a
    18 18 
     test('T25730', [req_c, unless(arch('x86_64'), skip), normalise_errmsg_fun(ignore_llvm_and_vortex)], compile_and_run, ['T25730C.c'])
    19 19 
       # T25730C.c contains Intel instrinsics, so only run this test on x86
    20 20 
     test('T20645', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex), when(have_llvm(), extra_ways(["optllvm"]))], compile_and_run, [''])
    21 
    +# T26065.c tests LLVM linking of Intel instrinsics, so only run this test on x86
    22 
    +test('T26065', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex), when(have_llvm(), extra_ways(["optllvm"])),
    23 
    +                unless((arch('x86_64') or arch('i386')) and have_cpu_feature('bmi2'),skip)],
    24 
    +                compile_and_run, ['-mbmi2'])
    25 
    +

  • testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs
    ... ... @@ -19,13 +19,14 @@ pass :: ModGuts -> CoreM ModGuts
    19 19 
     pass g = do
    20 20 
               dflags <- getDynFlags
    21 21 
               mapM_ (printAnn dflags g) (mg_binds g) >> return g
    22 
    -  where printAnn :: DynFlags -> ModGuts -> CoreBind -> CoreM CoreBind
    23 
    -        printAnn dflags guts bndr@(NonRec b _) = do
    22 
    +  where printAnn :: DynFlags -> ModGuts -> CoreBind -> CoreM ()
    23 
    +        printAnn dflags guts (NonRec b _) = lookupAnn dflags guts b
    24 
    +        printAnn dflags guts (Rec ps) = mapM_ (lookupAnn dflags guts . fst) ps
    25 
    +
    26 
    +        lookupAnn dflags guts b = do
    24 27 
               anns <- annotationsOn guts b :: CoreM [SomeAnn]
    25 28 
               unless (null anns) $ putMsgS $
    26 29 
                 "Annotated binding found: " ++  showSDoc dflags (ppr b)
    27 
    -          return bndr
    28 
    -        printAnn _ _ bndr = return bndr
    29 30
    30 31 
     annotationsOn :: Data a => ModGuts -> CoreBndr -> CoreM [a]
    31 32 
     annotationsOn guts bndr = do

  • testsuite/tests/plugins/late-plugin/LatePlugin.hs
    ... ... @@ -43,8 +43,13 @@ editCoreBinding early modName pgm = do
    43 43 
         pure $ go pgm
    44 44 
       where
    45 45 
         go :: [CoreBind] -> [CoreBind]
    46 
    -    go (b@(NonRec v e) : bs)
    47 
    -      | occNameString (getOccName v) == "testBinding" && exprType e `eqType` intTy =
    48 
    -          NonRec v (mkUncheckedIntExpr $ bool 222222 111111 early) : bs
    49 
    -    go (b:bs) = b : go bs
    46 
    +    go (Rec ps : bs) = Rec (map (uncurry (go_bind (,))) ps) : go bs
    47 
    +    go (NonRec v e : bs) = go_bind NonRec v e : go bs
    50 48 
         go [] = []
    49 
    +
    50 
    +    go_bind c v e
    51 
    +      | occNameString (getOccName v) == "testBinding"
    52 
    +      , exprType e `eqType` intTy
    53 
    +      = c v (mkUncheckedIntExpr $ bool 222222 111111 early)
    54 
    +      | otherwise
    55 
    +      = c v e

  • testsuite/tests/plugins/simple-plugin/Simple/ReplacePlugin.hs
    ... ... @@ -51,5 +51,6 @@ fixGuts rep guts = pure $ guts { mg_binds = fmap fix_bind (mg_binds guts) }
    51 51 
           Tick t e      -> Tick t (fix_expr e)
    52 52 
           Type t        -> Type t
    53 53 
           Coercion c    -> Coercion c
    54 
    +      Let b body    -> Let (fix_bind b) (fix_expr body)
    54 55
    55 56 
         fix_alt (Alt c bs e) = Alt c bs (fix_expr e)

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help