{-|
  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 :: 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