{-# OPTIONS_GHC -fno-cse -fno-full-laziness #-}
module Graphics.HaGL.ExprID (
ExprID,
genID,
combineIDs,
idLabel,
HasExprID(..)
) where
import Prelude hiding (id)
import Data.Word (Word64)
import Data.Bits (shiftL, (.|.))
import Data.IORef
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BB
import qualified Crypto.Hash.MD5 as MD5
type ExprID = Word64
{-# NOINLINE unsafeCounter #-}
unsafeCounter :: IORef ExprID
unsafeCounter :: IORef ExprID
unsafeCounter = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef ExprID
0
{-# NOINLINE genID #-}
genID :: a -> ExprID
genID :: forall a. a -> ExprID
genID a
_ = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
ExprID
id <- forall a. IORef a -> IO a
readIORef IORef ExprID
unsafeCounter
forall a. IORef a -> a -> IO ()
writeIORef IORef ExprID
unsafeCounter (ExprID
id forall a. Num a => a -> a -> a
+ ExprID
1)
forall (m :: * -> *) a. Monad m => a -> m a
return ExprID
id
combineIDs :: [ExprID] -> ExprID
combineIDs :: [ExprID] -> ExprID
combineIDs = [ExprID] -> ExprID
fromBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ByteString -> ByteString
MD5.hashlazy forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ExprID -> Builder
BB.word64BE where
fromBytes :: [ExprID] -> ExprID
fromBytes = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ExprID
x (ExprID
s, Int
i) -> (ExprID
s forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL ExprID
x Int
i, Int
i forall a. Num a => a -> a -> a
+ Int
8)) (ExprID
0, Int
0)
idLabel :: ExprID -> String
idLabel :: ExprID -> String
idLabel ExprID
id | ExprID
id forall a. Ord a => a -> a -> Bool
>= ExprID
0 = String
"x" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ExprID
id
| Bool
otherwise = String
"y" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Num a => a -> a
negate ExprID
id)
class HasExprID a where
getID :: a -> ExprID