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

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

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

module Clash.Netlist.BlackBox.Util where

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

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

-- | Strip as many "Void" layers as possible. Might still return a Void if the
-- void doesn't contain a hwtype.
stripVoid :: HWType -> HWType
stripVoid :: HWType -> HWType
stripVoid (Void (Just e :: HWType
e)) = HWType -> HWType
stripVoid HWType
e
stripVoid e :: HWType
e = HWType
e

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

-- | Determine if the number of normal/literal/function inputs of a blackbox
-- context at least matches the number of argument that is expected by the
-- template.
verifyBlackBoxContext
  :: BlackBoxContext
  -- ^ Blackbox to verify
  -> N.BlackBox
  -- ^ Template to check against
  -> Bool
verifyBlackBoxContext :: BlackBoxContext -> BlackBox -> Bool
verifyBlackBoxContext bbCtx :: BlackBoxContext
bbCtx (N.BBFunction _ _ (N.TemplateFunction _ f :: BlackBoxContext -> Bool
f _)) = BlackBoxContext -> Bool
f BlackBoxContext
bbCtx
verifyBlackBoxContext bbCtx :: BlackBoxContext
bbCtx (N.BBTemplate t :: BlackBoxTemplate
t) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Element -> [Bool]) -> BlackBoxTemplate -> [Bool]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Element -> Maybe Bool) -> Element -> [Bool]
forall a. (Element -> Maybe a) -> Element -> [a]
walkElement Element -> Maybe Bool
verify') BlackBoxTemplate
t)
  where
    verify' :: Element -> Maybe Bool
verify' e :: Element
e =
      Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$
      case Element
e of
        Lit n :: Int
n ->
          case [(Expr, HWType, Bool)] -> Int -> Maybe (Expr, HWType, Bool)
forall a. [a] -> Int -> Maybe a
indexMaybe (BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx) Int
n of
            Just (_, _, b :: Bool
b) -> Bool
b
            _              -> Bool
False
        Const n :: Int
n ->
          case [(Expr, HWType, Bool)] -> Int -> Maybe (Expr, HWType, Bool)
forall a. [a] -> Int -> Maybe a
indexMaybe (BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx) Int
n of
            Just (_, _, b :: Bool
b) -> Bool
b
            _              -> Bool
False
        Component (Decl n :: Int
n l' :: [(BlackBoxTemplate, BlackBoxTemplate)]
l') ->
          case Int
-> IntMap
     (Either BlackBox (Identifier, [Declaration]), WireOrReg,
      [BlackBoxTemplate], [BlackBoxTemplate],
      [((Identifier, Identifier), BlackBox)], BlackBoxContext)
-> Maybe
     (Either BlackBox (Identifier, [Declaration]), WireOrReg,
      [BlackBoxTemplate], [BlackBoxTemplate],
      [((Identifier, Identifier), BlackBox)], BlackBoxContext)
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
n (BlackBoxContext
-> IntMap
     (Either BlackBox (Identifier, [Declaration]), WireOrReg,
      [BlackBoxTemplate], [BlackBoxTemplate],
      [((Identifier, Identifier), BlackBox)], BlackBoxContext)
bbFunctions BlackBoxContext
bbCtx) of
            Just _ ->
              ((BlackBoxTemplate, BlackBoxTemplate) -> Bool)
-> [(BlackBoxTemplate, BlackBoxTemplate)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(x :: BlackBoxTemplate
x,y :: BlackBoxTemplate
y) ->
                      BlackBoxContext -> BlackBox -> Bool
verifyBlackBoxContext BlackBoxContext
bbCtx (BlackBoxTemplate -> BlackBox
N.BBTemplate BlackBoxTemplate
x) Bool -> Bool -> Bool
&&
                         BlackBoxContext -> BlackBox -> Bool
verifyBlackBoxContext BlackBoxContext
bbCtx (BlackBoxTemplate -> BlackBox
N.BBTemplate BlackBoxTemplate
y)) [(BlackBoxTemplate, BlackBoxTemplate)]
l'
            Nothing ->
              Bool
False
        _ ->
          case Element -> Maybe Int
inputHole Element
e of
            Nothing ->
              Bool
True
            Just n :: Int
n ->
              Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [(Expr, HWType, Bool)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx)

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

-- | Update all the symbol references in a template, and increment the symbol
-- counter for every newly encountered symbol.
setSym
  :: forall m
   . Monad m
  => (IdType -> Identifier -> m Identifier)
  -> BlackBoxContext
  -> BlackBoxTemplate
  -> m (BlackBoxTemplate,[N.Declaration])
setSym :: (IdType -> Identifier -> m Identifier)
-> BlackBoxContext
-> BlackBoxTemplate
-> m (BlackBoxTemplate, [Declaration])
setSym mkUniqueIdentifierM :: IdType -> Identifier -> m Identifier
mkUniqueIdentifierM bbCtx :: BlackBoxContext
bbCtx l :: BlackBoxTemplate
l = do
    (a :: BlackBoxTemplate
a,(_,decls :: IntMap (Identifier, [Declaration])
decls)) <- StateT
  (IntMap Identifier, IntMap (Identifier, [Declaration]))
  m
  BlackBoxTemplate
-> (IntMap Identifier, IntMap (Identifier, [Declaration]))
-> m (BlackBoxTemplate,
      (IntMap Identifier, IntMap (Identifier, [Declaration])))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ((Element
 -> StateT
      (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element)
-> BlackBoxTemplate
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration]))
     m
     BlackBoxTemplate
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
setSym' BlackBoxTemplate
l) (IntMap Identifier
forall a. IntMap a
IntMap.empty,IntMap (Identifier, [Declaration])
forall a. IntMap a
IntMap.empty)
    (BlackBoxTemplate, [Declaration])
