{-|
  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)
#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 _ n :: Int
n       -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Lit n :: Int
n         -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Const n :: Int
n       -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Name n :: Int
n        -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Typ (Just n :: Int
n)  -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  TypM (Just n :: Int
n) -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Err (Just n :: Int
n)  -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  _             -> 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 bbCtx :: BlackBoxContext
bbCtx (N.BBFunction _ _ (N.TemplateFunction _ f :: BlackBoxContext -> Bool
f _)) =
  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 ("Template function for returned False")
verifyBlackBoxContext bbCtx :: BlackBoxContext
bbCtx (N.BBTemplate t :: 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 (\(x :: b
x, y :: b
y) -> [b
x, b
y])

    verify' :: Element -> Maybe (Maybe String)
verify' e :: 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 n :: 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 (inp :: Expr
inp, HWType -> Bool
isVoid -> Bool
False, False) ->
              String -> Maybe String
forall a. a -> Maybe a
Just ( "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]
++ " should be literal, as blackbox "
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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]
++ "], but was:\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr -> String
forall a. Show a => a -> String
show Expr
inp)
            _ -> Maybe String
forall a. Maybe a
Nothing
        Const n :: 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 (inp :: Expr
inp, HWType -> Bool
isVoid -> Bool
False, False) ->
              String -> Maybe String
forall a. a -> Maybe a
Just ( "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]
++ " should be literal, as blackbox "
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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]
++ "], but was:\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr -> String
forall a. Show a => a -> String
show Expr
inp)
            _ -> Maybe String
forall a. Maybe a
Nothing
        Component (Decl n :: Int
n subn :: Int
subn l' :: [(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 funcs :: [(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
                Nothing ->
                  String -> Maybe String
forall a. a -> Maybe a
Just ( "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
+1)
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ " 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]
++ " but "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 _ ->
                  [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')
            Nothing ->
              String -> Maybe String
forall a. a -> Maybe a
Just ( "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]
++ ", but BlackBoxContext did not contain one.")
        _ ->
          case Element -> Maybe Int
inputHole Element
e of
            Nothing ->
              Maybe String
forall a. Maybe a
Nothing
            Just n :: 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 _ -> Maybe String
forall a. Maybe a
Nothing
                Nothing ->
                  String -> Maybe String
forall a. a -> Maybe a
Just ( "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
+1)
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ " 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]
++ " 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 (e :: Expr
e,_,_) -> 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 (_,_,b :: 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 mkUniqueIdentifierM :: IdType -> Identifier -> m Identifier
mkUniqueIdentifierM bbCtx :: BlackBoxContext
bbCtx l :: BlackBoxTemplate
l = do
    (a :: BlackBoxTemplate
a,(_,decls :: 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' e :: Element
e = case Element
e of
      ToVar nm :: BlackBoxTemplate
nm i :: 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 nm' :: Identifier
nm' Nothing,_,_) ->
          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)

        (e' :: Expr
e',hwTy :: HWType
hwTy,_) -> 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
            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 "c$"Element -> BlackBoxTemplate -> BlackBoxTemplate
forall a. a -> [a] -> [a]
:BlackBoxTemplate
nm))))
              let decls :: [Declaration]
