{-|
Copyright  :  (C) 2016,      University of Twente,
                  2017,      QBayLogic, Google Inc.
                  2017-2019, Myrtle Software Ltd,
                  2021-2022, QBayLogic B.V.
License    :  BSD2 (see the file LICENSE)
Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>

'XException': An exception for uninitialized values

>>> show (errorX "undefined" :: Integer, 4 :: Int)
"(*** Exception: X: undefined
CallStack (from HasCallStack):
...
>>> showX (errorX "undefined" :: Integer, 4 :: Int)
"(undefined,4)"
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}

{-# LANGUAGE Trustworthy #-}

module Clash.XException
  ( -- * 'XException': An exception for uninitialized values
    XException(..), errorX, isX, hasX, maybeIsX, maybeHasX, fromJustX, undefined,
    xToErrorCtx, xToError
    -- * Printing 'XException's as @undefined@
  , ShowX (..), showsX, printX, showsPrecXWith
    -- * Strict evaluation
  , seqX, seqErrorX, forceX, deepseqX, rwhnfX, defaultSeqX, hwSeqX
    -- * Structured undefined / deep evaluation with undefined values
  , NFDataX (rnfX, deepErrorX, hasUndefined, ensureSpine)
  )
where

import           Prelude             hiding (undefined)

import           Clash.Annotations.Primitive (hasBlackBox)
import           Clash.CPP           (maxTupleSize, fSuperStrict)
import           Clash.XException.Internal
import           Clash.XException.TH
import           Control.Exception
  (ErrorCall (..), Handler(..), catch, catches, evaluate, throw)
import           Control.DeepSeq     (NFData, rnf)
import           Data.Complex        (Complex)
import           Data.Either         (isLeft)
import           Data.Foldable       (toList)
import           Data.Int            (Int8, Int16, Int32, Int64)
import           Data.Ord            (Down (Down))
import           Data.Ratio          (Ratio, numerator, denominator)
import qualified Data.Semigroup      as SG
import qualified Data.Monoid         as M
import           Data.Sequence       (Seq(Empty, (:<|)))
import           Data.Word           (Word8, Word16, Word32, Word64)
import           Foreign.C.Types     (CUShort)
import           GHC.Generics
import           GHC.Natural         (Natural)
import           GHC.Stack
  (HasCallStack, callStack, prettyCallStack, withFrozenCallStack)
import           Numeric.Half        (Half)
import           System.IO.Unsafe    (unsafeDupablePerformIO)

-- $setup
-- >>> :m -Prelude
-- >>> import Clash.Prelude
-- >>> import Clash.Class.BitPack (pack)
-- >>> import Clash.Sized.Vector (Vec)
-- >>> import Clash.Sized.RTree (RTree)
-- >>> :set -fplugin GHC.TypeLits.Normalise
-- >>> :set -fplugin GHC.TypeLits.KnownNat.Solver


-- | Either 'seqX' or 'deepseqX' depending on the value of the cabal flag
-- '-fsuper-strict'. If enabled, 'defaultSeqX' will be 'deepseqX', otherwise
-- 'seqX'. Flag defaults to /false/ and thus 'seqX'.
defaultSeqX :: NFDataX a => a -> b -> b
defaultSeqX :: a -> b -> b
defaultSeqX = if Bool
fSuperStrict then a -> b -> b
forall a b. NFDataX a => a -> b -> b
deepseqX else a -> b -> b
forall a b. a -> b -> b
seqX
{-# INLINE defaultSeqX #-}
infixr 0 `defaultSeqX`

-- | Like 'error', but throwing an 'XException' instead of an 'ErrorCall'
--
-- The 'ShowX' methods print these error-values as @undefined@; instead of error'ing
-- out with an exception.
errorX :: HasCallStack => String -> a
errorX :: String -> a
errorX String
msg = XException -> a
forall a e. Exception e => e -> a
throw (String -> XException
XException (String
"X: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CallStack -> String
prettyCallStack CallStack
HasCallStack => CallStack
callStack))

-- | Convert 'XException' to 'ErrorCall'
--
-- This is useful when tracking the source of 'XException' that gets eaten up by
-- 'Clash.Classes.BitPack.pack' inside of your circuit; since
-- 'Clash.Classes.BitPack.pack' translates 'XException' into undefined bits.
--
-- So for example if you have some large function f:
--
-- > f a b = ... pack a ... pack b ...
--
-- Where it is basically an error if either /a/ or /b/ ever throws an 'XException',
-- and so you want that to be reported the moment /a/ or /b/ is used, instead of
-- it being thrown when evaluating the result of /f/, then do:
--
-- > {-# LANGUAGE ViewPatterns #-}
-- > f (xToErrorCtx "a is X" -> a) (xToErrorCtx "b is X" -> b) = ...
--
-- Where we pass an extra string, for context, to know which argument evaluated
-- to an 'XException'. We can also use BangPatterns to report the potential
-- 'XException' being thrown by /a/ or /b/ even earlier, i.e. when /f/ is applied:
--
-- > {-# LANGUAGE ViewPatterns, BangPatterns #-}
-- > f (xToErrorCtx "a is X" -> !a) (xToErrorCtx "b is X" -> !b) = ...
--
-- __NB:__ Fully synthesizable, so doesn't have to be removed before synthesis
--
-- === __Example__
--
-- >>> :set -XViewPatterns -XDataKinds
-- >>> import Clash.Sized.BitVector
-- >>> import GHC.Stack
-- >>> :{
-- let h, h' :: Bit -> BitVector 8 -> BitVector 8
--     h (xToErrorCtx "a is X" -> a) (xToErrorCtx "b is X" -> b) = slice d7 d0 (pack a ++# b)
--     h' a b = slice d7 d0 (pack a ++# b)
-- :}
--
-- >>> h' (errorX "QQ") 3
-- 0b0000_0011
-- >>> h (errorX "QQ") 3
-- *** Exception: a is X
-- X: QQ
-- CallStack (from HasCallStack):
--   errorX, called at ...
-- <BLANKLINE>
xToErrorCtx :: String -> a -> a
xToErrorCtx :: String -> a -> a
xToErrorCtx String
ctx a
a = IO a -> a
forall a. IO a -> a
unsafeDupablePerformIO
  (IO a -> (XException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (a -> IO a
forall a. a -> IO a
evaluate a
a IO a -> IO a -> IO a
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return a
a)
         (\(XException String
msg) ->
           ErrorCall -> IO a
forall a e. Exception e => e -> a
throw (String -> ErrorCall
ErrorCall ([String] -> String
unlines [String
ctx,String
msg]))))
{-# NOINLINE xToErrorCtx #-}

-- | Convert 'XException' to 'ErrorCall'
--
-- This is useful when tracking the source of 'XException' that gets eaten up by
-- 'Clash.Classes.BitPack.pack' inside of your circuit; since
-- 'Clash.Classes.BitPack.pack' translates 'XException' into undefined bits.
--
-- So for example if you have some large function f:
--
-- > f a b = ... pack a ... pack b ...
--
-- Where it is basically an error if either /a/ or /b/ ever throws an 'XException',
-- and so you want that to be reported the moment /a/ or /b/ is used, instead of
-- it being thrown when evaluating the result of /f/, then do:
--
-- > {-# LANGUAGE ViewPatterns #-}
-- > f (xToError -> a) (xToError -> b) = ...
--
-- Unlike 'xToErrorCtx', where we have an extra String argument to distinguish
-- one call to 'xToError' to the other, 'xToError' will use the 'GHC.CallStack'
-- mechanism to aid the user in distinguishing different call to 'xToError'.
-- We can also use BangPatterns to report the potential 'XException' being
-- thrown by /a/ or /b/ even earlier, i.e. when /f/ is applied:
--
-- > {-# LANGUAGE ViewPatterns, BangPatterns #-}
-- > f (xToError -> !a) (xToError -> !b) = ...
--
-- __NB:__ Fully synthesizable, so doesn't have to be removed before synthesis
--
-- === __Example__
--
-- >>> :set -XViewPatterns -XDataKinds
-- >>> import Clash.Sized.BitVector
-- >>> import GHC.Stack
-- >>> :{
-- let f, g, h, h' :: HasCallStack => Bit -> BitVector 8 -> BitVector 8
--     f = g
--     g = h
--     h (xToError -> a) (xToError -> b) = slice d7 d0 (pack a ++# b)
--     h' a b = slice d7 d0 (pack a ++# b)
-- :}
--
-- >>> h' (errorX "QQ") 3
-- 0b0000_0011
-- >>> f (errorX "QQ") 3
-- *** Exception: CallStack (from HasCallStack):
--   xToError, called at ...
--   h, called at ...
--   g, called at ...
--   f, called at ...
-- X: QQ
-- CallStack (from HasCallStack):
--   errorX, called at ...
-- <BLANKLINE>
xToError :: HasCallStack => a -> a
xToError :: a -> a
xToError = String -> a -> a
forall a. String -> a -> a
xToErrorCtx (CallStack -> String
prettyCallStack CallStack
HasCallStack => CallStack
callStack)
{-# INLINE xToError #-}

-- | Like 'seq', however, whereas 'seq' will always do:
--
-- > seq  _|_              b = _|_
--
-- 'seqX' will do:
--
-- > seqX (XException msg) b = b
-- > seqX _|_              b = _|_
seqX :: a -> b -> b
seqX :: a -> b -> b
seqX a
a b
b = IO b -> b
forall a. IO a -> a
unsafeDupablePerformIO
  (IO b -> (XException -> IO b) -> IO b
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (a -> IO a
forall a. a -> IO a
evaluate a
a IO a -> IO b -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> b -> IO b
forall (m :: Type -> Type) a. Monad m => a -> m a
return b
b) (\(XException String
_) -> b -> IO b
forall (m :: Type -> Type) a. Monad m => a -> m a
return b
b))
{-# NOINLINE seqX #-}
{-# ANN seqX hasBlackBox #-}
infixr 0 `seqX`

-- | Like 'seqX', but will also catch ErrorCall exceptions which are thrown.
-- This should be used with care.
--
-- > seqErrorX (ErrorCall msg)  b = b
-- > seqErrorX (XException msg) b = b
-- > seqErrorX _|_              b = _|_
seqErrorX :: a -> b -> b
seqErrorX :: a -> b -> b
seqErrorX a
a b
b = IO b -> b
forall a. IO a -> a
unsafeDupablePerformIO
  ((a -> IO a
forall a. a -> IO a
evaluate a
a IO a -> IO b -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> b -> IO b
forall (m :: Type -> Type) a. Monad m => a -> m a
return b
b) IO b -> [Handler b] -> IO b
forall a. IO a -> [Handler a] -> IO a
`catches`
     [ (XException -> IO b) -> Handler b
forall a e. Exception e => (e -> IO a) -> Handler a
Handler (\(XException String
_) -> b -> IO b
forall (m :: Type -> Type) a. Monad m => a -> m a
return b
b)
     , (ErrorCall -> IO b) -> Handler b
forall a e. Exception e => (e -> IO a) -> Handler a
Handler (\(ErrorCall String
_) -> b -> IO b
forall (m :: Type -> Type) a. Monad m => a -> m a
return b
b)
     ])
{-# NOINLINE seqErrorX #-}
{-# ANN seqErrorX hasBlackBox #-}
infixr 0 `seqErrorX`

-- | Like 'seqX' in simulation, but will force its first argument to be rendered
-- in HDL. This is useful for components that need to be rendered in hardware,
-- but otherwise have no meaning in simulation. An example of such a component
-- would be an ILA: a component monitoring an internal signal of a design. The
-- output of such a component (typically a unit) can be passed as the first
-- argument to 'hwSeqX' to ensure the ILA ends up in the generated HDL.
--
-- __NB__: the result of 'hwSeqX' must (indirectly) be used at the very top of
-- a design. If it's not, Clash will remove it like it does for any other unused
-- circuit parts.
--
-- __NB__: Make sure the blackbox for the component with zero-width results
-- uses 'Clash.Netlist.BlackBox.Types.RenderVoid'
hwSeqX :: a -> b -> b
hwSeqX :: a -> b -> b
hwSeqX = a -> b -> b
forall a b. a -> b -> b
seqX
{-# NOINLINE hwSeqX #-}
{-# ANN hwSeqX hasBlackBox #-}
infixr 0 `hwSeqX`

-- | Evaluate a value with given function, returning 'Nothing' if it throws
-- 'XException'.
--
-- > maybeX hasX 42                  = Just 42
-- > maybeX hasX (XException msg)    = Nothing
-- > maybeX hasX (3, XException msg) = Nothing
-- > maybeX hasX (3, _|_)            = _|_
-- > maybeX hasX _|_                 = _|_
-- >
-- > maybeX isX 42                  = Just 42
-- > maybeX isX (XException msg)    = Nothing
-- > maybeX isX (3, XException msg) = Just (3, XException msg)
-- > maybeX isX (3, _|_)            = Just (3, _|_)
-- > maybeX isX _|_                 = _|_
--
maybeX :: (a -> Either String a) -> a -> Maybe a
maybeX :: (a -> Either String a) -> a -> Maybe a
maybeX a -> Either String a
f a
a = (String -> Maybe a) -> (a -> Maybe a) -> Either String a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> String -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (a -> Either String a
f a
a)

-- | Fully evaluate a value, returning 'Nothing' if it throws 'XException'.
--
-- > maybeHasX 42                  = Just 42
-- > maybeHasX (XException msg)    = Nothing
-- > maybeHasX (3, XException msg) = Nothing
-- > maybeHasX (3, _|_)            = _|_
-- > maybeHasX _|_                 = _|_
--
maybeHasX :: NFData a => a -> Maybe a
maybeHasX :: a -> Maybe a
maybeHasX = (a -> Either String a) -> a -> Maybe a
forall a. (a -> Either String a) -> a -> Maybe a
maybeX a -> Either String a
forall a. NFData a => a -> Either String a
hasX

-- | Evaluate a value to WHNF, returning 'Nothing' if it throws 'XException'.
--
-- > maybeIsX 42                  = Just 42
-- > maybeIsX (XException msg)    = Nothing
-- > maybeIsX (3, XException msg) = Just (3, XException msg)
-- > maybeIsX (3, _|_)            = Just (3, _|_)
-- > maybeIsX _|_                 = _|_
maybeIsX :: a -> Maybe a
maybeIsX :: a -> Maybe a
maybeIsX = (a -> Either String a) -> a -> Maybe a
forall a. (a -> Either String a) -> a -> Maybe a
maybeX a -> Either String a
forall a. a -> Either String a
isX

-- | Fully evaluate a value, returning @'Left' msg@ if it throws 'XException'.
-- If you want to determine if a value contains undefined parts, use
-- 'hasUndefined' instead.
--
-- > hasX 42                  = Right 42
-- > hasX (XException msg)    = Left msg
-- > hasX (3, XException msg) = Left msg
-- > hasX (3, _|_)            = _|_
-- > hasX _|_                 = _|_
--
-- If a data structure contains multiple 'XException's, the "first" message is
-- picked according to the implementation of 'rnf'.
hasX :: NFData a => a -> Either String a
hasX :: a -> Either String a
hasX a
a =
  IO (Either String a) -> Either String a
forall a. IO a -> a
unsafeDupablePerformIO
    (IO (Either String a)
-> (XException -> IO (Either String a)) -> IO (Either String a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
      (() -> IO ()
forall a. a -> IO a
evaluate (a -> ()
forall a. NFData a => a -> ()
rnf a
a) IO () -> IO (Either String a) -> IO (Either String a)
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Either String a -> IO (Either String a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (a -> Either String a
forall a b. b -> Either a b
Right a
a))
      (\(XException String
msg) -> Either String a -> IO (Either String a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Either String a
forall a b. a -> Either a b
Left String
msg)))
{-# NOINLINE hasX #-}

-- | Evaluate a value to WHNF, returning @'Left' msg@ if is a 'XException'.
--
-- > isX 42                  = Right 42
-- > isX (XException msg)    = Left msg
-- > isX (3, XException msg) = Right (3, XException msg)
-- > isX (3, _|_)            = Right (3, _|_)
-- > isX _|_                 = _|_
isX :: a -> Either String a
isX :: a -> Either String a
isX a
a =
  IO (Either String a) -> Either String a
forall a. IO a -> a
unsafeDupablePerformIO
    (IO (Either String a)
-> (XException -> IO (Either String a)) -> IO (Either String a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
      (a -> IO a
forall a. a -> IO a
evaluate a
a IO a -> IO (Either String a) -> IO (Either String a)
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Either String a -> IO (Either String a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (a -> Either String a
forall a b. b -> Either a b
Right a
a))
      (\(XException String
msg) -> Either String a -> IO (Either String a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Either String a
forall a b. a -> Either a b
Left String
msg)))
{-# NOINLINE isX #-}

-- | Like the 'Show' class, but values that normally throw an 'XException' are
-- converted to @undefined@, instead of error'ing out with an exception.
--
-- >>> show (errorX "undefined" :: Integer, 4 :: Int)
-- "(*** Exception: X: undefined
-- CallStack (from HasCallStack):
-- ...
-- >>> showX (errorX "undefined" :: Integer, 4 :: Int)
-- "(undefined,4)"
--
-- Can be derived using 'GHC.Generics':
--
-- > {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
-- >
-- > import Clash.Prelude
-- > import GHC.Generics
-- >
-- > data T = MkTA Int | MkTB Bool
-- >   deriving (Show,Generic,ShowX)
class ShowX a where
  -- | Like 'showsPrec', but values that normally throw an 'XException' are
  -- converted to @undefined@, instead of error'ing out with an exception.
  showsPrecX :: Int -> a -> ShowS

  -- | Like 'show', but values that normally throw an 'XException' are
  -- converted to @undefined@, instead of error'ing out with an exception.
  showX :: a -> String
  showX a
x = a -> String -> String
forall a. ShowX a => a -> String -> String
showsX a
x String
""

  -- | Like 'showList', but values that normally throw an 'XException' are
  -- converted to @undefined@, instead of error'ing out with an exception.
  showListX :: [a] -> ShowS
  showListX [a]
ls String
s = (a -> String -> String) -> [a] -> String -> String
forall a. (a -> String -> String) -> [a] -> String -> String
showListX__ a -> String -> String
forall a. ShowX a => a -> String -> String
showsX [a]
ls String
s

  default showsPrecX :: (Generic a, GShowX (Rep a)) => Int -> a -> ShowS
  showsPrecX = Int -> a -> String -> String
forall a.
(Generic a, GShowX (Rep a)) =>
Int -> a -> String -> String
genericShowsPrecX

-- | Like 'print', but values that normally throw an 'XException' are
-- converted to @undefined@, instead of error'ing out with an exception
printX :: ShowX a => a -> IO ()
printX :: a -> IO ()
printX a
x = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. ShowX a => a -> String
showX a
x

instance ShowX ()

instance {-# OVERLAPPABLE #-} ShowX a => ShowX [a] where
  showsPrecX :: Int -> [a] -> String -> String
showsPrecX Int
_ = [a] -> String -> String
forall a. ShowX a => [a] -> String -> String
showListX

instance ShowX Char where
  showsPrecX :: Int -> Char -> String -> String
showsPrecX = (Int -> Char -> String -> String)
-> Int -> Char -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> Char -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec

instance ShowX Bool

instance ShowX Double where
  showsPrecX :: Int -> Double -> String -> String
showsPrecX = (Int -> Double -> String -> String)
-> Int -> Double -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> Double -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec

instance ShowX a => ShowX (Down a) where
  showsPrecX :: Int -> Down a -> String -> String
showsPrecX = (Int -> Down a -> String -> String)
-> Int -> Down a -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> Down a -> String -> String
forall a. ShowX a => Int -> a -> String -> String
showsPrecX

instance (ShowX a, ShowX b) => ShowX (Either a b)

instance ShowX Float where
  showsPrecX :: Int -> Float -> String -> String
showsPrecX = (Int -> Float -> String -> String)
-> Int -> Float -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> Float -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec

instance ShowX Int where
  showsPrecX :: Int -> Int -> String -> String
showsPrecX = (Int -> Int -> String -> String) -> Int -> Int -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> Int -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec

instance ShowX Int8 where
  showsPrecX :: Int -> Int8 -> String -> String
showsPrecX = (Int -> Int8 -> String -> String)
-> Int -> Int8 -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> Int8 -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec

instance ShowX Int16 where
  showsPrecX :: Int -> Int16 -> String -> String
showsPrecX = (Int -> Int16 -> String -> String)
-> Int -> Int16 -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> Int16 -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec

instance ShowX Int32 where
  showsPrecX :: Int -> Int32 -> String -> String
showsPrecX = (Int -> Int32 -> String -> String)
-> Int -> Int32 -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> Int32 -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec

instance ShowX Int64 where
  showsPrecX :: Int -> Int64 -> String -> String
showsPrecX = (Int -> Int64 -> String -> String)
-> Int -> Int64 -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> Int64 -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec

instance ShowX Integer where
  showsPrecX :: Int -> Integer -> String -> String
showsPrecX = (Int -> Integer -> String -> String)
-> Int -> Integer -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> Integer -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec

instance ShowX Natural where
  showsPrecX :: Int -> Natural -> String -> String
showsPrecX = (Int -> Natural -> String -> String)
-> Int -> Natural -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> Natural -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec

instance ShowX a => ShowX (Seq a) where
  showsPrecX :: Int -> Seq a -> String -> String
showsPrecX Int
_ = [a] -> String -> String
forall a. ShowX a => [a] -> String -> String
showListX ([a] -> String -> String)
-> (Seq a -> [a]) -> Seq a -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList

instance ShowX Word where
  showsPrecX :: Int -> Word -> String -> String
showsPrecX = (Int -> Word -> String -> String)
-> Int -> Word -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> Word -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec

instance ShowX Word8 where
  showsPrecX :: Int -> Word8 -> String -> String
showsPrecX = (Int -> Word8 -> String -> String)
-> Int -> Word8 -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> Word8 -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec

instance ShowX Word16 where
  showsPrecX :: Int -> Word16 -> String -> String
showsPrecX = (Int -> Word16 -> String -> String)
-> Int -> Word16 -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> Word16 -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec

instance ShowX Word32 where
  showsPrecX :: Int -> Word32 -> String -> String
showsPrecX = (Int -> Word32 -> String -> String)
-> Int -> Word32 -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> Word32 -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec

instance ShowX Word64 where
  showsPrecX :: Int -> Word64 -> String -> String
showsPrecX = (Int -> Word64 -> String -> String)
-> Int -> Word64 -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> Word64 -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec

instance ShowX a => ShowX (Maybe a)

instance ShowX a => ShowX (Ratio a) where
  showsPrecX :: Int -> Ratio a -> String -> String
showsPrecX = (Int -> Ratio a -> String -> String)
-> Int -> Ratio a -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> Ratio a -> String -> String
forall a. ShowX a => Int -> a -> String -> String
showsPrecX

instance ShowX a => ShowX (Complex a)

instance {-# OVERLAPPING #-} ShowX String where
  showsPrecX :: Int -> String -> String -> String
showsPrecX = (Int -> String -> String -> String)
-> Int -> String -> String -> String
forall a.
(Int -> a -> String -> String) -> Int -> a -> String -> String
showsPrecXWith Int -> String -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec


-- | a variant of 'deepseqX' that is useful in some circumstances:
--
-- > forceX x = x `deepseqX` x
forceX :: NFDataX a => a -> a
forceX :: a -> a
forceX a
x = a
x a -> a -> a
forall a b. NFDataX a => a -> b -> b
`deepseqX` a
x
{-# INLINE forceX #-}

-- | 'deepseqX': fully evaluates the first argument, before returning the
-- second. Does not propagate 'XException's.
deepseqX :: NFDataX a => a -> b -> b
deepseqX :: a -> b -> b
deepseqX a
a b
b = a -> ()
forall a. NFDataX a => a -> ()
rnfX a
a () -> b -> b
`seq` b
b
{-# NOINLINE deepseqX #-}
{-# ANN deepseqX hasBlackBox #-}
infixr 0 `deepseqX`

-- | Reduce to weak head normal form
--
-- Equivalent to @\\x -> 'seqX' x ()@.
--
-- Useful for defining 'NFDataX.rnfX' for types for which NF=WHNF holds.
rwhnfX :: a -> ()
rwhnfX :: a -> ()
rwhnfX = (a -> () -> ()
forall a b. a -> b -> b
`seqX` ())
{-# INLINE rwhnfX #-}

-- | Class that houses functions dealing with /undefined/ values in Clash. See
-- 'deepErrorX' and 'rnfX'.
class NFDataX a where
  -- | Create a value where all the elements have an 'errorX',
  -- but the spine is defined.
  deepErrorX :: HasCallStack => String -> a

  default deepErrorX :: (HasCallStack, Generic a, GDeepErrorX (Rep a)) => String -> a
  deepErrorX = (HasCallStack => String -> a) -> String -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => String -> a) -> String -> a)
-> (HasCallStack => String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> (String -> Rep a Any) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Rep a Any
forall (f :: Type -> Type) a.
(GDeepErrorX f, HasCallStack) =>
String -> f a
gDeepErrorX

  -- | Determines whether any of parts of a given construct contain undefined
  -- parts. Note that a negative answer does not mean its bit representation
  -- is fully defined. For example:
  --
  -- >>> m = Nothing :: Maybe Bool
  -- >>> hasUndefined m
  -- False
  -- >>> pack m
  -- 0b0.
  -- >>> hasUndefined (pack m)
  -- True
  --
  hasUndefined :: a -> Bool

  default hasUndefined :: (Generic a, GHasUndefined (Rep a)) => a -> Bool
  hasUndefined = Rep a Any -> Bool
forall (f :: Type -> Type) a. GHasUndefined f => f a -> Bool
gHasUndefined (Rep a Any -> Bool) -> (a -> Rep a Any) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from

  -- | Create a value where at the very least the spine is defined. For example:
  --
  -- >>> spined = ensureSpine (errorX "?" :: (Int, Int))
  -- >>> case spined of (_, _) -> 'a'
  -- 'a'
  -- >>> fmap (const 'b') (ensureSpine undefined :: Vec 3 Int)
  -- 'b' :> 'b' :> 'b' :> Nil
  -- >>> fmap (const 'c') (ensureSpine undefined :: RTree 2 Int)
  -- <<'c','c'>,<'c','c'>>
  --
  -- For users familiar with 'Clash.Sized.Vector.lazyV': this is the generalized
  -- version of it.
  ensureSpine :: a -> a

  default ensureSpine :: (Generic a, GEnsureSpine (Rep a)) => a -> a
  ensureSpine = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> (a -> Rep a Any) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep a Any -> Rep a Any
forall (f :: Type -> Type) a. GEnsureSpine f => f a -> f a
gEnsureSpine (Rep a Any -> Rep a Any) -> (a -> Rep a Any) -> a -> Rep a Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from

  -- | Evaluate a value to NF. As opposed to 'NFData's
  -- 'rnf', it does not bubble up 'XException's.
  rnfX :: a -> ()

  default rnfX :: (Generic a, GNFDataX Zero (Rep a)) => a -> ()
  rnfX = RnfArgs Zero Any -> Rep a Any -> ()
forall arity (f :: Type -> Type) a.
GNFDataX arity f =>
RnfArgs arity a -> f a -> ()
grnfX RnfArgs Zero Any
forall a. RnfArgs Zero a
RnfArgs0 (Rep a Any -> ()) -> (a -> Rep a Any) -> a -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from

instance NFDataX ()

instance NFDataX b => NFDataX (a -> b) where
  deepErrorX :: String -> a -> b
deepErrorX = b -> a -> b
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (b -> a -> b) -> (String -> b) -> String -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> b
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX
  rnfX :: (a -> b) -> ()
rnfX = (a -> b) -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: (a -> b) -> Bool
hasUndefined = String -> (a -> b) -> Bool
forall a. HasCallStack => String -> a
error String
"hasUndefined on Undefined (a -> b): Not Yet Implemented"
  ensureSpine :: (a -> b) -> a -> b
ensureSpine = (a -> b) -> a -> b
forall a. a -> a
id

instance NFDataX a => NFDataX (Down a) where
  deepErrorX :: String -> Down a
deepErrorX = a -> Down a
forall a. a -> Down a
Down (a -> Down a) -> (String -> a) -> String -> Down a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX
  rnfX :: Down a -> ()
rnfX d :: Down a
d@(~(Down a
x)) = if Either String (Down a) -> Bool
forall a b. Either a b -> Bool
isLeft (Down a -> Either String (Down a)
forall a. a -> Either String a
isX Down a
d) then () else a -> ()
forall a. NFDataX a => a -> ()
rnfX a
x
  hasUndefined :: Down a -> Bool
hasUndefined d :: Down a
d@(~(Down a
x))= if Either String (Down a) -> Bool
forall a b. Either a b -> Bool
isLeft (Down a -> Either String (Down a)
forall a. a -> Either String a
isX Down a
d) then Bool
True else a -> Bool
forall a. NFDataX a => a -> Bool
hasUndefined a
x
  ensureSpine :: Down a -> Down a
ensureSpine ~(Down a
x) = a -> Down a
forall a. a -> Down a
Down (a -> a
forall a. NFDataX a => a -> a
ensureSpine a
x)

instance NFDataX Bool
instance NFDataX a => NFDataX [a]
instance (NFDataX a, NFDataX b) => NFDataX (Either a b)
instance NFDataX a => NFDataX (Maybe a)

instance NFDataX Char where
  deepErrorX :: String -> Char
deepErrorX = String -> Char
forall a. HasCallStack => String -> a
errorX
  rnfX :: Char -> ()
rnfX = Char -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: Char -> Bool
hasUndefined = Either String Char -> Bool
forall a b. Either a b -> Bool
isLeft (Either String Char -> Bool)
-> (Char -> Either String Char) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Either String Char
forall a. a -> Either String a
isX
  ensureSpine :: Char -> Char
ensureSpine = Char -> Char
forall a. a -> a
id

instance NFDataX Double where
  deepErrorX :: String -> Double
deepErrorX = String -> Double
forall a. HasCallStack => String -> a
errorX
  rnfX :: Double -> ()
rnfX = Double -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: Double -> Bool
hasUndefined = Either String Double -> Bool
forall a b. Either a b -> Bool
isLeft (Either String Double -> Bool)
-> (Double -> Either String Double) -> Double -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Either String Double
forall a. a -> Either String a
isX
  ensureSpine :: Double -> Double
ensureSpine = Double -> Double
forall a. a -> a
id

instance NFDataX Float where
  deepErrorX :: String -> Float
deepErrorX = String -> Float
forall a. HasCallStack => String -> a
errorX
  rnfX :: Float -> ()
rnfX = Float -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: Float -> Bool
hasUndefined = Either String Float -> Bool
forall a b. Either a b -> Bool
isLeft (Either String Float -> Bool)
-> (Float -> Either String Float) -> Float -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Either String Float
forall a. a -> Either String a
isX
  ensureSpine :: Float -> Float
ensureSpine = Float -> Float
forall a. a -> a
id

instance NFDataX Int where
  deepErrorX :: String -> Int
deepErrorX = String -> Int
forall a. HasCallStack => String -> a
errorX
  rnfX :: Int -> ()
rnfX = Int -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: Int -> Bool
hasUndefined = Either String Int -> Bool
forall a b. Either a b -> Bool
isLeft (Either String Int -> Bool)
-> (Int -> Either String Int) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Either String Int
forall a. a -> Either String a
isX
  ensureSpine :: Int -> Int
ensureSpine = Int -> Int
forall a. a -> a
id

instance NFDataX Int8 where
  deepErrorX :: String -> Int8
deepErrorX = String -> Int8
forall a. HasCallStack => String -> a
errorX
  rnfX :: Int8 -> ()
rnfX = Int8 -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: Int8 -> Bool
hasUndefined = Either String Int8 -> Bool
forall a b. Either a b -> Bool
isLeft (Either String Int8 -> Bool)
-> (Int8 -> Either String Int8) -> Int8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Either String Int8
forall a. a -> Either String a
isX
  ensureSpine :: Int8 -> Int8
ensureSpine = Int8 -> Int8
forall a. a -> a
id

instance NFDataX Int16 where
  deepErrorX :: String -> Int16
deepErrorX = String -> Int16
forall a. HasCallStack => String -> a
errorX
  rnfX :: Int16 -> ()
rnfX = Int16 -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: Int16 -> Bool
hasUndefined = Either String Int16 -> Bool
forall a b. Either a b -> Bool
isLeft (Either String Int16 -> Bool)
-> (Int16 -> Either String Int16) -> Int16 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Either String Int16
forall a. a -> Either String a
isX
  ensureSpine :: Int16 -> Int16
ensureSpine = Int16 -> Int16
forall a. a -> a
id

instance NFDataX Int32 where
  deepErrorX :: String -> Int32
deepErrorX = String -> Int32
forall a. HasCallStack => String -> a
errorX
  rnfX :: Int32 -> ()
rnfX = Int32 -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: Int32 -> Bool
hasUndefined = Either String Int32 -> Bool
forall a b. Either a b -> Bool
isLeft (Either String Int32 -> Bool)
-> (Int32 -> Either String Int32) -> Int32 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Either String Int32
forall a. a -> Either String a
isX
  ensureSpine :: Int32 -> Int32
ensureSpine = Int32 -> Int32
forall a. a -> a
id

instance NFDataX Int64 where
  deepErrorX :: String -> Int64
deepErrorX = String -> Int64
forall a. HasCallStack => String -> a
errorX
  rnfX :: Int64 -> ()
rnfX = Int64 -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: Int64 -> Bool
hasUndefined = Either String Int64 -> Bool
forall a b. Either a b -> Bool
isLeft (Either String Int64 -> Bool)
-> (Int64 -> Either String Int64) -> Int64 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Either String Int64
forall a. a -> Either String a
isX
  ensureSpine :: Int64 -> Int64
ensureSpine = Int64 -> Int64
forall a. a -> a
id

instance NFDataX Integer where
  deepErrorX :: String -> Integer
deepErrorX = String -> Integer
forall a. HasCallStack => String -> a
errorX
  rnfX :: Integer -> ()
rnfX = Integer -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: Integer -> Bool
hasUndefined = Either String Integer -> Bool
forall a b. Either a b -> Bool
isLeft (Either String Integer -> Bool)
-> (Integer -> Either String Integer) -> Integer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Either String Integer
forall a. a -> Either String a
isX
  ensureSpine :: Integer -> Integer
ensureSpine = Integer -> Integer
forall a. a -> a
id

instance NFDataX Natural where
  deepErrorX :: String -> Natural
deepErrorX = String -> Natural
forall a. HasCallStack => String -> a
errorX
  rnfX :: Natural -> ()
rnfX = Natural -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: Natural -> Bool
hasUndefined = Either String Natural -> Bool
forall a b. Either a b -> Bool
isLeft (Either String Natural -> Bool)
-> (Natural -> Either String Natural) -> Natural -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Either String Natural
forall a. a -> Either String a
isX
  ensureSpine :: Natural -> Natural
ensureSpine = Natural -> Natural
forall a. a -> a
id

instance NFDataX Word where
  deepErrorX :: String -> Word
deepErrorX = String -> Word
forall a. HasCallStack => String -> a
errorX
  rnfX :: Word -> ()
rnfX = Word -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: Word -> Bool
hasUndefined = Either String Word -> Bool
forall a b. Either a b -> Bool
isLeft (Either String Word -> Bool)
-> (Word -> Either String Word) -> Word -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Either String Word
forall a. a -> Either String a
isX
  ensureSpine :: Word -> Word
ensureSpine = Word -> Word
forall a. a -> a
id

instance NFDataX Word8 where
  deepErrorX :: String -> Word8
deepErrorX = String -> Word8
forall a. HasCallStack => String -> a
errorX
  rnfX :: Word8 -> ()
rnfX = Word8 -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: Word8 -> Bool
hasUndefined = Either String Word8 -> Bool
forall a b. Either a b -> Bool
isLeft (Either String Word8 -> Bool)
-> (Word8 -> Either String Word8) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Either String Word8
forall a. a -> Either String a
isX
  ensureSpine :: Word8 -> Word8
ensureSpine = Word8 -> Word8
forall a. a -> a
id

instance NFDataX Word16 where
  deepErrorX :: String -> Word16
deepErrorX = String -> Word16
forall a. HasCallStack => String -> a
errorX
  rnfX :: Word16 -> ()
rnfX = Word16 -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: Word16 -> Bool
hasUndefined = Either String Word16 -> Bool
forall a b. Either a b -> Bool
isLeft (Either String Word16 -> Bool)
-> (Word16 -> Either String Word16) -> Word16 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Either String Word16
forall a. a -> Either String a
isX
  ensureSpine :: Word16 -> Word16
ensureSpine = Word16 -> Word16
forall a. a -> a
id

instance NFDataX Word32 where
  deepErrorX :: String -> Word32
deepErrorX = String -> Word32
forall a. HasCallStack => String -> a
errorX
  rnfX :: Word32 -> ()
rnfX = Word32 -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: Word32 -> Bool
hasUndefined = Either String Word32 -> Bool
forall a b. Either a b -> Bool
isLeft (Either String Word32 -> Bool)
-> (Word32 -> Either String Word32) -> Word32 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Either String Word32
forall a. a -> Either String a
isX
  ensureSpine :: Word32 -> Word32
ensureSpine = Word32 -> Word32
forall a. a -> a
id

instance NFDataX Word64 where
  deepErrorX :: String -> Word64
deepErrorX = String -> Word64
forall a. HasCallStack => String -> a
errorX
  rnfX :: Word64 -> ()
rnfX = Word64 -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: Word64 -> Bool
hasUndefined = Either String Word64 -> Bool
forall a b. Either a b -> Bool
isLeft (Either String Word64 -> Bool)
-> (Word64 -> Either String Word64) -> Word64 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Either String Word64
forall a. a -> Either String a
isX
  ensureSpine :: Word64 -> Word64
ensureSpine = Word64 -> Word64
forall a. a -> a
id

instance NFDataX CUShort where
  deepErrorX :: String -> CUShort
deepErrorX = String -> CUShort
forall a. HasCallStack => String -> a
errorX
  rnfX :: CUShort -> ()
rnfX = CUShort -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: CUShort -> Bool
hasUndefined = Either String CUShort -> Bool
forall a b. Either a b -> Bool
isLeft (Either String CUShort -> Bool)
-> (CUShort -> Either String CUShort) -> CUShort -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUShort -> Either String CUShort
forall a. a -> Either String a
isX
  ensureSpine :: CUShort -> CUShort
ensureSpine = CUShort -> CUShort
forall a. a -> a
id

instance NFDataX Half where
  deepErrorX :: String -> Half
deepErrorX = String -> Half
forall a. HasCallStack => String -> a
errorX
  rnfX :: Half -> ()
rnfX = Half -> ()
forall a. a -> ()
rwhnfX
  hasUndefined :: Half -> Bool
hasUndefined = Either String Half -> Bool
forall a b. Either a b -> Bool
isLeft (Either String Half -> Bool)
-> (Half -> Either String Half) -> Half -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Half -> Either String Half
forall a. a -> Either String a
isX
  ensureSpine :: Half -> Half
ensureSpine = Half -> Half
forall a. a -> a
id

instance NFDataX a => NFDataX (Seq a) where
  deepErrorX :: String -> Seq a
deepErrorX = String -> Seq a
forall a. HasCallStack => String -> a
errorX
  rnfX :: Seq a -> ()
rnfX Seq a
s =
    if Either String (Seq a) -> Bool
forall a b. Either a b -> Bool
isLeft (Seq a -> Either String (Seq a)
forall a. a -> Either String a
isX Seq a
s) then () else Seq a -> ()
forall a. NFDataX a => Seq a -> ()
go Seq a
s
   where
    go :: Seq a -> ()
go Seq a
Empty = ()
    go (a
x :<| Seq a
xs) = a -> ()
forall a. NFDataX a => a -> ()
rnfX a
x () -> () -> ()
`seq` Seq a -> ()
go Seq a
xs
  ensureSpine :: Seq a -> Seq a
ensureSpine = Seq a -> Seq a
forall a. a -> a
id

  hasUndefined :: Seq a -> Bool
hasUndefined Seq a
s =
    if Either String (Seq a) -> Bool
forall a b. Either a b -> Bool
isLeft (Seq a -> Either String (Seq a)
forall a. a -> Either String a
isX Seq a
s) then Bool
True else Seq a -> Bool
forall a. NFDataX a => Seq a -> Bool
go Seq a
s
   where
    go :: Seq a -> Bool
go Seq a
Empty = Bool
False
    go (a
x :<| Seq a
xs) = a -> Bool
forall a. NFDataX a => a -> Bool
hasUndefined a
x Bool -> Bool -> Bool
|| Seq a -> Bool
forall a. NFDataX a => a -> Bool
hasUndefined Seq a
xs

instance NFDataX a => NFDataX (Ratio a) where
  deepErrorX :: String -> Ratio a
deepErrorX = String -> Ratio a
forall a. HasCallStack => String -> a
errorX
  rnfX :: Ratio a -> ()
rnfX Ratio a
r = a -> ()
forall a. NFDataX a => a -> ()
rnfX (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r) () -> () -> ()
`seq` a -> ()
forall a. NFDataX a => a -> ()
rnfX (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r)
  hasUndefined :: Ratio a -> Bool
hasUndefined Ratio a
r = Either String a -> Bool
forall a b. Either a b -> Bool
isLeft (a -> Either String a
forall a. a -> Either String a
isX (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r)) Bool -> Bool -> Bool
|| Either String a -> Bool
forall a b. Either a b -> Bool
isLeft (a -> Either String a
forall a. a -> Either String a
isX (Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
r))
  ensureSpine :: Ratio a -> Ratio a
ensureSpine = Ratio a -> Ratio a
forall a. a -> a
id

instance NFDataX a => NFDataX (Complex a) where
  deepErrorX :: String -> Complex a
deepErrorX = String -> Complex a
forall a. HasCallStack => String -> a
errorX

instance (NFDataX a, NFDataX b) => NFDataX (SG.Arg a b)
instance NFDataX (SG.All)
instance NFDataX (SG.Any)
instance NFDataX a => NFDataX (SG.Dual a)
instance NFDataX a => NFDataX (SG.Endo a)
instance NFDataX a => NFDataX (SG.First a)
instance NFDataX a => NFDataX (SG.Last a)
instance NFDataX a => NFDataX (SG.Max a)
instance NFDataX a => NFDataX (SG.Min a)
instance NFDataX a => NFDataX (SG.Product a)
instance NFDataX a => NFDataX (SG.Sum a)
instance NFDataX a => NFDataX (M.First a)
instance NFDataX a => NFDataX (M.Last a)

-- Sg.Option will be removed in 9.2. We can't locally disable deprecation
-- warnings (i.e., for this instance only) so we're prematurely removing it
-- instead.
#if __GLASGOW_HASKELL__ < 900
instance NFDataX a => NFDataX (SG.Option a)
#endif

-- | __N.B.__: The documentation only shows instances up to /3/-tuples. By
-- default, instances up to and including /12/-tuples will exist. If the flag
-- @large-tuples@ is set instances up to the GHC imposed limit will exist. The
-- GHC imposed limit is either 62 or 64 depending on the GHC version.
mkShowXTupleInstances [2..maxTupleSize]

-- | __N.B.__: The documentation only shows instances up to /3/-tuples. By
-- default, instances up to and including /12/-tuples will exist. If the flag
-- @large-tuples@ is set instances up to the GHC imposed limit will exist. The
-- GHC imposed limit is either 62 or 64 depending on the GHC version.
mkNFDataXTupleInstances [2..maxTupleSize]

-- | Call to 'errorX' with default string
undefined :: HasCallStack => a
undefined :: a
undefined = String -> a
forall a. HasCallStack => String -> a
errorX String
"undefined"

-- | Same as 'Data.Maybe.fromJust', but returns a bottom/undefined value that
-- other Clash constructs are aware of.
fromJustX :: HasCallStack => Maybe a -> a
fromJustX :: Maybe a -> a
fromJustX Maybe a
Nothing = String -> a
forall a. HasCallStack => String -> a
errorX String
"fromJustX: Nothing"
fromJustX (Just a
a) = a
a