-> m (BlackBoxTemplate, [Declaration])
forall (m :: * -> *) a. Monad m => a -> m a
return (BlackBoxTemplate
a,((Identifier, [Declaration]) -> [Declaration])
-> [(Identifier, [Declaration])] -> [Declaration]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Identifier, [Declaration]) -> [Declaration]
forall a b. (a, b) -> b
snd (IntMap (Identifier, [Declaration]) -> [(Identifier, [Declaration])]
forall a. IntMap a -> [a]
IntMap.elems IntMap (Identifier, [Declaration])
decls))
  where
    setSym'
      :: Element
      -> StateT ( IntMap.IntMap Identifier
                , IntMap.IntMap (Identifier,[N.Declaration]))
                m
                Element
    setSym' :: Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
setSym' e :: Element
e = case Element
e of
      Var nm :: BlackBoxTemplate
nm i :: Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [(Expr, HWType, Bool)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx) -> case BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
bbCtx [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
i of
        (Identifier nm' :: Identifier
nm' Nothing,_,_) ->
          Element
-> StateT
     (IntMap Identifier, IntMap (Identifier, [Declaration])) m Element
forall (m :: * -> *) a. Monad m => a -> m a
return (BlackBoxTemplate -> Int -> Element
Var [Text -> Element
Text (Identifier -> Text
Text.fromStrict Identifier
nm')] Int
i)

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

    concatT :: [Element] -> Text
    concatT :: BlackBoxTemplate -> Text
concatT = [Text] -> Text
Text.concat
            ([Text] -> Text)
-> (BlackBoxTemplate -> [Text]) -> BlackBoxTemplate -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Text) -> BlackBoxTemplate -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\case { Text t :: Text
t -> Text
t
                         ; Name i :: Int
i -> case BlackBoxContext -> Element -> Either [Char] Text
elementToText BlackBoxContext
bbCtx (Int -> Element
Name Int
i) of
                                         Right t :: Text
t ->
                                             Text
t
                                         Left msg :: [Char]
msg ->
                                             [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++  "Could not convert "
                                                               [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "~NAME[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "]"
                                                               [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ " to string:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg
                         ; Result _ | Identifier t :: Identifier
t _ <- (Expr, HWType) -> Expr
forall a b. (a, b) -> a
fst (BlackBoxContext -> (Expr, HWType)
bbResult BlackBoxContext
bbCtx)
                                    -> Identifier -> Text
Text.fromStrict Identifier
t
                         ; CompName -> Identifier -> Text
Text.fromStrict (BlackBoxContext -> Identifier
bbCompName BlackBoxContext
bbCtx)
                         ; _   -> [Char] -> Text
forall a. HasCallStack => [Char] -> a
error "unexpected element in GENSYM"})

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

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

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

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

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

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

-- | Render a single template element
renderElem :: Backend backend
           => BlackBoxContext
           -> Element
           -> State backend (Int -> Text)
renderElem :: BlackBoxContext -> Element -> State backend (Int -> Text)
renderElem b :: BlackBoxContext
b (Component (Decl n :: Int
n (l :: (BlackBoxTemplate, BlackBoxTemplate)
l:ls :: [(BlackBoxTemplate, BlackBoxTemplate)]
ls))) = do
  (o :: Expr
o,oTy :: HWType
oTy,_) <- (Text, HWType) -> (Expr, HWType, Bool)
idToExpr ((Text, HWType) -> (Expr, HWType, Bool))
-> StateT backend Identity (Text, HWType)
-> StateT backend Identity (Expr, HWType, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BlackBoxTemplate -> StateT backend Identity Text)
-> (BlackBoxTemplate -> StateT backend Identity HWType)
-> (BlackBoxTemplate, BlackBoxTemplate)
-> StateT backend Identity (Text, HWType)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> f b) -> (c -> f d) -> (a, c) -> f (b, d)
combineM (BlackBoxContext -> BlackBoxTemplate -> StateT backend Identity Text
forall backend.
Backend backend =>
BlackBoxContext -> BlackBoxTemplate -> State backend Text
lineToIdentifier BlackBoxContext
b) (HWType -> StateT backend Identity HWType
forall (m :: * -> *) a. Monad m => a -> m a
return (HWType -> StateT backend Identity HWType)
-> (BlackBoxTemplate -> HWType)
-> BlackBoxTemplate
-> StateT backend Identity HWType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b) (BlackBoxTemplate, BlackBoxTemplate)
l
  [(Expr, HWType, Bool)]
is <- ((BlackBoxTemplate, BlackBoxTemplate)
 -> StateT backend Identity (Expr, HWType, Bool))
-> [(BlackBoxTemplate, BlackBoxTemplate)]
-> StateT backend Identity [(Expr, HWType, Bool)]
forall (t :: * -> *) (m :: * -> *) 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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, HWType) -> (Expr, HWType, Bool)
idToExpr (StateT backend Identity (Text, HWType)
 -> StateT backend Identity (Expr, HWType, Bool))
-> ((BlackBoxTemplate, BlackBoxTemplate)
    -> StateT backend Identity (Text, HWType))
-> (BlackBoxTemplate, BlackBoxTemplate)
-> StateT backend Identity (Expr, HWType, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlackBoxTemplate -> StateT backend Identity Text)
-> (BlackBoxTemplate -> StateT backend Identity HWType)
-> (BlackBoxTemplate, BlackBoxTemplate)
-> StateT backend Identity (Text, HWType)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> f b) -> (c -> f d) -> (a, c) -> f (b, d)
combineM (BlackBoxContext -> BlackBoxTemplate -> StateT backend Identity Text
forall backend.
Backend backend =>
BlackBoxContext -> BlackBoxTemplate -> State backend Text
lineToIdentifier BlackBoxContext
b) (HWType -> StateT backend Identity HWType
forall (m :: * -> *) a. Monad m => a -> m a
return (HWType -> StateT backend Identity HWType)
-> (BlackBoxTemplate -> HWType)
-> BlackBoxTemplate
-> StateT backend Identity HWType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b)) [(BlackBoxTemplate, BlackBoxTemplate)]
ls
  let Just (templ0 :: Either BlackBox (Identifier, [Declaration])
templ0,_,libs :: [BlackBoxTemplate]
libs,imps :: [BlackBoxTemplate]
imps,inc :: [((Identifier, Identifier), BlackBox)]
inc,pCtx :: BlackBoxContext
pCtx)  = Int
-> IntMap
     (Either BlackBox (Identifier, [Declaration]), WireOrReg,
      [BlackBoxTemplate], [BlackBoxTemplate],
      [((Identifier, Identifier), BlackBox)], BlackBoxContext)