decls = case HWType -> Int
typeSize HWType
hwTy of
                    0 -> []
                    _ -> [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 (nm' :: Identifier
nm',_) -> 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 _ i :: 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
          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 "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 t :: 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 t :: BlackBoxTemplate
t i :: 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
          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 _ ->
            String
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
forall a. HasCallStack => String -> a
error ("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]
++ " is already defined in BlackBox for: "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bbnm)
      Component (Decl n :: Int
n subN :: Int
subN l' :: [(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 c :: Element
c t :: BlackBoxTemplate
t f :: 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 e' :: BlackBoxTemplate
e' m :: 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 t :: Bool
t e' :: BlackBoxTemplate
e' m :: 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
-> 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 t :: Text
t -> Text
t
        Name i :: Int
i ->
          case BlackBoxContext -> Element -> Either String Text
elementToText BlackBoxContext
bbCtx (Int -> Element
Name Int
i) of
            Right t :: Text
t -> Text
t
            Left msg :: String
msg ->
              String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++  "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
forall a. [a] -> [a] -> [a]
++ " to string:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n\nError occured while "
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ "processing blackbox for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bbnm
        Lit i :: Int
i ->
          case BlackBoxContext -> Element -> Either String Text
elementToText BlackBoxContext
bbCtx (Int -> Element
Lit Int
i) of
            Right t :: Text
t -> Text
t
            Left msg :: String
msg ->
              String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++  "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
forall a. [a] -> [a] -> [a]
++ " to string:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n\nError occured while "
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ "processing blackbox for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bbnm
        Result _ | Identifier t :: Identifier
t _ <- (Expr, HWType) -> Expr
forall a b. (a, b) -> a
fst (BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
bbCtx) -> Identifier -> Text
Text.fromStrict Identifier
t
        CompName -> Identifier -> Text
Text.fromStrict (BlackBoxContext -> Identifier
bbCompName BlackBoxContext
bbCtx)
        CtxName ->
          case BlackBoxContext -> Maybe Identifier
bbCtxName BlackBoxContext
bbCtx of
            Just nm :: Identifier
nm -> Identifier -> Text
Text.fromStrict Identifier
nm
            _ | Identifier t :: Identifier
t _ <- (Expr, HWType) -> Expr
forall a b. (a, b) -> a
fst (BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
bbCtx) -> Identifier -> Text
Text.fromStrict Identifier
t
            _ -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Internal error when processing blackbox "
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ "for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bbnm
        _ -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Unexpected element in GENSYM when processing "
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 as :: t String
as a :: 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]
++ "_"))
  | Bool
otherwise = String
a

