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

  Utilties to verify blackbox contexts against templates and rendering filled
  in templates
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}

module Clash.Netlist.BlackBox.Util where

import           Control.Exception               (throw)
import           Control.Lens
  (use, (%=), _1, _2, element, (^?))
import           Control.Monad                   (forM)
import           Control.Monad.State             (State, StateT (..), lift)
import           Data.Bool                       (bool)
import           Data.Foldable                   (foldrM)
import           Data.Hashable                   (Hashable (..))
import qualified Data.IntMap                     as IntMap
import           Data.List                       (nub)
import           Data.List.Extra                 (indexMaybe)
#if !MIN_VERSION_base(4,11,0)
import           Data.Monoid
#endif
import           Data.Maybe                      (mapMaybe, maybeToList, fromJust)
import           Data.Semigroup.Monad
import qualified Data.Text
import           Data.Text.Lazy                  (Text)
import qualified Data.Text.Lazy                  as Text
import qualified Data.Text.Prettyprint.Doc       as PP
import           Data.Text.Prettyprint.Doc.Extra
import           System.FilePath                 (replaceBaseName, takeBaseName,
                                                  takeFileName, (<.>))
import           Text.Printf
import           Text.Read                       (readEither)
import           Text.Trifecta.Result            hiding (Err)

import           Clash.Backend                   (Backend (..), Usage (..), mkUniqueIdentifier)
import qualified Clash.Backend                   as Backend
import           Clash.Netlist.BlackBox.Parser
import           Clash.Netlist.BlackBox.Types
import           Clash.Netlist.Id                (IdType (..))
import           Clash.Netlist.Types             (BlackBoxContext (..),
                                                  Expr (..), HWType (..),
                                                  Identifier, Literal (..),
                                                  Modifier (..),
                                                  Declaration(BlackBoxD))
import qualified Clash.Netlist.Types             as N
import           Clash.Netlist.Util              (typeSize, isVoid, stripVoid)
import           Clash.Signal.Internal
  (ResetKind(..), ResetPolarity(..), InitBehavior(..))
import           Clash.Util

inputHole :: Element -> Maybe Int
inputHole :: Element -> Maybe Int
inputHole = \case
  Arg Bool
_ Int
n       -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Lit Int
n         -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Const Int
n       -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Name Int
n        -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Typ (Just Int
n)  -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  TypM (Just Int
n) -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Err (Just Int
n)  -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Element
_             -> Maybe Int
forall a. Maybe a
Nothing

-- | Determine if the number of normal/literal/function inputs of a blackbox
-- context at least matches the number of argument that is expected by the
-- template.
verifyBlackBoxContext
  :: BlackBoxContext
  -- ^ Blackbox to verify
  -> N.BlackBox
  -- ^ Template to check against
  -> Maybe String
verifyBlackBoxContext :: BlackBoxContext -> BlackBox -> Maybe String
verifyBlackBoxContext BlackBoxContext
bbCtx (N.BBFunction String
_ Int
_ (N.TemplateFunction [Int]
_ BlackBoxContext -> Bool
f forall s. Backend s => BlackBoxContext -> State s Doc
_)) =
  if BlackBoxContext -> Bool
f BlackBoxContext
bbCtx then
    Maybe String
forall a. Maybe a
Nothing
  else
    -- TODO: Make TemplateFunction return a string
    String -> Maybe String
forall a. a -> Maybe a
Just (String
"Template function for returned False")
verifyBlackBoxContext BlackBoxContext
bbCtx (N.BBTemplate BlackBoxTemplate
t) =
  [Maybe String] -> Maybe String
forall a. [Maybe a] -> Maybe a
orElses ((Element -> [Maybe String]) -> BlackBoxTemplate -> [Maybe String]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap ((Element -> Maybe (Maybe String)) -> Element -> [Maybe String]
forall a. (Element -> Maybe a) -> Element -> [a]
walkElement Element -> Maybe (Maybe String)
verify') BlackBoxTemplate
t)
  where
    concatTups :: [(b, b)] -> [b]
concatTups = ((b, b) -> [b]) -> [(b, b)] -> [b]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (\(b
x, b
y) -> [b
x, b
y])

    verify' :: Element -> Maybe (Maybe String)
verify' Element
e =
      Maybe String -> Maybe (Maybe String)
forall a. a -> Maybe a
Just (Maybe String -> Maybe (Maybe String))
-> Maybe String -> Maybe (Maybe String)
forall a b. (a -> b) -> a -> b
$
      case Element
e of
        Lit Int
n ->
          case [(Expr, HWType, Bool)] -> Int -> Maybe (Expr, HWType, Bool)
forall a. [a] -> Int -> Maybe a
indexMaybe (BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx) Int
n of
            Just (Expr
inp, HWType -> Bool
isVoid -> Bool
False, Bool
False) ->
              String -> Maybe String
forall a. a -> Maybe a
Just ( String
"Argument " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" should be literal, as blackbox "
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"used ~LIT[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"], but was:\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr -> String
forall a. Show a => a -> String
show Expr
inp)
            Maybe (Expr, HWType, Bool)
_ -> Maybe String
forall a. Maybe a
Nothing
        Const Int
n ->
          case [(Expr, HWType, Bool)] -> Int -> Maybe (Expr, HWType, Bool)
forall a. [a] -> Int -> Maybe a
indexMaybe (BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx) Int
n of
            Just (Expr
inp, HWType -> Bool
isVoid -> Bool
False, Bool
False) ->
              String -> Maybe String
forall a. a -> Maybe a
Just ( String
"Argument " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" should be literal, as blackbox "
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"used ~CONST[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"], but was:\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr -> String
forall a. Show a => a -> String
show Expr
inp)
            Maybe (Expr, HWType, Bool)