-> Maybe
     (Either BlackBox (Identifier, [Declaration]), WireOrReg,
      [BlackBoxTemplate], [BlackBoxTemplate],
      [((Identifier, Identifier), BlackBox)], BlackBoxContext)
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
n (BlackBoxContext
-> IntMap
     (Either BlackBox (Identifier, [Declaration]), WireOrReg,
      [BlackBoxTemplate], [BlackBoxTemplate],
      [((Identifier, Identifier), BlackBox)], BlackBoxContext)
bbFunctions BlackBoxContext
b)
      b' :: BlackBoxContext
b' = BlackBoxContext
pCtx { bbResult :: (Expr, HWType)
bbResult = (Expr
o,HWType
oTy), bbInputs :: [(Expr, HWType, Bool)]
bbInputs = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
pCtx [(Expr, HWType, Bool)]
-> [(Expr, HWType, Bool)] -> [(Expr, HWType, Bool)]
forall a. [a] -> [a] -> [a]
++ [(Expr, HWType, Bool)]
is }
      layoutOptions :: LayoutOptions
layoutOptions = PageWidth -> LayoutOptions
LayoutOptions (Int -> Double -> PageWidth
AvailablePerLine 120 0.4)

  BlackBox
templ1 <-
    case Either BlackBox (Identifier, [Declaration])
