{-|
Copyright  :  (C) 2016,      University of Twente,
                  2017,      QBayLogic, Google Inc.
                  2017-2019, Myrtle Software Ltd
License    :  BSD2 (see the file LICENSE)
Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>

'X': An exception for uninitialized values

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

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

{-# LANGUAGE Trustworthy #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Clash.XException
  ( -- * 'X': An exception for uninitialized values
    XException(..), errorX, isX, hasX, maybeIsX, maybeHasX, fromJustX, undefined
    -- * Printing 'X' exceptions as \"X\"
  , ShowX (..), showsX, printX, showsPrecXWith
    -- * Strict evaluation
  , seqX, 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.TH
import           Control.Exception   (Exception, catch, 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           Data.Sequence       (Seq(Empty, (:<|)))
import           Data.Word           (Word8, Word16, Word32, Word64)
import           Foreign.C.Types     (CUShort)
import           GHC.Exts
  (Char (C#), Double (D#), Float (F#), Int (I#), Word (W#))
import           GHC.Generics
import           GHC.Natural         (Natural)
import           GHC.Show            (appPrec)
import           GHC.Stack
  (HasCallStack, callStack, prettyCallStack, withFrozenCallStack)
import           Numeric.Half        (Half)
import           System.IO.Unsafe    (unsafeDupablePerformIO)

-- $setup
-- >>> 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

-- | An exception representing an \"uninitialized\" value.
newtype XException = XException String

instance Show XException where
  show :: XException -> String
show (XException s :: String
s) = String
s

instance Exception XException

-- | 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 #-}

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

-- | 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
a b :: 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 _) -> b -> IO b
forall (m :: Type -> Type) a. Monad m => a -> m a
return b
b))
{-# NOINLINE seqX #-}
infixr 0 `seqX`

-- | 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 f :: a -> Either String a
f a :: 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'.
--
-- > maybeX 42                  = Just 42
-- > maybeX (XException msg)    = Nothing
-- > maybeX (3, XException msg) = Nothing
-- > maybeX (3, _|_)            = _|_
-- > maybeX _|_                 = _|_
--
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
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 msg :: 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, _|_)            = (3, _|_)
-- > isX _|_                 = _|_
isX :: a -> Either String a
isX :: a -> Either String a
isX a :: 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 msg :: 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 #-}

showXWith :: (a -> ShowS) -> a -> ShowS
showXWith :: (a -> ShowS) -> a -> ShowS
showXWith f :: a -> ShowS
f x :: a
x =
  \s :: String
s -> IO String -> String
forall a. IO a -> a
unsafeDupablePerformIO (IO String -> (XException -> IO String) -> IO String
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (a -> ShowS
f (a -> ShowS) -> IO a -> IO ShowS
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> IO a
forall a. a -> IO a
evaluate a
x IO ShowS -> IO String -> IO String
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> String -> IO String
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure String
s)
                                      (\(XException _) -> String -> IO String
forall (m :: Type -> Type) a. Monad m => a -> m a
return ('X'Char -> ShowS
forall a. a -> [a] -> [a]
: String
s)))

-- | Use when you want to create a 'ShowX' instance where:
--
-- - There is no 'Generic' instance for your data type
-- - The 'Generic' derived ShowX method would traverse into the (hidden)
--   implementation details of your data type, and you just want to show the
--   entire value as \"X\".
--
-- Can be used like:
--
-- > data T = ...
-- >
-- > instance Show T where ...
-- >
-- > instance ShowX T where
-- >   showsPrecX = showsPrecXWith showsPrec
showsPrecXWith :: (Int -> a -> ShowS) -> Int -> a -> ShowS
showsPrecXWith :: (Int -> a -> ShowS) -> Int -> a -> ShowS
showsPrecXWith f :: Int -> a -> ShowS
f n :: Int
n = (a -> ShowS) -> a -> ShowS
forall a. (a -> ShowS) -> a -> ShowS
showXWith (Int -> a -> ShowS
f Int
n)

-- | Like 'shows', but values that normally throw an 'X' exception are
-- converted to \"X\", instead of error'ing out with an exception.
showsX :: ShowX a => a -> ShowS
showsX :: a -> ShowS
showsX = Int -> a -> ShowS
forall a. ShowX a => Int -> a -> ShowS
showsPrecX 0

-- | Like 'print', but values that normally throw an 'X' exception are
-- converted to \"X\", instead of error'ing out with an exception
printX :: ShowX a => a -> IO ()
printX :: a -> IO ()
printX x :: 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

-- | Like the 'Show' class, but values that normally throw an 'X' exception are
-- converted to \"X\", 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)
-- "(X,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 'X' exception are
  -- converted to \"X\", instead of error'ing out with an exception.
  showsPrecX :: Int -> a -> ShowS

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

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

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

showListX__ :: (a -> ShowS) -> [a] -> ShowS
showListX__ :: (a -> ShowS) -> [a] -> ShowS
showListX__ showx :: a -> ShowS
showx = ([a] -> ShowS) -> [a] -> ShowS
forall a. (a -> ShowS) -> a -> ShowS
showXWith [a] -> ShowS
go
  where
    go :: [a] -> ShowS
go []     s :: String
s = "[]" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
    go (x :: a
x:xs :: [a]
xs) s :: String
s = '[' Char -> ShowS
forall a. a -> [a] -> [a]
: a -> ShowS
showx a
x ([a] -> String
showl [a]
xs)
      where
        showl :: [a] -> String
showl []     = ']'Char -> ShowS
forall a. a -> [a] -> [a]
:String
s
        showl (y :: a
y:ys :: [a]
ys) = ',' Char -> ShowS
forall a. a -> [a] -> [a]
: a -> ShowS
showx a
y ([a] -> String
showl [a]
ys)

data ShowType = Rec        -- Record
              | Tup        -- Tuple
              | Pref       -- Prefix
              | Inf String -- Infix

genericShowsPrecX :: (Generic a, GShowX (Rep a)) => Int -> a -> ShowS
genericShowsPrecX :: Int -> a -> ShowS
genericShowsPrecX n :: Int
n = ShowType -> Int -> Rep a Any -> ShowS
forall (f :: Type -> Type) a.
GShowX f =>
ShowType -> Int -> f a -> ShowS
gshowsPrecX ShowType
Pref Int
n (Rep a Any -> ShowS) -> (a -> Rep a Any) -> a -> ShowS
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 ShowX ()

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

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

instance ShowX Bool

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

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

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

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

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

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

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

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

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

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

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

instance ShowX a => ShowX (Seq a) where
  showsPrecX :: Int -> Seq a -> ShowS
showsPrecX _ = [a] -> ShowS
forall a. ShowX a => [a] -> ShowS
showListX ([a] -> ShowS) -> (Seq a -> [a]) -> Seq a -> ShowS
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 -> ShowS
showsPrecX = (Int -> Word -> ShowS) -> Int -> Word -> ShowS
forall a. (Int -> a -> ShowS) -> Int -> a -> ShowS
showsPrecXWith Int -> Word -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec

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

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

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

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

instance ShowX a => ShowX (Maybe a)

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

instance ShowX a => ShowX (Complex a)

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

class GShowX f where
  gshowsPrecX :: ShowType -> Int -> f a -> ShowS
  isNullary   :: f a -> Bool
  isNullary = String -> f a -> Bool
forall a. HasCallStack => String -> a
error "generic showX (isNullary): unnecessary case"

instance GShowX U1 where
  gshowsPrecX :: ShowType -> Int -> U1 a -> ShowS
gshowsPrecX _ _ U1 = ShowS
forall a. a -> a
id
  isNullary :: U1 a -> Bool
isNullary _ = Bool
True

instance (ShowX c) => GShowX (K1 i c) where
  gshowsPrecX :: ShowType -> Int -> K1 i c a -> ShowS
gshowsPrecX _ n :: Int
n (K1 a :: c
a) = Int -> c -> ShowS
forall a. ShowX a => Int -> a -> ShowS
showsPrecX Int
n c
a
  isNullary :: K1 i c a -> Bool
isNullary _ = Bool
False

instance (GShowX a, Constructor c) => GShowX (M1 C c a) where
  gshowsPrecX :: ShowType -> Int -> M1 C c a a -> ShowS
gshowsPrecX _ n :: Int
n c :: M1 C c a a
c@(M1 x :: a a
x) =
    case Fixity
fixity of
      Prefix ->
        Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec Bool -> Bool -> Bool
&& Bool -> Bool
not (a a -> Bool
forall (f :: Type -> Type) a. GShowX f => f a -> Bool
isNullary a a
x))
          ( (if M1 C c a a -> Bool
forall (f :: Type -> Type) p. C1 c f p -> Bool
conIsTuple M1 C c a a
c then ShowS
forall a. a -> a
id else String -> ShowS
showString (M1 C c a a -> String
forall k (c :: k) k1 (t :: k -> (k1 -> Type) -> k1 -> Type)
       (f :: k1 -> Type) (a :: k1).
Constructor c =>
t c f a -> String
conName M1 C c a a
c))
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if a a -> Bool
forall (f :: Type -> Type) a. GShowX f => f a -> Bool
isNullary a a
x Bool -> Bool -> Bool
|| M1 C c a a -> Bool
forall (f :: Type -> Type) p. C1 c f p -> Bool
conIsTuple M1 C c a a
c then ShowS
forall a. a -> a
id else String -> ShowS
showString " ")
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowType -> ShowS -> ShowS
showBraces ShowType
t (ShowType -> Int -> a a -> ShowS
forall (f :: Type -> Type) a.
GShowX f =>
ShowType -> Int -> f a -> ShowS
gshowsPrecX ShowType
t Int
appPrec a a
x))
      Infix _ m :: Int
m -> Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
m) (ShowType -> ShowS -> ShowS
showBraces ShowType
t (ShowType -> Int -> a a -> ShowS
forall (f :: Type -> Type) a.
GShowX f =>
ShowType -> Int -> f a -> ShowS
gshowsPrecX ShowType
t Int
m a a
x))
      where fixity :: Fixity
