{-|
  Copyright   :  (C) 2024, QBayLogic B.V.
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Clash.Unique
  ( Unique
  , pattern Unique#
  , Unique#
  , Uniquable (..)
  , fromGhcUnique
  ) where

import Data.Word (Word64)
#if MIN_VERSION_ghc(9,8,4)
import GHC.Word (Word64(W64#))
import GHC.Exts (Word64#)
#else
import GHC.Int (Int(I#))
import GHC.Exts (Int#)
#endif
#if MIN_VERSION_ghc(9,0,0)
import qualified GHC.Types.Unique as GHC
#else
import qualified Unique as GHC
#endif

#if MIN_VERSION_ghc(9,8,4)
type Unique = Word64
type Unique# = Word64#

pattern Unique#
  :: Unique#
  -- ^ Type of signal
  -> Unique
pattern Unique# u <- W64# u
  where
    Unique# u = W64# u
#else
type Unique = Int
type Unique# = Int#

pattern Unique#
  :: Unique#
  -- ^ Type of signal
  -> Unique
pattern $bUnique# :: Unique# -> Unique
$mUnique# :: forall r. Unique -> (Unique# -> r) -> (Void# -> r) -> r
Unique# u <- I# u
  where
    Unique# Unique#
u = Unique# -> Unique
I# Unique#
u
#endif

class Uniquable a where
  getUnique :: a -> Unique
  setUnique :: a -> Unique -> a

instance Uniquable Unique where
  getUnique :: Unique -> Unique
getUnique = Unique -> Unique
forall a. a -> a
id
  setUnique :: Unique -> Unique -> Unique
setUnique = (Unique -> Unique -> Unique) -> Unique -> Unique -> Unique
forall a b c. (a -> b -> c) -> b -> a -> c
flip Unique -> Unique -> Unique
forall a b. a -> b -> a
const

#if !MIN_VERSION_ghc(9,8,4)
instance Uniquable Word64 where
  getUnique :: Word64 -> Unique
getUnique = Word64 -> Unique
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  setUnique :: Word64 -> Unique -> Word64
setUnique Word64
_ = Unique -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
#endif

fromGhcUnique :: GHC.Unique -> Unique
fromGhcUnique :: Unique -> Unique
fromGhcUnique = Unique -> Unique
GHC.getKey