templ0 of
      Left t :: BlackBox
t ->
        BlackBox -> StateT backend Identity BlackBox
forall (m :: * -> *) a. Monad m => a -> m a
return BlackBox
t
      Right (nm :: Identifier
nm,ds :: [Declaration]
ds) -> do
        Doc
block <- Mon (State backend) Doc -> State backend Doc
forall (f :: * -> *) m. Mon f m -> f m
getMon (Identifier -> [Declaration] -> Mon (State backend) Doc
forall state.
Backend state =>
Identifier -> [Declaration] -> Mon (State state) Doc
blockDecl Identifier
nm [Declaration]
ds)
        BlackBox -> StateT backend Identity BlackBox
forall (m :: * -> *) a. Monad m => a -> m a
return (BlackBox -> StateT backend Identity BlackBox)
-> BlackBox -> StateT backend Identity BlackBox
forall a b. (a -> b) -> a -> b
$ BlackBoxTemplate -> BlackBox
N.BBTemplate
               (BlackBoxTemplate -> BlackBox) -> BlackBoxTemplate -> BlackBox
forall a b. (a -> b) -> a -> b
$ Text -> BlackBoxTemplate
parseFail
               (Text -> BlackBoxTemplate) -> Text -> BlackBoxTemplate
forall a b. (a -> b) -> a -> b
$ SimpleDocStream () -> Text
forall ann. SimpleDocStream ann -> Text
renderLazy
               (SimpleDocStream () -> Text) -> SimpleDocStream () -> Text
forall a b. (a -> b) -> a -> b
$ LayoutOptions -> Doc -> SimpleDocStream ()
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
layoutOptions Doc
block

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

  if BlackBoxContext -> BlackBox -> Bool
verifyBlackBoxContext BlackBoxContext
b' BlackBox
templ4
    then do
      Int -> Doc
bb <- [BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
forall backend.
Backend backend =>
[BlackBoxTemplate]
-> [BlackBoxTemplate]
-> [((Identifier, Identifier), BlackBox)]
-> BlackBox
-> BlackBoxContext
-> State backend (Int -> Doc)
renderBlackBox [BlackBoxTemplate]
libs [BlackBoxTemplate]
imps [((Identifier, Identifier), BlackBox)]
inc BlackBox
templ4 BlackBoxContext
b'
      (Int -> Text) -> State backend (Int -> Text)
forall (m :: * -> *) 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)
    else do
      SrcSpan
sp <- State backend SrcSpan
forall state. Backend state => State state SrcSpan
getSrcSpan
      ClashException -> State backend (Int -> Text)