fixity = M1 C c a a -> Fixity
forall k (c :: k) k1 (t :: k -> (k1 -> Type) -> k1 -> Type)
       (f :: k1 -> Type) (a :: k1).
Constructor c =>
t c f a -> Fixity
conFixity M1 C c a a
c
            t :: ShowType
t = if M1 C c a a -> Bool
forall k (c :: k) k1 (t :: k -> (k1 -> Type) -> k1 -> Type)
       (f :: k1 -> Type) (a :: k1).
Constructor c =>
t c f a -> Bool
conIsRecord M1 C c a a
c then ShowType
Rec else
                  case M1 C c a a -> Bool
forall (f :: Type -> Type) p. C1 c f p -> Bool
conIsTuple M1 C c a a
c of
                    True -> ShowType
Tup
                    False -> case Fixity
fixity of
                                Prefix    -> ShowType
Pref
                                Infix _ _ -> String -> ShowType
Inf (ShowS
forall a. Show a => a -> String
show (M1 C c a a -> String
forall k (c :: k) k1 (t :: k -> (k1 -> Type) -> k1 -> Type)
       (f :: k1 -> Type) (a :: k1).
Constructor c =>
t c f a -> String
conName M1 C c a a
c))
            showBraces :: ShowType -> ShowS -> ShowS
            showBraces :: ShowType -> ShowS -> ShowS
