{-# LANGUAGE AllowAmbiguousTypes #-}

module Binrep.Util where

-- tshow
import Data.Text qualified as Text
import Data.Text ( Text )

-- posIntToNat
import GHC.Exts ( Int(..), int2Word# )
import GHC.Num.Natural ( Natural(..) )

-- natVal''
import GHC.TypeNats ( KnownNat, natVal' )
import GHC.Exts ( proxy#, Proxy# )

tshow :: Show a => a -> Text
tshow :: forall a. Show a => a -> Text
tshow = String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

-- | Convert some 'Int' @i@ where @i >= 0@ to a 'Natural'.
--
-- This is intended for wrapping the output of 'length' functions.
--
-- underflows if you call it with a negative 'Int' :)
posIntToNat :: Int -> Natural
posIntToNat :: Int -> Natural
posIntToNat (I# Int#
i#) = Word# -> Natural
NS (Int# -> Word#
int2Word# Int#
i#)
{-# INLINE posIntToNat #-}

natVal'' :: forall a. KnownNat a => Natural
natVal'' :: forall (a :: Natural). KnownNat a => Natural
natVal'' = forall (n :: Natural). KnownNat n => Proxy# n -> Natural
natVal' (forall {k} (a :: k). Proxy# a
proxy# :: Proxy# a)
{-# INLINE natVal'' #-}