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

  Blackbox functions for primitives in the @Clash.Magic@ module.
-}

{-# 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 :: BlackBoxFunction
clashCompileErrorBBF Bool
_isD Text
_primName [Either Term Type]
args [Type]
_ty
  |   Term
_hasCallstack
    : (([Char] -> [Char])
-> ([Char] -> [Char]) -> Either [Char] [Char] -> [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char] -> [Char]
forall a. a -> a
id (Either [Char] [Char] -> [Char])
-> (Term -> Either [Char] [Char]) -> Term -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Either [Char] [Char]
forall a. TermLiteral a => Term -> Either [Char] a
termToDataError -> [Char]
msg)
    : [Term]
_ <- [Either Term Type] -> [Term]
forall a b. [Either a b] -> [a]
lefts [Either Term Type]
args
  = Either [Char] (BlackBoxMeta, BlackBox)
-> NetlistMonad (Either [Char] (BlackBoxMeta, BlackBox))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either [Char] (BlackBoxMeta, BlackBox)
 -> NetlistMonad (Either [Char] (BlackBoxMeta, BlackBox)))
-> Either [Char] (BlackBoxMeta, BlackBox)
-> NetlistMonad (Either [Char] (BlackBoxMeta, BlackBox))
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] (BlackBoxMeta, BlackBox)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (BlackBoxMeta, BlackBox))
-> [Char] -> Either [Char] (BlackBoxMeta, BlackBox)
forall a b. (a -> b) -> a -> b
$ [Char]
"clashCompileError: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
msg
  | Bool
otherwise
  = Either [Char] (BlackBoxMeta, BlackBox)
-> NetlistMonad (Either [Char] (BlackBoxMeta, BlackBox))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either [Char] (BlackBoxMeta, BlackBox)
 -> NetlistMonad (Either [Char] (BlackBoxMeta, BlackBox)))
-> Either [Char] (BlackBoxMeta, BlackBox)
-> NetlistMonad (Either [Char] (BlackBoxMeta, BlackBox))
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] (BlackBoxMeta, BlackBox)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (BlackBoxMeta, BlackBox))
-> [Char] -> Either [Char] (BlackBoxMeta, BlackBox)
forall a b. (a -> b) -> a -> b
$ Name -> [Char]
forall a. Show a => a -> [Char]
show 'clashCompileErrorBBF [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
": bad args:\n" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Either Term Type] -> [Char]
forall a. Show a => a -> [Char]
ppShow [Either Term Type]
args