forall a e. Exception e => e -> a
throw (SrcSpan -> [Char] -> Maybe [Char] -> ClashException
ClashException SrcSpan
sp ($(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "\nCan't match context:\n"
                                          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ BlackBoxContext -> [Char]
forall a. Show a => a -> [Char]
show BlackBoxContext
b' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "\nwith template:\n"
                                          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Either BlackBox (Identifier, [Declaration]) -> [Char]
forall a. Show a => a -> [Char]
show Either BlackBox (Identifier, [Declaration])
templ0) Maybe [Char]
forall a. Maybe a
Nothing)

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

renderElem b :: BlackBoxContext
b (Period n :: Int
n) = do
  let (_, ty :: HWType
ty, _) = BlackBoxContext -> [(Expr, HWType, Bool)]
bbInputs BlackBoxContext
b [(Expr, HWType, Bool)] -> Int -> (Expr, HWType, Bool)
forall a. [a] -> Int -> a
!! Int
n
  case HWType -> HWType
stripVoid HWType
ty of
    KnownDomain _ period :: Integer
period _ _ _ _ ->
      (Int -> Text) -> State backend (Int -> Text)
forall (m :: * -> *) 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
$ [Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
period
    _ ->
      [Char] -> State backend (Int -> Text)
forall a. HasCallStack => [Char] -> a
error ([Char] -> State backend (Int -> Text))
-> [Char] -> State backend (Int -> Text)
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "Period: Expected `KnownDomain` or `KnownConfiguration`, not: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HWType -> [Char]
forall a. Show a => a -> [Char]
show HWType
ty

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


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

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

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

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

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

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

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

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

parseFail :: Text -> BlackBoxTemplate
parseFail :: Text -> BlackBoxTemplate
parseFail t :: Text
t = case Text -> Result BlackBoxTemplate
runParse Text
t of
  Failure errInfo :: ErrInfo
errInfo ->
    [Char] -> BlackBoxTemplate
forall a. HasCallStack => [Char] -> a
error (SimpleDoc -> [Char] -> [Char]
ANSI.displayS (Doc -> SimpleDoc
ANSI.renderCompact (ErrInfo -> Doc
_errDoc ErrInfo
errInfo)) "")
  Success templ :: BlackBoxTemplate
templ -> BlackBoxTemplate
templ

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

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

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

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

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

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

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

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

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

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

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

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

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

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

renderTag b :: BlackBoxContext
b (Length e :: Element
e) = Text -> State backend Text
forall (m :: * -> *) 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
. [Char] -> Text
Text.pack ([Char] -> Text) -> (HWType -> [Char]) -> HWType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> (HWType -> Int) -> HWType -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> Int
vecLen (HWType -> State backend Text) -> HWType -> State backend Text
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
e]
  where
    vecLen :: HWType -> Int
vecLen (Vector n :: Int
n _)               = Int
n
    vecLen (Void (Just (Vector n :: Int
n _))) = Int
n
    vecLen thing :: HWType
thing =
      [Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "vecLen of a non-vector type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HWType -> [Char]
forall a. Show a => a -> [Char]
show HWType
thing

renderTag b :: BlackBoxContext
b (Depth e :: Element
e) = Text -> State backend Text
forall (m :: * -> *) 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
. [Char] -> Text
Text.pack ([Char] -> Text) -> (HWType -> [Char]) -> HWType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> (HWType -> Int) -> HWType -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWType -> Int
treeDepth (HWType -> State backend Text) -> HWType -> State backend Text
forall a b. (a -> b) -> a -> b
$ BlackBoxContext -> BlackBoxTemplate -> HWType
lineToType BlackBoxContext
b [Element
e]
  where
    treeDepth :: HWType -> Int
treeDepth (RTree n :: Int
n _)               = Int
n
    treeDepth (Void (Just (RTree n :: Int
n _))) = Int
n
    treeDepth thing :: HWType
thing =
      [Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ $(curLoc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "treeDepth of a non-tree type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HWType -> [Char]
forall a. Show a => a -> [Char]
show HWType
thing

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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