{-# Language MagicHash #-}
{-# Language ForeignFunctionInterface #-}
{-# Language UnliftedFFITypes #-}
{-# Language GHCForeignImportPrim #-}
{-# Language UnboxedTuples #-}
{-# Language CPP #-}

-- | This module provides a small set of function for extremely fast @max@ and
-- @min@ operations that are branchless.
--
-- This should be temporary, since GHC is supposed to get the branchless variants.
--
-- NOTE these do not seem to be faster anyway.

module Data.Ord.Fast where

import GHC.Exts



class FastMinMax x where
  fastmin :: x -> x -> x
  fastmax :: x -> x -> x
  -- | Clamp values to @>=0@.
  clamp :: x -> x

instance FastMinMax Int where
  fastmin :: Int -> Int -> Int
fastmin (I# Int#
x) (I# Int#
y) =
    let !xmy :: Int#
xmy = Int#
x Int# -> Int# -> Int#
-# Int#
y
        res :: Int
res  = Int# -> Int
I# ( Int#
y Int# -> Int# -> Int#
+# ( Int#
xmy Int# -> Int# -> Int#
`andI#` Int# -> Int# -> Int#
uncheckedIShiftRA# Int#
xmy Int#
63# ) )
    in  Int
res
  {-# Inline fastmin #-}
  fastmax :: Int -> Int -> Int
fastmax (I# Int#
x) (I# Int#
y) =
    let !xmy :: Int#
xmy  = Int#
x Int# -> Int# -> Int#
-# Int#
y
        res :: Int
res  = Int# -> Int
I# ( Int#
x Int# -> Int# -> Int#
-# ( Int#
xmy Int# -> Int# -> Int#
`andI#` Int# -> Int# -> Int#
uncheckedIShiftRA# Int#
xmy Int#
63# ) )
    in  Int
res
  -- FROM: https://ghc.gitlab.haskell.org/ghc/doc/libraries/ghc-bignum-1.0/src/GHC-Num-Primitives.html#maxI%23
  -- NOTE: slightly slower than the above version
  --fastmax (I# x) (I# y)
  --  | isTrue# (x >=# y) = I# x
  --  | True              = I# y
  {-# Inline fastmax #-}
  clamp :: Int -> Int
clamp (I# Int#
x) = Int# -> Int
I# (Int# -> Int# -> Int#
andI# Int#
x (Int# -> Int#
notI# (Int# -> Int# -> Int#
uncheckedIShiftRA# Int#
x Int#
63#)))
  {-# Inline clamp #-}