{-# LANGUAGE TemplateHaskellQuotes #-}
module Clash.Primitives.Magic
( clashCompileErrorBBF
) where
import Data.Either (lefts)
import GHC.Stack (HasCallStack)
import Text.Show.Pretty
import Clash.Core.TermLiteral (termToDataError)
import Clash.Netlist.BlackBox.Types (BlackBoxFunction)
import Clash.Netlist.Types ()
clashCompileErrorBBF :: HasCallStack => BlackBoxFunction
clashCompileErrorBBF :: HasCallStack => BlackBoxFunction
clashCompileErrorBBF Bool
_isD Text
_primName [Either Term Type]
args [Type]
_ty
| Term
_hasCallstack
: ((String -> String)
-> (String -> String) -> Either String String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> String
forall a. HasCallStack => String -> a
error String -> String
forall a. a -> a
id (Either String String -> String)
-> (Term -> Either String String) -> Term -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Either String String
forall a. TermLiteral a => Term -> Either String a
termToDataError -> String
msg)
: [Term]
_ <- [Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
lefts [Either Term Type]
args
= Either String (BlackBoxMeta, BlackBox)
-> NetlistMonad (Either String (BlackBoxMeta, BlackBox))
forall a. a -> NetlistMonad a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either String (BlackBoxMeta, BlackBox)
-> NetlistMonad (Either String (BlackBoxMeta, BlackBox)))
-> Either String (BlackBoxMeta, BlackBox)
-> NetlistMonad (Either String (BlackBoxMeta, BlackBox))
forall a b. (a -> b) -> a -> b
$ String -> Either String (BlackBoxMeta, BlackBox)
forall a b. a -> Either a b
Left (String -> Either String (BlackBoxMeta, BlackBox))
-> String -> Either String (BlackBoxMeta, BlackBox)
forall a b. (a -> b) -> a -> b
$ String
"clashCompileError: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg
| Bool
otherwise
= Either String (BlackBoxMeta, BlackBox)
-> NetlistMonad (Either String (BlackBoxMeta, BlackBox))
forall a. a -> NetlistMonad a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either String (BlackBoxMeta, BlackBox)
-> NetlistMonad (Either String (BlackBoxMeta, BlackBox)))
-> Either String (BlackBoxMeta, BlackBox)
-> NetlistMonad (Either String (BlackBoxMeta, BlackBox))
forall a b. (a -> b) -> a -> b
$ String -> Either String (BlackBoxMeta, BlackBox)
forall a b. a -> Either a b
Left (String -> Either String (BlackBoxMeta, BlackBox))
-> String -> Either String (BlackBoxMeta, BlackBox)
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. Show a => a -> String
show 'clashCompileErrorBBF String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": bad args:\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Either Term Type] -> String
forall a. Show a => a -> String
ppShow [Either Term Type]
args