{-|
  Copyright  :  (C) 2012-2016, University of Twente,
                    2016-2017, Myrtle Software Ltd,
                    2021-2023, QBayLogic B.V.
                    2022     , LUMI GUIDE FIETSDETECTIE B.V.
                    2022     , Google Inc.
  License    :  BSD2 (see the file LICENSE)
  Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>

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

{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# 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, gets)
import           Data.Bitraversable              (bitraverse)
import           Data.Bool                       (bool)
import           Data.Coerce                     (coerce)
import           Data.Foldable                   (foldrM)
import           Data.Hashable                   (Hashable (..))
import qualified Data.HashMap.Strict             as HashMap
import qualified Data.IntMap                     as IntMap
import           Data.List                       (nub)
import           Data.List.Extra                 (indexMaybe)
import           Data.Maybe                      (mapMaybe, maybeToList, fromJust)
import           Data.Monoid                     (Ap(getAp))
import qualified Data.Text
import           Data.Text.Lazy                  (Text)
import qualified Data.Text.Lazy                  as Text

#if MIN_VERSION_prettyprinter(1,7,0)
import qualified Prettyprinter                   as PP
#else
import qualified Data.Text.Prettyprint.Doc       as PP
#endif

import           Data.Text.Prettyprint.Doc.Extra
import           GHC.Stack                       (HasCallStack)
import           System.FilePath                 (replaceBaseName, takeBaseName,
                                                  takeFileName, (<.>))
import           Text.Printf
import           Text.Read                       (readEither)
import           Text.Trifecta.Result            hiding (Err)

import           Clash.Backend
  (Backend (..), DomainMap, Usage (..), AggressiveXOptBB(..), RenderEnums(..))
import           Clash.Netlist.BlackBox.Parser
import           Clash.Netlist.BlackBox.Types
import           Clash.Netlist.Types
  (BlackBoxContext (..), Expr (..), HWType (..), Literal (..), Modifier (..),
   Declaration(BlackBoxD))
import qualified Clash.Netlist.Id                as Id
import qualified Clash.Netlist.Types             as N
import           Clash.Netlist.Util              (typeSize, isVoid, stripAttributes, stripVoid)
import           Clash.Signal.Internal
  (ResetKind(..), ResetPolarity(..), InitBehavior(..), VDomainConfiguration (..))
import           Clash.Util
import qualified Clash.Util.Interpolate          as I

import           Clash.Annotations.Primitive     (HDL(VHDL))

inputHole :: Element -> Maybe Int
inputHole :: Element -> Maybe Int
inputHole = \case
  Text Text
_           -> Maybe Int
forall a. Maybe a
Nothing
  Component Decl
_      -> Maybe Int
forall a. Maybe a
Nothing
  Element
Result           -> Maybe Int
forall a. Maybe a
Nothing
  Arg Int
n            -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  ArgGen Int
_ Int
n       -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Const Int
n          -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Lit Int
n            -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Name Int
n           -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  ToVar [Element]
_ Int
n        -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Sym Text
_ Int
_          -> Maybe Int
forall a. Maybe a
Nothing
  Typ Maybe Int
nM           -> Maybe Int
nM
  TypM Maybe Int
nM          -> Maybe Int
nM
  Err Maybe Int
nM           -> Maybe Int
nM
  TypElem Element
_        -> Maybe Int
forall a. Maybe a
Nothing
  Element
CompName         -> Maybe Int
forall a. Maybe a
Nothing
  IncludeName Int
_    -> Maybe Int
forall a. Maybe a
Nothing
  IndexType Element
_      -> Maybe Int
forall a. Maybe a
Nothing
  Size Element
_           -> Maybe Int
forall a. Maybe a
Nothing
  Length Element
_         -> Maybe Int
forall a. Maybe a
Nothing
  Depth Element
_          -> Maybe Int
forall a. Maybe a
Nothing
  MaxIndex Element
_       -> Maybe Int
forall a. Maybe a
Nothing
  FilePath Element
_       -> Maybe Int
forall a. Maybe a
Nothing
  Template [Element]
_ [Element]
_     -> Maybe Int
forall a. Maybe a
Nothing
  Gen Bool
_            -> Maybe Int
forall a. Maybe a
Nothing
  IF Element
_ [Element]
_ [Element]
_         -> Maybe Int
forall a. Maybe a
Nothing
  And [Element]
_            -> Maybe Int
forall a. Maybe a
Nothing
  Element
IW64             -> Maybe Int
forall a. Maybe a
Nothing
  CmpLE Element
_ Element
_        -> Maybe Int
forall a. Maybe a
Nothing
  HdlSyn HdlSyn
_         -> Maybe Int
forall a. Maybe a
Nothing
  BV Bool
_ [Element]
_ Element
_         -> Maybe Int
forall a. Maybe a
Nothing
  Sel Element
_ Int
_          -> Maybe Int
forall a. Maybe a
Nothing
  IsLit Int
n          -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  IsVar Int
n          -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  IsScalar Int
n       -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  IsActiveHigh Int
n   -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Tag Int
n            -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Period Int
n         -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Element
LongestPeriod    -> Maybe Int
forall a. Maybe a
Nothing
  ActiveEdge ActiveEdge
_ Int
n   -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  IsSync Int
n         -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  IsInitDefined Int
n  -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  IsActiveEnable Int
n -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  IsUndefined Int
n    -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  StrCmp [Element]
_ Int
n       -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  OutputUsage Int
n    -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  Vars Int
n           -> Int -> Maybe Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
n
  GenSym [Element]
_ Int
_       -> Maybe Int
forall a. Maybe a
Nothing
  Repeat [Element]
_ [Element]
_       -> Maybe Int
forall a. Maybe a
Nothing
  DevNull [Element]
_        -> Maybe Int
forall a. Maybe a
Nothing
  SigD [Element]
_ Maybe Int
nM        -> Maybe Int
nM
  Element
CtxName          -> Maybe Int
forall a. Maybe a
Nothing

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

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

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

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

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

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

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

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

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

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

renderBlackBox
  :: Backend backend
  => [BlackBoxTemplate]
  -> [BlackBoxTemplate]
  -> [((Data.Text.Text,Data.Text.Text), N.BlackBox)]
  -> N.BlackBox
  -> BlackBoxContext
  -> State backend (Int -> Doc)
renderBlackBox :: [[Element]]
-> [[Element]]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
renderBlackBox [[Element]]
libs [[Element]]
imps [((Text, Text), BlackBox)]
includes BlackBox
bb BlackBoxContext
bbCtx = do
  let nms' :: [Text]
nms' = (((Text, Text), BlackBox) -> Int -> Text)
-> [((Text, Text), BlackBox)] -> [Int] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\((Text, Text), BlackBox)
_ Int
i -> Text
"~INCLUDENAME[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")
                     [((Text, Text), BlackBox)]
includes
                     [(Int
0 :: Int)..]
      layout :: LayoutOptions
layout = PageWidth -> LayoutOptions
LayoutOptions (Int -> Double -> PageWidth
AvailablePerLine Int
120 Double
0.4)
  [Text]
nms <-
    [((Text, Text), BlackBox)]
-> (((Text, Text), 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 [((Text, Text), BlackBox)]
includes ((((Text, Text), BlackBox) -> StateT backend Identity Text)
 -> StateT backend Identity [Text])
-> (((Text, Text), BlackBox) -> StateT backend Identity Text)
-> StateT backend Identity [Text]
forall a b. (a -> b) -> a -> b
$ \((Text
nm,Text
_),BlackBox
inc) -> do
      case BlackBoxContext -> BlackBox -> Maybe String
verifyBlackBoxContext BlackBoxContext
bbCtx BlackBox
inc of
        Maybe String
Nothing -> () -> StateT backend Identity ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
        Just String
err0 -> do
          SrcSpan
sp <- State backend SrcSpan
forall state. Backend state => State state SrcSpan
getSrcSpan
          let err1 :: String
err1 = [String] -> String
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [ String
"Couldn't instantiate blackbox for "
                            , Text -> String
Data.Text.unpack (BlackBoxContext -> Text
bbName BlackBoxContext
bbCtx), String
". Verification "
                            , String
"procedure reported:\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err0 ]
          ClashException -> StateT backend Identity ()
forall a e. Exception e => e -> a
throw (SrcSpan -> String -> Maybe String -> ClashException
ClashException SrcSpan
sp ($(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err1) Maybe String
forall a. Maybe a
Nothing)
      let bbCtx' :: BlackBoxContext
bbCtx' = BlackBoxContext
bbCtx {bbQsysIncName :: [Text]
bbQsysIncName = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.toStrict [Text]
nms'}
      Int -> Text
incForHash <- ([Element] -> State backend (Int -> Text))
-> (String
    -> Int -> TemplateFunction -> State backend (Int -> Text))
-> BlackBox
-> State backend (Int -> Text)
forall r.
([Element] -> r)
-> (String -> Int -> TemplateFunction -> r) -> BlackBox -> r
onBlackBox (BlackBoxContext -> [Element] -> State backend (Int -> Text)
forall backend.
Backend backend =>
BlackBoxContext -> [Element] -> State backend (Int -> Text)
renderTemplate BlackBoxContext
bbCtx')
                               (\String
_name Int
_hash (N.TemplateFunction [Int]
_ BlackBoxContext -> Bool
_ forall s. Backend s => BlackBoxContext -> State s Doc
f) -> do
                                  Doc
t <- BlackBoxContext -> State backend Doc
forall s. Backend s => BlackBoxContext -> State s Doc
f BlackBoxContext
bbCtx'
                                  let t' :: Text
t' = SimpleDocStream () -> Text
forall ann. SimpleDocStream ann -> Text
renderLazy (LayoutOptions -> Doc -> SimpleDocStream ()
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
layout Doc
t)
                                  (Int -> Text) -> State backend (Int -> Text)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Int -> Text
forall a b. a -> b -> a
const Text
t'))
                               BlackBox
inc
      Int
iw <- State backend Int
forall state. Backend state => State state Int
iwWidth
      Identifier
topNm <- State backend Identifier
forall state. Backend state => State state Identifier
getTopName
      let incHash :: Int
incHash = Text -> Int
forall a. Hashable a => a -> Int
hash (Int -> Text
incForHash Int
0)
          nm' :: Text
nm'     = [Text] -> Text
Text.concat
                      [ Text -> Text
Text.fromStrict (Identifier -> Text
Id.toText Identifier
topNm)
                      , Text
"_"
                      , Text -> Text
Text.fromStrict Text
nm
                      , Text
"_"
                      , String -> Text
Text.pack (String -> Int -> String
forall r. PrintfType r => String -> r
printf (String
"%0" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
iw Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"X") Int
incHash)
                      ]
      Text -> StateT backend Identity Text
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Text
nm'

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

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

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

      BlackBox
templ1 <-
        case Either BlackBox (Identifier, [Declaration])
templ0 of
          Left BlackBox
t ->
            BlackBox -> StateT backend Identity BlackBox
forall (m :: Type -> Type) a. Monad m => a -> m a
return BlackBox
t
          Right (Identifier
nm0,[Declaration]
ds) -> do
            Identifier
nm1 <- Identifier -> StateT backend Identity Identifier
forall (m :: Type -> Type).
(HasCallStack, IdentifierSetMonad m) =>
Identifier -> m Identifier
Id.next Identifier
nm0
            Doc
block <- Ap (State backend) Doc -> State backend Doc
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (Identifier -> [Declaration] -> Ap (State backend) Doc
forall state.
Backend state =>
Identifier -> [Declaration] -> Ap (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 [Element]
templ2 -> do
            ([Element]
templ3, [Declaration]
templDecls) <- BlackBoxContext
-> [Element] -> StateT backend Identity ([Element], [Declaration])
forall (m :: Type -> Type).
IdentifierSetMonad m =>
BlackBoxContext -> [Element] -> m ([Element], [Declaration])
setSym BlackBoxContext
b' [Element]
templ2
            case [Declaration]
templDecls of
              [] ->
                BlackBox -> StateT backend Identity BlackBox
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Element] -> BlackBox
N.BBTemplate [Element]
templ3)
              [Declaration]
_ -> do
                Text
nm1 <- Identifier -> Text
Id.toText (Identifier -> Text)
-> StateT backend Identity Identifier
-> StateT backend Identity Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> StateT backend Identity Identifier
forall (m :: Type -> Type).
(HasCallStack, IdentifierSetMonad m) =>
Text -> m Identifier
Id.makeBasic Text
"bb"
                Identifier
nm2 <- Text -> StateT backend Identity Identifier
forall (m :: Type -> Type).
(HasCallStack, IdentifierSetMonad m) =>
Text -> m Identifier
Id.makeBasic Text
"bb"
                let bbD :: Declaration
bbD = Text
-> [[Element]]
-> [[Element]]
-> [((Text, Text), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> Declaration
BlackBoxD Text
nm1 [[Element]]
libs [[Element]]
imps [((Text, Text), BlackBox)]
inc ([Element] -> BlackBox
N.BBTemplate [Element]
templ3) BlackBoxContext
b'
                Doc
block <- Ap (State backend) Doc -> State backend Doc
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (Identifier -> [Declaration] -> Ap (State backend) Doc
forall state.
Backend state =>
Identifier -> [Declaration] -> Ap (State state) Doc
blockDecl Identifier
nm2 ([Declaration]
templDecls [Declaration] -> [Declaration] -> [Declaration]
forall a. [a] -> [a] -> [a]
++ [Declaration
bbD]))
                BlackBox -> StateT backend Identity BlackBox
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Doc -> BlackBox
forall ann. Doc ann -> BlackBox
render Doc
block)

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

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

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

renderElem BlackBoxContext
_ Element
LongestPeriod = do
  DomainMap
doms <- State backend DomainMap
forall state. Backend state => State state DomainMap
domainConfigurations
  -- Longest period with a minimum of 100 ns, see:
  -- https://github.com/clash-lang/clash-compiler/issues/2455
  let longestPeriod :: Natural
longestPeriod = [Natural] -> Natural
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum (Natural
100_000 Natural -> [Natural] -> [Natural]
forall a. a -> [a] -> [a]
: [VDomainConfiguration -> Natural
vPeriod VDomainConfiguration
v | VDomainConfiguration
v <- DomainMap -> [VDomainConfiguration]
forall k v. HashMap k v -> [v]
HashMap.elems DomainMap
doms])
  (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 (Natural -> String
forall a. Show a => a -> String
show Natural
longestPeriod)))

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


renderElem BlackBoxContext
b (IF Element
c [Element]
t [Element]
f) = do
  Int
iw <- State backend Int
forall state. Backend state => State state Int
iwWidth
  HDL
hdl <- (backend -> HDL) -> StateT backend Identity HDL
forall s (m :: Type -> Type) a. MonadState s m => (s -> a) -> m a
gets backend -> HDL
forall state. Backend state => state -> HDL
hdlKind
  HdlSyn
syn <- State backend HdlSyn
forall state. Backend state => State state HdlSyn
hdlSyn
  RenderEnums
enums <- State backend RenderEnums
forall state. Backend state => State state RenderEnums
renderEnums
  AggressiveXOptBB
xOpt <- State backend AggressiveXOptBB
forall state. Backend state => State state AggressiveXOptBB
aggressiveXOptBB
  Int
c' <- Bool
-> Int
-> HDL
-> HdlSyn
-> RenderEnums
-> Element
-> State backend Int
forall backend.
Backend backend =>
Bool
-> Int
-> HDL
-> HdlSyn
-> RenderEnums
-> Element
-> State backend Int
check (AggressiveXOptBB -> Bool
coerce AggressiveXOptBB
xOpt) Int
iw HDL
hdl HdlSyn
syn RenderEnums
enums Element
c
  if Int
c' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then BlackBoxContext -> [Element] -> State backend (Int -> Text)
forall backend.
Backend backend =>
BlackBoxContext -> [Element] -> State backend (Int -> Text)
renderTemplate BlackBoxContext
b [Element]
t else BlackBoxContext -> [Element] -> State backend (Int -> Text)
forall backend.
Backend backend =>
BlackBoxContext -> [Element] -> State backend (Int -> Text)
renderTemplate BlackBoxContext
b [Element]
f
  where
    check :: Backend backend => Bool -> Int -> HDL -> HdlSyn -> RenderEnums -> Element -> State backend Int
    check :: Bool
-> Int
-> HDL
-> HdlSyn
-> RenderEnums
-> Element
-> State backend Int
check Bool
xOpt Int
iw HDL
hdl HdlSyn
syn RenderEnums
enums Element
c' = case Element
c' of
      (Size Element
e)   -> Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> State backend Int) -> Int -> State backend Int
forall a b. (a -> b) -> a -> b
$ HWType -> Int
typeSize (BlackBoxContext -> [Element] -> HWType
lineToType BlackBoxContext
b [Element
e])
      (Length Element
e) -> Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> State backend Int) -> Int -> State backend Int
forall a b. (a -> b) -> a -> b
$ case BlackBoxContext -> [Element] -> HWType
lineToType BlackBoxContext
b [Element
e] of
                       (Vector Int
n HWType
_)              -> Int
n
                       Void (Just (Vector Int
n HWType
_))  -> Int
n
                       (MemBlob Int
n Int
_)             -> Int
n
                       Void (Just (MemBlob Int
n Int
_)) -> Int
n
                       HWType
_                         -> Int
0 -- HACK: So we can test in splitAt if one of the
                              -- vectors in the tuple had a zero length
      (Lit Int
n) -> Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> State backend Int) -> Int -> State backend Int
forall a b. (a -> b) -> a -> b
$ case BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n of
        (Expr
l,HWType
_,Bool
_)
          | Literal Maybe (HWType, Int)
_ Literal
l' <- Expr
l ->
            case Literal
l' of
              -- Integer, Int#, KnownNat, Natural, Word#
              NumLit Integer
i -> Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
              -- Bit
              BitLit Bit
bl -> case Bit
bl of
                Bit
N.H -> Int
1
                Bit
N.L -> Int
0
                Bit
_   -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"IF: LIT bit literal must be high or low"
              -- Bool
              BoolLit Bool
bl -> Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
0 Int
1 Bool
bl
              Literal
_ -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"IF: LIT must be a numeric lit"
          -- Int
          | DataCon (Signed Int
_) Modifier
_ [Literal Maybe (HWType, Int)
_ (NumLit Integer
i)] <- Expr
l
            -> Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
          -- Word, SNat
          | DataCon (Unsigned Int
_) Modifier
_ [Literal Maybe (HWType, Int)
_ (NumLit Integer
i)] <- Expr
l
            -> Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
          | BlackBoxE Text
pNm [[Element]]
_lib [[Element]]
_use [((Text, Text), BlackBox)]
_incl BlackBox
_templ BlackBoxContext
bbCtx Bool
_paren <- Expr
l
          , Text
pNm Text -> [Text] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Text
"GHC.Int.I8#", Text
"GHC.Int.I16#", Text
"GHC.Int.I32#", Text
"GHC.Int.I64#"
                       ,Text
"GHC.Word.W8#",Text
"GHC.Word.W16#",Text
"GHC.Word.W32#",Text
"GHC.Word.W64#"
                       ,Text
"GHC.Types.I#",Text
"GHC.Types.W#"
                       ]
          , [Literal Maybe (HWType, Int)
_ (NumLit Integer
j)] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
          -> Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
j
        (Expr, HWType, Bool)
k -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String
"IF: LIT must be a numeric lit:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Expr, HWType, Bool) -> String
forall a. Show a => a -> String
show (Expr, HWType, Bool)
k)
      (Depth Element
e)  -> Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> State backend Int) -> Int -> State backend Int
forall a b. (a -> b) -> a -> b
$ case BlackBoxContext -> [Element] -> HWType
lineToType BlackBoxContext
b [Element
e] of
                      (RTree Int
n HWType
_) -> Int
n
                      HWType
_ -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"IF: treedepth of non-tree type"
      Element
IW64       -> Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> State backend Int) -> Int -> State backend Int
forall a b. (a -> b) -> a -> b
$ if Int
iw Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
64 then Int
1 else Int
0
      (HdlSyn HdlSyn
s) -> Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> State backend Int) -> Int -> State backend Int
forall a b. (a -> b) -> a -> b
$ if HdlSyn
s HdlSyn -> HdlSyn -> Bool
forall a. Eq a => a -> a -> Bool
== HdlSyn
syn then Int
1 else Int
0
      (IsVar Int
n)  -> Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> State backend Int) -> Int -> State backend Int
forall a b. (a -> b) -> a -> b
$ let (Expr
e,HWType
_,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
                    in case Expr
e of
                      Identifier Identifier
_ Maybe Modifier
Nothing -> Int
1
                      Expr
_                    -> Int
0
      (IsLit Int
n)  -> Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> State backend Int) -> Int -> State backend Int
forall a b. (a -> b) -> a -> b
$ let (Expr
e,HWType
_,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
                    in case Expr
e of
                      DataCon {}   -> Int
1
                      Literal {}   -> Int
1
                      BlackBoxE {} -> Int
1
                      Expr
_            -> Int
0
      (IsScalar Int
n) -> let (Expr
_,HWType
ty,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
                          isScalar :: HDL -> HWType -> p
isScalar HDL
_ HWType
Bit          = p
1
                          isScalar HDL
_ HWType
Bool         = p
1
                          isScalar HDL
VHDL HWType
Integer   = p
1
                          isScalar HDL
VHDL (Sum Text
_ [Text]
_) = case RenderEnums
enums of
                                                       RenderEnums Bool
True  -> p
1
                                                       RenderEnums Bool
False -> p
0
                          isScalar HDL
_ HWType
_            = p
0
                        in Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> State backend Int) -> Int -> State backend Int
forall a b. (a -> b) -> a -> b
$ HDL -> HWType -> Int
forall p. Num p => HDL -> HWType -> p
isScalar HDL
hdl HWType
ty

      (IsUndefined Int
n) -> Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> State backend Int) -> Int -> State backend Int
forall a b. (a -> b) -> a -> b
$
        let (Expr
e, HWType
_, Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
        in if Bool
xOpt Bool -> Bool -> Bool
&& Expr -> Bool
checkUndefined Expr
e then Int
1 else Int
0

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

      (ActiveEdge ActiveEdge
edgeRequested Int
n) -> do
        let (Expr
_, HWType
ty, Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
        VDomainConfiguration
domConf <- HWType -> State backend VDomainConfiguration
forall backend.
(Backend backend, HasCallStack) =>
HWType -> State backend VDomainConfiguration
getDomainConf HWType
ty
        case VDomainConfiguration
domConf of
          VDomainConfiguration String
_ Natural
_ ActiveEdge
edgeActual ResetKind
_ InitBehavior
_ ResetPolarity
_ -> Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> State backend Int) -> Int -> State backend Int
forall a b. (a -> b) -> a -> b
$
            if ActiveEdge
edgeRequested ActiveEdge -> ActiveEdge -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveEdge
edgeActual then Int
1 else Int
0

      (IsSync Int
n) -> do
        let (Expr
_, HWType
ty, Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
        VDomainConfiguration
domConf <- HWType -> State backend VDomainConfiguration
forall backend.
(Backend backend, HasCallStack) =>
HWType -> State backend VDomainConfiguration
getDomainConf HWType
ty
        case VDomainConfiguration
domConf of
          VDomainConfiguration String
_ Natural
_ ActiveEdge
_ ResetKind
Synchronous InitBehavior
_ ResetPolarity
_ -> Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
1
          VDomainConfiguration String
_ Natural
_ ActiveEdge
_ ResetKind
Asynchronous InitBehavior
_ ResetPolarity
_ -> Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
0

      (IsInitDefined Int
n) -> do
        let (Expr
_, HWType
ty, Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
        VDomainConfiguration
domConf <- HWType -> State backend VDomainConfiguration
forall backend.
(Backend backend, HasCallStack) =>
HWType -> State backend VDomainConfiguration
getDomainConf HWType
ty
        case VDomainConfiguration
domConf of
          VDomainConfiguration String
_ Natural
_ ActiveEdge
_ ResetKind
_ InitBehavior
Defined ResetPolarity
_ -> Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
1
          VDomainConfiguration String
_ Natural
_ ActiveEdge
_ ResetKind
_ InitBehavior
Unknown ResetPolarity
_ -> Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
0

      (IsActiveHigh Int
n) -> do
        let (Expr
_, HWType
ty, Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
        VDomainConfiguration
domConf <- HWType -> State backend VDomainConfiguration
forall backend.
(Backend backend, HasCallStack) =>
HWType -> State backend VDomainConfiguration
getDomainConf HWType
ty
        case VDomainConfiguration
domConf of
          VDomainConfiguration String
_ Natural
_ ActiveEdge
_ ResetKind
_ InitBehavior
_ ResetPolarity
ActiveHigh -> Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
1
          VDomainConfiguration String
_ Natural
_ ActiveEdge
_ ResetKind
_ InitBehavior
_ ResetPolarity
ActiveLow  -> Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
0

      (StrCmp [Text Text
t1] Int
n) -> Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> State backend Int) -> Int -> State backend Int
forall a b. (a -> b) -> a -> b
$
        let (Expr
e,HWType
_,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
        in  case Expr -> Maybe String
exprToString Expr
e of
              Just String
t2
                | Text
t1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
Text.pack String
t2 -> Int
1
                | Bool
otherwise -> Int
0
              Maybe String
Nothing -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Expected a string literal: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr -> String
forall a. Show a => a -> String
show Expr
e
      (And [Element]
es)   -> do
        [Int]
es' <- (Element -> State backend Int)
-> [Element] -> StateT backend Identity [Int]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool
-> Int
-> HDL
-> HdlSyn
-> RenderEnums
-> Element
-> State backend Int
forall backend.
Backend backend =>
Bool
-> Int
-> HDL
-> HdlSyn
-> RenderEnums
-> Element
-> State backend Int
check Bool
xOpt Int
iw HDL
hdl HdlSyn
syn RenderEnums
enums) [Element]
es
        Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Int -> State backend Int) -> Int -> State backend Int
forall a b. (a -> b) -> a -> b
$ if (Int -> Bool) -> [Int] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
0) [Int]
es'
                       then Int
1
                       else Int
0
      CmpLE Element
e1 Element
e2 -> do
        Int
v1 <- Bool
-> Int
-> HDL
-> HdlSyn
-> RenderEnums
-> Element
-> State backend Int
forall backend.
Backend backend =>
Bool
-> Int
-> HDL
-> HdlSyn
-> RenderEnums
-> Element
-> State backend Int
check Bool
xOpt Int
iw HDL
hdl HdlSyn
syn RenderEnums
enums Element
e1
        Int
v2 <- Bool
-> Int
-> HDL
-> HdlSyn
-> RenderEnums
-> Element
-> State backend Int
forall backend.
Backend backend =>
Bool
-> Int
-> HDL
-> HdlSyn
-> RenderEnums
-> Element
-> State backend Int
check Bool
xOpt Int
iw HDL
hdl HdlSyn
syn RenderEnums
enums Element
e2
        if Int
v1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
v2
          then Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
1
          else Int -> State backend Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Int
0
      Element
_ -> String -> State backend Int
forall a. HasCallStack => String -> a
error (String -> State backend Int) -> String -> State backend Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"IF: condition must be: SIZE, LENGTH, LIT, DEPTH, IW64, VIVADO, OTHERSYN, ISVAR, ISLIT, ISUNDEFINED, ISACTIVEENABLE, ACTIVEEDGE, ISSYNC, ISINITDEFINED, ISACTIVEHIGH, STRCMP, AND, ISSCALAR or CMPLE."
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nGot: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Element -> String
forall a. Show a => a -> String
show Element
c'
renderElem BlackBoxContext
b Element
e = (Text -> Int -> Text)
-> StateT backend Identity Text -> State backend (Int -> Text)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int -> Text
forall a b. a -> b -> a
const (BlackBoxContext -> Element -> StateT backend Identity Text
forall backend.
Backend backend =>
BlackBoxContext -> Element -> State backend Text
renderTag BlackBoxContext
b Element
e)

getDomainConf :: (Backend backend, HasCallStack) => HWType -> State backend VDomainConfiguration
getDomainConf :: HWType -> State backend VDomainConfiguration
getDomainConf = StateT backend Identity DomainMap
-> HWType -> State backend VDomainConfiguration
forall (m :: Type -> Type).
(Monad m, HasCallStack) =>
m DomainMap -> HWType -> m VDomainConfiguration
generalGetDomainConf StateT backend Identity DomainMap
forall state. Backend state => State state DomainMap
domainConfigurations

generalGetDomainConf
  :: forall m. (Monad m, HasCallStack)
  => (m DomainMap) -- ^ a way to get the `DomainMap`
  -> HWType -> m VDomainConfiguration
generalGetDomainConf :: m DomainMap -> HWType -> m VDomainConfiguration
generalGetDomainConf m DomainMap
getDomainMap HWType
ty = case (([Attr Text], HWType) -> HWType
forall a b. (a, b) -> b
snd (([Attr Text], HWType) -> HWType)
-> (HWType -> ([Attr Text], HWType)) -> HWType -> HWType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> ([Attr Text], HWType)
stripAttributes (HWType -> ([Attr Text], HWType))
-> (HWType -> HWType) -> HWType -> ([Attr Text], HWType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> HWType
stripVoid) HWType
ty of
  KnownDomain Text
dom Integer
period ActiveEdge
activeEdge ResetKind
resetKind InitBehavior
initBehavior ResetPolarity
resetPolarity ->
    VDomainConfiguration -> m VDomainConfiguration
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (VDomainConfiguration -> m VDomainConfiguration)
-> VDomainConfiguration -> m VDomainConfiguration
forall a b. (a -> b) -> a -> b
$ String
-> Natural
-> ActiveEdge
-> ResetKind
-> InitBehavior
-> ResetPolarity
-> VDomainConfiguration
VDomainConfiguration (Text -> String
Data.Text.unpack Text
dom) (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
period) ActiveEdge
activeEdge ResetKind
resetKind InitBehavior
initBehavior ResetPolarity
resetPolarity

  Clock Text
dom -> HasCallStack => Text -> m VDomainConfiguration
Text -> m VDomainConfiguration
go Text
dom
  ClockN Text
dom -> HasCallStack => Text -> m VDomainConfiguration
Text -> m VDomainConfiguration
go Text
dom
  Reset Text
dom  -> HasCallStack => Text -> m VDomainConfiguration
Text -> m VDomainConfiguration
go Text
dom
  Enable Text
dom -> HasCallStack => Text -> m VDomainConfiguration
Text -> m VDomainConfiguration
go Text
dom
  Product Text
_DiffClock Maybe [Text]
_ [Clock Text
dom,HWType
_clkN] -> HasCallStack => Text -> m VDomainConfiguration
Text -> m VDomainConfiguration
go Text
dom
  HWType
t -> String -> m VDomainConfiguration
forall a. HasCallStack => String -> a
error (String -> m VDomainConfiguration)
-> String -> m VDomainConfiguration
forall a b. (a -> b) -> a -> b
$ String
"Don't know how to get a Domain out of HWType: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> HWType -> String
forall a. Show a => a -> String
show HWType
t
 where
  go :: HasCallStack => N.DomainName -> m VDomainConfiguration
  go :: Text -> m VDomainConfiguration
go Text
dom = do
    DomainMap
doms <- m DomainMap
getDomainMap
    case Text -> DomainMap -> Maybe VDomainConfiguration
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
dom DomainMap
doms of
      Maybe VDomainConfiguration
Nothing -> String -> m VDomainConfiguration
forall a. HasCallStack => String -> a
error (String -> m VDomainConfiguration)
-> String -> m VDomainConfiguration
forall a b. (a -> b) -> a -> b
$ String
"Can't find domain " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
dom String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". Please report an issue at https://github.com/clash-lang/clash-compiler/issues."
      Just VDomainConfiguration
conf -> VDomainConfiguration -> m VDomainConfiguration
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure VDomainConfiguration
conf

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

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

bbResult :: HasCallStack => String -> BlackBoxContext -> (Expr, HWType)
bbResult :: String -> BlackBoxContext -> (Expr, HWType)
bbResult String
_s (BlackBoxContext -> [(Expr, HWType)]
bbResults -> [(Expr, HWType)
r]) = (Expr, HWType)
r
bbResult String
s BlackBoxContext
ctx = String -> (Expr, HWType)
forall a. HasCallStack => String -> a
error [I.i|
  Multi result primitives not supported when using template tag #{s}. Tag used
  in blackbox implementation of #{bbName ctx} |]

-- | 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 -> [Element] -> State backend Text
lineToIdentifier BlackBoxContext
b = (Element -> Text -> State backend Text)
-> Text -> [Element] -> State backend Text
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM (\Element
e Text
a -> do
                              Text
e' <- BlackBoxContext -> Element -> State backend Text
forall backend.
Backend backend =>
BlackBoxContext -> Element -> State backend Text
renderTag BlackBoxContext
b Element
e
                              Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text
e' Text -> Text -> Text
`Text.append` Text
a)
                   ) Text
Text.empty

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

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

-- | Give a context and a tagged hole (of a template), returns part of the
-- context that matches the tag of the hole.
renderTag :: Backend backend
          => BlackBoxContext
          -> Element
          -> State backend Text
renderTag :: BlackBoxContext -> Element -> State backend Text
renderTag BlackBoxContext
_ (Text Text
t)        = Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
t
renderTag BlackBoxContext
b (Element
Result)    = do
  (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
. Ap (State backend) Doc -> State backend Doc
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (Ap (State backend) Doc -> State backend Doc)
-> ((Expr, HWType) -> Ap (State backend) Doc)
-> (Expr, HWType)
-> State backend Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Expr -> Ap (State backend) Doc
forall state. Backend state => Bool -> Expr -> Ap (State state) Doc
expr Bool
False (Expr -> Ap (State backend) Doc)
-> ((Expr, HWType) -> Expr)
-> (Expr, HWType)
-> Ap (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
$ HasCallStack => String -> BlackBoxContext -> (Expr, HWType)
String -> BlackBoxContext -> (Expr, HWType)
bbResult String
"~RESULT" BlackBoxContext
b
renderTag BlackBoxContext
b (Arg Int
n)  = do
  let (Expr
e,HWType
_,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ap (State backend) Doc -> State backend Doc
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (Bool -> Expr -> Ap (State backend) Doc
forall state. Backend state => Bool -> Expr -> Ap (State state) Doc
expr Bool
True Expr
e)

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

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

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

  mkLit :: Expr -> Expr
mkLit (Literal (Just (Signed Int
_,Int
_)) Literal
i)                                 = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
i  -- Integer, Int#
  mkLit (Literal (Just (Unsigned Int
_,Int
_)) Literal
i)                               = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
i  -- KnownNat, Natural, Word#

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

  mkLit (BlackBoxE Text
pNm [[Element]]
_ [[Element]]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_) | Text
pNm Text -> [Text] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Text
"GHC.Int.I8#", Text
"GHC.Int.I16#", Text
"GHC.Int.I32#", Text
"GHC.Int.I64#"
                                                     ,Text
"GHC.Word.W8#",Text
"GHC.Word.W16#",Text
"GHC.Word.W32#",Text
"GHC.Word.W64#"
                                                     ,Text
"GHC.Types.I#",Text
"GHC.Types.W#"
                                                     ]
                                        , [Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
                                        = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
i
  mkLit (BlackBoxE Text
pNm [[Element]]
_ [[Element]]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
bbCtx Bool
_) | Text
pNm Text -> [Text] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Text
"Clash.Sized.Internal.Signed.fromInteger#"
                                                     ,Text
"Clash.Sized.Internal.Unsigned.fromInteger#"
                                                     ,Text
"Clash.Sized.Internal.Index.fromInteger#"]
                                        , [Literal {}, Literal Maybe (HWType, Int)
_ Literal
i] <- BlackBoxContext -> [Expr]
extractLiterals BlackBoxContext
bbCtx
                                         = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
i
  mkLit Expr
i                                                               = Expr
i

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

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

renderTag BlackBoxContext
b (BV Bool
True [Element]
es Element
e) = do
  Text
e' <- [Text] -> Text
Text.concat ([Text] -> Text)
-> StateT backend Identity [Text] -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> State backend Text)
-> [Element] -> StateT backend Identity [Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((Int -> Text) -> Text)
-> StateT backend Identity (Int -> Text) -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
0) (StateT backend Identity (Int -> Text) -> State backend Text)
-> (Element -> StateT backend Identity (Int -> Text))
-> Element
-> State backend Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlackBoxContext -> Element -> StateT backend Identity (Int -> Text)
forall backend.
(HasCallStack, Backend backend) =>
BlackBoxContext -> Element -> State backend (Int -> Text)
renderElem BlackBoxContext
b) [Element]
es
  let ty :: HWType
ty = BlackBoxContext -> [Element] -> 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
<$> Ap (State backend) Doc -> State backend Doc
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (HWType -> Text -> Ap (State backend) Doc
forall state.
Backend state =>
HWType -> Text -> Ap (State state) Doc
toBV HWType
ty Text
e')
renderTag BlackBoxContext
b (BV Bool
False [Element]
es Element
e) = do
  Text
e' <- [Text] -> Text
Text.concat ([Text] -> Text)
-> StateT backend Identity [Text] -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Element -> State backend Text)
-> [Element] -> StateT backend Identity [Text]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((Int -> Text) -> Text)
-> StateT backend Identity (Int -> Text) -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
0) (StateT backend Identity (Int -> Text) -> State backend Text)
-> (Element -> StateT backend Identity (Int -> Text))
-> Element
-> State backend Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlackBoxContext -> Element -> StateT backend Identity (Int -> Text)
forall backend.
(HasCallStack, Backend backend) =>
BlackBoxContext -> Element -> State backend (Int -> Text)
renderElem BlackBoxContext
b) [Element]
es)
  let ty :: HWType