renderFilePath :: [(String,FilePath)] -> String -> ([(String,FilePath)],String)
renderFilePath :: [(String, String)] -> String -> ([(String, String)], String)
renderFilePath fs :: [(String, String)]
fs f :: 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 bbCtx :: BlackBoxContext
bbCtx l :: 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 (\col :: 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 libs :: [BlackBoxTemplate]
libs imps :: [BlackBoxTemplate]
imps includes :: [((Identifier, Identifier), BlackBox)]
includes bb :: BlackBox
bb bbCtx :: 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 (\_ i :: Int
i -> "~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
<> "]")
                     [((Identifier, Identifier), BlackBox)]
includes
                     [(0 :: Int)..]
      layout :: LayoutOptions
layout = PageWidth -> LayoutOptions
LayoutOptions (Int -> Double -> PageWidth
AvailablePerLine 120 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
$ \((nm :: Identifier
nm,_),inc :: 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')
                               (\_name :: String
_name _hash :: Int
_hash (N.TemplateFunction _ _ f :: 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 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 ("%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` 4) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 bt :: 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 (\col :: Int
col -> let t1 :: Text
t1 = Int -> Text
t (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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
-2) (Text -> Doc
forall a ann. Pretty a => a -> Doc ann
PP.pretty Text
t1))
        N.BBFunction _ _ (N.TemplateFunction _ _ bf :: 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 (\_ -> 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
$ 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)
                            (\_name :: String
_name _hash :: Int
_hash (N.TemplateFunction _ _ f :: 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
$ 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
$ 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 (\nm' :: Text
nm' ((_, ext :: Identifier
ext), _) inc :: 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 b :: BlackBoxContext
b (Component (Decl n :: Int
n subN :: Int
subN (l :: (BlackBoxTemplate, BlackBoxTemplate)
l:ls :: [(BlackBoxTemplate, BlackBoxTemplate)]
ls))) = do
  (o :: Expr
o,oTy :: HWType
oTy,_) <- (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 [ "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
+1 ), " 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 (templ0 :: Either BlackBox (Identifier, [Declaration])
templ0,_,libs :: [BlackBoxTemplate]
libs,imps :: [BlackBoxTemplate]
imps,inc :: [((Identifier, Identifier), BlackBox)]
inc,pCtx :: 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 120 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 t :: BlackBox
t ->
        BlackBox -> StateT backend Identity BlackBox
forall (m :: Type -> Type) a. Monad m => a -> m a
return BlackBox
t
      Right (nm0 :: Identifier
nm0,ds :: [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 templ2 :: BlackBoxTemplate
templ2 -> do
        (templ3 :: BlackBoxTemplate
templ3, templDecls :: [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)
          _ -> do
            Identifier
nm1 <- IdType -> Identifier -> State backend Identifier
forall s. Backend s => IdType -> Identifier -> State s Identifier
Backend.mkUniqueIdentifier IdType
Basic "bb"
            Identifier
nm2 <- IdType -> Identifier -> State backend Identifier
forall s. Backend s => IdType -> Identifier -> State s Identifier
Backend.mkUniqueIdentifier IdType
Basic "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
    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 err0 :: 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 [ "Couldn't instantiate blackbox for "
                        , Identifier -> String
Data.Text.unpack (BlackBoxContext -> Identifier
bbName BlackBoxContext
b), ". Verification procedure "
                        , "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 ($(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err1) Maybe String
forall a. Maybe a
Nothing)

renderElem b :: BlackBoxContext
b (SigD e :: BlackBoxTemplate
e m :: 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
$ 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
             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 n :: Int
n  -> let (_,ty' :: HWType
ty',_) = 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 b :: BlackBoxContext
b (Period n :: Int
n) = do
  let (_, ty :: HWType
ty, _) = 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 _ period :: Integer
period _ _ _ _ ->
      (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
    _ ->
      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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 b :: BlackBoxContext
b (Tag n :: Int
n) = do
  let (_, ty :: HWType
ty, _) = 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 dom :: 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)))
    Reset dom :: 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 dom :: 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)))
    _ ->
      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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 b :: BlackBoxContext
b (IF c :: Element
c t :: BlackBoxTemplate
t f :: 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
> 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 iw :: t
iw syn :: HdlSyn
syn c' :: Element
c' = case Element
c' of
      (Size e :: Element
e)   -> HWType -> Int
typeSize (BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
e])
      (Length e :: Element
e) -> case BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
e] of
                       (Vector n :: Int
n _)             -> Int
n
                       Void (Just (Vector n :: Int
n _)) -> Int
n
                       _                        -> 0 -- HACK: So we can test in splitAt if one of the
                              -- vectors in the tuple had a zero length
      (Lit n :: 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
        (l :: Expr
l,_,_)
          | Literal _ l' :: Literal
l' <- Expr
l ->
            case Literal
l' of
              NumLit i :: Integer
i -> Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
              BitLit bl :: Bit
bl -> case Bit
bl of
                N.H -> 1
                N.L -> 0
                _   -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "IF: LIT bit literal must be high or low"
              BoolLit bl :: Bool
bl -> Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool 0 1 Bool
bl
              _ -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "IF: LIT must be a numeric lit"
          | DataCon (Signed _) _ [Literal _ (NumLit i :: Integer
i)] <- Expr
l
            -> Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
          | DataCon (Unsigned _) _ [Literal _ (NumLit i :: Integer
i)] <- Expr
l
            -> Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
        k :: (Expr, HWType, Bool)
k -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ("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 e :: Element
e)  -> case BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
e] of
                      (RTree n :: Int
n _) -> Int
n
                      _ -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "IF: treedepth of non-tree type"
      IW64       -> if t
iw t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== 64 then 1 else 0
      (HdlSyn s :: HdlSyn
s) -> if HdlSyn
s HdlSyn -> HdlSyn -> Bool
forall a. Eq a => a -> a -> Bool
== HdlSyn
syn then 1 else 0
      (IsVar n :: Int
n)  -> let (e :: Expr
e,_,_) = 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 _ Nothing -> 1
                      _                    -> 0
      (IsLit n :: Int
n)  -> let (e :: Expr
e,_,_) = 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 {}   -> 1
                      Literal {}   -> 1
                      BlackBoxE {} -> 1
                      _            -> 0

      (IsActiveEnable n :: Int
n) ->
        let (e :: Expr
e, ty :: HWType
ty, _) = 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 Nothing (BoolLit True), Bool)  -> 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 Nothing (BoolLit False), Bool) -> 1
          (_, Bool)                               -> 1
          _ ->
            String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "IsActiveEnable: Expected Bool, not: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HWType -> String
forall a. Show a => a -> String
show HWType
ty

      (ActiveEdge edgeRequested :: ActiveEdge
edgeRequested n :: Int
n) ->
        let (_, ty :: HWType
ty, _) = 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 _ _ edgeActual :: ActiveEdge
edgeActual _ _ _ ->
            if ActiveEdge
edgeRequested ActiveEdge -> ActiveEdge -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveEdge
edgeActual then 1 else 0
          _ ->
            String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 n :: Int
n) ->
        let (_, ty :: HWType
ty, _) = 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 _ _ _ Synchronous _ _ -> 1
          KnownDomain _ _ _ Asynchronous _ _ -> 0
          _ -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 n :: Int
n) ->
        let (_, ty :: HWType
ty, _) = 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 _ _ _ _ Defined _ -> 1
          KnownDomain _ _ _ _ Unknown _ -> 0
          _ -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 n :: Int
n) ->
        let (_, ty :: HWType
ty, _) = 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 _ _ _ _ _ ActiveHigh -> 1
          KnownDomain _ _ _ _ _ ActiveLow -> 0
          _ -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 t1 :: Text
t1] n :: Int
n) ->
        let (e :: Expr
e,_,_) = 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 t2 :: String
t2
                | Text