showBraces Rec     p :: ShowS
p = Char -> ShowS
showChar '{' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar '}'
            showBraces Tup     p :: ShowS
p = Char -> ShowS
showChar '(' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar ')'
            showBraces Pref    p :: ShowS
p = ShowS
p
            showBraces (Inf _) p :: ShowS
p = ShowS
p

            conIsTuple :: C1 c f p -> Bool
            conIsTuple :: C1 c f p -> Bool
conIsTuple y :: C1 c f p
y = String -> Bool
tupleName (C1 c f p -> String
forall k (c :: k) k1 (t :: k -> (k1 -> Type) -> k1 -> Type)
       (f :: k1 -> Type) (a :: k1).
Constructor c =>
t c f a -> String
conName C1 c f p
y) where
              tupleName :: String -> Bool
tupleName ('(':',':_) = Bool
True
              tupleName _           = Bool
False

instance (Selector s, GShowX a) => GShowX (M1 S s a) where
  gshowsPrecX :: ShowType -> Int -> M1 S s a a -> ShowS
gshowsPrecX t :: ShowType
t n :: Int
n s :: M1 S s a a
s@(M1 x :: a a
x) | M1 S s a a -> String
forall k (s :: k) k1 (t :: k -> (k1 -> Type) -> k1 -> Type)
       (f :: k1 -> Type) (a :: k1).
Selector s =>
t s f a -> String
selName M1 S s a a
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" =   ShowType -> Int -> a a -> ShowS
forall (f :: Type -> Type) a.
GShowX f =>
ShowType -> Int -> f a -> ShowS
gshowsPrecX ShowType
t Int
n a a
x
                           | Bool
otherwise       =   String -> ShowS
showString (M1 S s a a -> String
forall k (s :: k) k1 (t :: k -> (k1 -> Type) -> k1 -> Type)
       (f :: k1 -> Type) (a :: k1).
Selector s =>
t s f a -> String
selName M1 S s a a
s)
                                               ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString " = "
                                               ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowType -> Int -> a a -> ShowS
forall (f :: Type -> Type) a.
GShowX f =>
ShowType -> Int -> f a -> ShowS
gshowsPrecX ShowType
t 0 a a
x
  isNullary :: M1 S s a a -> Bool
isNullary (M1 x :: a a
x) = a a -> Bool
forall (f :: Type -> Type) a. GShowX f => f a -> Bool
isNullary a a
x

instance (GShowX a) => GShowX (M1 D d a) where
  gshowsPrecX :: ShowType -> Int -> M1 D d a a -> ShowS