ty = BlackBoxContext -> [Element] -> 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
<$> Ap (State backend) Doc -> State backend Doc
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (HWType -> Text -> Ap (State backend) Doc
forall state.
Backend state =>
HWType -> Text -> Ap (State state) Doc
fromBV HWType
ty Text
e')

renderTag BlackBoxContext
b (Sel Element
e Int
n) =
  let ty :: HWType
ty = BlackBoxContext -> [Element] -> 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
<$> Ap (State backend) Doc -> State backend Doc
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (HWType -> Int -> Ap (State backend) Doc
forall state.
Backend state =>
HWType -> Int -> Ap (State state) Doc
hdlRecSel HWType
ty Int
n)

renderTag BlackBoxContext
b (Typ Maybe Int
Nothing)   = (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (State backend Doc -> State backend Text)
-> ((Expr, HWType) -> State backend Doc)
-> (Expr, HWType)
-> State backend Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ap (State backend) Doc -> State backend Doc
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (Ap (State backend) Doc -> State backend Doc)
-> ((Expr, HWType) -> Ap (State backend) Doc)
-> (Expr, HWType)
-> State backend Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Usage -> HWType -> Ap (State backend) Doc
forall state.
Backend state =>
Usage -> HWType -> Ap (State state) Doc
hdlType Usage
Internal (HWType -> Ap (State backend) Doc)
-> ((Expr, HWType) -> HWType)
-> (Expr, HWType)
-> Ap (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
$ HasCallStack => String -> BlackBoxContext -> (Expr, HWType)
String -> BlackBoxContext -> (Expr, HWType)
bbResult String
"~TYPO" BlackBoxContext
b
renderTag BlackBoxContext
b (Typ (Just Int
n))  = let (Expr
_,HWType
ty,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
                              in  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ap (State backend) Doc -> State backend Doc
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (Usage -> HWType -> Ap (State backend) Doc
forall state.
Backend state =>
Usage -> HWType -> Ap (State state) Doc
hdlType Usage
Internal HWType
ty)
renderTag BlackBoxContext
b (TypM Maybe Int
Nothing)  = (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (State backend Doc -> State backend Text)
-> ((Expr, HWType) -> State backend Doc)
-> (Expr, HWType)
-> State backend Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ap (State backend) Doc -> State backend Doc
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (Ap (State backend) Doc -> State backend Doc)
-> ((Expr, HWType) -> Ap (State backend) Doc)
-> (Expr, HWType)
-> State backend Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> Ap (State backend) Doc
forall state. Backend state => HWType -> Ap (State state) Doc
hdlTypeMark (HWType -> Ap (State backend) Doc)
-> ((Expr, HWType) -> HWType)
-> (Expr, HWType)
-> Ap (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
$ HasCallStack => String -> BlackBoxContext -> (Expr, HWType)
String -> BlackBoxContext -> (Expr, HWType)
bbResult String
"~TYPMO" BlackBoxContext
b
renderTag BlackBoxContext
b (TypM (Just Int
n)) = let (Expr
_,HWType
ty,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
                              in  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ap (State backend) Doc -> State backend Doc
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (HWType -> Ap (State backend) Doc
forall state. Backend state => HWType -> Ap (State state) Doc
hdlTypeMark HWType
ty)
renderTag BlackBoxContext
b (Err Maybe Int
Nothing)   = (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (State backend Doc -> State backend Text)
-> ((Expr, HWType) -> State backend Doc)
-> (Expr, HWType)
-> State backend Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ap (State backend) Doc -> State backend Doc
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (Ap (State backend) Doc -> State backend Doc)
-> ((Expr, HWType) -> Ap (State backend) Doc)
-> (Expr, HWType)
-> State backend Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> Ap (State backend) Doc
forall state. Backend state => HWType -> Ap (State state) Doc
hdlTypeErrValue (HWType -> Ap (State backend) Doc)
-> ((Expr, HWType) -> HWType)
-> (Expr, HWType)
-> Ap (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
$ HasCallStack => String -> BlackBoxContext -> (Expr, HWType)
String -> BlackBoxContext -> (Expr, HWType)
bbResult String
"~ERRORO" BlackBoxContext
b
renderTag BlackBoxContext
b (Err (Just Int
n))  = let (Expr
_,HWType
ty,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
                              in  Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Ap (State backend) Doc -> State backend Doc
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (HWType -> Ap (State backend) Doc
forall state. Backend state => HWType -> Ap (State state) Doc
hdlTypeErrValue HWType
ty)
renderTag BlackBoxContext
b (Size Element
e)        = Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> State backend Text)
-> (HWType -> Text) -> HWType -> State backend Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (HWType -> String) -> HWType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (HWType -> Int) -> HWType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> Int
typeSize (HWType -> State backend Text) -> HWType -> State backend Text
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> [Element] -> HWType
lineToType BlackBoxContext
b [Element
e]

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

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

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

renderTag BlackBoxContext
b e :: Element
e@(TypElem Element
_)   = let ty :: HWType
ty = BlackBoxContext -> [Element] -> 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
<$> Ap (State backend) Doc -> State backend Doc
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (Usage -> HWType -> Ap (State backend) Doc
forall state.
Backend state =>
Usage -> HWType -> Ap (State state) Doc
hdlType Usage
Internal HWType
ty)
renderTag BlackBoxContext
_ (Gen Bool
b)         = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> State backend Doc
forall state. Backend state => Bool -> State state Doc
genStmt Bool
b
renderTag BlackBoxContext
_ (GenSym [Text Text
t] Int
_) = Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
t

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

renderTag BlackBoxContext
b (IndexType (Lit Int
n)) =
  case BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n of
    (Literal Maybe (HWType, Int)
_ (NumLit Integer
n'),HWType
_,Bool
_) ->
      let hty :: HWType
hty = Integer -> HWType
Index (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
n')
      in  (Doc -> Text) -> State backend Doc -> State backend Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Ap (State backend) Doc -> State backend Doc
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (Usage -> HWType -> Ap (State backend) Doc
forall state.
Backend state =>
Usage -> HWType -> Ap (State state) Doc
hdlType Usage
Internal HWType
hty))
    (Expr, HWType, Bool)
x -> String -> State backend Text
forall a. HasCallStack => String -> a
error (String -> State backend Text) -> String -> State backend Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Index type not given a literal: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Expr, HWType, Bool) -> String
forall a. Show a => a -> String
show (Expr, HWType, Bool)
x
renderTag BlackBoxContext
b (FilePath Element
e)    = case Element
e of
  Lit Int
n -> do
    let (Expr
e',HWType
_,Bool
_) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
    case Expr -> Maybe String
exprToString Expr
e' of
      Just String
s -> do
        String
s' <- String -> State backend String
forall state. Backend state => String -> State state String
addAndSetData String
s
        Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Text
Text.pack (String -> String
forall a. Show a => a -> String
show String
s'))
      Maybe String
_ -> do
        Text
e2  <- Ap (State backend) Text -> State backend Text
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (Element -> Ap (State backend) Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Ap m Text
prettyElem Element
e)
        String -> State backend Text
forall a. HasCallStack => String -> a
error (String -> State backend Text) -> String -> State backend Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"argument of ~FILE:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
e2 String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
"does not reduce to a string"
  Element
_ -> do Text
e' <- Ap (State backend) Text -> State backend Text
forall k (f :: k -> Type) (a :: k). Ap f a -> f a
getAp (Element -> Ap (State backend) Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Ap m Text
prettyElem Element
e)
          String -> State backend Text
forall a. HasCallStack => String -> a
error (String -> State backend Text) -> String -> State backend Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"~FILE expects a ~LIT[N] argument, but got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
e'
renderTag BlackBoxContext
b (IncludeName Int
n) = case [Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
indexMaybe (BlackBoxContext -> [Text]
bbQsysIncName BlackBoxContext
b) Int
n of
  Just Text
nm -> Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> Text
Text.fromStrict Text
nm)
  Maybe Text
_ -> String -> State backend Text
forall a. HasCallStack => String -> a
error (String -> State backend Text) -> String -> State backend Text
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"~INCLUDENAME[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] does not correspond to any index of the 'includes' field that is specified in the primitive definition"
renderTag BlackBoxContext
b (OutputUsage Int
n) = do
  HDL
hdl <- (backend -> HDL) -> StateT backend Identity HDL
forall s (m :: Type -> Type) a. MonadState s m => (s -> a) -> m a
gets backend -> HDL
forall state. Backend state => state -> HDL
hdlKind

  let u :: Usage
u = case Int
-> IntMap
     [(Either BlackBox (Identifier, [Declaration]), Usage, [[Element]],
       [[Element]], [((Text, Text), BlackBox)], BlackBoxContext)]
-> Maybe
     [(Either BlackBox (Identifier, [Declaration]), Usage, [[Element]],
       [[Element]], [((Text, Text), BlackBox)], BlackBoxContext)]
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
n (BlackBoxContext
-> IntMap
     [(Either BlackBox (Identifier, [Declaration]), Usage, [[Element]],
       [[Element]], [((Text, Text), BlackBox)], BlackBoxContext)]
bbFunctions BlackBoxContext
b) of
            Just ((Either BlackBox (Identifier, [Declaration])
_,Usage
u',[[Element]]
_,[[Element]]
_,[((Text, Text), BlackBox)]
_,BlackBoxContext
_):[(Either BlackBox (Identifier, [Declaration]), Usage, [[Element]],
  [[Element]], [((Text, Text), BlackBox)], BlackBoxContext)]
_) -> Usage
u'
            Maybe
  [(Either BlackBox (Identifier, [Declaration]), Usage, [[Element]],
    [[Element]], [((Text, Text), BlackBox)], BlackBoxContext)]
_ -> String -> Usage
forall a. HasCallStack => String -> a
error (String -> Usage) -> String -> Usage
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"~OUTPUTUSAGE[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] used where argument " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not a function"

  Text -> State backend Text
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Text -> State backend Text) -> Text -> State backend Text
forall a b. (a -> b) -> a -> b
$ case (HDL
hdl, Usage
u) of
    (HDL
VHDL, N.Proc Blocking
N.Blocking) -> Text
"variable"
    (HDL
VHDL, Usage
_) -> Text
"signal"

    (HDL
_, Usage
N.Cont) -> Text
"wire"
    (HDL
_, Usage
_) -> Text
"reg"
renderTag BlackBoxContext
b (Repeat [Element
es] [Element
i]) = do
  String
i'  <- Text -> String
Text.unpack (Text -> String) -> State backend Text -> State backend String
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> BlackBoxContext -> Element -> State backend Text
forall backend.
Backend backend =>
BlackBoxContext -> Element -> State backend Text
renderTag BlackBoxContext
b Element
i
  Text
es' <- BlackBoxContext -> Element -> State backend Text
forall backend.
Backend backend =>
BlackBoxContext -> Element -> State backend Text
renderTag BlackBoxContext
b Element
es
  let i'' :: Int
i'' = case (String -> Either String Int
forall a. Read a => String -> Either String a
readEither String
i' :: Either String Int) of
              Left String
msg -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Could not parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
i' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". read reported: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
              Right Int
n  -> Int
n
  Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> State backend Text) -> Text -> State backend Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
i'' ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
forall a. a -> [a]
repeat Text
es'

renderTag BlackBoxContext
b (DevNull [Element]
es) = do
  [Int -> Text]
_ <- (Element -> StateT backend Identity (Int -> Text))
-> [Element] -> 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) [Element]
es
  Text -> State backend Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Text -> State backend Text) -> Text -> State backend Text
forall a b. (a -> b) -> a -> b
$ Text
Text.empty

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

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

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

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


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

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

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

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

-- | Extracts string from SSymbol or string literals
exprToString
  :: Expr
  -> Maybe String
exprToString :: Expr -> Maybe String
exprToString (Literal Maybe (HWType, Int)
_ (NumLit Integer
i)) = String -> Maybe String
forall a. a -> Maybe a
Just (Integer -> String
forall a. Show a => a -> String
show Integer
i)
exprToString (Literal Maybe (HWType, Int)
_ (StringLit String
l)) = String -> Maybe String
forall a. a -> Maybe a
Just String
l
exprToString (BlackBoxE Text
"Clash.Promoted.Symbol.SSymbol" [[Element]]
_ [[Element]]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
ctx Bool
_) =
  case BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
ctx of
    (Expr
e0,HWType
_,Bool
_):[(Expr, HWType, Bool)]
_ -> Expr -> Maybe String
exprToString Expr
e0
    [(Expr, HWType, Bool)]
_ -> String -> Maybe String
forall a. HasCallStack => String -> a
error String
"internal error: insufficient bbInputs"
exprToString (BlackBoxE Text
"GHC.CString.unpackCString#" [[Element]]
_ [[Element]]
_ [((Text, Text), BlackBox)]
_ BlackBox
_ BlackBoxContext
ctx Bool
_) =
  case BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
ctx of
    (Expr
e0,HWType
_,Bool
_):[(Expr, HWType, Bool)]
_ -> Expr -> Maybe String
exprToString Expr
e0
    [(Expr, HWType, Bool)]
_ -> String -> Maybe String
forall a. HasCallStack => String -> a
error String
"internal error: insufficient bbInputs"
exprToString Expr
_ = Maybe String
forall a. Maybe a
Nothing

prettyBlackBox :: Monad m
               => BlackBoxTemplate
               -> Ap m Text
prettyBlackBox :: [Element] -> Ap m Text
prettyBlackBox [Element]
bbT = [Text] -> Text
Text.concat ([Text] -> Text) -> Ap m [Text] -> Ap m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> Ap m Text) -> [Element] -> Ap 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 -> Ap m Text
forall (m :: Type -> Type).
(HasCallStack, Monad m) =>
Element -> Ap m Text
prettyElem [Element]
bbT

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

-- Domain attributes:
prettyElem (Tag Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Ap m Doc -> Ap m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Ap m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~TAG" Ap m Doc -> Ap m Doc -> Ap m Doc
forall a. Semigroup a => a -> a -> a
<> Ap m Doc -> Ap m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Ap m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (Period Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Ap m Doc -> Ap m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Ap m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~PERIOD" Ap m Doc -> Ap m Doc -> Ap m Doc
forall a. Semigroup a => a -> a -> a
<> Ap m Doc -> Ap m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Ap m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem Element
LongestPeriod = Text -> Ap m Text
forall (m :: Type -> Type) a. Monad m => a -> m a
return Text
"~LONGESTPERIOD"
prettyElem (ActiveEdge ActiveEdge
e Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Ap m Doc -> Ap m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Ap m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~ACTIVEEDGE" Ap m Doc -> Ap m Doc -> Ap m Doc
forall a. Semigroup a => a -> a -> a
<> Ap m Doc -> Ap m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Text -> Ap 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))) Ap m Doc -> Ap m Doc -> Ap m Doc
forall a. Semigroup a => a -> a -> a
<> Ap m Doc -> Ap m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Ap m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (IsSync Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Ap m Doc -> Ap m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Ap m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~ISSYNC" Ap m Doc -> Ap m Doc -> Ap m Doc
forall a. Semigroup a => a -> a -> a
<> Ap m Doc -> Ap m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Ap m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))
prettyElem (IsInitDefined Int
i) = Doc -> Text
forall ann. Doc ann -> Text
renderOneLine (Doc -> Text) -> Ap m Doc -> Ap m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Ap m Doc
forall (f :: Type -> Type). Applicative f => Text -> f Doc
string Text
"~ISINITDEFINED" Ap m Doc -> Ap m Doc -> Ap m Doc
forall a. Semigroup a => a -> a -> a
<> Ap m Doc -> Ap m Doc
forall (f :: Type -> Type). Functor f => f Doc -> f Doc
brackets (Int -> Ap m Doc
forall (f :: Type -> Type). Applicative f => Int -> f Doc
int Int
i))

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

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

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

-- | Determine variables used in an expression. Used for VHDL sensitivity list.
-- Also see: https://github.com/clash-lang/clash-compiler/issues/365
usedVariables :: Expr -> [N.IdentifierText]
usedVariables :: Expr -> [Text]
usedVariables Expr
Noop              = []
usedVariables (Identifier Identifier
i Maybe Modifier
_)  = [Identifier -> Text
Id.toText Identifier
i]
usedVariables (DataCon HWType
_ Modifier
_ [Expr]
es)  = (Expr -> [Text]) -> [Expr] -> [Text]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Expr -> [Text]
usedVariables [Expr]
es
usedVariables (DataTag HWType
_ Either Identifier Identifier
e')    = [Identifier -> Text
Id.toText ((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 (ToBv Maybe Identifier
_ HWType
_ Expr
e') = Expr -> [Text]
usedVariables Expr
e'
usedVariables (FromBv Maybe Identifier
_ HWType
_ Expr
e') = Expr -> [Text]
usedVariables Expr
e'
usedVariables (IfThenElse Expr
e1 Expr
e2 Expr
e3) = (Expr -> [Text]) -> [Expr] -> [Text]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Expr -> [Text]
usedVariables [Expr
e1,Expr
e2,Expr
e3]
usedVariables (BlackBoxE Text
_ [[Element]]
_ [[Element]]
_ [((Text, Text), BlackBox)]
_ BlackBox
t BlackBoxContext
bb Bool
_) = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text]
sList [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
sList')
  where
    matchArg :: Element -> Maybe Int
matchArg (Arg Int
i) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
    matchArg Element
_         = Maybe Int
forall a. Maybe a
Nothing

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

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

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

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

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

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

-- | Is the value of the 'Expr' fully undefined?
checkUndefined :: Expr -> Bool
checkUndefined :: Expr -> Bool
checkUndefined = \case
  BlackBoxE Text
_ [[Element]]
_ [[Element]]
_ [((Text, Text), BlackBox)]
_ (N.BBTemplate [Err Maybe Int
_]) BlackBoxContext
_ Bool
_ -> Bool
True
  BlackBoxE Text
"Clash.Sized.Internal.BitVector.fromInteger#" [] [] [] BlackBox
_ BlackBoxContext
bbCtx Bool
_
    | [(Expr, HWType, Bool)
sz, (Expr, HWType, Bool)
mask, (Expr, HWType, Bool)
_val] <- BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx
    , (Literal Maybe (HWType, Int)
_ (NumLit Integer
sz0), HWType
_, Bool
True) <- (Expr, HWType, Bool)
sz
    , (Literal Maybe (HWType, Int)
_ (NumLit Integer
mask0), HWType
_, Bool
True) <- (Expr, HWType, Bool)
mask
    , Integer
mask0 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
sz0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
    -> Bool
True
  DataCon (Product Text
_ Maybe [Text]
_ [HWType]
_) Modifier
_ [Expr]
es -> [Bool] -> Bool
forall (t :: Type -> Type). Foldable t => t Bool -> Bool
and ((Expr -> Bool) -> [Expr] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Bool
checkUndefined [Expr]
es)
  Expr
_ -> Bool
False