{-# 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
verifyBlackBoxContext
:: BlackBoxContext
-> N.BlackBox
-> 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
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]
= ((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
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'
]
(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
-> FilePath
-> 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'
renderTemplate
:: Backend backend
=> BlackBoxContext
-> BlackBoxTemplate
-> 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'
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
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
(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
NumLit Integer
i -> Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
BitLit Bit
bl -> case Bit
bl of
Bit
N.H -> Int
1
Bit
N.L -> Int
0
Bit
_ -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"IF: LIT bit literal must be high or low"
BoolLit Bool
bl -> Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
0 Int
1 Bool
bl
Literal
_ -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ $(String
curLoc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"IF: LIT must be a numeric lit"
| DataCon (Signed Int
_) Modifier
_ [Literal Maybe (HWType, Int)
_ (NumLit Integer
i)] <- Expr
l
-> Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
| DataCon (Unsigned Int
_) Modifier
_ [Literal Maybe (HWType, Int)
_ (NumLit Integer
i)] <- Expr
l
-> Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
| 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
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
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)
-> 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} |]
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"
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
mkLit (Literal (Just (Unsigned Int
_,Int
_)) Literal
i) = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
i
mkLit (DataCon HWType
_ (DC (Void {}, Int
_)) [Literal (Just (Signed Int
_,Int
_)) Literal
i]) = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
i
mkLit (DataCon HWType
_ (DC (Void {}, Int
_)) [Literal (Just (Unsigned Int
_,Int
_)) Literal
i]) = Maybe (HWType, Int) -> Literal -> Expr
Literal Maybe (HWType, Int)
forall a. Maybe a
Nothing Literal
i
mkLit (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
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." ]
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'
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
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
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
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))
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"
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 =
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 -> []
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'
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