[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Fix FMA instruction on LLVM

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Tue Jan 23 15:16:45 UTC 2024



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


Commits:
38fe28df by sheaf at 2024-01-23T10:16:29-05:00
Fix FMA instruction on LLVM

We were emitting the wrong instructions for fused multiply-add
operations on LLVM:

  - the instruction name is "llvm.fma.f32" or "llvm.fma.f64", not "fmadd"
  - LLVM does not support other instructions such as "fmsub"; instead
    we implement these by flipping signs of some arguments
  - the instruction is an LLVM intrinsic, which requires handling it
    like a normal function call instead of a machine instruction

Fixes #24223

- - - - -
e9ea05e8 by Jade at 2024-01-23T10:16:30-05:00
Enhance Documentation of functions exported by Data.Function

This patch aims to improve the documentation of functions exported
in Data.Function

Tracking: #17929
Fixes: #10065

- - - - -
50b8e1d5 by Jade at 2024-01-23T10:16:31-05:00
Improve documentation of hGetLine.

- Add explanation for whether a newline is returned
- Add examples

Fixes #14804

- - - - -


7 changed files:

- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/Llvm/Ppr.hs
- compiler/GHC/Llvm/Syntax.hs
- libraries/base/src/Data/Function.hs
- libraries/base/src/GHC/Base.hs
- libraries/base/src/GHC/IO/Handle/Text.hs
- testsuite/tests/primops/should_run/all.T


Changes:

=====================================
compiler/GHC/CmmToLlvm/CodeGen.hs
=====================================
@@ -12,6 +12,7 @@ import GHC.Platform
 import GHC.Platform.Regs ( activeStgRegs )
 
 import GHC.Llvm
+import GHC.Llvm.Types
 import GHC.CmmToLlvm.Base
 import GHC.CmmToLlvm.Config
 import GHC.CmmToLlvm.Regs
@@ -1765,31 +1766,49 @@ genMachOp_slow opt op [x, y] = case op of
                     pprPanic "isSMulOK: Not bit type! " $
                         lparen <> ppr word <> rparen
 
-        panicOp = panic $ "LLVM.CodeGen.genMachOp_slow: unary op encountered"
+        panicOp = panic $ "LLVM.CodeGen.genMachOp_slow: non-binary op encountered"
                        ++ "with two arguments! (" ++ show op ++ ")"
 
-genMachOp_slow _opt op [x, y, z] = case op of
-    MO_FMA var _ -> triLlvmOp getVarType (FMAOp var)
-    _            -> panicOp
-    where
-        triLlvmOp ty op = do
-          platform <- getPlatform
-          runExprData $ do
-            vx <- exprToVarW x
-            vy <- exprToVarW y
-            vz <- exprToVarW z
-
-            if | getVarType vx == getVarType vy
-               , getVarType vx == getVarType vz
-               -> doExprW (ty vx) $ op vx vy vz
-               | otherwise
-               -> pprPanic "triLlvmOp types" (pdoc platform x $$ pdoc platform y $$ pdoc platform z)
-        panicOp = panic $ "LLVM.CodeGen.genMachOp_slow: non-ternary op encountered"
-                       ++ "with three arguments! (" ++ show op ++ ")"
+genMachOp_slow _opt op [x, y, z] = do
+  platform <- getPlatform
+  let
+    neg x = CmmMachOp (MO_F_Neg (cmmExprWidth platform x)) [x]
+    panicOp = panic $ "LLVM.CodeGen.genMachOp_slow: non-ternary op encountered"
+                   ++ "with three arguments! (" ++ show op ++ ")"
+  case op of
+    MO_FMA var _ ->
+      case var of
+        -- LLVM only has the fmadd variant.
+        FMAdd   -> genFmaOp x y z
+        -- Other fused multiply-add operations are implemented in terms of fmadd
+        -- This is sound: it does not lose any precision.
+        FMSub   -> genFmaOp x y (neg z)
+        FNMAdd  -> genFmaOp (neg x) y z
+        FNMSub  -> genFmaOp (neg x) y (neg z)
+    _ -> panicOp
 
 -- More than three expressions, invalid!
 genMachOp_slow _ _ _ = panic "genMachOp_slow: More than 3 expressions in MachOp!"
 
+-- | Generate code for a fused multiply-add operation.
+genFmaOp :: CmmExpr -> CmmExpr -> CmmExpr -> LlvmM ExprData
+genFmaOp x y z = runExprData $ do
+  vx <- exprToVarW x
+  vy <- exprToVarW y
+  vz <- exprToVarW z
+  let tx = getVarType vx
+      ty = getVarType vy
+      tz = getVarType vz
+  Panic.massertPpr
+    (tx == ty && tx == tz)
+    (vcat [ text "fma: mismatched arg types"
+          , ppLlvmType tx, ppLlvmType ty, ppLlvmType tz ])
+  let fname = case tx of
+        LMFloat  -> fsLit "llvm.fma.f32"
+        LMDouble -> fsLit "llvm.fma.f64"
+        _ -> pprPanic "fma: type not LMFloat or LMDouble" (ppLlvmType tx)
+  fptr <- liftExprData $ getInstrinct fname ty [tx, ty, tz]
+  doExprW tx $ Call StdCall fptr [vx, vy, vz] [ReadNone, NoUnwind]
 
 -- | Handle CmmLoad expression.
 genLoad :: Atomic -> CmmExpr -> CmmType -> AlignmentSpec -> LlvmM ExprData


=====================================
compiler/GHC/Llvm/Ppr.hs
=====================================
@@ -27,7 +27,7 @@ module GHC.Llvm.Ppr (
     ppLit,
     ppTypeLit,
     ppName,
-    ppPlainName
+    ppPlainName,
 
     ) where
 
@@ -40,7 +40,6 @@ import GHC.Llvm.Types
 import Data.List ( intersperse )
 import GHC.Utils.Outputable
 
-import GHC.Cmm.MachOp ( FMASign(..), pprFMASign )
 import GHC.CmmToLlvm.Config
 import GHC.Utils.Panic
 import GHC.Types.Unique
@@ -289,7 +288,6 @@ ppLlvmExpression opts expr
         AtomicRMW  aop tgt src ordering -> ppAtomicRMW opts aop tgt src ordering
         CmpXChg    addr old new s_ord f_ord -> ppCmpXChg opts addr old new s_ord f_ord
         Phi        tp predecessors  -> ppPhi opts tp predecessors
-        FMAOp      op x y z         -> pprFMAOp opts op x y z
         Asm        asm c ty v se sk -> ppAsm opts asm c ty v se sk
         MExpr      meta expr        -> ppMetaAnnotExpr opts meta expr
 {-# SPECIALIZE ppLlvmExpression :: LlvmCgConfig -> LlvmExpression -> SDoc #-}
@@ -377,13 +375,6 @@ ppCmpOp opts op left right =
 {-# SPECIALIZE ppCmpOp :: LlvmCgConfig -> LlvmCmpOp -> LlvmVar -> LlvmVar -> SDoc #-}
 {-# SPECIALIZE ppCmpOp :: LlvmCgConfig -> LlvmCmpOp -> LlvmVar -> LlvmVar -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
-pprFMAOp :: IsLine doc => LlvmCgConfig -> FMASign -> LlvmVar -> LlvmVar -> LlvmVar -> doc
-pprFMAOp opts signs x y z =
-  pprFMASign signs <+> ppLlvmType (getVarType x)
-        <+> ppName opts x <> comma
-        <+> ppName opts y <> comma
-        <+> ppName opts z
-
 ppAssignment :: IsLine doc => LlvmCgConfig -> LlvmVar -> doc -> doc
 ppAssignment opts var expr = ppName opts var <+> equals <+> expr
 {-# SPECIALIZE ppAssignment :: LlvmCgConfig -> LlvmVar -> SDoc -> SDoc #-}


=====================================
compiler/GHC/Llvm/Syntax.hs
=====================================
@@ -10,7 +10,6 @@ import GHC.Llvm.MetaData
 import GHC.Llvm.Types
 
 import GHC.Types.Unique
-import GHC.Cmm.MachOp ( FMASign(..) )
 
 -- | Block labels
 type LlvmBlockId = Unique
@@ -339,8 +338,6 @@ data LlvmExpression
   -}
   | Asm LMString LMString LlvmType [LlvmVar] Bool Bool
 
-  | FMAOp FMASign LlvmVar LlvmVar LlvmVar
-
   {- |
     A LLVM expression with metadata attached to it.
   -}


=====================================
libraries/base/src/Data/Function.hs
=====================================
@@ -39,7 +39,12 @@ infixl 1 &
 -- | @'fix' f@ is the least fixed point of the function @f@,
 -- i.e. the least defined @x@ such that @f x = x at .
 --
--- For example, we can write the factorial function using direct recursion as
+-- When @f@ is strict, this means that because, by the definition of strictness,
+-- @f &#x22a5; = &#x22a5;@ and such the least defined fixed point of any strict function is @&#x22a5;@.
+--
+-- ==== __Examples__
+--
+-- We can write the factorial function using direct recursion as
 --
 -- >>> let fac n = if n <= 1 then 1 else n * fac (n-1) in fac 5
 -- 120
@@ -47,12 +52,31 @@ infixl 1 &
 -- This uses the fact that Haskell’s @let@ introduces recursive bindings. We can
 -- rewrite this definition using 'fix',
 --
--- >>> fix (\rec n -> if n <= 1 then 1 else n * rec (n-1)) 5
--- 120
---
 -- Instead of making a recursive call, we introduce a dummy parameter @rec@;
 -- when used within 'fix', this parameter then refers to 'fix'’s argument, hence
 -- the recursion is reintroduced.
+--
+-- >>> fix (\rec n -> if n <= 1 then 1 else n * rec (n-1)) 5
+-- 120
+--
+-- Using 'fix', we can implement versions of 'Data.List.repeat' as @'fix' '.' '(:)'@
+-- and 'Data.List.cycle' as @'fix' '.' '(++)'@
+--
+-- >>> take 10 $ fix (0:)
+-- [0,0,0,0,0,0,0,0,0,0]
+--
+-- >>> map (fix (\rec n -> if n < 2 then n else rec (n - 1) + rec (n - 2))) [1..10]
+-- [1,1,2,3,5,8,13,21,34,55]
+--
+-- ==== __Implementation Details__
+--
+-- The current implementation of 'fix' uses structural sharing
+--
+-- @'fix' f = let x = f x in x@
+--
+-- A more straightforward but non-sharing version would look like
+--
+-- @'fix' f = f ('fix' f)@
 fix :: (a -> a) -> a
 fix f = let x = f x in x
 
@@ -60,11 +84,20 @@ fix f = let x = f x in x
 -- unary function @u@ to two arguments @x@ and @y at . From the opposite
 -- perspective, it transforms two inputs and combines the outputs.
 --
--- @((+) \``on`\` f) x y = f x + f y@
+-- @(op \``on`\` f) x y = f x \``op`\` f y@
+--
+-- ==== __Examples__
 --
--- Typical usage: @'Data.List.sortBy' ('Prelude.compare' \`on\` 'Prelude.fst')@.
+-- >>> sortBy (compare `on` length) [[0, 1, 2], [0, 1], [], [0]]
+-- [[],[0],[0,1],[0,1,2]]
 --
--- Algebraic properties:
+-- >>> ((+) `on` length) [1, 2, 3] [-1]
+-- 4
+--
+-- >>> ((,) `on` (*2)) 2 3
+-- (4,6)
+--
+-- ==== __Algebraic properties__
 --
 -- * @(*) \`on\` 'id' = (*) -- (if (*) &#x2209; {&#x22a5;, 'const' &#x22a5;})@
 --
@@ -118,9 +151,19 @@ on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
 -- convenience.  Its precedence is one higher than that of the forward
 -- application operator '$', which allows '&' to be nested in '$'.
 --
+--
+-- This is a version of @'flip' 'id'@, where 'id' is specialized from @a -> a@ to @(a -> b) -> (a -> b)@
+-- which by the associativity of @(->)@ is @(a -> b) -> a -> b at .
+-- flipping this yields @a -> (a -> b) -> b@ which is the type signature of '&'
+--
+-- ==== __Examples__
+--
 -- >>> 5 & (+1) & show
 -- "6"
 --
+-- >>> sqrt $ [1 / n^2 | n <- [1..1000]] & sum & (*6)
+-- 3.1406380562059946
+--
 -- @since 4.8.0.0
 (&) :: forall r a (b :: TYPE r). a -> (a -> b) -> b
 x & f = f x
@@ -130,7 +173,15 @@ x & f = f x
 --
 -- It is equivalent to @'flip' ('Data.Bool.bool' 'id')@.
 --
--- Algebraic properties:
+-- ==== __Examples__
+--
+-- >>> map (\x -> applyWhen (odd x) (*2) x) [1..10]
+-- [2,2,6,4,10,6,14,8,18,10]
+--
+-- >>> map (\x -> applyWhen (length x > 6) ((++ "...") . take 3) x) ["Hi!", "This is amazing", "Hope you're doing well today!", ":D"]
+-- ["Hi!","Thi...","Hop...",":D"]
+--
+-- ==== __Algebraic properties__
 --
 -- * @applyWhen 'True' = 'id'@
 --


=====================================
libraries/base/src/GHC/Base.hs
=====================================
@@ -1703,6 +1703,20 @@ maxInt  = I# 0x7FFFFFFFFFFFFFFF#
 -- | Identity function.
 --
 -- > id x = x
+--
+-- This function might seem useless at first glance, but it can be very useful
+-- in a higher order context.
+--
+-- ==== __Examples__
+--
+-- >>> length $ filter id [True, True, False, True]
+-- 3
+--
+-- >>> Just (Just 3) >>= id
+-- Just 3
+--
+-- >>> foldr id 0 [(^3), (*5), (+2)]
+-- 1000
 id                      :: a -> a
 id x                    =  x
 
@@ -1736,6 +1750,13 @@ breakpointCond _ r = r
 data Opaque = forall a. O a
 -- | @const x y@ always evaluates to @x@, ignoring its second argument.
 --
+-- > const x = \_ -> x
+--
+-- This function might seem useless at first glance, but it can be very useful
+-- in a higher order context.
+--
+-- ==== __Examples__
+--
 -- >>> const 42 "hello"
 -- 42
 --
@@ -1744,7 +1765,22 @@ data Opaque = forall a. O a
 const                   :: a -> b -> a
 const x _               =  x
 
--- | Function composition.
+-- | Right to left function composition.
+--
+-- prop> (f . g) x = f (g x)
+--
+-- prop> f . id = f = id . f
+--
+-- ==== __Examples__
+--
+-- >>> map ((*2) . length) [[], [0, 1, 2], [0]]
+-- [0,6,2]
+--
+-- >>> foldr (.) id [(+1), (*3), (^3)] 2
+-- 25
+--
+-- >>> let (...) = (.).(.) in ((*2)...(+)) 5 10
+-- 30
 {-# INLINE (.) #-}
 -- Make sure it has TWO args only on the left, so that it inlines
 -- when applied to two functions, even if there is no final argument
@@ -1753,8 +1789,17 @@ const x _               =  x
 
 -- | @'flip' f@ takes its (first) two arguments in the reverse order of @f at .
 --
+-- prop> flip f x y = f y x
+--
+-- prop> flip . flip = id
+--
+-- ==== __Examples__
+--
 -- >>> flip (++) "hello" "world"
 -- "worldhello"
+--
+-- >>> let (.>) = flip (.) in (+1) .> show $ 5
+-- "6"
 flip                    :: (a -> b -> c) -> b -> a -> c
 flip f x y              =  f y x
 
@@ -1766,15 +1811,18 @@ flip f x y              =  f y x
 -- (\x -> undefined x) `seq` () and thus would just evaluate to (), but now
 -- it is equivalent to undefined `seq` () which diverges.
 
-{- | @($)@ is the __function application__ operator.
+{- | @'($)'@ is the __function application__ operator.
 
-Applying @($)@ to a function @f@ and an argument @x@ gives the same result as applying @f@ to @x@ directly. The definition is akin to this:
+Applying @'($)'@ to a function @f@ and an argument @x@ gives the same result as applying @f@ to @x@ directly. The definition is akin to this:
 
 @
 ($) :: (a -> b) -> a -> b
 ($) f x = f x
 @
 
+This is @'id'@ specialized from @a -> a@ to @(a -> b) -> (a -> b)@ which by the associativity of @(->)@
+is the same as @(a -> b) -> a -> b at .
+
 On the face of it, this may appear pointless! But it's actually one of the most useful and important operators in Haskell.
 
 The order of operations is very different between @($)@ and normal function application. Normal function application has precedence 10 - higher than any operator - and associates to the left. So these two definitions are equivalent:
@@ -1791,7 +1839,7 @@ expr = min 5 $ 1 + 5
 expr = (min 5) (1 + 5)
 @
 
-=== Uses
+==== __Examples__
 
 A common use cases of @($)@ is to avoid parentheses in complex expressions.
 
@@ -1820,7 +1868,7 @@ applyFive = map ($ 5) [(+1), (2^)]
 >>> [6, 32]
 @
 
-=== Technical Remark (Representation Polymorphism)
+==== __Technical Remark (Representation Polymorphism)__
 
 @($)@ is fully representation-polymorphic. This allows it to also be used with arguments of unlifted and even unboxed kinds, such as unboxed integers:
 


=====================================
libraries/base/src/GHC/IO/Handle/Text.hs
=====================================
@@ -179,16 +179,28 @@ hGetChar handle =
 
 -- | Computation 'hGetLine' @hdl@ reads a line from the file or
 -- channel managed by @hdl at .
+-- 'hGetLine' does not return the newline as part of the result.
+--
+-- A line is separated by the newline
+-- set with 'System.IO.hSetNewlineMode' or 'nativeNewline' by default.
+-- The read newline character(s) are not returned as part of the result.
+--
+-- If 'hGetLine' encounters end-of-file at any point while reading
+-- in the middle of a line, it is treated as a line terminator and the (partial)
+-- line is returned.
 --
 -- This operation may fail with:
 --
 --  * 'isEOFError' if the end of file is encountered when reading
 --    the /first/ character of the line.
 --
--- If 'hGetLine' encounters end-of-file at any other point while reading
--- in a line, it is treated as a line terminator and the (partial)
--- line is returned.
-
+-- ==== __Examples__
+--
+-- >>> withFile "/home/user/foo" ReadMode hGetLine >>= putStrLn
+-- this is the first line of the file :O
+--
+-- >>> withFile "/home/user/bar" ReadMode (replicateM 3 . hGetLine)
+-- ["this is the first line","this is the second line","this is the third line"]
 hGetLine :: Handle -> IO String
 hGetLine h =
   wantReadableHandle_ "hGetLine" h $ \ handle_ ->


=====================================
testsuite/tests/primops/should_run/all.T
=====================================
@@ -61,12 +61,14 @@ test('UnliftedWeakPtr', normal, compile_and_run, [''])
 test('FMA_Primops'
     , [ when(have_cpu_feature('fma'), extra_hc_opts('-mfma'))
       , js_skip # JS backend doesn't have an FMA implementation
+      , when(have_llvm(), extra_ways(["optllvm"]))
       ]
      , compile_and_run, [''])
 test('FMA_ConstantFold'
-    , [ js_skip # JS backend doesn't have an FMA implementation ]
+    , [ when(have_cpu_feature('fma'), extra_hc_opts('-mfma'))
+      , js_skip # JS backend doesn't have an FMA implementation
       , expect_broken(21227)
-      , omit_ghci # fails during compilation phase, remove after !10563
+      , when(have_llvm(), extra_ways(["optllvm"]))
       ]
     , compile_and_run, ['-O'])
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4b24d5c93915a2df6e67edbd4ccf783616b1a23e...50b8e1d5e7f6d299f009d1acbd930972a069265e

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4b24d5c93915a2df6e67edbd4ccf783616b1a23e...50b8e1d5e7f6d299f009d1acbd930972a069265e
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240123/2b16060b/attachment-0001.html>


More information about the ghc-commits mailing list