t1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
Text.pack String
t2 -> 1
                | Bool
otherwise -> 0
              Nothing -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Expected a string literal: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr -> String
forall a. Show a => a -> String
show Expr
e
      (And es :: 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
/=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 1
                       else 0
      CmpLE e1 :: Element
e1 e2 :: 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 1
                        else 0
      _ -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "IF: condition must be: SIZE, LENGTH, IW64, LIT, ISLIT, or ISARG"

renderElem b :: BlackBoxContext
b e :: 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 t :: Text
t = case Text -> Result BlackBoxTemplate
runParse Text
t of
  Failure errInfo :: 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 templ :: BlackBoxTemplate
templ -> BlackBoxTemplate
templ

idToExpr
  :: (Text,HWType)
  -> (Expr,HWType,Bool)
idToExpr :: (Text, HWType) -> (Expr, HWType, Bool)
idToExpr (t :: Text
t,ty :: 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 b :: 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 (\e :: Element
e a :: 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 b :: BlackBoxContext
b [(Typ 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 b :: BlackBoxContext
b [(Typ (Just n :: Int
n))] = let (_,ty :: HWType
ty,_) = 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 b :: BlackBoxContext
b [(TypElem t :: Element
t)]    = case BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
t] of
                                  Vector _ elTy :: HWType
elTy -> HWType
elTy
                                  _ -> String -> HWType
forall a. HasCallStack => String -> a
error (String -> HWType) -> String -> HWType
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "Element type selection of a non-vector type"
lineToType b :: BlackBoxContext
b [(IndexType (Lit n :: 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 _ (NumLit n' :: Integer
n'),_,_) -> Integer -> HWType
Index (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
n')
    x :: (Expr, HWType, Bool)
x -> String -> HWType
forall a. HasCallStack => String -> a
error (String -> HWType) -> String -> HWType
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 _ _ = String -> HWType
forall a. HasCallStack => String -> a
error (String -> HWType) -> String -> HWType
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 _ (Text t :: Text
t)        = Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
t
renderTag b :: BlackBoxContext
b (Result esc :: 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 b :: BlackBoxContext
b (Arg esc :: Bool
esc n :: Int
n)  = do
  let (e :: Expr
e,_,_) = 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 b :: BlackBoxContext
b (Const n :: Int
n)  = do
  let (e :: Expr
e,_,_) = 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 b :: BlackBoxContext
b t :: Element
t@(ArgGen k :: Int
k n :: Int
n)
  | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== BlackBoxContext -> Int
bbLevel BlackBoxContext
b
  , let (e :: Expr
e,_,_) = 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 b :: BlackBoxContext
b (Lit n :: 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
  (e :: Expr
e,_,_) = 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 _,_)) i :: Literal
i)                                 = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
i
  mkLit (Literal (Just (Unsigned _,_)) i :: Literal
i)                               = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
i
  mkLit (DataCon _ (DC (Void {}, _)) [Literal (Just (Signed _,_)) i :: Literal
i])   = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
i
  mkLit (DataCon _ (DC (Void {}, _)) [Literal (Just (Unsigned _,_)) i :: Literal
i]) = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
i
  mkLit i :: Expr
i                                                               = Expr
i

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

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

renderTag b :: BlackBoxContext
b (BV True es :: BlackBoxTemplate
es e :: 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
$ 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 b :: BlackBoxContext
b (BV False es :: BlackBoxTemplate
es e :: 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
$ 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 b :: BlackBoxContext
b (Sel e :: Element
e n :: 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 b :: BlackBoxContext
b (Typ 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 b :: BlackBoxContext
b (Typ (Just n :: Int
n))  = let (_,ty :: HWType
ty,_) = 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 b :: BlackBoxContext
b (TypM 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 b :: BlackBoxContext
b (TypM (Just n :: Int
n)) = let (_,ty :: HWType
ty,_) = 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 b :: BlackBoxContext
b (Err 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 b :: BlackBoxContext
b (Err (Just n :: Int
n))  = let (_,ty :: HWType
ty,_) = 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 b :: BlackBoxContext
b (Size e :: 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 b :: BlackBoxContext
b (Length e :: 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 n :: Int
n _)               = Int
n
    vecLen (Void (Just (Vector n :: Int
n _))) = Int
n
    vecLen thing :: HWType
thing =
      String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 b :: BlackBoxContext
b (Depth e :: 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 n :: Int
n _)               = Int
n
    treeDepth (Void (Just (RTree n :: Int
n _))) = Int
n
    treeDepth thing :: HWType
thing =
      String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 b :: BlackBoxContext
b (MaxIndex e :: 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 n :: Int
n _) = Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1
    vecLen thing :: HWType
thing =
      String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 b :: BlackBoxContext
b e :: Element
e@(TypElem _)   = 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 _ (Gen b :: 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 _ (GenSym [Text t :: Text
t] _) = Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
t

-- Determine variables used in argument /n/.
renderTag b :: BlackBoxContext
b (Vars 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
vars'
  where
    (e :: Expr
e, _, _) = 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 ',') [Text]
vars)

renderTag b :: BlackBoxContext
b (IndexType (Lit n :: 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 _ (NumLit n' :: Integer
n'),_,_) ->
      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))
    x :: (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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 b :: BlackBoxContext
b (FilePath e :: Element
e)    = case Element
e of
  Lit n :: Int
n -> do
    let (e' :: Expr
e',_,_) = 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 s :: 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'))
      _ -> 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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]
++  "does not reduce to a string"
  _ -> 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "~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 b :: BlackBoxContext
b (IncludeName n :: Int
n) = case [Identifier] -> Int -> Maybe Identifier
forall a. [a] -> Int -> Maybe a
indexMaybe (BlackBoxContext -> [Identifier]
bbQsysIncName BlackBoxContext
b) Int
n of
  Just nm :: Identifier
nm -> Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Identifier -> Text
Text.fromStrict Identifier
nm)
  _ -> 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "~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]
++ "] does not correspond to any index of the 'includes' field that is specified in the primitive definition"
renderTag b :: BlackBoxContext
b (OutputWireReg n :: 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 ((_,rw :: WireOrReg
rw,_,_,_,_):_) -> case WireOrReg
rw of {N.Wire -> Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return "wire"; N.Reg -> Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return "reg"}
  _ -> 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "~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]
++ "] 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]
++ " is not a function"
renderTag b :: BlackBoxContext
b (Repeat [es :: Element
es] [i :: 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 msg :: String
msg -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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]
++ ". read reported: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ "."
              Right n :: 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 b :: BlackBoxContext
b (DevNull es :: 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 b :: BlackBoxContext
b (Template filenameL :: BlackBoxTemplate
filenameL sourceL :: BlackBoxTemplate
sourceL) = case Either String (String, String)
file of
  Left msg :: 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [ "Name or source in ~TEMPLATE construct"
                                   , "did not reduce to a string."
                                   , "'elementToText' reported:"
                                   , String
msg ]
  Right fstup :: (String, String)
fstup@(filename :: String
filename, _source :: 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [ "Multiple ~TEMPLATE constructs"
                                           , "specifiy the same filename"
                                           , "but different contents. Make"
                                           , "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 "")
      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 "")

  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 b :: BlackBoxContext
b 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 b :: BlackBoxContext
b CtxName = case BlackBoxContext -> Maybe Identifier
bbCtxName BlackBoxContext
b of
  Just nm :: Identifier
nm -> Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Identifier -> Text
Text.fromStrict Identifier
nm)
  _ | Identifier t :: Identifier
t _ <- (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)
  _ -> String -> State backend Text
forall a. HasCallStack => String -> a
error "internal error"


renderTag _ e :: 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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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 bbCtx :: BlackBoxContext
bbCtx elements :: 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 (\txt :: Either String Text
txt el :: Element
el -> case Either String Text
txt of
                          -- Append new string (if no error) to string so far
                          Right s :: 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.
                          msg :: 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 "") BlackBoxTemplate
elements

elementToText
    :: BlackBoxContext
    -> Element
    -> Either String Text
elementToText :: BlackBoxContext -> Element -> Either String Text
elementToText bbCtx :: BlackBoxContext
bbCtx  (Name n :: Int
n) = BlackBoxContext -> Element -> Either String Text
elementToText BlackBoxContext
bbCtx (Int -> Element
Lit Int
n)
elementToText _bbCtx :: BlackBoxContext
_bbCtx (Text t :: 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 bbCtx :: BlackBoxContext
bbCtx  (Lit n :: 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 (e :: Expr
e,_,_) ->
            case Expr -> Maybe String
exprToString Expr
e of
                Just t :: 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
                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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [ "Could not extract string from"
                                                , Expr -> String
forall a. Show a => a -> String
show Expr
e, "referred to by"
                                                , Element -> String
forall a. Show a => a -> String
show (Int -> Element
Lit Int
n) ]
        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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [ "Invalid literal", Element -> String
forall a. Show a => a -> String
show (Int -> Element
Lit Int
n)
                                        , "used in blackbox with context:"
                                        , BlackBoxContext -> String
forall a. Show a => a -> String
show BlackBoxContext
bbCtx, "." ]

elementToText _bbCtx :: BlackBoxContext
_bbCtx e :: 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
$ "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 _ (NumLit i :: Integer
i)) = String -> Maybe String
forall a. a -> Maybe a
Just (Integer -> String
forall a. Show a => a -> String
show Integer
i)
exprToString (Literal _ (StringLit l :: String
l)) = String -> Maybe String
forall a. a -> Maybe a
Just String
l
exprToString (BlackBoxE "Clash.Promoted.Symbol.SSymbol" _ _ _ _ ctx :: BlackBoxContext
ctx _) =
  let (e' :: Expr
e',_,_) = [(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 "GHC.CString.unpackCString#" _ _ _ _ ctx :: BlackBoxContext
ctx _) =
  let (e' :: Expr
e',_,_) = [(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 _ = Maybe String
forall a. Maybe a
Nothing

prettyBlackBox :: Monad m
               => BlackBoxTemplate
               -> Mon m Text
prettyBlackBox :: BlackBoxTemplate -> Mon m Text
prettyBlackBox bbT :: 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 t :: Text
t) = Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
t
prettyElem (Component (Decl i :: Int
i 0 args :: [(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 (\(a :: BlackBoxTemplate
a,b :: 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 2 (Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string "~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 "~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 "=>" 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 "~" 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 (\(a :: Text
a,b :: Text
b) -> Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string "~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 "=>" 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)]
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 "~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
$ $(curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "prettyElem can't (yet) render ~INST when subfuncion /= 0!"
prettyElem (Result b :: Bool
b) = if Bool
b then Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return "~ERESULT" else Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return "~RESULT"
prettyElem (Arg b :: Bool
b i :: 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 "~EARG" else Text -> Mon m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string "~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 i :: 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 "~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 i :: 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 "~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 i :: 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 "~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 es :: BlackBoxTemplate
es i :: 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 "~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 _ i :: 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 "~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 Nothing) = Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return "~TYPO"
prettyElem (Typ (Just i :: 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 "~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 Nothing) = Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return "~TYPMO"
prettyElem (TypM (Just i :: 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 "~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 Nothing) = Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return "~ERRORO"
prettyElem (Err (Just i :: 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 "~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 e :: 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 "~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 CompName = Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return "~COMPNAME"
prettyElem (IncludeName i :: 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
<$> ("~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 e :: 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 "~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 e :: 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 "~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 e :: 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 "~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 e :: 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 "~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 e :: 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 "~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 e :: 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 "~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 b :: Bool
b) = if Bool
b then Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return "~GENERATE" else Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return "~ENDGENERATE"
prettyElem (IF b :: Element
b esT :: BlackBoxTemplate
esT esF :: 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 "~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 "~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 "~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 "~FI")
prettyElem (And es :: 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 "~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 e1 :: Element
e1 e2 :: 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 "~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 IW64 = Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return "~IW64"
prettyElem (HdlSyn s :: HdlSyn
s) = case HdlSyn
s of
  Vivado -> Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return "~VIVADO"
  _      -> Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return "~OTHERSYN"
prettyElem (BV b :: Bool
b es :: BlackBoxTemplate
es e :: 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 "~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 "~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 e :: Element
e i :: 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 "~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 i :: 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 "~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 i :: 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 "~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 i :: 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 "~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 i :: 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 "~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 i :: 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 "~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 i :: 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 "~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 e :: ActiveEdge
e i :: 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 "~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 i :: 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 "~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 i :: 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 "~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 es :: BlackBoxTemplate
es i :: 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 "~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 es :: BlackBoxTemplate
es i :: 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 "~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 [es :: Element
es] [i :: 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 "~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 es :: BlackBoxTemplate
es i :: 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
$ $(curLoc)
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ "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]
++ " 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]
++ ". Both lists are expected to have a single element."
prettyElem (DevNull es :: 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 "~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 es :: BlackBoxTemplate
es mI :: 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 "~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 "~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 i :: 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 "~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 i :: 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 "~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 n :: Int
n x :: 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 "~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 bbname :: BlackBoxTemplate
bbname source :: 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 "~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 CtxName = Text -> Mon m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return "~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 f :: Element -> Maybe a
f el :: 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 _ _ args :: [(BlackBoxTemplate, BlackBoxTemplate)]
args) ->
          ((BlackBoxTemplate, BlackBoxTemplate) -> [a])
-> [(BlackBoxTemplate, BlackBoxTemplate)] -> [a]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (\(a :: BlackBoxTemplate
a,b :: 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 e :: Element
e -> Element -> [a]
go Element
e
        FilePath e :: Element
e -> Element -> [a]
go Element
e
        Template bbname :: BlackBoxTemplate
bbname source :: 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 b :: Element
b esT :: BlackBoxTemplate
esT esF :: 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 es :: 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
        BV _ es :: 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
        GenSym es :: 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
        DevNull es :: 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 _ -> []
        Result _ -> []
        Arg _ _ -> []
        ArgGen _ _ -> []
        Const _ -> []
        Lit _ -> []
        Name _ -> []
        ToVar es :: 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
        Sym _ _ -> []
        Typ _ -> []
        TypM _ -> []
        Err _ -> []
        TypElem e :: Element
e -> Element -> [a]
go Element
e
        CompName -> []
        IncludeName _ -> []
        Size e :: Element
e -> Element -> [a]
go Element
e
        Length e :: Element
e -> Element -> [a]
go Element
e
        Depth e :: Element
e -> Element -> [a]
go Element
e
        MaxIndex e :: Element
e -> Element -> [a]
go Element
e
        Gen _ -> []
        And es :: 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 e1 :: Element
e1 e2 :: Element
e2 -> Element -> [a]
go Element
e1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Element -> [a]
go Element
e2
        IW64 -> []
        HdlSyn _ -> []
        Sel e :: Element
e _ -> Element -> [a]
go Element
e
        IsLit _ -> []
        IsVar _ -> []
        Tag _ -> []
        Period _ -> []
        ActiveEdge _ _ -> []
        IsSync _ -> []
        IsInitDefined _ -> []
        IsActiveHigh _ -> []
        IsActiveEnable _ -> []
        StrCmp es :: 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
        OutputWireReg _ -> []
        Vars _ -> []
        Repeat es1 :: BlackBoxTemplate
es1 es2 :: 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
        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 Noop              = []
usedVariables (Identifier i :: Identifier
i _)  = [Identifier
i]
usedVariables (DataCon _ _ es :: [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 _ e' :: 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 _ _ _ e' :: Expr
e') = Expr -> [Identifier]
usedVariables Expr
e'
usedVariables (IfThenElse e1 :: Expr
e1 e2 :: Expr
e2 e3 :: 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 _ _ _ _ t :: BlackBox
t bb :: BlackBoxContext
bb _) = [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 _ i :: Int
i) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
    matchArg _         = Maybe Int
forall a. Maybe a
Nothing

    matchVar :: Element -> Maybe Identifier
matchVar (ToVar [Text v :: Text
v] _) = Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just (Text -> Identifier
Text.toStrict Text
v)
    matchVar _                  = 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 (\_ _ _ -> []) 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 (\(e :: Expr
e,_,_) -> 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 _nm :: String
_nm _hsh :: Int
_hsh (N.TemplateFunction k :: [Int]
k _ _)) = [Int]
k
getUsedArguments (N.BBTemplate t :: 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 _ i :: Int
i -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        Component (Decl i :: Int
i _ _) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        Const i :: Int
i -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        IsLit i :: Int
i -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        IsActiveEnable i :: Int
i -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        Lit i :: Int
i -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        Name i :: Int
i -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
        ToVar _ i :: Int
i -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i

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

        -- Others. Template tags only using types of arguments can be considered
        -- "not used".
        And _ -> Maybe Int
forall a. Maybe a
Nothing
        ArgGen _ _ -> Maybe Int
forall a. Maybe a
Nothing
        BV _ _ _ -> Maybe Int
forall a. Maybe a
Nothing
        CmpLE _ _ -> Maybe Int
forall a. Maybe a
Nothing
        CompName -> Maybe Int
forall a. Maybe a
Nothing
        Depth _ -> Maybe Int
forall a. Maybe a
Nothing
        DevNull _ -> Maybe Int
forall a. Maybe a
Nothing
        Err _ -> Maybe Int
forall a. Maybe a
Nothing
        FilePath _ -> Maybe Int
forall a. Maybe a
Nothing
        Gen _ -> Maybe Int
forall a. Maybe a
Nothing
        GenSym _ _ -> Maybe Int
forall a. Maybe a
Nothing
        HdlSyn _ -> Maybe Int
forall a. Maybe a
Nothing
        IF _ _ _ -> Maybe Int
forall a. Maybe a
Nothing
        IncludeName _ -> Maybe Int
forall a. Maybe a
Nothing
        IndexType _ -> Maybe Int
forall a. Maybe a
Nothing
        IsActiveHigh _ -> Maybe Int
forall a. Maybe a
Nothing
        IsVar _ -> Maybe Int
forall a. Maybe a
Nothing
        IW64 -> Maybe Int
forall a. Maybe a
Nothing
        Length _ -> Maybe Int
forall a. Maybe a
Nothing
        MaxIndex _ -> Maybe Int
forall a. Maybe a
Nothing
        OutputWireReg _ -> Maybe Int
forall a. Maybe a
Nothing
        Repeat _ _ -> Maybe Int
forall a. Maybe a
Nothing
        Result _ -> Maybe Int
forall a. Maybe a
Nothing
        Sel _ _ -> Maybe Int
forall a. Maybe a
Nothing
        SigD _ _ -> Maybe Int
forall a. Maybe a
Nothing
        Size _ -> Maybe Int
forall a. Maybe a
Nothing
        StrCmp _ _ -> Maybe Int
forall a. Maybe a
Nothing
        Sym _ _ -> Maybe Int
forall a. Maybe a
Nothing
        Template _ _ -> Maybe Int
forall a. Maybe a
Nothing
        Text _ -> Maybe Int
forall a. Maybe a
Nothing
        Typ _ -> Maybe Int
forall a. Maybe a
Nothing
        TypElem _ -> Maybe Int
forall a. Maybe a
Nothing
        TypM _ -> Maybe Int
forall a. Maybe a
Nothing
        Vars _ -> Maybe Int
forall a. Maybe a
Nothing
        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 f :: BlackBoxTemplate -> r
f _ (N.BBTemplate t :: BlackBoxTemplate
t) = BlackBoxTemplate -> r
f BlackBoxTemplate
t
onBlackBox _ g :: String -> Int -> TemplateFunction -> r
g (N.BBFunction n :: String
n h :: Int
h t :: TemplateFunction
t) = String -> Int -> TemplateFunction -> r
g String
n Int
h TemplateFunction
t