gshowsPrecX t :: ShowType
t = (Int -> M1 D d a a -> ShowS) -> Int -> M1 D d a a -> ShowS
forall a. (Int -> a -> ShowS) -> Int -> a -> ShowS
showsPrecXWith Int -> M1 D d a a -> ShowS
go
    where go :: Int -> M1 D d a a -> ShowS
go n :: Int
n (M1 x :: a a
x) = ShowType -> Int -> a a -> ShowS
forall (f :: Type -> Type) a.
GShowX f =>
ShowType -> Int -> f a -> ShowS
gshowsPrecX ShowType
t Int
n a a
x

instance (GShowX a, GShowX b) => GShowX (a :+: b) where
  gshowsPrecX :: ShowType -> Int -> (:+:) a b a -> ShowS
gshowsPrecX t :: ShowType
t n :: Int
n (L1 x :: a a
x) = ShowType -> Int -> a a -> ShowS
forall (f :: Type -> Type) a.
GShowX f =>
ShowType -> Int -> f a -> ShowS
gshowsPrecX ShowType
t Int
n a a
x
  gshowsPrecX t :: ShowType
t n :: Int
n (R1 x :: b a
x) = ShowType -> Int -> b a -> ShowS
forall (f :: Type -> Type) a.
GShowX f =>
ShowType -> Int -> f a -> ShowS
gshowsPrecX ShowType
t Int
n b a
x

instance (GShowX a, GShowX b) => GShowX (a :*: b) where
  gshowsPrecX :: ShowType -> Int -> (:*:) a b a -> ShowS
gshowsPrecX t :: ShowType
t@ShowType
Rec     n :: Int
n (a :: a a
a :*: b :: b a
b) =
    ShowType -> Int -> a a -> ShowS
forall (f :: Type -> Type) a.
GShowX f =>
ShowType -> Int -> f a -> ShowS
gshowsPrecX ShowType
t Int
n     a a
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString ", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowType -> Int -> b a -> ShowS
forall (f :: Type -> Type) a.
GShowX f =>
ShowType -> Int -> f a -> ShowS
gshowsPrecX ShowType
t Int
n     b a
b
  gshowsPrecX t :: ShowType
t@(Inf s :: String
s) n :: Int
n (a :: a a
a :*: b :: b a
b) =
    ShowType -> Int -> a a -> ShowS
forall (f :: Type -> Type) a.
GShowX f =>
ShowType -> Int -> f a -> ShowS
gshowsPrecX ShowType
t Int
n     a a
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
s    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowType -> Int -> b a -> ShowS
forall (f :: Type -> Type) a.
GShowX f =>
ShowType -> Int -> f a -> ShowS
gshowsPrecX ShowType
t Int
n     b a
b
  gshowsPrecX t :: ShowType
t@ShowType
Tup     n :: Int
n (a :: a a
a :*: b :: b a
b) =
    ShowType -> Int -> a a -> ShowS
forall (f :: Type -> Type) a.
GShowX f =>
ShowType -> Int -> f a -> ShowS
gshowsPrecX ShowType
t Int
n     a a
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar ','    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowType -> Int -> b a -> ShowS
forall (f :: Type -> Type) a.
GShowX f =>
ShowType -> Int -> f a -> ShowS
gshowsPrecX ShowType
t Int
n     b a
b
  gshowsPrecX t :: ShowType
t@ShowType
Pref    n :: Int
n (a :: a a
a :*: b :: b a
b) =
    ShowType -> Int -> a a -> ShowS
forall (f :: Type -> Type) a.
GShowX f =>
ShowType -> Int -> f a -> ShowS
gshowsPrecX ShowType
t (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) a a
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar ' '    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowType -> Int -> b a -> ShowS
forall (f :: Type -> Type) a.
GShowX f =>
ShowType -> Int -> f a -> ShowS
gshowsPrecX ShowType
t (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) b a
b

  -- If we have a product then it is not a nullary constructor
  isNullary :: (:*:) a b a -> Bool
isNullary _ = Bool
False

-- Unboxed types
instance GShowX UChar where
  gshowsPrecX :: ShowType -> Int -> UChar a -> ShowS
gshowsPrecX _ _ (UChar c)   = Int -> Char -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 0 (Char# -> Char
C# Char#
c) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar '#'
instance GShowX UDouble where
  gshowsPrecX :: ShowType -> Int -> UDouble a -> ShowS
gshowsPrecX _ _ (UDouble d) = Int -> Double -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 0 (Double# -> Double
D# Double#
d) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString "##"
instance GShowX UFloat where
  gshowsPrecX :: ShowType -> Int -> UFloat a -> ShowS