_ -> Maybe String
forall a. Maybe a
Nothing
        Component (Decl Int
n Int
subn [(BlackBoxTemplate, BlackBoxTemplate)]
l') ->
          case Int
-> IntMap
     [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
       [BlackBoxTemplate], [BlackBoxTemplate],
       [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
-> Maybe
     [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
       [BlackBoxTemplate], [BlackBoxTemplate],
       [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
n (BlackBoxContext
-> IntMap
     [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
       [BlackBoxTemplate], [BlackBoxTemplate],
       [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
bbFunctions BlackBoxContext
bbCtx) of
            Just [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
  [BlackBoxTemplate], [BlackBoxTemplate],
  [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
funcs ->
              case [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
  [BlackBoxTemplate], [BlackBoxTemplate],
  [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
-> Int
-> Maybe
     (Either BlackBox (Identifier, [Declaration]), WireOrReg,
      [BlackBoxTemplate], [BlackBoxTemplate],
      [((Identifier, Identifier), BlackBox)], BlackBoxContext)
forall a. [a] -> Int -> Maybe a
indexMaybe [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
  [BlackBoxTemplate], [BlackBoxTemplate],
  [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
funcs Int
subn of
                Maybe
  (Either BlackBox (Identifier, [Declaration]), WireOrReg,
   [BlackBoxTemplate], [BlackBoxTemplate],
   [((Identifier, Identifier), BlackBox)], BlackBoxContext)
Nothing ->
                  String -> Maybe String
forall a. a -> Maybe a
Just ( String
"Blackbox requested at least " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
subnInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" renders of function at argument " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" but "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"found only " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([(Either BlackBox (Identifier, [Declaration]), WireOrReg,
  [BlackBoxTemplate], [BlackBoxTemplate],
  [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
-> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
  [BlackBoxTemplate], [BlackBoxTemplate],
  [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
funcs) )
                Just (Either BlackBox (Identifier, [Declaration]), WireOrReg,
 [BlackBoxTemplate], [BlackBoxTemplate],
 [((Identifier, Identifier), BlackBox)], BlackBoxContext)
_ ->
                  [Maybe String] -> Maybe String
forall a. [Maybe a] -> Maybe a
orElses ([Maybe String] -> Maybe String) -> [Maybe String] -> Maybe String
forall a b. (a -> b) -> a -> b
$
                    (BlackBoxTemplate -> Maybe String)
-> [BlackBoxTemplate] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map
                      (BlackBoxContext -> BlackBox -> Maybe String
verifyBlackBoxContext BlackBoxContext
bbCtx (BlackBox -> Maybe String)
-> (BlackBoxTemplate -> BlackBox)
-> BlackBoxTemplate
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlackBoxTemplate -> BlackBox
N.BBTemplate)
                      ([(BlackBoxTemplate, BlackBoxTemplate)] -> [BlackBoxTemplate]
forall b. [(b, b)] -> [b]
concatTups [(BlackBoxTemplate, BlackBoxTemplate)]
l')
            Maybe
  [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
    [BlackBoxTemplate], [BlackBoxTemplate],
    [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
Nothing ->
              String -> Maybe String
forall a. a -> Maybe a
Just ( String
"Blackbox requested instantiation of function at argument "
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but BlackBoxContext did not contain one.")
        Element
_ ->
          case Element -> Maybe Int
inputHole Element
e of
            Maybe Int
Nothing ->
              Maybe String
forall a. Maybe a
Nothing
            Just Int
n ->
              case [(Expr, HWType, Bool)] -> Int -> Maybe (Expr, HWType, Bool)
forall a. [a] -> Int -> Maybe a
indexMaybe (BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx) Int
n of
                Just (Expr, HWType, Bool)
_ -> Maybe String
forall a. Maybe a
Nothing
                Maybe (Expr, HWType, Bool)
Nothing ->
                  String -> Maybe String
forall a. a -> Maybe a
Just ( String
"Blackbox required at least " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" arguments, but only " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([(Expr, HWType, Bool)] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length (BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx))
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" were passed." )

extractLiterals :: BlackBoxContext
                -> [Expr]
extractLiterals :: BlackBoxContext -> [Expr]
extractLiterals = ((Expr, HWType, Bool) -> Expr) -> [(Expr, HWType, Bool)] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (\case (Expr
e,HWType
_,Bool
_) -> Expr
e)
                ([(Expr, HWType, Bool)] -> [Expr])
-> (BlackBoxContext -> [(Expr, HWType, Bool)])
-> BlackBoxContext
-> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Expr, HWType, Bool) -> Bool)
-> [(Expr, HWType, Bool)] -> [(Expr, HWType, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case (Expr
_,HWType
_,Bool
b) -> Bool
b)
                ([(Expr, HWType, Bool)] -> [(Expr, HWType, Bool)])
-> (BlackBoxContext -> [(Expr, HWType, Bool)])
-> BlackBoxContext
-> [(Expr, HWType, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs

-- | Update all the symbol references in a template, and increment the symbol
-- counter for every newly encountered symbol.
setSym
  :: forall m
   . Monad m
  => (IdType -> Identifier -> m Identifier)
  -> BlackBoxContext
  -> BlackBoxTemplate
  -> m (BlackBoxTemplate,[N.Declaration])
setSym :: (IdType -> Identifier -> m Identifier)
-> BlackBoxContext
-> BlackBoxTemplate
-> m (BlackBoxTemplate, [Declaration])
setSym IdType -> Identifier -> m Identifier
mkUniqueIdentifierM BlackBoxContext
bbCtx BlackBoxTemplate
l = do
    (BlackBoxTemplate
a,(IntMap Identifier
_,IntMap (Identifier, [Declaration])
decls)) <- StateT
  (IntMap Identifier, IntMap (Identifier, [Declaration]))
  m
  BlackBoxTemplate
-> (IntMap Identifier, IntMap (Identifier, [Declaration]))
-> m (BlackBoxTemplate,
      (IntMap Identifier, IntMap (Identifier, [Declaration])))
forall s (m :: Type -> Type) a. StateT s m a -> s -> m (a, s)
runStateT ((Element
 -> StateT
      (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element)
-> BlackBoxTemplate
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     BlackBoxTemplate
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
setSym' BlackBoxTemplate
l) (IntMap Identifier
forall a. IntMap a
IntMap.empty,IntMap (Identifier, [Declaration])
forall a. IntMap a
IntMap.empty)
    (BlackBoxTemplate, [Declaration])
-> m (BlackBoxTemplate, [Declaration])
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BlackBoxTemplate
a,((Identifier, [Declaration]) -> [Declaration])
-> [(Identifier, [Declaration])] -> [Declaration]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (Identifier, [Declaration]) -> [Declaration]
forall a b. (a, b) -> b
snd (IntMap (Identifier, [Declaration]) -> [(Identifier, [Declaration])]
forall a. IntMap a -> [a]
IntMap.elems IntMap (Identifier, [Declaration])
decls))
  where
    bbnm :: String
bbnm = Identifier -> String
Data.Text.unpack (BlackBoxContext -> Identifier
bbName BlackBoxContext
bbCtx)

    setSym'
      :: Element
      -> StateT ( IntMap.IntMap Identifier
                , IntMap.IntMap (Identifier,[N.Declaration]))
                m
                Element
    setSym' :: Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
setSym' Element
e = case Element
e of
      ToVar BlackBoxTemplate
nm Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [(Expr, HWType, Bool)] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length (BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx) -> case BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
i of
        (Identifier Identifier
nm' Maybe Modifier
Nothing,HWType
_,Bool
_) ->
          Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BlackBoxTemplate -> Int -> Element
ToVar [Text -> Element
Text (Identifier -> Text
Text.fromStrict Identifier
nm')] Int
i)

        (Expr
e',HWType
hwTy,Bool
_) -> do
          Maybe (Identifier, [Declaration])
varM <- Int
-> IntMap (Identifier, [Declaration])
-> Maybe (Identifier, [Declaration])
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
i (IntMap (Identifier, [Declaration])
 -> Maybe (Identifier, [Declaration]))
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     (IntMap (Identifier, [Declaration]))
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     (Maybe (Identifier, [Declaration]))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (IntMap (Identifier, [Declaration]))
  (IntMap Identifier, IntMap (Identifier, [Declaration]))
  (IntMap (Identifier, [Declaration]))
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     (IntMap (Identifier, [Declaration]))
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting
  (IntMap (Identifier, [Declaration]))
  (IntMap Identifier, IntMap (Identifier, [Declaration]))
  (IntMap (Identifier, [Declaration]))
forall s t a b. Field2 s t a b => Lens s t a b
_2
          case Maybe (Identifier, [Declaration])
varM of
            Maybe (Identifier, [Declaration])
Nothing -> do
              Identifier
nm' <- m Identifier
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     Identifier
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IdType -> Identifier -> m Identifier
mkUniqueIdentifierM IdType
Extended (Text -> Identifier
Text.toStrict (BlackBoxTemplate -> Text
concatT (Text -> Element
Text Text
"c$"Element -> BlackBoxTemplate -> BlackBoxTemplate
forall a. a -> [a] -> [a]
:BlackBoxTemplate
nm))))
              let decls :: [Declaration]
decls = case HWType -> Int
typeSize HWType
hwTy of
                    Int
0 -> []
                    Int
_ -> [Maybe Identifier -> Identifier -> HWType -> Declaration
N.NetDecl Maybe Identifier
forall a. Maybe a
Nothing Identifier
nm' HWType
hwTy
                         ,Identifier -> Expr -> Declaration
N.Assignment Identifier
nm' Expr
e'
                         ]
              (IntMap (Identifier, [Declaration])
 -> Identity (IntMap (Identifier, [Declaration])))
-> (IntMap Identifier, IntMap (Identifier, [Declaration]))
-> Identity (IntMap Identifier, IntMap (Identifier, [Declaration]))
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((IntMap (Identifier, [Declaration])
  -> Identity (IntMap (Identifier, [Declaration])))
 -> (IntMap Identifier, IntMap (Identifier, [Declaration]))
 -> Identity
      (IntMap Identifier, IntMap (Identifier, [Declaration])))
-> (IntMap (Identifier, [Declaration])
    -> IntMap (Identifier, [Declaration]))
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Int
-> (Identifier, [Declaration])
-> IntMap (Identifier, [Declaration])
-> IntMap (Identifier, [Declaration])
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
i (Identifier
nm',[Declaration]
decls))
              Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BlackBoxTemplate -> Int -> Element
ToVar [Text -> Element
Text (Identifier -> Text
Text.fromStrict Identifier
nm')] Int
i)
            Just (Identifier
nm',[Declaration]
_) -> Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BlackBoxTemplate -> Int -> Element
ToVar [Text -> Element
Text (Identifier -> Text
Text.fromStrict Identifier
nm')] Int
i)
      Sym Text
_ Int
i -> do
        Maybe Identifier
symM <- Int -> IntMap Identifier -> Maybe Identifier
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
i (IntMap Identifier -> Maybe Identifier)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     (IntMap Identifier)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     (Maybe Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (IntMap Identifier)
  (IntMap Identifier, IntMap (Identifier, [Declaration]))
  (IntMap Identifier)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     (IntMap Identifier)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting
  (IntMap Identifier)
  (IntMap Identifier, IntMap (Identifier, [Declaration]))
  (IntMap Identifier)
forall s t a b. Field1 s t a b => Lens s t a b
_1
        case Maybe Identifier
symM of
          Maybe Identifier
Nothing -> do
            Identifier
t <- m Identifier
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     Identifier
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IdType -> Identifier -> m Identifier
mkUniqueIdentifierM IdType
Extended Identifier
"c$n")
            (IntMap Identifier -> Identity (IntMap Identifier))
-> (IntMap Identifier, IntMap (Identifier, [Declaration]))
-> Identity (IntMap Identifier, IntMap (Identifier, [Declaration]))
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((IntMap Identifier -> Identity (IntMap Identifier))
 -> (IntMap Identifier, IntMap (Identifier, [Declaration]))
 -> Identity
      (IntMap Identifier, IntMap (Identifier, [Declaration])))
-> (IntMap Identifier -> IntMap Identifier)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Int -> Identifier -> IntMap Identifier -> IntMap Identifier
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
i Identifier
t)
            Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Int -> Element
Sym (Identifier -> Text
Text.fromStrict Identifier
t) Int
i)
          Just Identifier
t -> Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Int -> Element
Sym (Identifier -> Text
Text.fromStrict Identifier
t) Int
i)
      GenSym BlackBoxTemplate
t Int
i -> do
        Maybe Identifier
symM <- Int -> IntMap Identifier -> Maybe Identifier
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
i (IntMap Identifier -> Maybe Identifier)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     (IntMap Identifier)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     (Maybe Identifier)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (IntMap Identifier)
  (IntMap Identifier, IntMap (Identifier, [Declaration]))
  (IntMap Identifier)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     (IntMap Identifier)
forall s (m :: Type -> Type) a.
MonadState s m =>
Getting a s a -> m a
use Getting
  (IntMap Identifier)
  (IntMap Identifier, IntMap (Identifier, [Declaration]))
  (IntMap Identifier)
forall s t a b. Field1 s t a b => Lens s t a b
_1
        case Maybe Identifier
symM of
          Maybe Identifier
Nothing -> do
            Identifier
t' <- m Identifier
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     Identifier
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IdType -> Identifier -> m Identifier
mkUniqueIdentifierM IdType
Basic (Text -> Identifier
Text.toStrict (BlackBoxTemplate -> Text
concatT BlackBoxTemplate
t)))
            (IntMap Identifier -> Identity (IntMap Identifier))
-> (IntMap Identifier, IntMap (Identifier, [Declaration]))
-> Identity (IntMap Identifier, IntMap (Identifier, [Declaration]))
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((IntMap Identifier -> Identity (IntMap Identifier))
 -> (IntMap Identifier, IntMap (Identifier, [Declaration]))
 -> Identity
      (IntMap Identifier, IntMap (Identifier, [Declaration])))
-> (IntMap Identifier -> IntMap Identifier)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m ()
forall s (m :: Type -> Type) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Int -> Identifier -> IntMap Identifier -> IntMap Identifier
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
i Identifier
t')
            Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BlackBoxTemplate -> Int -> Element
GenSym [Text -> Element
Text (Identifier -> Text
Text.fromStrict Identifier
t')] Int
i)
          Just Identifier
_ ->
            String
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
forall a. HasCallStack => String -> a
error (String
"Symbol #" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (BlackBoxTemplate, Int) -> String
forall a. Show a => a -> String
show (BlackBoxTemplate
t,Int
i)
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is already defined in BlackBox for: "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bbnm)
      Component (Decl Int
n Int
subN [(BlackBoxTemplate, BlackBoxTemplate)]
l') ->
        Decl -> Element
Component (Decl -> Element)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Decl
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int -> [(BlackBoxTemplate, BlackBoxTemplate)] -> Decl
Decl Int
n Int
subN ([(BlackBoxTemplate, BlackBoxTemplate)] -> Decl)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     [(BlackBoxTemplate, BlackBoxTemplate)]
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Decl
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((BlackBoxTemplate, BlackBoxTemplate)
 -> StateT
      (IntMap Identifier, IntMap (Identifier, [Declaration]))
      m
      (BlackBoxTemplate, BlackBoxTemplate))
-> [(BlackBoxTemplate, BlackBoxTemplate)]
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     [(BlackBoxTemplate, BlackBoxTemplate)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((BlackBoxTemplate
 -> StateT
      (IntMap Identifier, IntMap (Identifier, [Declaration]))
      m
      BlackBoxTemplate)
-> (BlackBoxTemplate
    -> StateT
         (IntMap Identifier, IntMap (Identifier, [Declaration]))
         m
         BlackBoxTemplate)
-> (BlackBoxTemplate, BlackBoxTemplate)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     (BlackBoxTemplate, BlackBoxTemplate)
forall (f :: Type -> Type) a b c d.
Applicative f =>
(a -> f b) -> (c -> f d) -> (a, c) -> f (b, d)
combineM ((Element
 -> StateT
      (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element)
-> BlackBoxTemplate
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     BlackBoxTemplate
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
setSym') ((Element
 -> StateT
      (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element)
-> BlackBoxTemplate
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     BlackBoxTemplate
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
setSym')) [(BlackBoxTemplate, BlackBoxTemplate)]
l')
      IF Element
c BlackBoxTemplate
t BlackBoxTemplate
f      -> Element -> BlackBoxTemplate -> BlackBoxTemplate -> Element
IF (Element -> BlackBoxTemplate -> BlackBoxTemplate -> Element)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     (BlackBoxTemplate -> BlackBoxTemplate -> Element)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Element
c StateT
  (IntMap Identifier, IntMap (Identifier, [Declaration]))
  m
  (BlackBoxTemplate -> BlackBoxTemplate -> Element)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     BlackBoxTemplate
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     (BlackBoxTemplate -> Element)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (Element
 -> StateT
      (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element)
-> BlackBoxTemplate
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     BlackBoxTemplate
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
setSym' BlackBoxTemplate
t StateT
  (IntMap Identifier, IntMap (Identifier, [Declaration]))
  m
  (BlackBoxTemplate -> Element)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     BlackBoxTemplate
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (Element
 -> StateT
      (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element)
-> BlackBoxTemplate
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     BlackBoxTemplate
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
setSym' BlackBoxTemplate
f
      SigD BlackBoxTemplate
e' Maybe Int
m     -> BlackBoxTemplate -> Maybe Int -> Element
SigD (BlackBoxTemplate -> Maybe Int -> Element)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     BlackBoxTemplate
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     (Maybe Int -> Element)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Element
 -> StateT
      (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element)
-> BlackBoxTemplate
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     BlackBoxTemplate
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
setSym' BlackBoxTemplate
e') StateT
  (IntMap Identifier, IntMap (Identifier, [Declaration]))
  m
  (Maybe Int -> Element)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     (Maybe Int)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Maybe Int
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     (Maybe Int)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe Int
m
      BV Bool
t BlackBoxTemplate
e' Element
m     -> Bool -> BlackBoxTemplate -> Element -> Element
BV (Bool -> BlackBoxTemplate -> Element -> Element)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Bool
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     (BlackBoxTemplate -> Element -> Element)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Bool
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
t StateT
  (IntMap Identifier, IntMap (Identifier, [Declaration]))
  m
  (BlackBoxTemplate -> Element -> Element)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     BlackBoxTemplate
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     (Element -> Element)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (Element
 -> StateT
      (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element)
-> BlackBoxTemplate
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     BlackBoxTemplate
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
setSym' BlackBoxTemplate
e' StateT
  (IntMap Identifier, IntMap (Identifier, [Declaration]))
  m
  (Element -> Element)
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Element
m
      Element
_             -> Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Element
e

    concatT :: [Element] -> Text
    concatT :: BlackBoxTemplate -> Text
concatT = [Text] -> Text
Text.concat ([Text] -> Text)
-> (BlackBoxTemplate -> [Text]) -> BlackBoxTemplate -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Text) -> BlackBoxTemplate -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (
      \case
        Text Text
t -> Text
t
        Name Int
i ->
          case BlackBoxContext -> Element -> Either String Text
elementToText BlackBoxContext
bbCtx (Int -> Element
Name Int
i) of
            Right Text
t -> Text
t
            Left String
msg ->
              String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
"Could not convert ~NAME[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to string:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\nError occured while "
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"processing blackbox for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bbnm
        Lit Int
i ->
          case BlackBoxContext -> Element -> Either String Text
elementToText BlackBoxContext
bbCtx (Int -> Element
Lit Int
i) of
            Right Text
t -> Text
t
            Left String
msg ->
              String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
"Could not convert ~LIT[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to string:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\nError occured while "
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"processing blackbox for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bbnm
        Result Bool
_ | Identifier Identifier
t Maybe Modifier
_ <- (Expr, HWType) -> Expr
forall a b. (a, b) -> a
fst (BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
bbCtx) -> Identifier -> Text
Text.fromStrict Identifier
t
        Element
CompName -> Identifier -> Text
Text.fromStrict (BlackBoxContext -> Identifier
bbCompName BlackBoxContext
bbCtx)
        Element
CtxName ->
          case BlackBoxContext -> Maybe Identifier
bbCtxName BlackBoxContext
bbCtx of
            Just Identifier
nm -> Identifier -> Text
Text.fromStrict Identifier
nm
            Maybe Identifier
_ | Identifier Identifier
t Maybe Modifier
_ <- (Expr, HWType) -> Expr
forall a b. (a, b) -> a
fst (BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
bbCtx) -> Identifier -> Text
Text.fromStrict Identifier
t
            Maybe Identifier
_ -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Internal error when processing blackbox "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bbnm
        Element
_ -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Unexpected element in GENSYM when processing "
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"blackbox for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bbnm
        )

selectNewName
    :: Foldable t
    => t String
    -- ^ Set of existing names
    -> FilePath
    -- ^ Name for new file (
    -> String
selectNewName :: t String -> String -> String
selectNewName t String
as String
a
  | String -> t String -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
elem String
a t String
as = t String -> String -> String
forall (t :: Type -> Type).
Foldable t =>
t String -> String -> String
selectNewName t String
as (String -> String -> String
replaceBaseName String
a (String -> String
takeBaseName String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"))
  | Bool
otherwise = String
a

renderFilePath :: [(String,FilePath)] -> String -> ([(String,FilePath)],String)
renderFilePath :: [(String, String)] -> String -> ([(String, String)], String)
renderFilePath [(String, String)]
fs String
f = ((String
f'',String
f)(String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:[(String, String)]
fs, String
f'')
  where
    f' :: String
f'  = String -> String
takeFileName String
f
    f'' :: String
f'' = [String] -> String -> String
forall (t :: Type -> Type).
Foldable t =>
t String -> String -> String
selectNewName (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst [(String, String)]
fs) String
f'

-- | Render a blackbox given a certain context. Returns a filled out template
-- and a list of 'hidden' inputs that must be added to the encompassing component.
renderTemplate
  :: Backend backend
  => BlackBoxContext -- ^ Context used to fill in the hole
  -> BlackBoxTemplate -- ^ Blackbox template
  -> State backend (Int -> Text)
renderTemplate :: BlackBoxContext -> BlackBoxTemplate -> State backend (Int -> Text)
renderTemplate BlackBoxContext
bbCtx BlackBoxTemplate
l = do
  [Int -> Text]
l' <- (Element -> State backend (Int -> Text))
-> BlackBoxTemplate -> StateT backend Identity [Int -> Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (BlackBoxContext -> Element -> State backend (Int -> Text)
forall backend.
(HasCallStack, Backend backend) =>
BlackBoxContext -> Element -> State backend (Int -> Text)
renderElem BlackBoxContext
bbCtx) BlackBoxTemplate
l
  (Int -> Text) -> State backend (Int -> Text)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (\Int
col -> [Text] -> Text
Text.concat (((Int -> Text) -> Text) -> [Int -> Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
col) [Int -> Text]
l'))

renderBlackBox
  :: Backend backend
  => [BlackBoxTemplate]
  -> [BlackBoxTemplate]
  -> [((Data.Text.Text,Data.Text.Text), N.BlackBox)]
  -> N.BlackBox
  -> BlackBoxContext
  -> State backend (Int -> Doc)
renderBlackBox :: [BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
renderBlackBox [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Identifier, Identifier), BlackBox)]
includes BlackBox
bb BlackBoxContext
bbCtx = do
  let nms' :: [Text]
nms' = (((Identifier, Identifier), BlackBox) -> Int -> Text)
-> [((Identifier, Identifier), BlackBox)] -> [Int] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\((Identifier, Identifier), BlackBox)
_ Int
i -> Text
"~INCLUDENAME[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")
                     [((Identifier, Identifier), BlackBox)]
includes
                     [(Int
0 :: Int)..]
      layout :: LayoutOptions
layout = PageWidth -> LayoutOptions
LayoutOptions (Int -> Double -> PageWidth
AvailablePerLine Int
120 Double
0.4)
  [Text]
nms <-
    [((Identifier, Identifier), BlackBox)]
-> (((Identifier, Identifier), BlackBox)
    -> StateT backend Identity Text)
-> StateT backend Identity [Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [((Identifier, Identifier), BlackBox)]
includes ((((Identifier, Identifier), BlackBox)
  -> StateT backend Identity Text)
 -> StateT backend Identity [Text])
-> (((Identifier, Identifier), BlackBox)
    -> StateT backend Identity Text)
-> StateT backend Identity [Text]
forall a b. (a -> b) -> a -> b
$ \((Identifier
nm,Identifier
_),BlackBox
inc) -> do
      let bbCtx' :: BlackBoxContext
bbCtx' = BlackBoxContext
bbCtx {bbQsysIncName :: [Identifier]
bbQsysIncName = (Text -> Identifier) -> [Text] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Identifier
Text.toStrict [Text]
nms'}
      Int -> Text
incForHash <- (BlackBoxTemplate -> State backend (Int -> Text))
-> (String
    -> Int -> TemplateFunction -> State backend (Int -> Text))
-> BlackBox
-> State backend (Int -> Text)
forall r.
(BlackBoxTemplate -> r)
-> (String -> Int -> TemplateFunction -> r) -> BlackBox -> r
onBlackBox (BlackBoxContext -> BlackBoxTemplate -> State backend (Int -> Text)
forall backend.
Backend backend =>
BlackBoxContext -> BlackBoxTemplate -> State backend (Int -> Text)
renderTemplate BlackBoxContext
bbCtx')
                               (\String
_name Int
_hash (N.TemplateFunction [Int]
_ BlackBoxContext -> Bool
_ forall s. Backend s => BlackBoxContext -> State s Doc
f) -> do
                                  Doc
t <- BlackBoxContext -> State backend Doc
forall s. Backend s => BlackBoxContext -> State s Doc
f BlackBoxContext
bbCtx'
                                  let t' :: Text
t' = SimpleDocStream () -> Text
forall ann. SimpleDocStream ann -> Text
renderLazy (LayoutOptions -> Doc -> SimpleDocStream ()
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
layout Doc
t)
                                  (Int -> Text) -> State backend (Int -> Text)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Int -> Text
forall a b. a -> b -> a
const Text
t'))
                               BlackBox
inc
      Int
iw <- State backend Int
forall state. Backend state => State state Int
iwWidth
      let incHash :: Int
incHash = Text -> Int
forall a. Hashable a => a -> Int
hash (Int -> Text
incForHash Int
0)
          nm' :: Text
nm'     = [Text] -> Text
Text.concat
                      [ Identifier -> Text
Text.fromStrict Identifier
nm
                      , String -> Text
Text.pack (String -> Int -> String
forall r. PrintfType r => String -> r
printf (String
"%0" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
iw Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"X") Int
incHash)
                      ]
      Text -> StateT backend Identity Text
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Text
nm'

  let bbNamedCtx :: BlackBoxContext
bbNamedCtx = BlackBoxContext
bbCtx {bbQsysIncName :: [Identifier]
bbQsysIncName = (Text -> Identifier) -> [Text] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Identifier
Text.toStrict [Text]
nms}
      incs :: [BlackBox]
incs = ((Identifier, Identifier), BlackBox) -> BlackBox
forall a b. (a, b) -> b
snd (((Identifier, Identifier), BlackBox) -> BlackBox)
-> [((Identifier, Identifier), BlackBox)] -> [BlackBox]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [((Identifier, Identifier), BlackBox)]
includes
  Int -> Doc
bb' <- case BlackBox
bb of
        N.BBTemplate BlackBoxTemplate
bt   -> do
          Int -> Text
t <- BlackBoxContext -> BlackBoxTemplate -> State backend (Int -> Text)
forall backend.
Backend backend =>
BlackBoxContext -> BlackBoxTemplate -> State backend (Int -> Text)
renderTemplate BlackBoxContext
bbNamedCtx BlackBoxTemplate
bt
          (Int -> Doc) -> State backend (Int -> Doc)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (\Int
col -> let t1 :: Text
t1 = Int -> Text
t (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                          in  if Text -> Bool
Text.null Text
t1
                              then Doc
forall ann. Doc ann
PP.emptyDoc
                              else Int -> Doc -> Doc
forall ann. Int -> Doc ann -> Doc ann
PP.nest (Int
colInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) (Text -> Doc
forall a ann. Pretty a => a -> Doc ann
PP.pretty Text
t1))
        N.BBFunction String
_ Int
_ (N.TemplateFunction [Int]
_ BlackBoxContext -> Bool
_ forall s. Backend s => BlackBoxContext -> State s Doc
bf)  -> do
          Doc
t <- BlackBoxContext -> State backend Doc
forall s. Backend s => BlackBoxContext -> State s Doc
bf BlackBoxContext
bbNamedCtx
          (Int -> Doc) -> State backend (Int -> Doc)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (\Int
_ -> Doc
t)

  [Doc]
incs' <- (BlackBox -> State backend Doc)
-> [BlackBox] -> StateT backend Identity [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((BlackBoxTemplate -> State backend Doc)
-> (String -> Int -> TemplateFunction -> State backend Doc)
-> BlackBox
-> State backend Doc
forall r.
(BlackBoxTemplate -> r)
-> (String -> Int -> TemplateFunction -> r) -> BlackBox -> r
onBlackBox (((Int -> Text) -> Doc)
-> State backend (Int -> Text) -> State backend Doc
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Doc
forall a ann. Pretty a => a -> Doc ann
PP.pretty (Text -> Doc) -> ((Int -> Text) -> Text) -> (Int -> Text) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
0)) (State backend (Int -> Text) -> State backend Doc)
-> (BlackBoxTemplate -> State backend (Int -> Text))
-> BlackBoxTemplate
-> State backend Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlackBoxContext -> BlackBoxTemplate -> State backend (Int -> Text)
forall backend.
Backend backend =>
BlackBoxContext -> BlackBoxTemplate -> State backend (Int -> Text)
renderTemplate BlackBoxContext
bbNamedCtx)
                            (\String
_name Int
_hash (N.TemplateFunction [Int]
_ BlackBoxContext -> Bool
_ forall s. Backend s => BlackBoxContext -> State s Doc
f) -> BlackBoxContext -> State backend Doc
forall s. Backend s => BlackBoxContext -> State s Doc
f BlackBoxContext
bbNamedCtx))
                [BlackBox]
incs
  [Text]
libs' <- (BlackBoxTemplate -> StateT backend Identity Text)
-> [BlackBoxTemplate] -> StateT backend Identity [Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((Int -> Text) -> Text)
-> State backend (Int -> Text) -> StateT backend Identity Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
0) (State backend (Int -> Text) -> StateT backend Identity Text)
-> (BlackBoxTemplate -> State backend (Int -> Text))
-> BlackBoxTemplate
-> StateT backend Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlackBoxContext -> BlackBoxTemplate -> State backend (Int -> Text)
forall backend.
Backend backend =>
BlackBoxContext -> BlackBoxTemplate -> State backend (Int -> Text)
renderTemplate BlackBoxContext
bbNamedCtx) [BlackBoxTemplate]
libs
  [Text]
imps' <- (BlackBoxTemplate -> StateT backend Identity Text)
-> [BlackBoxTemplate] -> StateT backend Identity [Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((Int -> Text) -> Text)
-> State backend (Int -> Text) -> StateT backend Identity Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
0) (State backend (Int -> Text) -> StateT backend Identity Text)
-> (BlackBoxTemplate -> State backend (Int -> Text))
-> BlackBoxTemplate
-> StateT backend Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlackBoxContext -> BlackBoxTemplate -> State backend (Int -> Text)
forall backend.
Backend backend =>
BlackBoxContext -> BlackBoxTemplate -> State backend (Int -> Text)
renderTemplate BlackBoxContext
bbNamedCtx) [BlackBoxTemplate]
imps
  [(String, Doc)] -> State backend ()
forall state. Backend state => [(String, Doc)] -> State state ()
addIncludes ([(String, Doc)] -> State backend ())
-> [(String, Doc)] -> State backend ()
forall a b. (a -> b) -> a -> b
$ (Text
 -> ((Identifier, Identifier), BlackBox) -> Doc -> (String, Doc))
-> [Text]
-> [((Identifier, Identifier), BlackBox)]
-> [Doc]
-> [(String, Doc)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\Text
nm' ((Identifier
_, Identifier
ext), BlackBox
_) Doc
inc -> (Text -> String
Text.unpack Text
nm' String -> String -> String
<.> Identifier -> String
Data.Text.unpack Identifier
ext, Doc
inc)) [Text]
nms [((Identifier, Identifier), BlackBox)]
includes [Doc]
incs'
  [Text] -> State backend ()
forall state. Backend state => [Text] -> State state ()
addLibraries [Text]
libs'
  [Text] -> State backend ()
forall state. Backend state => [Text] -> State state ()
addImports [Text]
imps'
  (Int -> Doc) -> State backend (Int -> Doc)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Int -> Doc
bb'

-- | Render a single template element
renderElem
  :: HasCallStack
  => Backend backend
  => BlackBoxContext
  -> Element
  -> State backend (Int -> Text)
renderElem :: BlackBoxContext -> Element -> State backend (Int -> Text)
renderElem BlackBoxContext
b (Component (Decl Int
n Int
subN ((BlackBoxTemplate, BlackBoxTemplate)
l:[(BlackBoxTemplate, BlackBoxTemplate)]
ls))) = do
  (Expr
o,HWType
oTy,Bool
_) <- (Text, HWType) -> (Expr, HWType, Bool)
idToExpr ((Text, HWType) -> (Expr, HWType, Bool))
-> StateT backend Identity (Text, HWType)
-> StateT backend Identity (Expr, HWType, Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (BlackBoxTemplate -> StateT backend Identity Text)
-> (BlackBoxTemplate -> StateT backend Identity HWType)
-> (BlackBoxTemplate, BlackBoxTemplate)
-> StateT backend Identity (Text, HWType)
forall (f :: Type -> Type) a b c d.
Applicative f =>
(a -> f b) -> (c -> f d) -> (a, c) -> f (b, d)
combineM (BlackBoxContext -> BlackBoxTemplate -> StateT backend Identity Text
forall backend.
Backend backend =>
BlackBoxContext -> BlackBoxTemplate -> State backend Text
lineToIdentifier BlackBoxContext
b) (HWType -> StateT backend Identity HWType
forall (m :: Type -> Type) a. Monad m => a -> m a
return (HWType -> StateT backend Identity HWType)
-> (BlackBoxTemplate -> HWType)
-> BlackBoxTemplate
-> StateT backend Identity HWType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b) (BlackBoxTemplate, BlackBoxTemplate)
l
  [(Expr, HWType, Bool)]
is <- ((BlackBoxTemplate, BlackBoxTemplate)
 -> StateT backend Identity (Expr, HWType, Bool))
-> [(BlackBoxTemplate, BlackBoxTemplate)]
-> StateT backend Identity [(Expr, HWType, Bool)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((Text, HWType) -> (Expr, HWType, Bool))
-> StateT backend Identity (Text, HWType)
-> StateT backend Identity (Expr, HWType, Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, HWType) -> (Expr, HWType, Bool)
idToExpr (StateT backend Identity (Text, HWType)
 -> StateT backend Identity (Expr, HWType, Bool))
-> ((BlackBoxTemplate, BlackBoxTemplate)
    -> StateT backend Identity (Text, HWType))
-> (BlackBoxTemplate, BlackBoxTemplate)
-> StateT backend Identity (Expr, HWType, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlackBoxTemplate -> StateT backend Identity Text)
-> (BlackBoxTemplate -> StateT backend Identity HWType)
-> (BlackBoxTemplate, BlackBoxTemplate)
-> StateT backend Identity (Text, HWType)
forall (f :: Type -> Type) a b c d.
Applicative f =>
(a -> f b) -> (c -> f d) -> (a, c) -> f (b, d)
combineM (BlackBoxContext -> BlackBoxTemplate -> StateT backend Identity Text
forall backend.
Backend backend =>
BlackBoxContext -> BlackBoxTemplate -> State backend Text
lineToIdentifier BlackBoxContext
b) (HWType -> StateT backend Identity HWType
forall (m :: Type -> Type) a. Monad m => a -> m a
return (HWType -> StateT backend Identity HWType)
-> (BlackBoxTemplate -> HWType)
-> BlackBoxTemplate
-> StateT backend Identity HWType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b)) [(BlackBoxTemplate, BlackBoxTemplate)]
ls
  let func0 :: Maybe
  [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
    [BlackBoxTemplate], [BlackBoxTemplate],
    [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
func0 = Int
-> IntMap
     [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
       [BlackBoxTemplate], [BlackBoxTemplate],
       [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
-> Maybe
     [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
       [BlackBoxTemplate], [BlackBoxTemplate],
       [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
n (BlackBoxContext
-> IntMap
     [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
       [BlackBoxTemplate], [BlackBoxTemplate],
       [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
bbFunctions BlackBoxContext
b)
      errr :: String
errr = [String] -> String
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [ String
"renderElem: not enough functions rendered? Needed "
                    , Int -> String
forall a. Show a => a -> String
show (Int
subN Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 ), String
" got only ", Int -> String
forall a. Show a => a -> String
show ([(Either BlackBox (Identifier, [Declaration]), WireOrReg,
  [BlackBoxTemplate], [BlackBoxTemplate],
  [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
-> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length (Maybe
  [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
    [BlackBoxTemplate], [BlackBoxTemplate],
    [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
-> [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
     [BlackBoxTemplate], [BlackBoxTemplate],
     [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
forall a. HasCallStack => Maybe a -> a
fromJust Maybe
  [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
    [BlackBoxTemplate], [BlackBoxTemplate],
    [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
func0)) ]
      func1 :: Maybe
  (Either BlackBox (Identifier, [Declaration]), WireOrReg,
   [BlackBoxTemplate], [BlackBoxTemplate],
   [((Identifier, Identifier), BlackBox)], BlackBoxContext)
func1 = String
-> Int
-> [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
     [BlackBoxTemplate], [BlackBoxTemplate],
     [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
-> (Either BlackBox (Identifier, [Declaration]), WireOrReg,
    [BlackBoxTemplate], [BlackBoxTemplate],
    [((Identifier, Identifier), BlackBox)], BlackBoxContext)
forall a. HasCallStack => String -> Int -> [a] -> a
indexNote' String
errr Int
subN ([(Either BlackBox (Identifier, [Declaration]), WireOrReg,
   [BlackBoxTemplate], [BlackBoxTemplate],
   [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
 -> (Either BlackBox (Identifier, [Declaration]), WireOrReg,
     [BlackBoxTemplate], [BlackBoxTemplate],
     [((Identifier, Identifier), BlackBox)], BlackBoxContext))
-> Maybe
     [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
       [BlackBoxTemplate], [BlackBoxTemplate],
       [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
-> Maybe
     (Either BlackBox (Identifier, [Declaration]), WireOrReg,
      [BlackBoxTemplate], [BlackBoxTemplate],
      [((Identifier, Identifier), BlackBox)], BlackBoxContext)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe
  [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
    [BlackBoxTemplate], [BlackBoxTemplate],
    [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
func0
      Just (Either BlackBox (Identifier, [Declaration])
templ0,WireOrReg
_,[BlackBoxTemplate]
libs,[BlackBoxTemplate]
imps,[((Identifier, Identifier), BlackBox)]
inc,BlackBoxContext
pCtx) = Maybe
  (Either BlackBox (Identifier, [Declaration]), WireOrReg,
   [BlackBoxTemplate], [BlackBoxTemplate],
   [((Identifier, Identifier), BlackBox)], BlackBoxContext)
func1
      b' :: BlackBoxContext
b' = BlackBoxContext
pCtx { bbResult :: (Expr, HWType)
bbResult = (Expr
o,HWType
oTy), bbInputs :: [(Expr, HWType, Bool)]
bbInputs = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
pCtx [(Expr, HWType, Bool)]
-> [(Expr, HWType, Bool)] -> [(Expr, HWType, Bool)]
forall a. [a] -> [a] -> [a]
++ [(Expr, HWType, Bool)]
is }
      layoutOptions :: LayoutOptions
layoutOptions = PageWidth -> LayoutOptions
LayoutOptions (Int -> Double -> PageWidth
AvailablePerLine Int
120 Double
0.4)
      render :: Doc ann -> BlackBox
render = BlackBoxTemplate -> BlackBox
N.BBTemplate (BlackBoxTemplate -> BlackBox)
-> (Doc ann -> BlackBoxTemplate) -> Doc ann -> BlackBox
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> BlackBoxTemplate
parseFail (Text -> BlackBoxTemplate)
-> (Doc ann -> Text) -> Doc ann -> BlackBoxTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream ann -> Text
forall ann. SimpleDocStream ann -> Text
renderLazy (SimpleDocStream ann -> Text)
-> (Doc ann -> SimpleDocStream ann) -> Doc ann -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
layoutOptions

  BlackBox
templ1 <-
    case Either BlackBox (Identifier, [Declaration])
templ0 of
      Left BlackBox
t ->
        BlackBox -> StateT backend Identity BlackBox
forall (m :: Type -> Type) a. Monad m => a -> m a
return BlackBox
t
      Right (Identifier
nm0,[Declaration]
ds) -> do
        Identifier
nm1 <- IdType -> Identifier -> State backend Identifier
forall s. Backend s => IdType -> Identifier -> State s Identifier
mkUniqueIdentifier IdType
Basic Identifier
nm0
        Doc
block <- Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Identifier -> [Declaration] -> Mon (State backend) Doc
forall state.
Backend state =>
Identifier -> [Declaration] -> Mon (State state) Doc
blockDecl Identifier
nm1 [Declaration]
ds)
        BlackBox -> StateT backend Identity BlackBox
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc -> BlackBox
forall ann. Doc ann -> BlackBox
render Doc
block)

  BlackBox
templ4 <-
    case BlackBox
templ1 of
      N.BBFunction {} ->
        BlackBox -> StateT backend Identity BlackBox
forall (m :: Type -> Type) a. Monad m => a -> m a
return BlackBox
templ1
      N.BBTemplate BlackBoxTemplate
templ2 -> do
        (BlackBoxTemplate
templ3, [Declaration]
templDecls) <- (IdType -> Identifier -> State backend Identifier)
-> BlackBoxContext
-> BlackBoxTemplate
-> StateT backend Identity (BlackBoxTemplate, [Declaration])
forall (m :: Type -> Type).
Monad m =>
(IdType -> Identifier -> m Identifier)
-> BlackBoxContext
-> BlackBoxTemplate
-> m (BlackBoxTemplate, [Declaration])
setSym IdType -> Identifier -> State backend Identifier
forall s. Backend s => IdType -> Identifier -> State s Identifier
Backend.mkUniqueIdentifier BlackBoxContext
b' BlackBoxTemplate
templ2
        case [Declaration]
templDecls of
          [] ->
            BlackBox -> StateT backend Identity BlackBox
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BlackBoxTemplate -> BlackBox
N.BBTemplate BlackBoxTemplate
templ3)
          [Declaration]
_ -> do
            Identifier
nm1 <- IdType -> Identifier -> State backend Identifier
forall s. Backend s => IdType -> Identifier -> State s Identifier
Backend.mkUniqueIdentifier IdType
Basic Identifier
"bb"
            Identifier
nm2 <- IdType -> Identifier -> State backend Identifier
forall s. Backend s => IdType -> Identifier -> State s Identifier
Backend.mkUniqueIdentifier IdType
Basic Identifier
"bb"
            let bbD :: Declaration
bbD = Identifier
-> [BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> Declaration
BlackBoxD Identifier
nm1 [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Identifier, Identifier), BlackBox)]
inc (BlackBoxTemplate -> BlackBox
N.BBTemplate BlackBoxTemplate
templ3) BlackBoxContext
b'
            Doc
block <- Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Identifier -> [Declaration] -> Mon (State backend) Doc
forall state.
Backend state =>
Identifier -> [Declaration] -> Mon (State state) Doc
blockDecl Identifier
nm2 ([Declaration]
templDecls [Declaration] -> [Declaration] -> [Declaration]
forall a. [a] -> [a] -> [a]
++ [Declaration
bbD]))
            BlackBox -> StateT backend Identity BlackBox
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc -> BlackBox
forall ann. Doc ann -> BlackBox
render Doc
block)

  case BlackBoxContext -> BlackBox -> Maybe String
verifyBlackBoxContext BlackBoxContext
b' BlackBox
templ4 of
    Maybe String
Nothing -> do
      Int -> Doc
bb <- [BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
forall backend.
Backend backend =>
[BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
renderBlackBox [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Identifier, Identifier), BlackBox)]
inc BlackBox
templ4 BlackBoxContext
b'
      (Int -> Text) -> State backend (Int -> Text)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SimpleDocStream () -> Text
forall ann. SimpleDocStream ann -> Text
renderLazy (SimpleDocStream () -> Text)
-> (Int -> SimpleDocStream ()) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc -> SimpleDocStream ()
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
layoutOptions (Doc -> SimpleDocStream ())
-> (Int -> Doc) -> Int -> SimpleDocStream ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc
bb)
    Just String
err0 -> do
      SrcSpan
sp <- State backend SrcSpan
forall state. Backend state => State state SrcSpan
getSrcSpan
      let err1 :: String
err1 = [String] -> String
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [ String
"Couldn't instantiate blackbox for "
                        , Identifier -> String
Data.Text.unpack (BlackBoxContext -> Identifier
bbName BlackBoxContext
b), String
". Verification procedure "
                        , String
"reported:\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err0 ]
      ClashException -> State backend (Int -> Text)
forall a e. Exception e => e -> a
throw (SrcSpan -> String -> Maybe String -> ClashException
ClashException SrcSpan
sp ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err1) Maybe String
forall a. Maybe a
Nothing)

renderElem BlackBoxContext
b (SigD BlackBoxTemplate
e Maybe Int
m) = do
  Text
e' <- [Text] -> Text
Text.concat ([Text] -> Text)
-> StateT backend Identity [Text] -> StateT backend Identity Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT backend Identity Text)
-> BlackBoxTemplate -> StateT backend Identity [Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((Int -> Text) -> Text)
-> State backend (Int -> Text) -> StateT backend Identity Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
0) (State backend (Int -> Text) -> StateT backend Identity Text)
-> (Element -> State backend (Int -> Text))
-> Element
-> StateT backend Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlackBoxContext -> Element -> State backend (Int -> Text)
forall backend.
(HasCallStack, Backend backend) =>
BlackBoxContext -> Element -> State backend (Int -> Text)
renderElem BlackBoxContext
b) BlackBoxTemplate
e
  let ty :: HWType
ty = case Maybe Int
m of
             Maybe Int
Nothing -> (Expr, HWType) -> HWType
forall a b. (a, b) -> b
snd ((Expr, HWType) -> HWType) -> (Expr, HWType) -> HWType
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
b
             Just Int
n  -> let (Expr
_,HWType
ty',Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
                        in  HWType
ty'
  Doc
t  <- Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Text -> HWType -> Mon (State backend) Doc
forall state.
Backend state =>
Text -> HWType -> Mon (State state) Doc
hdlSig Text
e' HWType
ty)
  (Int -> Text) -> State backend (Int -> Text)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Int -> Text
forall a b. a -> b -> a
const (Doc -> Text
forall ann. Doc ann -> Text
renderOneLine Doc
t))

renderElem BlackBoxContext
b (Period Int
n) = do
  let (Expr
_, HWType
ty, Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
  case HWType -> HWType
stripVoid HWType
ty of
    KnownDomain Identifier
_ Integer
period ActiveEdge
_ ResetKind
_ InitBehavior
_ ResetPolarity
_ ->
      (Int -> Text) -> State backend (Int -> Text)
forall (m :: Type -> Type) a. Monad m => a -> m a
return ((Int -> Text) -> State backend (Int -> Text))
-> (Int -> Text) -> State backend (Int -> Text)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Text
forall a b. a -> b -> a
const (Text -> Int -> Text) -> Text -> Int -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
period
    HWType
_ ->
      String -> State backend (Int -> Text)
forall a. HasCallStack => String -> a
error (String -> State backend (Int -> Text))
-> String -> State backend (Int -> Text)
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Period: Expected `KnownDomain` or `KnownConfiguration`, not: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
ty

renderElem BlackBoxContext
b (Tag Int
n) = do
  let (Expr
_, HWType
ty, Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
  case HWType -> HWType
stripVoid HWType
ty of
    KnownDomain Identifier
dom Integer
_ ActiveEdge
_ ResetKind
_ InitBehavior
_ ResetPolarity
_ ->
      (Int -> Text) -> State backend (Int -> Text)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Int -> Text
forall a b. a -> b -> a
const (String -> Text
Text.pack (Identifier -> String
Data.Text.unpack Identifier
dom)))
    Reset Identifier
dom ->
      (Int -> Text) -> State backend (Int -> Text)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Int -> Text
forall a b. a -> b -> a
const (String -> Text
Text.pack (Identifier -> String
Data.Text.unpack Identifier
dom)))
    Clock Identifier
dom ->
      (Int -> Text) -> State backend (Int -> Text)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Int -> Text
forall a b. a -> b -> a
const (String -> Text
Text.pack (Identifier -> String
Data.Text.unpack Identifier
dom)))
    HWType
_ ->
      String -> State backend (Int -> Text)
forall a. HasCallStack => String -> a
error (String -> State backend (Int -> Text))
-> String -> State backend (Int -> Text)
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Tag: Expected `KnownDomain` or `KnownConfiguration`, not: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
ty


renderElem BlackBoxContext
b (IF Element
c BlackBoxTemplate
t BlackBoxTemplate
f) = do
  Int
iw <- State backend Int
forall state. Backend state => State state Int
iwWidth
  HdlSyn
syn <- State backend HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  let c' :: Int
c' = Int -> HdlSyn -> Element -> Int
forall t. (Eq t, Num t) => t -> HdlSyn -> Element -> Int
check Int
iw HdlSyn
syn Element
c
  if Int
c' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then BlackBoxContext -> BlackBoxTemplate -> State backend (Int -> Text)
forall backend.
Backend backend =>
BlackBoxContext -> BlackBoxTemplate -> State backend (Int -> Text)
renderTemplate BlackBoxContext
b BlackBoxTemplate
t else BlackBoxContext -> BlackBoxTemplate -> State backend (Int -> Text)
forall backend.
Backend backend =>
BlackBoxContext -> BlackBoxTemplate -> State backend (Int -> Text)
renderTemplate BlackBoxContext
b BlackBoxTemplate
f
  where
    check :: t -> HdlSyn -> Element -> Int
check t
iw HdlSyn
syn Element
c' = case Element
c' of
      (Size Element
e)   -> HWType -> Int
typeSize (BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
e])
      (Length Element
e) -> case BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
e] of
                       (Vector Int
n HWType
_)             -> Int
n
                       Void (Just (Vector Int
n HWType
_)) -> Int
n
                       HWType
_                        -> Int
0 -- HACK: So we can test in splitAt if one of the
                              -- vectors in the tuple had a zero length
      (Lit Int
n) -> case BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n of
        (Expr
l,HWType
_,Bool
_)
          | Literal Maybe (HWType, Int)
_ Literal
l' <- Expr
l ->
            case Literal
l' of
              NumLit Integer
i -> Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
              BitLit Bit
bl -> case Bit
bl of
                Bit
N.H -> Int
1
                Bit
N.L -> Int
0
                Bit
_   -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"IF: LIT bit literal must be high or low"
              BoolLit Bool
bl -> Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
0 Int
1 Bool
bl
              Literal
_ -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"IF: LIT must be a numeric lit"
          | DataCon (Signed Int
_) Modifier
_ [Literal Maybe (HWType, Int)
_ (NumLit Integer
i)] <- Expr
l
            -> Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
          | DataCon (Unsigned Int
_) Modifier
_ [Literal Maybe (HWType, Int)
_ (NumLit Integer
i)] <- Expr
l
            -> Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
        (Expr, HWType, Bool)
k -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String
"IF: LIT must be a numeric lit:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Expr, HWType, Bool) -> String
forall a. Show a => a -> String
show (Expr, HWType, Bool)
k)
      (Depth Element
e)  -> case BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
e] of
                      (RTree Int
n HWType
_) -> Int
n
                      HWType
_ -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"IF: treedepth of non-tree type"
      Element
IW64       -> if t
iw t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
64 then Int
1 else Int
0
      (HdlSyn HdlSyn
s) -> if HdlSyn
s HdlSyn -> HdlSyn -> Bool
forall a. Eq a => a -> a -> Bool
== HdlSyn
syn then Int
1 else Int
0
      (IsVar Int
n)  -> let (Expr
e,HWType
_,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
                    in case Expr
e of
                      Identifier Identifier
_ Maybe Modifier
Nothing -> Int
1
                      Expr
_                    -> Int
0
      (IsLit Int
n)  -> let (Expr
e,HWType
_,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
                    in case Expr
e of
                      DataCon {}   -> Int
1
                      Literal {}   -> Int
1
                      BlackBoxE {} -> Int
1
                      Expr
_            -> Int
0

      (IsActiveEnable Int
n) ->
        let (Expr
e, HWType
ty, Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n in
        case (Expr
e, HWType
ty) of
          (Literal Maybe (HWType, Int)
Nothing (BoolLit Bool
True), HWType
Bool)  -> Int
0
          -- TODO: Emit warning? If enable signal is inferred as always False,
          -- TODO: the component will never be enabled. This is probably not the
          -- TODO: user's intention.
          (Literal Maybe (HWType, Int)
Nothing (BoolLit Bool
False), HWType
Bool) -> Int
1
          (Expr
_, HWType
Bool)                               -> Int
1
          (Expr, HWType)
_ ->
            String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"IsActiveEnable: Expected Bool, not: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
ty

      (ActiveEdge ActiveEdge
edgeRequested Int
n) ->
        let (Expr
_, HWType
ty, Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n in
        case HWType -> HWType
stripVoid HWType
ty of
          KnownDomain Identifier
_ Integer
_ ActiveEdge
edgeActual ResetKind
_ InitBehavior
_ ResetPolarity
_ ->
            if ActiveEdge
edgeRequested ActiveEdge -> ActiveEdge -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveEdge
edgeActual then Int
1 else Int
0
          HWType
_ ->
            String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"ActiveEdge: Expected `KnownDomain` or `KnownConfiguration`, not: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
ty

      (IsSync Int
n) ->
        let (Expr
_, HWType
ty, Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n in
        case HWType -> HWType
stripVoid HWType
ty of
          KnownDomain Identifier
_ Integer
_ ActiveEdge
_ ResetKind
Synchronous InitBehavior
_ ResetPolarity
_ -> Int
1
          KnownDomain Identifier
_ Integer
_ ActiveEdge
_ ResetKind
Asynchronous InitBehavior
_ ResetPolarity
_ -> Int
0
          HWType
_ -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"IsSync: Expected `KnownDomain` or `KnownConfiguration`, not: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
ty

      (IsInitDefined Int
n) ->
        let (Expr
_, HWType
ty, Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n in
        case HWType -> HWType
stripVoid HWType
ty of
          KnownDomain Identifier
_ Integer
_ ActiveEdge
_ ResetKind
_ InitBehavior
Defined ResetPolarity
_ -> Int
1
          KnownDomain Identifier
_ Integer
_ ActiveEdge
_ ResetKind
_ InitBehavior
Unknown ResetPolarity
_ -> Int
0
          HWType
_ -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"IsInitDefined: Expected `KnownDomain` or `KnownConfiguration`, not: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
ty

      (IsActiveHigh Int
n) ->
        let (Expr
_, HWType
ty, Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n in
        case HWType -> HWType
stripVoid HWType
ty of
          KnownDomain Identifier
_ Integer
_ ActiveEdge
_ ResetKind
_ InitBehavior
_ ResetPolarity
ActiveHigh -> Int
1
          KnownDomain Identifier
_ Integer
_ ActiveEdge
_ ResetKind
_ InitBehavior
_ ResetPolarity
ActiveLow -> Int
0
          HWType
_ -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"IsActiveHigh: Expected `KnownDomain` or `KnownConfiguration`, not: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
ty

      (StrCmp [Text Text
t1] Int
n) ->
        let (Expr
e,HWType
_,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
        in  case Expr -> Maybe String
exprToString Expr
e of
              Just String
t2
                | Text
t1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
Text.pack String
t2 -> Int
1
                | Bool
otherwise -> Int
0
              Maybe String
Nothing -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Expected a string literal: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr -> String
forall a. Show a => a -> String
show Expr
e
      (And BlackBoxTemplate
es)   -> if (Int -> Bool) -> [Int] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
0) ((Element -> Int) -> BlackBoxTemplate -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (t -> HdlSyn -> Element -> Int
check t
iw HdlSyn
syn) BlackBoxTemplate
es)
                       then Int
1
                       else Int
0
      CmpLE Element
e1 Element
e2 -> if t -> HdlSyn -> Element -> Int
check t
iw HdlSyn
syn Element
e1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= t -> HdlSyn -> Element -> Int
check t
iw HdlSyn
syn Element
e2
                        then Int
1
                        else Int
0
      Element
_ -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"IF: condition must be: SIZE, LENGTH, IW64, LIT, ISLIT, or ISARG"

renderElem BlackBoxContext
b Element
e = (Text -> Int -> Text)
-> StateT backend Identity Text -> State backend (Int -> Text)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int -> Text
forall a b. a -> b -> a
const (BlackBoxContext -> Element -> StateT backend Identity Text
forall backend.
Backend backend =>
BlackBoxContext -> Element -> State backend Text
renderTag BlackBoxContext
b Element
e)

parseFail :: Text -> BlackBoxTemplate
parseFail :: Text -> BlackBoxTemplate
parseFail Text
t = case Text -> Result BlackBoxTemplate
runParse Text
t of
  Failure ErrInfo
errInfo ->
    String -> BlackBoxTemplate
forall a. HasCallStack => String -> a
error (Doc AnsiStyle -> String
forall a. Show a => a -> String
show (ErrInfo -> Doc AnsiStyle
_errDoc ErrInfo
errInfo))
  Success BlackBoxTemplate
templ -> BlackBoxTemplate
templ

idToExpr
  :: (Text,HWType)
  -> (Expr,HWType,Bool)
idToExpr :: (Text, HWType) -> (Expr, HWType, Bool)
idToExpr (Text
t,HWType
ty) = (Identifier -> Maybe Modifier -> Expr
Identifier (Text -> Identifier
Text.toStrict Text
t) Maybe Modifier
forall a. Maybe a
Nothing,HWType
ty,Bool
False)

-- | Fill out the template corresponding to an output/input assignment of a
-- component instantiation, and turn it into a single identifier so it can
-- be used for a new blackbox context.
lineToIdentifier :: Backend backend
                 => BlackBoxContext
                 -> BlackBoxTemplate
                 -> State backend Text
lineToIdentifier :: BlackBoxContext -> BlackBoxTemplate -> State backend Text
lineToIdentifier BlackBoxContext
b = (Element -> Text -> State backend Text)
-> Text -> BlackBoxTemplate -> State backend Text
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM (\Element
e Text
a -> do
                              Text
e' <- BlackBoxContext -> Element -> State backend Text
forall backend.
Backend backend =>
BlackBoxContext -> Element -> State backend Text
renderTag BlackBoxContext
b Element
e
                              Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text
e' Text -> Text -> Text
`Text.append` Text
a)
                   ) Text
Text.empty

lineToType :: BlackBoxContext
           -> BlackBoxTemplate
           -> HWType
lineToType :: BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [(Typ Maybe Int
Nothing)]  = (Expr, HWType) -> HWType
forall a b. (a, b) -> b
snd ((Expr, HWType) -> HWType) -> (Expr, HWType) -> HWType
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
b
lineToType BlackBoxContext
b [(Typ (Just Int
n))] = let (Expr
_,HWType
ty,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
                                in  HWType
ty
lineToType BlackBoxContext
b [(TypElem Element
t)]    = case BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
t] of
                                  Vector Int
_ HWType
elTy -> HWType
elTy
                                  HWType
_ -> String -> HWType
forall a. HasCallStack => String -> a
error (String -> HWType) -> String -> HWType
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Element type selection of a non-vector type"
lineToType BlackBoxContext
b [(IndexType (Lit Int
n))] =
  case BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n of
    (Literal Maybe (HWType, Int)
_ (NumLit Integer
n'),HWType
_,Bool
_) -> Integer -> HWType
Index (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
n')
    (Expr, HWType, Bool)
x -> String -> HWType
forall a. HasCallStack => String -> a
error (String -> HWType) -> String -> HWType
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Index type not given a literal: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Expr, HWType, Bool) -> String
forall a. Show a => a -> String
show (Expr, HWType, Bool)
x

lineToType BlackBoxContext
_ BlackBoxTemplate
_ = String -> HWType
forall a. HasCallStack => String -> a
error (String -> HWType) -> String -> HWType
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Unexpected type manipulation"

-- | Give a context and a tagged hole (of a template), returns part of the
-- context that matches the tag of the hole.
renderTag :: Backend backend
          => BlackBoxContext
          -> Element
          -> State backend Text
renderTag :: BlackBoxContext -> Element -> State backend Text
renderTag BlackBoxContext
_ (Text Text
t)        = Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
t
renderTag BlackBoxContext
b (Result Bool
esc)    = do
  Identifier -> Identifier
escape <- if Bool
esc then State backend (Identifier -> Identifier)
forall state.
Backend state =>
State state (Identifier -> Identifier)
unextend else (Identifier -> Identifier)
-> State backend (Identifier -> Identifier)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Identifier -> Identifier
forall a. a -> a
id
  (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Identifier -> Text
Text.fromStrict (Identifier -> Text) -> (Doc -> Identifier) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Identifier
escape (Identifier -> Identifier)
-> (Doc -> Identifier) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Identifier
Text.toStrict (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (State backend Doc -> State backend Text)
-> ((Expr, HWType) -> State backend Doc)
-> (Expr, HWType)
-> State backend Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Mon (State backend) Doc -> State backend Doc)
-> ((Expr, HWType) -> Mon (State backend) Doc)
-> (Expr, HWType)
-> State backend Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Expr -> Mon (State backend) Doc
forall state.
Backend state =>
Bool -> Expr -> Mon (State state) Doc
expr Bool
False (Expr -> Mon (State backend) Doc)
-> ((Expr, HWType) -> Expr)
-> (Expr, HWType)
-> Mon (State backend) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr, HWType) -> Expr
forall a b. (a, b) -> a
fst ((Expr, HWType) -> State backend Text)
-> (Expr, HWType) -> State backend Text
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
b
renderTag BlackBoxContext
b (Arg Bool
esc Int
n)  = do
  let (Expr
e,HWType
_,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
  Identifier -> Identifier
escape <- if Bool
esc then State backend (Identifier -> Identifier)
forall state.
Backend state =>
State state (Identifier -> Identifier)
unextend else (Identifier -> Identifier)
-> State backend (Identifier -> Identifier)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Identifier -> Identifier
forall a. a -> a
id
  (Identifier -> Text
Text.fromStrict (Identifier -> Text) -> (Doc -> Identifier) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Identifier
escape (Identifier -> Identifier)
-> (Doc -> Identifier) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Identifier
Text.toStrict (Text -> Identifier) -> (Doc -> Text) -> Doc -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
forall ann. Doc ann -> Text
renderOneLine) (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Bool -> Expr -> Mon (State backend) Doc
forall state.
Backend state =>
Bool -> Expr -> Mon (State state) Doc
expr Bool
False Expr
e)

renderTag BlackBoxContext
b (Const Int
n)  = do
  let (Expr
e,HWType
_,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Bool -> Expr -> Mon (State backend) Doc
forall state.
Backend state =>
Bool -> Expr -> Mon (State state) Doc
expr Bool
False Expr
e)

renderTag BlackBoxContext
b t :: Element
t@(ArgGen Int
k Int
n)
  | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== BlackBoxContext -> Int
bbLevel BlackBoxContext
b
  , let (Expr
e,HWType
_,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
  = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Bool -> Expr -> Mon (State backend) Doc
forall state.
Backend state =>
Bool -> Expr -> Mon (State state) Doc
expr Bool
False Expr
e)
  | Bool
otherwise
  = Mon (State backend) Text -> State backend Text
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Element -> Mon (State backend) Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem Element
t)

renderTag BlackBoxContext
b (Lit Int
n) =
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Bool -> Expr -> Mon (State backend) Doc
forall state.
Backend state =>
Bool -> Expr -> Mon (State state) Doc
expr Bool
False (Expr -> Expr
mkLit Expr
e))
 where
  (Expr
e,HWType
_,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n

  mkLit :: Expr -> Expr
mkLit (Literal (Just (Signed Int
_,Int
_)) Literal
i)                                 = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
i
  mkLit (Literal (Just (Unsigned Int
_,Int
_)) Literal
i)                               = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
i
  mkLit (DataCon HWType
_ (DC (Void {}, Int
_)) [Literal (Just (Signed Int
_,Int
_)) Literal
i])   = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
i
  mkLit (DataCon HWType
_ (DC (Void {}, Int
_)) [Literal (Just (Unsigned Int
_,Int
_)) Literal
i]) = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
i
  mkLit Expr
i                                                               = Expr
i

renderTag BlackBoxContext
b e :: Element
e@(Name Int
_i) =
  case BlackBoxContext -> Element -> Either String Text
elementToText BlackBoxContext
b Element
e of
      Right Text
s  -> Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
s
      Left String
msg -> String -> State backend Text
forall a. HasCallStack => String -> a
error (String -> State backend Text) -> String -> State backend Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [ String
"Error when reducing to string"
                                               , String
"in ~NAME construct:", String
msg ]

renderTag BlackBoxContext
_ (ToVar [Text Text
t] Int
_) = Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
t
renderTag BlackBoxContext
_ (Sym Text
t Int
_) = Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
t

renderTag BlackBoxContext
b (BV Bool
True BlackBoxTemplate
es Element
e) = do
  Text
e' <- [Text] -> Text
Text.concat ([Text] -> Text)
-> StateT backend Identity [Text] -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> State backend Text)
-> BlackBoxTemplate -> StateT backend Identity [Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((Int -> Text) -> Text)
-> StateT backend Identity (Int -> Text) -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
0) (StateT backend Identity (Int -> Text) -> State backend Text)
-> (Element -> StateT backend Identity (Int -> Text))
-> Element
-> State backend Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlackBoxContext -> Element -> StateT backend Identity (Int -> Text)
forall backend.
(HasCallStack, Backend backend) =>
BlackBoxContext -> Element -> State backend (Int -> Text)
renderElem BlackBoxContext
b) BlackBoxTemplate
es
  let ty :: HWType
ty = BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
e]
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (HWType -> Text -> Mon (State backend) Doc
forall state.
Backend state =>
HWType -> Text -> Mon (State state) Doc
toBV HWType
ty Text
e')
renderTag BlackBoxContext
b (BV Bool
False BlackBoxTemplate
es Element
e) = do
  Text
e' <- [Text] -> Text
Text.concat ([Text] -> Text)
-> StateT backend Identity [Text] -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Element -> State backend Text)
-> BlackBoxTemplate -> StateT backend Identity [Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((Int -> Text) -> Text)
-> StateT backend Identity (Int -> Text) -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
0) (StateT backend Identity (Int -> Text) -> State backend Text)
-> (Element -> StateT backend Identity (Int -> Text))
-> Element
-> State backend Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlackBoxContext -> Element -> StateT backend Identity (Int -> Text)
forall backend.
(HasCallStack, Backend backend) =>
BlackBoxContext -> Element -> State backend (Int -> Text)
renderElem BlackBoxContext
b) BlackBoxTemplate
es)
  let ty :: HWType
ty = BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
e]
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (HWType -> Text -> Mon (State backend) Doc
forall state.
Backend state =>
HWType -> Text -> Mon (State state) Doc
fromBV HWType
ty Text
e')

renderTag BlackBoxContext
b (Sel Element
e Int
n) =
  let ty :: HWType
ty = BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
e]
  in  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (HWType -> Int -> Mon (State backend) Doc
forall state.
Backend state =>
HWType -> Int -> Mon (State state) Doc
hdlRecSel HWType
ty Int
n)

renderTag BlackBoxContext
b (Typ Maybe Int
Nothing)   = (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (State backend Doc -> State backend Text)
-> ((Expr, HWType) -> State backend Doc)
-> (Expr, HWType)
-> State backend Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Mon (State backend) Doc -> State backend Doc)
-> ((Expr, HWType) -> Mon (State backend) Doc)
-> (Expr, HWType)
-> State backend Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Usage -> HWType -> Mon (State backend) Doc
forall state.
Backend state =>
Usage -> HWType -> Mon (State state) Doc
hdlType Usage
Internal (HWType -> Mon (State backend) Doc)
-> ((Expr, HWType) -> HWType)
-> (Expr, HWType)
-> Mon (State backend) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr, HWType) -> HWType
forall a b. (a, b) -> b
snd ((Expr, HWType) -> State backend Text)
-> (Expr, HWType) -> State backend Text
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
b
renderTag BlackBoxContext
b (Typ (Just Int
n))  = let (Expr
_,HWType
ty,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
                              in  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Usage -> HWType -> Mon (State backend) Doc
forall state.
Backend state =>
Usage -> HWType -> Mon (State state) Doc
hdlType Usage
Internal HWType
ty)
renderTag BlackBoxContext
b (TypM Maybe Int
Nothing)  = (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (State backend Doc -> State backend Text)
-> ((Expr, HWType) -> State backend Doc)
-> (Expr, HWType)
-> State backend Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Mon (State backend) Doc -> State backend Doc)
-> ((Expr, HWType) -> Mon (State backend) Doc)
-> (Expr, HWType)
-> State backend Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> Mon (State backend) Doc
forall state. Backend state => HWType -> Mon (State state) Doc
hdlTypeMark (HWType -> Mon (State backend) Doc)
-> ((Expr, HWType) -> HWType)
-> (Expr, HWType)
-> Mon (State backend) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr, HWType) -> HWType
forall a b. (a, b) -> b
snd ((Expr, HWType) -> State backend Text)
-> (Expr, HWType) -> State backend Text
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
b
renderTag BlackBoxContext
b (TypM (Just Int
n)) = let (Expr
_,HWType
ty,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
                              in  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (HWType -> Mon (State backend) Doc
forall state. Backend state => HWType -> Mon (State state) Doc
hdlTypeMark HWType
ty)
renderTag BlackBoxContext
b (Err Maybe Int
Nothing)   = (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (State backend Doc -> State backend Text)
-> ((Expr, HWType) -> State backend Doc)
-> (Expr, HWType)
-> State backend Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Mon (State backend) Doc -> State backend Doc)
-> ((Expr, HWType) -> Mon (State backend) Doc)
-> (Expr, HWType)
-> State backend Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> Mon (State backend) Doc
forall state. Backend state => HWType -> Mon (State state) Doc
hdlTypeErrValue (HWType -> Mon (State backend) Doc)
-> ((Expr, HWType) -> HWType)
-> (Expr, HWType)
-> Mon (State backend) Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr, HWType) -> HWType
forall a b. (a, b) -> b
snd ((Expr, HWType) -> State backend Text)
-> (Expr, HWType) -> State backend Text
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
b
renderTag BlackBoxContext
b (Err (Just Int
n))  = let (Expr
_,HWType
ty,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
                              in  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (HWType -> Mon (State backend) Doc
forall state. Backend state => HWType -> Mon (State state) Doc
hdlTypeErrValue HWType
ty)
renderTag BlackBoxContext
b (Size Element
e)        = Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> State backend Text)
-> (HWType -> Text) -> HWType -> State backend Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (HWType -> String) -> HWType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (HWType -> Int) -> HWType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> Int
typeSize (HWType -> State backend Text) -> HWType -> State backend Text
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
e]

renderTag BlackBoxContext
b (Length Element
e) = Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> State backend Text)
-> (HWType -> Text) -> HWType -> State backend Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (HWType -> String) -> HWType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (HWType -> Int) -> HWType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> Int
vecLen (HWType -> State backend Text) -> HWType -> State backend Text
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
e]
  where
    vecLen :: HWType -> Int
vecLen (Vector Int
n HWType
_)               = Int
n
    vecLen (Void (Just (Vector Int
n HWType
_))) = Int
n
    vecLen HWType
thing =
      String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"vecLen of a non-vector type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
thing

renderTag BlackBoxContext
b (Depth Element
e) = Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> State backend Text)
-> (HWType -> Text) -> HWType -> State backend Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (HWType -> String) -> HWType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (HWType -> Int) -> HWType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> Int
treeDepth (HWType -> State backend Text) -> HWType -> State backend Text
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
e]
  where
    treeDepth :: HWType -> Int
treeDepth (RTree Int
n HWType
_)               = Int
n
    treeDepth (Void (Just (RTree Int
n HWType
_))) = Int
n
    treeDepth HWType
thing =
      String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"treeDepth of a non-tree type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
thing

renderTag BlackBoxContext
b (MaxIndex Element
e) = Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> State backend Text)
-> (HWType -> Text) -> HWType -> State backend Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (HWType -> String) -> HWType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (HWType -> Int) -> HWType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> Int
vecLen (HWType -> State backend Text) -> HWType -> State backend Text
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
e]
  where
    vecLen :: HWType -> Int
vecLen (Vector Int
n HWType
_) = Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
    vecLen HWType
thing =
      String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"vecLen of a non-vector type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
thing

renderTag BlackBoxContext
b e :: Element
e@(TypElem Element
_)   = let ty :: HWType
ty = BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
e]
                              in  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Usage -> HWType -> Mon (State backend) Doc
forall state.
Backend state =>
Usage -> HWType -> Mon (State state) Doc
hdlType Usage
Internal HWType
ty)
renderTag BlackBoxContext
_ (Gen Bool
b)         = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> State backend Doc
forall state. Backend state => Bool -> State state Doc
genStmt Bool
b
renderTag BlackBoxContext
_ (GenSym [Text Text
t] Int
_) = Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
t

-- Determine variables used in argument /n/.
renderTag BlackBoxContext
b (Vars Int
n) = Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> State backend Text) -> Text -> State backend Text
forall a b. (a -> b) -> a -> b
$ Text
vars'
  where
    (Expr
e, HWType
_, Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
    vars :: [Text]
vars      = (Identifier -> Text) -> [Identifier] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Identifier -> Text
Text.fromStrict (Expr -> [Identifier]
usedVariables Expr
e)
    vars' :: Text
vars'     = [Text] -> Text
Text.concat ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Text -> Text
Text.cons Char
',') [Text]
vars)

renderTag BlackBoxContext
b (IndexType (Lit Int
n)) =
  case BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n of
    (Literal Maybe (HWType, Int)
_ (NumLit Integer
n'),HWType
_,Bool
_) ->
      let hty :: HWType
hty = Integer -> HWType
Index (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
n')
      in  (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Mon (State backend) Doc -> State backend Doc
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Usage -> HWType -> Mon (State backend) Doc
forall state.
Backend state =>
Usage -> HWType -> Mon (State state) Doc
hdlType Usage
Internal HWType
hty))
    (Expr, HWType, Bool)
x -> String -> State backend Text
forall a. HasCallStack => String -> a
error (String -> State backend Text) -> String -> State backend Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Index type not given a literal: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Expr, HWType, Bool) -> String
forall a. Show a => a -> String
show (Expr, HWType, Bool)
x
renderTag BlackBoxContext
b (FilePath Element
e)    = case Element
e of
  Lit Int
n -> do
    let (Expr
e',HWType
_,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
    case Expr -> Maybe String
exprToString Expr
e' of
      Just String
s -> do
        String
s' <- String -> State backend String
forall state. Backend state => String -> State state String
addAndSetData String
s
        Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Text
Text.pack (String -> String
forall a. Show a => a -> String
show String
s'))
      Maybe String
_ -> do
        Text
e2  <- Mon (State backend) Text -> State backend Text
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Element -> Mon (State backend) Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem Element
e)
        String -> State backend Text
forall a. HasCallStack => String -> a
error (String -> State backend Text) -> String -> State backend Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"argument of ~FILEPATH:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
"does not reduce to a string"
  Element
_ -> do Text
e' <- Mon (State backend) Text -> State backend Text
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Element -> Mon (State backend) Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem Element
e)
          String -> State backend Text
forall a. HasCallStack => String -> a
error (String -> State backend Text) -> String -> State backend Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"~FILEPATH expects a ~LIT[N] argument, but got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
e'
renderTag BlackBoxContext
b (IncludeName Int
n) = case [Identifier] -> Int -> Maybe Identifier
forall a. [a] -> Int -> Maybe a
indexMaybe (BlackBoxContext -> [Identifier]
bbQsysIncName BlackBoxContext
b) Int
n of
  Just Identifier
nm -> Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Identifier -> Text
Text.fromStrict Identifier
nm)
  Maybe Identifier
_ -> String -> State backend Text
forall a. HasCallStack => String -> a
error (String -> State backend Text) -> String -> State backend Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"~INCLUDENAME[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] does not correspond to any index of the 'includes' field that is specified in the primitive definition"
renderTag BlackBoxContext
b (OutputWireReg Int
n) = case Int
-> IntMap
     [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
       [BlackBoxTemplate], [BlackBoxTemplate],
       [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
-> Maybe
     [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
       [BlackBoxTemplate], [BlackBoxTemplate],
       [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
n (BlackBoxContext
-> IntMap
     [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
       [BlackBoxTemplate], [BlackBoxTemplate],
       [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
bbFunctions BlackBoxContext
b) of
  Just ((Either BlackBox (Identifier, [Declaration])
_,WireOrReg
rw,[BlackBoxTemplate]
_,[BlackBoxTemplate]
_,[((Identifier, Identifier), BlackBox)]
_,BlackBoxContext
_):[(Either BlackBox (Identifier, [Declaration]), WireOrReg,
  [BlackBoxTemplate], [BlackBoxTemplate],
  [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
_) -> case WireOrReg
rw of {WireOrReg
N.Wire -> Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"wire"; WireOrReg
N.Reg -> Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"reg"}
  Maybe
  [(Either BlackBox (Identifier, [Declaration]), WireOrReg,
    [BlackBoxTemplate], [BlackBoxTemplate],
    [((Identifier, Identifier), BlackBox)], BlackBoxContext)]
_ -> String -> State backend Text
forall a. HasCallStack => String -> a
error (String -> State backend Text) -> String -> State backend Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"~OUTPUTWIREREG[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] used where argument " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not a function"
renderTag BlackBoxContext
b (Repeat [Element
es] [Element
i]) = do
  String
i'  <- Text -> String
Text.unpack (Text -> String) -> State backend Text -> State backend String
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> BlackBoxContext -> Element -> State backend Text
forall backend.
Backend backend =>
BlackBoxContext -> Element -> State backend Text
renderTag BlackBoxContext
b Element
i
  Text
es' <- BlackBoxContext -> Element -> State backend Text
forall backend.
Backend backend =>
BlackBoxContext -> Element -> State backend Text
renderTag BlackBoxContext
b Element
es
  let i'' :: Int
i'' = case (String -> Either String Int
forall a. Read a => String -> Either String a
readEither String
i' :: Either String Int) of
              Left String
msg -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Could not parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
i' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". read reported: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
              Right Int
n  -> Int
n
  Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> State backend Text) -> Text -> State backend Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
i'' ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
forall a. a -> [a]
repeat Text
es'

renderTag BlackBoxContext
b (DevNull BlackBoxTemplate
es) = do
  [Int -> Text]
_ <- (Element -> StateT backend Identity (Int -> Text))
-> BlackBoxTemplate -> StateT backend Identity [Int -> Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (BlackBoxContext -> Element -> StateT backend Identity (Int -> Text)
forall backend.
(HasCallStack, Backend backend) =>
BlackBoxContext -> Element -> State backend (Int -> Text)
renderElem BlackBoxContext
b) BlackBoxTemplate
es
  Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> State backend Text) -> Text -> State backend Text
forall a b. (a -> b) -> a -> b
$ Text
Text.empty

renderTag BlackBoxContext
b (Template BlackBoxTemplate
filenameL BlackBoxTemplate
sourceL) = case Either String (String, String)
file of
  Left String
msg ->
      String -> State backend Text
forall a. HasCallStack => String -> a
error (String -> State backend Text) -> String -> State backend Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [ String
"Name or source in ~TEMPLATE construct"
                                   , String
"did not reduce to a string."
                                   , String
"'elementToText' reported:"
                                   , String
msg ]
  Right fstup :: (String, String)
fstup@(String
filename, String
_source) -> do
    [(String, String)]
fs <- State backend [(String, String)]
forall state. Backend state => State state [(String, String)]
getMemoryDataFiles
    if String -> [String] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
elem String
filename (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst [(String, String)]
fs)
      then if Bool -> Bool
not ((String, String) -> [(String, String)] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
elem (String, String)
fstup [(String, String)]
fs)
        then String -> State backend Text
forall a. HasCallStack => String -> a
error (String -> State backend Text) -> String -> State backend Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [ String
"Multiple ~TEMPLATE constructs"
                                           , String
"specifiy the same filename"
                                           , String
"but different contents. Make"
                                           , String
"sure these names are unique." ]
      -- We replace the Template element with an empty constant, so nothing
      -- ends up in the generated HDL.
        else Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Text
Text.pack String
"")
      else do
        (String, String) -> State backend ()
forall state. Backend state => (String, String) -> State state ()
addMemoryDataFile (String, String)
fstup
        Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Text
Text.pack String
"")

  where
      file :: Either String (String, String)
file = do
          Text
filename <- BlackBoxContext -> BlackBoxTemplate -> Either String Text
elementsToText BlackBoxContext
b BlackBoxTemplate
filenameL
          Text
source   <- BlackBoxContext -> BlackBoxTemplate -> Either String Text
elementsToText BlackBoxContext
b BlackBoxTemplate
sourceL
          (String, String) -> Either String (String, String)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> String
Text.unpack Text
filename, Text -> String
Text.unpack Text
source)

renderTag BlackBoxContext
b Element
CompName = Text -> State backend Text
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Identifier -> Text
Text.fromStrict (BlackBoxContext -> Identifier
bbCompName BlackBoxContext
b))

renderTag BlackBoxContext
b Element
CtxName = case BlackBoxContext -> Maybe Identifier
bbCtxName BlackBoxContext
b of
  Just Identifier
nm -> Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Identifier -> Text
Text.fromStrict Identifier
nm)
  Maybe Identifier
_ | Identifier Identifier
t Maybe Modifier
_ <- (Expr, HWType) -> Expr
forall a b. (a, b) -> a
fst (BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
b)
    -> Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Identifier -> Text
Text.fromStrict Identifier
t)
  Maybe Identifier
_ -> String -> State backend Text
forall a. HasCallStack => String -> a
error String
"internal error"


renderTag BlackBoxContext
_ Element
e = do Text
e' <- Mon (State backend) Text -> State backend Text
forall (f :: Type -> Type) m. Mon f m -> f m
getMon (Element -> Mon (State backend) Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem Element
e)
                   String -> State backend Text
forall a. HasCallStack => String -> a
error (String -> State backend Text) -> String -> State backend Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Unable to evaluate: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
e'

-- | Compute string from a list of elements. Can interpret ~NAME string literals
-- on template level (constants).
elementsToText
    :: BlackBoxContext
    -> [Element]
    -> Either String Text
elementsToText :: BlackBoxContext -> BlackBoxTemplate -> Either String Text
elementsToText BlackBoxContext
bbCtx BlackBoxTemplate
elements =
    (Either String Text -> Element -> Either String Text)
-> Either String Text -> BlackBoxTemplate -> Either String Text
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Either String Text
txt Element
el -> case Either String Text
txt of
                          -- Append new string (if no error) to string so far
                          Right Text
s -> (Text -> Text -> Text
Text.append Text
s) (Text -> Text) -> Either String Text -> Either String Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> BlackBoxContext -> Element -> Either String Text
elementToText BlackBoxContext
bbCtx Element
el
                          -- If previous iteration resulted in an error: stop.
                          Either String Text
msg -> Either String Text
msg) (Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"") BlackBoxTemplate
elements

elementToText
    :: BlackBoxContext
    -> Element
    -> Either String Text
elementToText :: BlackBoxContext -> Element -> Either String Text
elementToText BlackBoxContext
bbCtx  (Name Int
n) = BlackBoxContext -> Element -> Either String Text
elementToText BlackBoxContext
bbCtx (Int -> Element
Lit Int
n)
elementToText BlackBoxContext
_bbCtx (Text Text
t) = Text -> Either String Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ Text
t
elementToText BlackBoxContext
bbCtx  (Lit Int
n) =
    case BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx [(Expr, HWType, Bool)]
-> Getting
     (First (Expr, HWType, Bool))
     [(Expr, HWType, Bool)]
     (Expr, HWType, Bool)
-> Maybe (Expr, HWType, Bool)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Int
-> IndexedTraversal'
     Int [(Expr, HWType, Bool)] (Expr, HWType, Bool)
forall (t :: Type -> Type) a.
Traversable t =>
Int -> IndexedTraversal' Int (t a) a
element Int
n of
        Just (Expr
e,HWType
_,Bool
_) ->
            case Expr -> Maybe String
exprToString Expr
e of
                Just String
t ->
                    Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
t
                Maybe String
Nothing ->
                    String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [ String
"Could not extract string from"
                                                , Expr -> String
forall a. Show a => a -> String
show Expr
e, String
"referred to by"
                                                , Element -> String
forall a. Show a => a -> String
show (Int -> Element
Lit Int
n) ]
        Maybe (Expr, HWType, Bool)
Nothing ->
            String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [ String
"Invalid literal", Element -> String
forall a. Show a => a -> String
show (Int -> Element
Lit Int
n)
                                        , String
"used in blackbox with context:"
                                        , BlackBoxContext -> String
forall a. Show a => a -> String
show BlackBoxContext
bbCtx, String
"." ]

elementToText BlackBoxContext
_bbCtx Element
e = String -> Either String Text
forall a. HasCallStack => String -> a
error (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ String
"Unexpected string like: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Element -> String
forall a. Show a => a -> String
show Element
e

-- | Extracts string from SSymbol or string literals
exprToString
  :: Expr
  -> Maybe String
exprToString :: Expr -> Maybe String
exprToString (Literal Maybe (HWType, Int)
_ (NumLit Integer
i)) = String -> Maybe String
forall a. a -> Maybe a
Just (Integer -> String
forall a. Show a => a -> String
show Integer
i)
exprToString (Literal Maybe (HWType, Int)
_ (StringLit String
l)) = String -> Maybe String
forall a. a -> Maybe a
Just String
l
exprToString (BlackBoxE Identifier
"Clash.Promoted.Symbol.SSymbol" [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
ctx Bool
_) =
  let (Expr
e',HWType
_,Bool
_) = [(Expr, HWType, Bool)] -> (Expr, HWType, Bool)
forall a. [a] -> a
head (BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
ctx)
  in  Expr -> Maybe String
exprToString Expr
e'
exprToString (BlackBoxE Identifier
"GHC.CString.unpackCString#" [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
_ BlackBoxContext
ctx Bool
_) =
  let (Expr
e',HWType
_,Bool
_) = [(Expr, HWType, Bool)] -> (Expr, HWType, Bool)
forall a. [a] -> a
head (BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
ctx)
  in  Expr -> Maybe String
exprToString Expr
e'
exprToString Expr
_ = Maybe String
forall a. Maybe a
Nothing

prettyBlackBox :: Monad m
               => BlackBoxTemplate
               -> Mon m Text
prettyBlackBox :: BlackBoxTemplate -> Mon m Text
prettyBlackBox BlackBoxTemplate
bbT = [Text] -> Text
Text.concat ([Text] -> Text) -> Mon m [Text] -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> Mon m Text) -> BlackBoxTemplate -> Mon m [Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem BlackBoxTemplate
bbT

prettyElem
  :: (HasCallStack, Monad m)
  => Element
  -> Mon m Text
prettyElem :: Element -> Mon m Text
prettyElem (Text Text
t) = Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
t
prettyElem (Component (Decl Int
i Int
0 [(BlackBoxTemplate, BlackBoxTemplate)]
args)) = do
  [(Text, Text)]
args' <- ((BlackBoxTemplate, BlackBoxTemplate) -> Mon m (Text, Text))
-> [(BlackBoxTemplate, BlackBoxTemplate)] -> Mon m [(Text, Text)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(BlackBoxTemplate
a,BlackBoxTemplate
b) -> (,) (Text -> Text -> (Text, Text))
-> Mon m Text -> Mon m (Text -> (Text, Text))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> BlackBoxTemplate -> Mon m Text
forall (m :: Type -> Type).
Monad m =>
BlackBoxTemplate -> Mon m Text
prettyBlackBox BlackBoxTemplate
a Mon m (Text -> (Text, Text)) -> Mon m Text -> Mon m (Text, Text)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> BlackBoxTemplate -> Mon m Text
forall (m :: Type -> Type).
Monad m =>
BlackBoxTemplate -> Mon m Text
prettyBlackBox BlackBoxTemplate
b) [(BlackBoxTemplate, BlackBoxTemplate)]
args
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (Int -> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => Int -> f Doc -> f Doc
nest Int
2 (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~INST" Mon m Doc -> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<>
        Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~OUTPUT" Mon m Doc -> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"=>" Mon m Doc -> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string ((Text, Text) -> Text
forall a b. (a, b) -> a
fst ([(Text, Text)] -> (Text, Text)
forall a. [a] -> a
head [(Text, Text)]
args')) Mon m Doc -> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string ((Text, Text) -> Text
forall a b. (a, b) -> b
snd ([(Text, Text)] -> (Text, Text)
forall a. [a] -> a
head [(Text, Text)]
args')) Mon m Doc -> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<>
        Mon m [Doc] -> Mon m Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
vcat (((Text, Text) -> Mon m Doc) -> [(Text, Text)] -> Mon m [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Text
a,Text
b) -> Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~INPUT" Mon m Doc -> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"=>" Mon m Doc -> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
a Mon m Doc -> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
b Mon m Doc -> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~") ([(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a]
tail [(Text, Text)]
args')))
      Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc
forall (f :: Type -> Type). Applicative f => f Doc
line Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~INST")
prettyElem (Component (Decl {})) =
  String -> Mon m Text
forall a. HasCallStack => String -> a
error (String -> Mon m Text) -> String -> Mon m Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"prettyElem can't (yet) render ~INST when subfuncion /= 0!"
prettyElem (Result Bool
b) = if Bool
b then Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"~ERESULT" else Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"~RESULT"
prettyElem (Arg Bool
b Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (if Bool
b then Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~EARG" else Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~ARG" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (Lit Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~LIT" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (Const Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~CONST" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (Name Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~NAME" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (ToVar BlackBoxTemplate
es Int
i) = do
  Text
es' <- BlackBoxTemplate -> Mon m Text
forall (m :: Type -> Type).
Monad m =>
BlackBoxTemplate -> Mon m Text
prettyBlackBox BlackBoxTemplate
es
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~VAR" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
es') Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (Sym Text
_ Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~SYM" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (Typ Maybe Int
Nothing) = Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"~TYPO"
prettyElem (Typ (Just Int
i)) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~TYP" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (TypM Maybe Int
Nothing) = Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"~TYPMO"
prettyElem (TypM (Just Int
i)) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~TYPM" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (Err Maybe Int
Nothing) = Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"~ERRORO"
prettyElem (Err (Just Int
i)) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~ERROR" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (TypElem Element
e) = do
  Text
e' <- Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem Element
e
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~TYPEL" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e'))
prettyElem Element
CompName = Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"~COMPNAME"
prettyElem (IncludeName Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Mon m Doc
"~INCLUDENAME" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (IndexType Element
e) = do
  Text
e' <- Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem Element
e
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~INDEXTYPE" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e'))
prettyElem (Size Element
e) = do
  Text
e' <- Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem Element
e
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~SIZE" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e'))
prettyElem (Length Element
e) = do
  Text
e' <- Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem Element
e
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~LENGTH" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e'))
prettyElem (Depth Element
e) = do
  Text
e' <- Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem Element
e
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~DEPTH" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e'))
prettyElem (MaxIndex Element
e) = do
  Text
e' <- Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem Element
e
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~MAXINDEX" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e'))
prettyElem (FilePath Element
e) = do
  Text
e' <- Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem Element
e
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~FILE" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e'))
prettyElem (Gen Bool
b) = if Bool
b then Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"~GENERATE" else Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"~ENDGENERATE"
prettyElem (IF Element
b BlackBoxTemplate
esT BlackBoxTemplate
esF) = do
  Text
b' <- Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem Element
b
  Text
esT' <- BlackBoxTemplate -> Mon m Text
forall (m :: Type -> Type).
Monad m =>
BlackBoxTemplate -> Mon m Text
prettyBlackBox BlackBoxTemplate
esT
  Text
esF' <- BlackBoxTemplate -> Mon m Text
forall (m :: Type -> Type).
Monad m =>
BlackBoxTemplate -> Mon m Text
prettyBlackBox BlackBoxTemplate
esF
  (SimpleDocStream () -> Text
forall ann. SimpleDocStream ann -> Text
renderLazy (SimpleDocStream () -> Text)
-> (Doc -> SimpleDocStream ()) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> SimpleDocStream ()
forall ann. Doc ann -> SimpleDocStream ann
layoutCompact) (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~IF" Mon m Doc -> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
b' Mon m Doc -> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f Doc -> f Doc
<+> Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~THEN" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<>
     Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
esT' Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<>
     Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~ELSE" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<>
     Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
esF' Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<>
     Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~FI")
prettyElem (And BlackBoxTemplate
es) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~AND" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<>
  (Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Mon m [Doc] -> Mon m Doc
forall (f :: Type -> Type). Functor f => f [Doc] -> f Doc
hcat (Mon m Doc -> Mon m [Doc] -> Mon m [Doc]
forall (f :: Type -> Type).
Applicative f =>
f Doc -> f [Doc] -> f [Doc]
punctuate Mon m Doc
forall (f :: Type -> Type). Applicative f => f Doc
comma ((Element -> Mon m Doc) -> BlackBoxTemplate -> Mon m [Doc]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (Text -> Mon m Doc)
-> (Element -> Mon m Text) -> Element -> Mon m Doc
forall (m :: Type -> Type) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem) BlackBoxTemplate
es)))))
prettyElem (CmpLE Element
e1 Element
e2) = do
  Text
e1' <- Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem Element
e1
  Text
e2' <- Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem Element
e2
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~CMPLE" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e1')
                                     Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e2'))
prettyElem Element
IW64 = Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"~IW64"
prettyElem (HdlSyn HdlSyn
s) = case HdlSyn
s of
  HdlSyn
Vivado -> Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"~VIVADO"
  HdlSyn
_      -> Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"~OTHERSYN"
prettyElem (BV Bool
b BlackBoxTemplate
es Element
e) = do
  Text
es' <- BlackBoxTemplate -> Mon m Text
forall (m :: Type -> Type).
Monad m =>
BlackBoxTemplate -> Mon m Text
prettyBlackBox BlackBoxTemplate
es
  Text
e'  <- BlackBoxTemplate -> Mon m Text
forall (m :: Type -> Type).
Monad m =>
BlackBoxTemplate -> Mon m Text
prettyBlackBox [Element
e]
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
    if Bool
b
       then Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~TOBV" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
es') Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e')
       else Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~FROMBV" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
es') Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e')
prettyElem (Sel Element
e Int
i) = do
  Text
e' <- Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem Element
e
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~SEL" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
e') Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (IsLit Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~ISLIT" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (IsVar Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~ISVAR" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (IsActiveHigh Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~ISACTIVEHIGH" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (IsActiveEnable Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~ISACTIVEENABLE" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))

-- Domain attributes:
prettyElem (Tag Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~TAG" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (Period Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~PERIOD" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (ActiveEdge ActiveEdge
e Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~ACTIVEEDGE" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (String -> Text
Text.pack (ActiveEdge -> String
forall a. Show a => a -> String
show ActiveEdge
e))) Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (IsSync Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~ISSYNC" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (IsInitDefined Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~ISINITDEFINED" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))

prettyElem (StrCmp BlackBoxTemplate
es Int
i) = do
  Text
es' <- BlackBoxTemplate -> Mon m Text
forall (m :: Type -> Type).
Monad m =>
BlackBoxTemplate -> Mon m Text
prettyBlackBox BlackBoxTemplate
es
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~STRCMP" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
es') Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (GenSym BlackBoxTemplate
es Int
i) = do
  Text
es' <- BlackBoxTemplate -> Mon m Text
forall (m :: Type -> Type).
Monad m =>
BlackBoxTemplate -> Mon m Text
prettyBlackBox BlackBoxTemplate
es
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~GENSYM" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
es') Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (Repeat [Element
es] [Element
i]) = do
  Text
es' <- Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem Element
es
  Text
i'  <- Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem Element
i
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine
    (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~REPEAT"
    Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<>  Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
es')
    Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<>  Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
i')
prettyElem (Repeat BlackBoxTemplate
es BlackBoxTemplate
i) = String -> Mon m Text
forall a. HasCallStack => String -> a
error (String -> Mon m Text) -> String -> Mon m Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc)
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Unexpected number of arguments in either "
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ BlackBoxTemplate -> String
forall a. Show a => a -> String
show BlackBoxTemplate
es
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" or "
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ BlackBoxTemplate -> String
forall a. Show a => a -> String
show BlackBoxTemplate
i
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Both lists are expected to have a single element."
prettyElem (DevNull BlackBoxTemplate
es) = do
  [Text]
es' <- (Element -> Mon m Text) -> BlackBoxTemplate -> Mon m [Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem BlackBoxTemplate
es
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~DEVNULL" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (Text -> Mon m Doc) -> Text -> Mon m Doc
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.concat [Text]
es'))

prettyElem (SigD BlackBoxTemplate
es Maybe Int
mI) = do
  Text
es' <- BlackBoxTemplate -> Mon m Text
forall (m :: Type -> Type).
Monad m =>
BlackBoxTemplate -> Mon m Text
prettyBlackBox BlackBoxTemplate
es
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (Mon m Doc -> (Int -> Mon m Doc) -> Maybe Int -> Mon m Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~SIGDO" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
es'))
           (((Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~SIGD" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
es')) Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<>) (Mon m Doc -> Mon m Doc) -> (Int -> Mon m Doc) -> Int -> Mon m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int)
           Maybe Int
mI)
prettyElem (Vars Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~VARS" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (OutputWireReg Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~RESULTWIREREG" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (ArgGen Int
n Int
x) =
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~ARGN" Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
n) Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
x))
prettyElem (Template BlackBoxTemplate
bbname BlackBoxTemplate
source) = do
  [Text]
bbname' <- (Element -> Mon m Text) -> BlackBoxTemplate -> Mon m [Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem BlackBoxTemplate
bbname
  [Text]
source' <- (Element -> Mon m Text) -> BlackBoxTemplate -> Mon m [Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> Mon m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Mon m Text
prettyElem BlackBoxTemplate
source
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Mon m Doc -> Mon m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~TEMPLATE"
                                  Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (Text -> Mon m Doc) -> Text -> Mon m Doc
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.concat [Text]
bbname')
                                  Mon m Doc -> Mon m Doc -> Mon m Doc
forall a. Semigroup a => a -> a -> a
<> Mon m Doc -> Mon m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string (Text -> Mon m Doc) -> Text -> Mon m Doc
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.concat [Text]
source'))
prettyElem Element
CtxName = Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"~CTXNAME"

-- | Recursively walk @Element@, applying @f@ to each element in the tree.
walkElement
  :: (Element -> Maybe a)
  -> Element
  -> [a]
walkElement :: (Element -> Maybe a) -> Element -> [a]
walkElement Element -> Maybe a
f Element
el = Maybe a -> [a]
forall a. Maybe a -> [a]
maybeToList (Element -> Maybe a
f Element
el) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
walked
  where
    go :: Element -> [a]
go     = (Element -> Maybe a) -> Element -> [a]
forall a. (Element -> Maybe a) -> Element -> [a]
walkElement Element -> Maybe a
f
    walked :: [a]
walked =
      -- TODO: alternatives are purposely explicitly listed in case @Element@
      -- TODO: gets extended. This way, GHC will complain about missing
      -- TODO: alternatives. It would probably be better to replace it by Lens
      -- TODO: logic?
      case Element
el of
        Component (Decl Int
_ Int
_ [(BlackBoxTemplate, BlackBoxTemplate)]
args) ->
          ((BlackBoxTemplate, BlackBoxTemplate) -> [a])
-> [(BlackBoxTemplate, BlackBoxTemplate)] -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (\(BlackBoxTemplate
a,BlackBoxTemplate
b) -> (Element -> [a]) -> BlackBoxTemplate -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Element -> [a]
go BlackBoxTemplate
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (Element -> [a]) -> BlackBoxTemplate -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Element -> [a]
go BlackBoxTemplate
b) [(BlackBoxTemplate, BlackBoxTemplate)]
args
        IndexType Element
e -> Element -> [a]
go Element
e
        FilePath Element
e -> Element -> [a]
go Element
e
        Template BlackBoxTemplate
bbname BlackBoxTemplate
source ->
          (Element -> [a]) -> BlackBoxTemplate -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Element -> [a]
go BlackBoxTemplate
bbname [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (Element -> [a]) -> BlackBoxTemplate -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Element -> [a]
go BlackBoxTemplate
source
        IF Element
b BlackBoxTemplate
esT BlackBoxTemplate
esF ->
          Element -> [a]
go Element
b [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (Element -> [a]) -> BlackBoxTemplate -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Element -> [a]
go BlackBoxTemplate
esT [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (Element -> [a]) -> BlackBoxTemplate -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Element -> [a]
go BlackBoxTemplate
esF
        SigD BlackBoxTemplate
es Maybe Int
_ -> (Element -> [a]) -> BlackBoxTemplate -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Element -> [a]
go BlackBoxTemplate
es
        BV Bool
_ BlackBoxTemplate
es Element
_ -> (Element -> [a]) -> BlackBoxTemplate -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Element -> [a]
go BlackBoxTemplate
es
        GenSym BlackBoxTemplate
es Int
_ -> (Element -> [a]) -> BlackBoxTemplate -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Element -> [a]
go BlackBoxTemplate
es
        DevNull BlackBoxTemplate
es -> (Element -> [a]) -> BlackBoxTemplate -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Element -> [a]
go BlackBoxTemplate
es
        Text Text
_ -> []
        Result Bool
_ -> []
        Arg Bool
_ Int
_ -> []
        ArgGen Int
_ Int
_ -> []
        Const Int
_ -> []
        Lit Int
_ -> []
        Name Int
_ -> []
        ToVar BlackBoxTemplate
es Int
_ -> (Element -> [a]) -> BlackBoxTemplate -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Element -> [a]
go BlackBoxTemplate
es
        Sym Text
_ Int
_ -> []
        Typ Maybe Int
_ -> []
        TypM Maybe Int
_ -> []
        Err Maybe Int
_ -> []
        TypElem Element
e -> Element -> [a]
go Element
e
        Element
CompName -> []
        IncludeName Int
_ -> []
        Size Element
e -> Element -> [a]
go Element
e
        Length Element
e -> Element -> [a]
go Element
e
        Depth Element
e -> Element -> [a]
go Element
e
        MaxIndex Element
e -> Element -> [a]
go Element
e
        Gen Bool
_ -> []
        And BlackBoxTemplate
es -> (Element -> [a]) -> BlackBoxTemplate -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Element -> [a]
go BlackBoxTemplate
es
        CmpLE Element
e1 Element
e2 -> Element -> [a]
go Element
e1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Element -> [a]
go Element
e2
        Element
IW64 -> []
        HdlSyn HdlSyn
_ -> []
        Sel Element
e Int
_ -> Element -> [a]
go Element
e
        IsLit Int
_ -> []
        IsVar Int
_ -> []
        Tag Int
_ -> []
        Period Int
_ -> []
        ActiveEdge ActiveEdge
_ Int
_ -> []
        IsSync Int
_ -> []
        IsInitDefined Int
_ -> []
        IsActiveHigh Int
_ -> []
        IsActiveEnable Int
_ -> []
        StrCmp BlackBoxTemplate
es Int
_ -> (Element -> [a]) -> BlackBoxTemplate -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Element -> [a]
go BlackBoxTemplate
es
        OutputWireReg Int
_ -> []
        Vars Int
_ -> []
        Repeat BlackBoxTemplate
es1 BlackBoxTemplate
es2 ->
          (Element -> [a]) -> BlackBoxTemplate -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Element -> [a]
go BlackBoxTemplate
es1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (Element -> [a]) -> BlackBoxTemplate -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Element -> [a]
go BlackBoxTemplate
es2
        Element
CtxName -> []

-- | Determine variables used in an expression. Used for VHDL sensitivity list.
-- Also see: https://github.com/clash-lang/clash-compiler/issues/365
usedVariables :: Expr -> [Identifier]
usedVariables :: Expr -> [Identifier]
usedVariables Expr
Noop              = []
usedVariables (Identifier Identifier
i Maybe Modifier
_)  = [Identifier
i]
usedVariables (DataCon HWType
_ Modifier
_ [Expr]
es)  = (Expr -> [Identifier]) -> [Expr] -> [Identifier]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Expr -> [Identifier]
usedVariables [Expr]
es
usedVariables (DataTag HWType
_ Either Identifier Identifier
e')    = [(Identifier -> Identifier)
-> (Identifier -> Identifier)
-> Either Identifier Identifier
-> Identifier
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Identifier -> Identifier
forall a. a -> a
id Identifier -> Identifier
forall a. a -> a
id Either Identifier Identifier
e']
usedVariables (Literal {})      = []
usedVariables (ConvBV Maybe Identifier
_ HWType
_ Bool
_ Expr
e') = Expr -> [Identifier]
usedVariables Expr
e'
usedVariables (IfThenElse Expr
e1 Expr
e2 Expr
e3) = (Expr -> [Identifier]) -> [Expr] -> [Identifier]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Expr -> [Identifier]
usedVariables [Expr
e1,Expr
e2,Expr
e3]
usedVariables (BlackBoxE Identifier
_ [BlackBoxTemplate]
_ [BlackBoxTemplate]
_ [((Identifier, Identifier), BlackBox)]
_ BlackBox
t BlackBoxContext
bb Bool
_) = [Identifier] -> [Identifier]
forall a. Eq a => [a] -> [a]
nub ([Identifier]
sList [Identifier] -> [Identifier] -> [Identifier]
forall a. [a] -> [a] -> [a]
++ [Identifier]
sList')
  where
    matchArg :: Element -> Maybe Int
matchArg (Arg Bool
_ Int
i) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
    matchArg Element
_         = Maybe Int
forall a. Maybe a
Nothing

    matchVar :: Element -> Maybe Identifier
matchVar (ToVar [Text Text
v] Int
_) = Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just (Text -> Identifier
Text.toStrict Text
v)
    matchVar Element
_                  = Maybe Identifier
forall a. Maybe a
Nothing

    t' :: BlackBoxTemplate
t'     = (BlackBoxTemplate -> BlackBoxTemplate)
-> (String -> Int -> TemplateFunction -> BlackBoxTemplate)
-> BlackBox
-> BlackBoxTemplate
forall r.
(BlackBoxTemplate -> r)
-> (String -> Int -> TemplateFunction -> r) -> BlackBox -> r
onBlackBox BlackBoxTemplate -> BlackBoxTemplate
forall a. a -> a
id (\String
_ Int
_ TemplateFunction
_ -> []) BlackBox
t
    usedIs :: [(Expr, HWType, Bool)]
usedIs = (Int -> Maybe (Expr, HWType, Bool))
-> [Int] -> [(Expr, HWType, Bool)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([(Expr, HWType, Bool)] -> Int -> Maybe (Expr, HWType, Bool)
forall a. [a] -> Int -> Maybe a
indexMaybe (BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bb)) ((Element -> [Int]) -> BlackBoxTemplate -> [Int]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap ((Element -> Maybe Int) -> Element -> [Int]
forall a. (Element -> Maybe a) -> Element -> [a]
walkElement Element -> Maybe Int
matchArg) BlackBoxTemplate
t')
    sList :: [Identifier]
sList  = ((Expr, HWType, Bool) -> [Identifier])
-> [(Expr, HWType, Bool)] -> [Identifier]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (\(Expr
e,HWType
_,Bool
_) -> Expr -> [Identifier]
usedVariables Expr
e) [(Expr, HWType, Bool)]
usedIs
    sList' :: [Identifier]
sList' = (Element -> [Identifier]) -> BlackBoxTemplate -> [Identifier]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap ((Element -> Maybe Identifier) -> Element -> [Identifier]
forall a. (Element -> Maybe a) -> Element -> [a]
walkElement Element -> Maybe Identifier
matchVar) BlackBoxTemplate
t'

-- | Collect arguments (e.g., ~ARG, ~LIT) used in this blackbox
getUsedArguments :: N.BlackBox -> [Int]
getUsedArguments :: BlackBox -> [Int]
getUsedArguments (N.BBFunction String
_nm Int
_hsh (N.TemplateFunction [Int]
k BlackBoxContext -> Bool
_ forall s. Backend s => BlackBoxContext -> State s Doc
_)) = [Int]
k
getUsedArguments (N.BBTemplate BlackBoxTemplate
t) = [Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub ((Element -> [Int]) -> BlackBoxTemplate -> [Int]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap ((Element -> Maybe Int) -> Element -> [Int]
forall a. (Element -> Maybe a) -> Element -> [a]
walkElement Element -> Maybe Int
matchArg) BlackBoxTemplate
t)
  where
    matchArg :: Element -> Maybe Int
matchArg =
      \case
        Arg Bool
_ Int
i -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        Component (Decl Int
i Int
_ [(BlackBoxTemplate, BlackBoxTemplate)]
_) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        Const Int
i -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        IsLit Int
i -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        IsActiveEnable Int
i -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        Lit Int
i -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        Name Int
i -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        ToVar BlackBoxTemplate
_ Int
i -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i

        -- Domain properties (only need type):
        IsInitDefined Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        ActiveEdge ActiveEdge
_ Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        IsSync Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        Period Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        Tag Int
_ -> Maybe Int
forall a. Maybe a
Nothing

        -- Others. Template tags only using types of arguments can be considered
        -- "not used".
        And BlackBoxTemplate
_ -> Maybe Int
forall a. Maybe a
Nothing
        ArgGen Int
_ Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        BV Bool
_ BlackBoxTemplate
_ Element
_ -> Maybe Int
forall a. Maybe a
Nothing
        CmpLE Element
_ Element
_ -> Maybe Int
forall a. Maybe a
Nothing
        Element
CompName -> Maybe Int
forall a. Maybe a
Nothing
        Depth Element
_ -> Maybe Int
forall a. Maybe a
Nothing
        DevNull BlackBoxTemplate
_ -> Maybe Int
forall a. Maybe a
Nothing
        Err Maybe Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        FilePath Element
_ -> Maybe Int
forall a. Maybe a
Nothing
        Gen Bool
_ -> Maybe Int
forall a. Maybe a
Nothing
        GenSym BlackBoxTemplate
_ Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        HdlSyn HdlSyn
_ -> Maybe Int
forall a. Maybe a
Nothing
        IF Element
_ BlackBoxTemplate
_ BlackBoxTemplate
_ -> Maybe Int
forall a. Maybe a
Nothing
        IncludeName Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        IndexType Element
_ -> Maybe Int
forall a. Maybe a
Nothing
        IsActiveHigh Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        IsVar Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        Element
IW64 -> Maybe Int
forall a. Maybe a
Nothing
        Length Element
_ -> Maybe Int
forall a. Maybe a
Nothing
        MaxIndex Element
_ -> Maybe Int
forall a. Maybe a
Nothing
        OutputWireReg Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        Repeat BlackBoxTemplate
_ BlackBoxTemplate
_ -> Maybe Int
forall a. Maybe a
Nothing
        Result Bool
_ -> Maybe Int
forall a. Maybe a
Nothing
        Sel Element
_ Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        SigD BlackBoxTemplate
_ Maybe Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        Size Element
_ -> Maybe Int
forall a. Maybe a
Nothing
        StrCmp BlackBoxTemplate
_ Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        Sym Text
_ Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        Template BlackBoxTemplate
_ BlackBoxTemplate
_ -> Maybe Int
forall a. Maybe a
Nothing
        Text Text
_ -> Maybe Int
forall a. Maybe a
Nothing
        Typ Maybe Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        TypElem Element
_ -> Maybe Int
forall a. Maybe a
Nothing
        TypM Maybe Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        Vars Int
_ -> Maybe Int
forall a. Maybe a
Nothing
        Element
CtxName -> Maybe Int
forall a. Maybe a
Nothing

onBlackBox
  :: (BlackBoxTemplate -> r)
  -> (N.BBName -> N.BBHash -> N.TemplateFunction -> r)
  -> N.BlackBox
  -> r
onBlackBox :: (BlackBoxTemplate -> r)
-> (String -> Int -> TemplateFunction -> r) -> BlackBox -> r
onBlackBox BlackBoxTemplate -> r
f String -> Int -> TemplateFunction -> r
_ (N.BBTemplate BlackBoxTemplate
t) = BlackBoxTemplate -> r
f BlackBoxTemplate
t
onBlackBox BlackBoxTemplate -> r
_ String -> Int -> TemplateFunction -> r
g (N.BBFunction String
n Int
h TemplateFunction
t) = String -> Int -> TemplateFunction -> r
g String
n Int
h TemplateFunction
t