module Control.Concurrent.Chan.Unagi.Constants 
    where

-- Constants for boxed and unboxed unagi.

import Data.Bits
import Control.Exception(assert)

divMod_sEGMENT_LENGTH :: Int -> (Int,Int)
{-# INLINE divMod_sEGMENT_LENGTH #-}
divMod_sEGMENT_LENGTH :: Int -> (Int, Int)
divMod_sEGMENT_LENGTH Int
n = let d :: Int
d = Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
lOG_SEGMENT_LENGTH
                              m :: Int
m = Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
sEGMENT_LENGTH_MN_1
                           in Int
d Int -> (Int, Int) -> (Int, Int)
`seq` Int
m Int -> (Int, Int) -> (Int, Int)
`seq` (Int
d,Int
m)

-- Nexttant for now: back-of-envelope considerations:
--   - making most of constant factor for cloning array of *any* size
--   - make most of overheads of moving to the next segment, etc.
--   - provide enough runway for creating next segment when 32 simultaneous writers 
--   - the larger this the larger one-time cost for the lucky writer
--   - as arrays collect in heap, performance might suffer, so bigger arrays
--     give us a constant factor edge there. see:
--       http://stackoverflow.com/q/23462004/176841
--
sEGMENT_LENGTH :: Int
{-# INLINE sEGMENT_LENGTH #-}
sEGMENT_LENGTH :: Int
sEGMENT_LENGTH = Int
1024 -- NOTE: THIS MUST REMAIN A POWER OF 2!

-- Number of reads on which to spin for new segment creation.
-- Back-of-envelope (time_to_create_new_segment / time_for_read_IOref) + margin.
-- See usage site.
--
-- NOTE: this was calculated for boxed Unagi, but it probably doesn't make a
-- measurable difference that we use it for Unagi.Unboxed too.
nEW_SEGMENT_WAIT :: Int
nEW_SEGMENT_WAIT :: Int
nEW_SEGMENT_WAIT = Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (((Float
14.6::Float) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.3Float -> Float -> Float
forall a. Num a => a -> a -> a
*Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sEGMENT_LENGTH) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
3.7) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10

lOG_SEGMENT_LENGTH :: Int
lOG_SEGMENT_LENGTH :: Int
lOG_SEGMENT_LENGTH = 
    let x :: Int
x = Int
10  -- ...pre-computed from...
     in Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float
forall a. Floating a => a -> a -> a
logBase (Float
2::Float) (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sEGMENT_LENGTH))
         Int
x

sEGMENT_LENGTH_MN_1 :: Int
sEGMENT_LENGTH_MN_1 :: Int
sEGMENT_LENGTH_MN_1 = Int
sEGMENT_LENGTH Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1