gshowsPrecX _ _ (UFloat f)  = Int -> Float -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 0 (Float# -> Float
F# Float#
f) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar '#'
instance GShowX UInt where
  gshowsPrecX :: ShowType -> Int -> UInt a -> ShowS
gshowsPrecX _ _ (UInt i)    = Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 0 (Int# -> Int
I# Int#
i) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar '#'
instance GShowX UWord where
  gshowsPrecX :: ShowType -> Int -> UWord a -> ShowS
gshowsPrecX _ _ (UWord w)   = Int -> Word -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 0 (Word# -> Word
W# Word#
w) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString "##"

-- | a variant of 'deepseqX' that is useful in some circumstances:
--
-- > forceX x = x `deepseqX` x
forceX :: NFDataX a => a -> a
forceX :: a -> a
forceX x :: 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
a b :: b
b = a -> ()
forall a. NFDataX a => a -> ()
rnfX a
a () -> b -> b
forall a b. a -> b -> b
`seq` b
b
{-# NOINLINE 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 #-}

-- | Hidden internal type-class. Adds a generic implementation for the "NFData"
-- part of 'NFDataX'
class GNFDataX arity f where
  grnfX :: RnfArgs arity a -> f a -> ()

instance GNFDataX arity V1 where
  grnfX :: RnfArgs arity a -> V1 a -> ()
grnfX _ x :: V1 a
x = case V1 a
x of {}

data Zero
data One

data RnfArgs arity a where
  RnfArgs0 :: RnfArgs Zero a
  RnfArgs1  :: (a -> ()) -> RnfArgs One a

instance GNFDataX arity U1 where
  grnfX :: RnfArgs arity a -> U1 a -> ()
grnfX _ u :: U1 a
u = if Either String (U1 a) -> Bool
forall a b. Either a b -> Bool
isLeft (U1 a -> Either String (U1 a)
forall a. a -> Either String a
isX U1 a
u) then () else case U1 a
u of U1 -> ()

instance NFDataX a => GNFDataX arity (K1 i a) where
  grnfX :: RnfArgs arity a -> K1 i a a -> ()
grnfX _ = a -> ()
forall a. NFDataX a => a -> ()
rnfX (a -> ()) -> (K1 i a a -> a) -> K1 i a a -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 i a a -> a
forall i c k (p :: k). K1 i c p -> c
unK1
  {-# INLINEABLE grnfX #-}

instance GNFDataX arity a => GNFDataX arity (M1 i c a) where
  grnfX :: RnfArgs arity a -> M1 i c a a -> ()
grnfX args :: RnfArgs arity a
args a :: M1 i c a a
a =
    -- Check for X needed to handle edge-case "data Void"
    if Either String (M1 i c a a) -> Bool
forall a b. Either a b -> Bool
isLeft (M1 i c a a -> Either String (M1 i c a a)
forall a. a -> Either String a
isX M1 i c a a
a) then
      ()
    else
      RnfArgs arity a -> a a -> ()
forall arity (f :: Type -> Type) a.
GNFDataX arity f =>
RnfArgs arity a -> f a -> ()
grnfX RnfArgs arity a
args (M1 i c a a -> a a
forall i (c :: Meta) k (f :: k -> Type) (p :: k). M1 i c f p -> f p
unM1 M1 i c a a
a)
  {-# INLINEABLE grnfX #-}

instance (GNFDataX arity a, GNFDataX arity b) => GNFDataX arity (a :*: b) where
  grnfX :: RnfArgs arity a -> (:*:) a b a -> ()
grnfX args :: RnfArgs arity a
args xy :: (:*:) a b a
xy@(~(x :: a a
x :*: y :: b a
y)) =
    if Either String ((:*:) a b a) -> Bool
forall a b. Either a b -> Bool
isLeft ((:*:) a b a -> Either String ((:*:) a b a)
forall a. a -> Either String a
isX (:*:) a b a
xy) then
      ()
    else
      RnfArgs arity a -> a a -> ()
forall arity (f :: Type -> Type) a.
GNFDataX arity f =>
RnfArgs arity a -> f a -> ()
grnfX RnfArgs arity a
args a a
x () -> () -> ()
forall a b. a -> b -> b
`seq` RnfArgs arity a -> b a -> ()
forall arity (f :: Type -> Type) a.
GNFDataX arity f =>
RnfArgs arity a -> f a -> ()
grnfX RnfArgs arity a
args b a
y
  {-# INLINEABLE grnfX #-}

instance (GNFDataX arity a, GNFDataX arity b) => GNFDataX arity (a :+: b) where
  grnfX :: RnfArgs arity a -> (:+:) a b a -> ()
grnfX args :: RnfArgs arity a
args lrx :: (:+:) a b a
lrx =
    if Either String ((:+:) a b a) -> Bool
forall a b. Either a b -> Bool
isLeft ((:+:) a b a -> Either String ((:+:) a b a)
forall a. a -> Either String a
isX (:+:) a b a
lrx) then
      ()
    else
      case (:+:) a b a
lrx of
        L1 x :: a a
x -> RnfArgs arity a -> a a -> ()
forall arity (f :: Type -> Type) a.
GNFDataX arity f =>
RnfArgs arity a -> f a -> ()
grnfX RnfArgs arity a
args a a
x
        R1 x :: b a
x -> RnfArgs arity a -> b a -> ()
forall arity (f :: Type -> Type) a.
GNFDataX arity f =>
RnfArgs arity a -> f a -> ()
grnfX RnfArgs arity a
args b a
x
  {-# INLINEABLE grnfX #-}

instance GNFDataX One Par1 where
  grnfX :: RnfArgs One a -> Par1 a -> ()
grnfX (RnfArgs1 r :: a -> ()
r) = a -> ()
r (a -> ()) -> (Par1 a -> a) -> Par1 a -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Par1 a -> a
forall p. Par1 p -> p
unPar1

instance NFDataX1 f => GNFDataX One (Rec1 f) where
  grnfX :: RnfArgs One a -> Rec1 f a -> ()
grnfX (RnfArgs1 r :: a -> ()
r) = (a -> ()) -> f a -> ()
forall (f :: Type -> Type) a. NFDataX1 f => (a -> ()) -> f a -> ()
liftRnfX a -> ()
r (f a -> ()) -> (Rec1 f a -> f a) -> Rec1 f a -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec1 f a -> f a
forall k (f :: k -> Type) (p :: k). Rec1 f p -> f p
unRec1

instance (NFDataX1 f, GNFDataX One g) => GNFDataX One (f :.: g) where
  grnfX :: RnfArgs One a -> (:.:) f g a -> ()
grnfX args :: RnfArgs One a
args = (g a -> ()) -> f (g a) -> ()
forall (f :: Type -> Type) a. NFDataX1 f => (a -> ()) -> f a -> ()
liftRnfX (RnfArgs One a -> g a -> ()
forall arity (f :: Type -> Type) a.
GNFDataX arity f =>
RnfArgs arity a -> f a -> ()
grnfX RnfArgs One a
args) (f (g a) -> ()) -> ((:.:) f g a -> f (g a)) -> (:.:) f g a -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:.:) f g a -> f (g a)
forall k2 (f :: k2 -> Type) k1 (g :: k1 -> k2) (p :: k1).
(:.:) f g p -> f (g p)
unComp1

class GEnsureSpine f where
  gEnsureSpine :: f a -> f a

instance GEnsureSpine U1 where
  gEnsureSpine :: U1 a -> U1 a
gEnsureSpine _u :: U1 a
_u = U1 a
forall k (p :: k). U1 p
U1

instance NFDataX a => GEnsureSpine (K1 i a) where
  gEnsureSpine :: K1 i a a -> K1 i a a
gEnsureSpine = a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a a) -> (K1 i a a -> a) -> K1 i a a -> K1 i a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. NFDataX a => a -> a
ensureSpine (a -> a) -> (K1 i a a -> a) -> K1 i a a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 i a a -> a
forall i c k (p :: k). K1 i c p -> c
unK1
  {-# INLINEABLE gEnsureSpine #-}

instance GEnsureSpine a => GEnsureSpine (M1 i c a) where
  gEnsureSpine :: M1 i c a a -> M1 i c a a
gEnsureSpine a :: M1 i c a a
a = a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> Type) (p :: k). f p -> M1 i c f p
M1 (a a -> a a
forall (f :: Type -> Type) a. GEnsureSpine f => f a -> f a
gEnsureSpine (M1 i c a a -> a a
forall i (c :: Meta) k (f :: k -> Type) (p :: k). M1 i c f p -> f p
unM1 M1 i c a a
a))
  {-# INLINEABLE gEnsureSpine #-}

instance (GEnsureSpine a, GEnsureSpine b) => GEnsureSpine (a :*: b) where
  gEnsureSpine :: (:*:) a b a -> (:*:) a b a
gEnsureSpine ~(x :: a a
x :*: y :: b a
y) = a a -> a a
forall (f :: Type -> Type) a. GEnsureSpine f => f a -> f a
gEnsureSpine a a
x a a -> b a -> (:*:) a b a
forall k (f :: k -> Type) (g :: k -> Type) (p :: k).
f p -> g p -> (:*:) f g p
:*: b a -> b a
forall (f :: Type -> Type) a. GEnsureSpine f => f a -> f a
gEnsureSpine b a
y
  {-# INLINEABLE gEnsureSpine #-}

instance (GEnsureSpine a, GEnsureSpine b) => GEnsureSpine (a :+: b) where
  gEnsureSpine :: (:+:) a b a -> (:+:) a b a
gEnsureSpine lrx :: (:+:) a b a
lrx =
    case (:+:) a b a
lrx of
      (L1 x :: a a
x) -> a a -> (:+:) a b a
forall k (f :: k -> Type) (g :: k -> Type) (p :: k).
f p -> (:+:) f g p
L1 (a a -> a a
forall (f :: Type -> Type) a. GEnsureSpine f => f a -> f a
gEnsureSpine a a
x)
      (R1 x :: b a
x) -> b a -> (:+:) a b a
forall k (f :: k -> Type) (g :: k -> Type) (p :: k).
g p -> (:+:) f g p
R1 (b a -> b a
forall (f :: Type -> Type) a. GEnsureSpine f => f a -> f a
gEnsureSpine b a
x)
  {-# INLINEABLE gEnsureSpine #-}

instance GEnsureSpine V1 where
  gEnsureSpine :: V1 a -> V1 a
gEnsureSpine _ = String -> V1 a
forall a. HasCallStack => String -> a
error "Unreachable code?"

-- | A class of functors that can be fully evaluated, according to semantics
-- of NFDataX.
class NFDataX1 f where
  -- | 'liftRnfX' should reduce its argument to normal form (that is, fully
  -- evaluate all sub-components), given an argument to reduce @a@ arguments,
  -- and then return '()'.
  --
  -- See 'rnfX' for the generic deriving.
  liftRnfX :: (a -> ()) -> f a -> ()

  default liftRnfX :: (Generic1 f, GNFDataX One (Rep1 f)) => (a -> ()) -> f a -> ()
  liftRnfX r :: a -> ()
r = RnfArgs One a -> Rep1 f a -> ()
forall arity (f :: Type -> Type) a.
GNFDataX arity f =>
RnfArgs arity a -> f a -> ()
grnfX ((a -> ()) -> RnfArgs One a
forall a. (a -> ()) -> RnfArgs One a
RnfArgs1 a -> ()
r) (Rep1 f a -> ()) -> (f a -> Rep1 f a) -> f a -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Rep1 f a
forall k (f :: k -> Type) (a :: k). Generic1 f => f a -> Rep1 f a
from1


class GHasUndefined f where
  gHasUndefined :: f a -> Bool

instance GHasUndefined U1 where
  gHasUndefined :: U1 a -> Bool
gHasUndefined u :: U1 a
u = if Either String (U1 a) -> Bool
forall a b. Either a b -> Bool
isLeft (U1 a -> Either String (U1 a)
forall a. a -> Either String a
isX U1 a
u) then Bool
True else case U1 a
u of U1 -> Bool
False

instance NFDataX a => GHasUndefined (K1 i a) where
  gHasUndefined :: K1 i a a -> Bool
gHasUndefined = a -> Bool
forall a. NFDataX a => a -> Bool
hasUndefined (a -> Bool) -> (K1 i a a -> a) -> K1 i a a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 i a a -> a
forall i c k (p :: k). K1 i c p -> c
unK1
  {-# INLINEABLE gHasUndefined #-}

instance GHasUndefined a => GHasUndefined (M1 i c a) where
  gHasUndefined :: M1 i c a a -> Bool
gHasUndefined a :: M1 i c a a
a =
    -- Check for X needed to handle edge-case "data Void"
    if Either String (M1 i c a a) -> Bool
forall a b. Either a b -> Bool
isLeft (M1 i c a a -> Either String (M1 i c a a)
forall a. a -> Either String a
isX M1 i c a a
a) then
      Bool
True
    else
      a a -> Bool
forall (f :: Type -> Type) a. GHasUndefined f => f a -> Bool
gHasUndefined (M1 i c a a -> a a
forall i (c :: Meta) k (f :: k -> Type) (p :: k). M1 i c f p -> f p
unM1 M1 i c a a
a)
  {-# INLINEABLE gHasUndefined #-}

instance (GHasUndefined a, GHasUndefined b) => GHasUndefined (a :*: b) where
  gHasUndefined :: (:*:) a b a -> Bool
gHasUndefined xy :: (:*:) a b a
xy@(~(x :: a a
x :*: y :: b a
y)) =
    if Either String ((:*:) a b a) -> Bool
forall a b. Either a b -> Bool
isLeft ((:*:) a b a -> Either String ((:*:) a b a)
forall a. a -> Either String a
isX (:*:) a b a
xy) then
      Bool
True
    else
      a a -> Bool
forall (f :: Type -> Type) a. GHasUndefined f => f a -> Bool
gHasUndefined a a
x Bool -> Bool -> Bool
|| b a -> Bool
forall (f :: Type -> Type) a. GHasUndefined f => f a -> Bool
gHasUndefined b a
y
  {-# INLINEABLE gHasUndefined #-}

instance (GHasUndefined a, GHasUndefined b) => GHasUndefined (a :+: b) where
  gHasUndefined :: (:+:) a b a -> Bool
gHasUndefined lrx :: (:+:) a b a
lrx =
    if Either String ((:+:) a b a) -> Bool
forall a b. Either a b -> Bool
isLeft ((:+:) a b a -> Either String ((:+:) a b a)
forall a. a -> Either String a
isX (:+:) a b a
lrx) then
      Bool
True
    else
      case (:+:) a b a
lrx of
        L1 x :: a a
x -> a a -> Bool
forall (f :: Type -> Type) a. GHasUndefined f => f a -> Bool
gHasUndefined a a
x
        R1 x :: b a
x -> b a -> Bool
forall (f :: Type -> Type) a. GHasUndefined f => f a -> Bool
gHasUndefined b a
x
  {-# INLINEABLE gHasUndefined #-}

instance GHasUndefined V1 where
  gHasUndefined :: V1 a -> Bool
gHasUndefined _ = String -> Bool
forall a. HasCallStack => String -> a
error "Unreachable code?"

-- | 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
  -- 0.
  -- >>> 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'>
  -- >>> 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 "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 x :: 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 x :: 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 x :: 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 s :: 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 Empty = ()
    go (x :: a
x :<| xs :: Seq a
xs) = a -> ()
forall a. NFDataX a => a -> ()
rnfX a
x () -> () -> ()
forall a b. a -> b -> b
`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 s :: 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 Empty = Bool
False
    go (x :: a
x :<| xs :: 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 r :: Ratio a
r = a -> ()
forall a. NFDataX a => a -> ()
rnfX (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r) () -> () -> ()
forall a b. a -> b -> b
`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 r :: 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.Option a)
instance NFDataX a => NFDataX (SG.Product a)
instance NFDataX a => NFDataX (SG.Sum a)

class GDeepErrorX f where
  gDeepErrorX :: HasCallStack => String -> f a

instance GDeepErrorX V1 where
  gDeepErrorX :: String -> V1 a
gDeepErrorX = String -> V1 a
forall a. HasCallStack => String -> a
errorX

instance GDeepErrorX U1 where
  gDeepErrorX :: String -> U1 a
gDeepErrorX = U1 a -> String -> U1 a
forall a b. a -> b -> a
const U1 a
forall k (p :: k). U1 p
U1

instance (GDeepErrorX a) => GDeepErrorX (M1 m d a) where
  gDeepErrorX :: String -> M1 m d a a
gDeepErrorX e :: String
e = a a -> M1 m d a a
forall k i (c :: Meta) (f :: k -> Type) (p :: k). f p -> M1 i c f p
M1 (String -> a a
forall (f :: Type -> Type) a.
(GDeepErrorX f, HasCallStack) =>
String -> f a
gDeepErrorX String
e)

instance (GDeepErrorX f, GDeepErrorX g) => GDeepErrorX (f :*: g) where
  gDeepErrorX :: String -> (:*:) f g a
gDeepErrorX e :: String
e = String -> f a
forall (f :: Type -> Type) a.
(GDeepErrorX f, HasCallStack) =>
String -> f a
gDeepErrorX String
e f a -> g a -> (:*:) f g a
forall k (f :: k -> Type) (g :: k -> Type) (p :: k).
f p -> g p -> (:*:) f g p
:*: String -> g a
forall (f :: Type -> Type) a.
(GDeepErrorX f, HasCallStack) =>
String -> f a
gDeepErrorX String
e

instance NFDataX c => GDeepErrorX (K1 i c) where
  gDeepErrorX :: String -> K1 i c a
gDeepErrorX e :: String
e = c -> K1 i c a
forall k i c (p :: k). c -> K1 i c p
K1 (String -> c
forall a. (NFDataX a, HasCallStack) => String -> a
deepErrorX String
e)

instance GDeepErrorX (f :+: g) where
  gDeepErrorX :: String -> (:+:) f g a
gDeepErrorX = String -> (:+:) f g a
forall a. HasCallStack => String -> a
errorX

mkShowXTupleInstances [2..maxTupleSize]
mkNFDataXTupleInstances [2..maxTupleSize]

undefined :: HasCallStack => a
undefined :: a
undefined = String -> a
forall a. HasCallStack => String -> a
errorX "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 Nothing = String -> a
forall a. HasCallStack => String -> a
errorX "isJustX: Nothing"
fromJustX (Just a :: a
a) = a
a