[Git][ghc/ghc][master] 2 commits: Add clamp function to Data.Ord

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00
Add clamp function to Data.Ord

- - - - -
fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00
Add tests

- - - - -


4 changed files:

- libraries/base/Data/Ord.hs
- libraries/base/tests/all.T
- + libraries/base/tests/clamp.hs
- + libraries/base/tests/clamp.stdout


Changes:

=====================================
libraries/base/Data/Ord.hs
=====================================
@@ -21,6 +21,7 @@ module Data.Ord (
    Ordering(..),
    Down(..),
    comparing,
+   clamp,
  ) where
 
 import Data.Bits (Bits, FiniteBits)
@@ -44,6 +45,25 @@ import GHC.Show
 comparing :: (Ord a) => (b -> a) -> b -> b -> Ordering
 comparing p x y = compare (p x) (p y)
 
+-- |
+-- > clamp (low, high) a = min high (max a low)
+--
+-- Function for ensursing the value @a@ is within the inclusive bounds given by
+-- @low@ and @high at . If it is, @a@ is returned unchanged. The result
+-- is otherwise @low@ if @a <= low@, or @high@ if @high <= a at .
+--
+-- When clamp is used at Double and Float, it has NaN propagating semantics in
+-- its second argument. That is, @clamp (l,h) NaN = NaN@, but @clamp (NaN, NaN)
+-- x = x at .
+--
+-- >>> clamp (0, 10) 2
+-- 2
+--
+-- >>> clamp ('a', 'm') 'x'
+-- 'm'
+clamp :: (Ord a) => (a, a) -> a -> a
+clamp (low, high) a = min high (max a low)
+
 -- | The 'Down' type allows you to reverse sort order conveniently.  A value of type
 -- @'Down' a@ contains a value of type @a@ (represented as @'Down' a@).
 -- If @a@ has an @'Ord'@ instance associated with it then comparing two


=====================================
libraries/base/tests/all.T
=====================================
@@ -256,3 +256,4 @@ test('T16943a', normal, compile_and_run, [''])
 test('T16943b', normal, compile_and_run, [''])
 test('T17499', [collect_stats('bytes allocated',5)], compile_and_run, ['-O -w'])
 test('T16643', normal, compile_and_run, [''])
+test('clamp', normal, compile_and_run, [''])


=====================================
libraries/base/tests/clamp.hs
=====================================
@@ -0,0 +1,28 @@
+import Data.Ord
+
+doClampInt :: (Int, Int) -> Int -> IO ()
+doClampInt bounds a = print $ clamp bounds a
+
+doClampFloat :: (Float, Float) -> Float -> IO ()
+doClampFloat bounds a = print $ clamp bounds a
+
+nan :: Float
+nan = 0 / 0
+
+main :: IO ()
+main = do
+  doClampInt (0, 100) 50       -- 50
+  doClampInt (0, 100) 200      -- 100
+  doClampInt (0, 100) (-5)     -- 0
+
+  doClampFloat (0, 100) 50     -- 50
+  doClampFloat (0, 100) 200    -- 100
+  doClampFloat (0, 100) (-5)   -- 0
+  doClampFloat (0, 100) nan    -- NaN
+  doClampFloat (nan, 100) 5    -- 5
+  doClampFloat (nan, 100) 105  -- 100
+  doClampFloat (5, nan) 105    -- 105
+  doClampFloat (5, nan) 3      -- 5
+
+  doClampFloat (nan, nan) 3    -- 3
+


=====================================
libraries/base/tests/clamp.stdout
=====================================
@@ -0,0 +1,12 @@
+50
+100
+0
+50.0
+100.0
+0.0
+NaN
+5.0
+100.0
+105.0
+5.0
+3.0



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a5a91cb67e8c4e2558031c04efccf3c378ba254...fb6e29e8d19deaf7581fdef14adc88a02573c83e

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a5a91cb67e8c4e2558031c04efccf3c378ba254...fb6e29e8d19deaf7581fdef14adc88a02573c83e
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/20200912/93d2056c/attachment-0001.html>