{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
-- | Syntax for the subset of VHDL-2008 emitted by the VHDL backend
--   (ReWire.Hyle.ToVHDL). Everything is typed std_logic_vector; Verilog-style
--   expression semantics (unsigned arithmetic, width rules) are provided by
--   functions in an emitted rw_helpers package.
module ReWire.VHDL.Syntax where

import ReWire.BitVector (BV, width, nat)
import ReWire.VHDL.Helpers (helpersPackage)
import ReWire.Pretty (text, Pretty (..), parens, (<+>), vsep, hsep, semi, colon, punctuate, comma, nest, align, Doc, empty)

import Data.Char (isAsciiLower, isDigit)
import Data.List (intersperse)
import Data.Text (Text)
import Numeric (showHex)
import Numeric.Natural (Natural)

import qualified Data.HashSet as Set
import qualified Data.Text    as T

type Name  = Text
type Size  = Word
type Index = Int

newtype Device = Device { Device -> [Unit]
devUnits :: [Unit] }
      deriving (Device -> Device -> Bool
(Device -> Device -> Bool)
-> (Device -> Device -> Bool) -> Eq Device
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Device -> Device -> Bool
== :: Device -> Device -> Bool
$c/= :: Device -> Device -> Bool
/= :: Device -> Device -> Bool
Eq, Int -> Device -> ShowS
[Device] -> ShowS
Device -> String
(Int -> Device -> ShowS)
-> (Device -> String) -> ([Device] -> ShowS) -> Show Device
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Device -> ShowS
showsPrec :: Int -> Device -> ShowS
$cshow :: Device -> String
show :: Device -> String
$cshowList :: [Device] -> ShowS
showList :: [Device] -> ShowS
Show)

instance Pretty Device where
      pretty :: forall ann. Device -> Doc ann
pretty (Device [Unit]
units) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
intersperse Doc ann
forall ann. Doc ann
empty ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Doc ann
forall ann. Doc ann
ppHelpers Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Unit -> Doc ann) -> [Unit] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Unit -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Unit -> Doc ann
pretty [Unit]
units
            where ppHelpers :: Doc an
                  ppHelpers :: forall ann. Doc ann
ppHelpers = [Doc an] -> Doc an
forall ann. [Doc ann] -> Doc ann
vsep ([Doc an] -> Doc an) -> [Doc an] -> Doc an
forall a b. (a -> b) -> a -> b
$ (Text -> Doc an) -> [Text] -> [Doc an]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc an
forall ann. Text -> Doc ann
text ([Text] -> [Doc an]) -> [Text] -> [Doc an]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
helpersPackage

-- | An entity/architecture pair with its context clause (use clauses, e.g.,
--   ieee.std_logic_1164.all; library clauses are derived).
data Unit = Unit
      { Unit -> Text
unitName       :: !Name
      , Unit -> [Text]
unitComments   :: ![Text] -- ^ Header comment lines, printed above the entity.
      , Unit -> [Text]
unitPackages   :: ![Text]
      , Unit -> [Port]
unitPorts      :: ![Port]
      , Unit -> [Component]
unitComponents :: ![Component]
      , Unit -> [Signal]
unitSignals    :: ![Signal]
      , Unit -> [Stmt]
unitStmts      :: ![Stmt]
      }
      deriving (Unit -> Unit -> Bool
(Unit -> Unit -> Bool) -> (Unit -> Unit -> Bool) -> Eq Unit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Unit -> Unit -> Bool
== :: Unit -> Unit -> Bool
$c/= :: Unit -> Unit -> Bool
/= :: Unit -> Unit -> Bool
Eq, Int -> Unit -> ShowS
[Unit] -> ShowS
Unit -> String
(Int -> Unit -> ShowS)
-> (Unit -> String) -> ([Unit] -> ShowS) -> Show Unit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Unit -> ShowS
showsPrec :: Int -> Unit -> ShowS
$cshow :: Unit -> String
show :: Unit -> String
$cshowList :: [Unit] -> ShowS
showList :: [Unit] -> ShowS
Show)

instance Pretty Unit where
      pretty :: forall ann. Unit -> Doc ann
pretty = Unit -> Doc ann
forall ann. Unit -> Doc ann
ppUnit

data Direction = In | Out
      deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> String
show :: Direction -> String
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show)

instance Pretty Direction where
      pretty :: forall ann. Direction -> Doc ann
pretty = \ case
            Direction
In  -> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"in"
            Direction
Out -> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"out"

data Port = Port !Name !Direction !Size
      deriving (Port -> Port -> Bool
(Port -> Port -> Bool) -> (Port -> Port -> Bool) -> Eq Port
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Port -> Port -> Bool
== :: Port -> Port -> Bool
$c/= :: Port -> Port -> Bool
/= :: Port -> Port -> Bool
Eq, Int -> Port -> ShowS
[Port] -> ShowS
Port -> String
(Int -> Port -> ShowS)
-> (Port -> String) -> ([Port] -> ShowS) -> Show Port
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Port -> ShowS
showsPrec :: Int -> Port -> ShowS
$cshow :: Port -> String
show :: Port -> String
$cshowList :: [Port] -> ShowS
showList :: [Port] -> ShowS
Show)

instance Pretty Port where
      pretty :: forall ann. Port -> Doc ann
pretty (Port Text
n Direction
d Size
sz) = Text -> Doc ann
forall ann. Text -> Doc ann
ppName Text
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Direction -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Direction -> Doc ann
pretty Direction
d Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Size -> Doc ann
forall an. Size -> Doc an
ppVecTy Size
sz

-- | Component declaration: name, integer generic names, ports.
data Component = Component !Name ![Name] ![Port]
      deriving (Component -> Component -> Bool
(Component -> Component -> Bool)
-> (Component -> Component -> Bool) -> Eq Component
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Component -> Component -> Bool
== :: Component -> Component -> Bool
$c/= :: Component -> Component -> Bool
/= :: Component -> Component -> Bool
Eq, Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
(Int -> Component -> ShowS)
-> (Component -> String)
-> ([Component] -> ShowS)
-> Show Component
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Component -> ShowS
showsPrec :: Int -> Component -> ShowS
$cshow :: Component -> String
show :: Component -> String
$cshowList :: [Component] -> ShowS
showList :: [Component] -> ShowS
Show)

instance Pretty Component where
      pretty :: forall ann. Component -> Doc ann
pretty (Component Text
n [Text]
gens [Port]
ps) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
            [ Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
6 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ [ Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"component" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
ppName Text
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"is" ]
                  [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [ Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"generic" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ (Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall ann. Text -> Doc ann
ppGeneric [Text]
gens) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
gens ]
                  [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [ Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"port" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
semi ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ (Port -> Doc ann) -> [Port] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Port -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Port -> Doc ann
pretty [Port]
ps) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Port] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Port]
ps ]
            , Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"end component" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            ]
            where ppGeneric :: Name -> Doc an
                  ppGeneric :: forall ann. Text -> Doc ann
ppGeneric Text
g = Text -> Doc an
forall ann. Text -> Doc ann
ppName Text
g Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc an
forall ann. Doc ann
colon Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc an
forall ann. Text -> Doc ann
text Text
"integer"

-- | Declarations in the architecture declarative part: signals with an
--   optional initial value, constants, and display-only comment lines.
data Signal = Signal !Name !Size !(Maybe BV)
            | Constant !Name !Size !BV
            | SigComment !Text
      deriving (Signal -> Signal -> Bool
(Signal -> Signal -> Bool)
-> (Signal -> Signal -> Bool) -> Eq Signal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Signal -> Signal -> Bool
== :: Signal -> Signal -> Bool
$c/= :: Signal -> Signal -> Bool
/= :: Signal -> Signal -> Bool
Eq, Int -> Signal -> ShowS
[Signal] -> ShowS
Signal -> String
(Int -> Signal -> ShowS)
-> (Signal -> String) -> ([Signal] -> ShowS) -> Show Signal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Signal -> ShowS
showsPrec :: Int -> Signal -> ShowS
$cshow :: Signal -> String
show :: Signal -> String
$cshowList :: [Signal] -> ShowS
showList :: [Signal] -> ShowS
Show)

instance Pretty Signal where
      pretty :: forall ann. Signal -> Doc ann
pretty = \ case
            Signal Text
n Size
sz Maybe BV
mbv  -> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"signal" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
ppName Text
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Size -> Doc ann
forall an. Size -> Doc an
ppVecTy Size
sz Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (BV -> Doc ann) -> Maybe BV -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty ((Text -> Doc ann
forall ann. Text -> Doc ann
text Text
" :=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (Doc ann -> Doc ann) -> (BV -> Doc ann) -> BV -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BV -> Doc ann
forall an. BV -> Doc an
ppInit) Maybe BV
mbv Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            Constant Text
n Size
sz BV
bv -> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"constant" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
ppName Text
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Size -> Doc ann
forall an. Size -> Doc an
ppVecTy Size
sz Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
":=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> BV -> Doc ann
forall an. BV -> Doc an
ppLit BV
bv Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            SigComment Text
c     -> Text -> Doc ann
forall ann. Text -> Doc ann
ppComment Text
c

ppComment :: Text -> Doc an
ppComment :: forall ann. Text -> Doc ann
ppComment Text
c = Text -> Doc an
forall ann. Text -> Doc ann
text Text
"--" Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc an
forall ann. Text -> Doc ann
text (Text -> Text
sanitizeComment Text
c)

-- | Newlines in comment text would push the remainder into code position.
sanitizeComment :: Text -> Text
sanitizeComment :: Text -> Text
sanitizeComment = (Char -> Char) -> Text -> Text
T.map ((Char -> Char) -> Text -> Text) -> (Char -> Char) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \ case
      Char
'\n' -> Char
' '
      Char
'\r' -> Char
' '
      Char
c    -> Char
c

data Stmt = Assign !LVal !Exp
          | SelAssign !Exp !LVal ![(BV, Exp)] !Exp                    -- ^ Selected signal assignment: scrutinee, target, choices, others.
          | Process ![Name] ![ProcVar] ![SeqStmt]                     -- ^ Sensitivity list (empty: none), variables, body.
          | Instantiate !Name !Name ![(Name, Integer)] ![(Name, Exp)] -- ^ Component, instance label, generic map, port map (empty name: positional).
          | Comment !Text
      deriving (Stmt -> Stmt -> Bool
(Stmt -> Stmt -> Bool) -> (Stmt -> Stmt -> Bool) -> Eq Stmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Stmt -> Stmt -> Bool
== :: Stmt -> Stmt -> Bool
$c/= :: Stmt -> Stmt -> Bool
/= :: Stmt -> Stmt -> Bool
Eq, Int -> Stmt -> ShowS
[Stmt] -> ShowS
Stmt -> String
(Int -> Stmt -> ShowS)
-> (Stmt -> String) -> ([Stmt] -> ShowS) -> Show Stmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Stmt -> ShowS
showsPrec :: Int -> Stmt -> ShowS
$cshow :: Stmt -> String
show :: Stmt -> String
$cshowList :: [Stmt] -> ShowS
showList :: [Stmt] -> ShowS
Show)

-- | Process-local variable declarations.
data ProcVar = LineVar !Name -- ^ variable n : line;
      deriving (ProcVar -> ProcVar -> Bool
(ProcVar -> ProcVar -> Bool)
-> (ProcVar -> ProcVar -> Bool) -> Eq ProcVar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProcVar -> ProcVar -> Bool
== :: ProcVar -> ProcVar -> Bool
$c/= :: ProcVar -> ProcVar -> Bool
/= :: ProcVar -> ProcVar -> Bool
Eq, Int -> ProcVar -> ShowS
[ProcVar] -> ShowS
ProcVar -> String
(Int -> ProcVar -> ShowS)
-> (ProcVar -> String) -> ([ProcVar] -> ShowS) -> Show ProcVar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcVar -> ShowS
showsPrec :: Int -> ProcVar -> ShowS
$cshow :: ProcVar -> String
show :: ProcVar -> String
$cshowList :: [ProcVar] -> ShowS
showList :: [ProcVar] -> ShowS
Show)

instance Pretty ProcVar where
      pretty :: forall ann. ProcVar -> Doc ann
pretty = \ case
            LineVar Text
n -> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"variable" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
ppName Text
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"line" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi

instance Pretty Stmt where
      pretty :: forall ann. Stmt -> Doc ann
pretty = \ case
            Assign LVal
lv Exp
e               -> LVal -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. LVal -> Doc ann
pretty LVal
lv Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"<=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
e Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            SelAssign Exp
c LVal
lv [(BV, Exp)]
arms Exp
dflt  -> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
6 ( [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
                  ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"with" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
c Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"select" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> LVal -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. LVal -> Doc ann
pretty LVal
lv Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"<=")
                  Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma (((BV, Exp) -> Doc ann) -> [(BV, Exp)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (BV, Exp) -> Doc ann
forall an. (BV, Exp) -> Doc an
ppArm [(BV, Exp)]
arms [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
dflt Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"when others"]) ) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            Comment Text
c                 -> Text -> Doc ann
forall ann. Text -> Doc ann
ppComment Text
c
            Process [Text]
sens [ProcVar]
vars [SeqStmt]
body    -> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
                  [ Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
6 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"process" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
sens then Doc ann
forall a. Monoid a => a
mempty else Doc ann
forall a. Monoid a => a
mempty Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ (Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall ann. Text -> Doc ann
ppName [Text]
sens))) Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (ProcVar -> Doc ann) -> [ProcVar] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ProcVar -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ProcVar -> Doc ann
pretty [ProcVar]
vars
                  , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
6 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"begin" Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (SeqStmt -> Doc ann) -> [SeqStmt] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map SeqStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SeqStmt -> Doc ann
pretty [SeqStmt]
body
                  , Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"end process" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
                  ]
            Instantiate Text
c Text
inst [(Text, Integer)]
gm [(Text, Exp)]
pm  -> Text -> Doc ann
forall ann. Text -> Doc ann
ppName Text
inst Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
ppName Text
c
                  Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (if [(Text, Integer)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Integer)]
gm then Doc ann
forall a. Monoid a => a
mempty else Doc ann
forall a. Monoid a => a
mempty Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"generic map" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ ((Text, Integer) -> Doc ann) -> [(Text, Integer)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Integer) -> Doc ann
forall an. (Text, Integer) -> Doc an
ppGenAssoc [(Text, Integer)]
gm))
                  Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"port map" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ ((Text, Exp) -> Doc ann) -> [(Text, Exp)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Exp) -> Doc ann
forall an. (Text, Exp) -> Doc an
ppPortAssoc [(Text, Exp)]
pm) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
                  where ppGenAssoc :: (Name, Integer) -> Doc an
                        ppGenAssoc :: forall an. (Text, Integer) -> Doc an
ppGenAssoc (Text
n, Integer
v) = Text -> Doc an
forall ann. Text -> Doc ann
ppName Text
n Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc an
forall ann. Text -> Doc ann
text Text
"=>" Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc an
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
v

                        ppPortAssoc :: (Name, Exp) -> Doc an
                        ppPortAssoc :: forall an. (Text, Exp) -> Doc an
ppPortAssoc = \ case
                              (Text
"", Exp
e) -> Exp -> Doc an
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
e
                              (Text
n, Exp
e)  -> Text -> Doc an
forall ann. Text -> Doc ann
ppName Text
n Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc an
forall ann. Text -> Doc ann
text Text
"=>" Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Exp -> Doc an
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
e

-- | A selected-assignment choice: the choices are literal bit-strings of
--   exactly the scrutinee's width (never constants or aggregates, for
--   portability).
ppArm :: (BV, Exp) -> Doc an
ppArm :: forall an. (BV, Exp) -> Doc an
ppArm (BV
v, Exp
e) = Exp -> Doc an
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
e Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc an
forall ann. Text -> Doc ann
text Text
"when" Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc an
forall ann. Text -> Doc ann
text Text
"\"" Doc an -> Doc an -> Doc an
forall a. Semigroup a => a -> a -> a
<> Text -> Doc an
forall ann. Text -> Doc ann
text (BV -> Text
ppBits BV
v) Doc an -> Doc an -> Doc an
forall a. Semigroup a => a -> a -> a
<> Text -> Doc an
forall ann. Text -> Doc ann
text Text
"\""

-- | Sequential statements (process bodies).
data SeqStmt = SIf ![(Cond, [SeqStmt])] ![SeqStmt] -- ^ if/elsif branches, else branch.
             | SAssign !LVal !Exp
             | SWait !Natural                      -- ^ wait for n ns;
             | SWriteLn ![Chunk]                   -- ^ write(l, ...); writeline(output, l);
             | SFinish                             -- ^ std.env.finish;
      deriving (SeqStmt -> SeqStmt -> Bool
(SeqStmt -> SeqStmt -> Bool)
-> (SeqStmt -> SeqStmt -> Bool) -> Eq SeqStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SeqStmt -> SeqStmt -> Bool
== :: SeqStmt -> SeqStmt -> Bool
$c/= :: SeqStmt -> SeqStmt -> Bool
/= :: SeqStmt -> SeqStmt -> Bool
Eq, Int -> SeqStmt -> ShowS
[SeqStmt] -> ShowS
SeqStmt -> String
(Int -> SeqStmt -> ShowS)
-> (SeqStmt -> String) -> ([SeqStmt] -> ShowS) -> Show SeqStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SeqStmt -> ShowS
showsPrec :: Int -> SeqStmt -> ShowS
$cshow :: SeqStmt -> String
show :: SeqStmt -> String
$cshowList :: [SeqStmt] -> ShowS
showList :: [SeqStmt] -> ShowS
Show)

-- | A piece of a line written by SWriteLn: a string literal or the
--   hex-string rendering of an expression.
data Chunk = ChunkLit !Text | ChunkHex !Exp
      deriving (Chunk -> Chunk -> Bool
(Chunk -> Chunk -> Bool) -> (Chunk -> Chunk -> Bool) -> Eq Chunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Chunk -> Chunk -> Bool
== :: Chunk -> Chunk -> Bool
$c/= :: Chunk -> Chunk -> Bool
/= :: Chunk -> Chunk -> Bool
Eq, Int -> Chunk -> ShowS
[Chunk] -> ShowS
Chunk -> String
(Int -> Chunk -> ShowS)
-> (Chunk -> String) -> ([Chunk] -> ShowS) -> Show Chunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Chunk -> ShowS
showsPrec :: Int -> Chunk -> ShowS
$cshow :: Chunk -> String
show :: Chunk -> String
$cshowList :: [Chunk] -> ShowS
showList :: [Chunk] -> ShowS
Show)

instance Pretty Chunk where
      pretty :: forall ann. Chunk -> Doc ann
pretty = \ case
            ChunkLit Text
t  -> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"string'(\"" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
t Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"\")"
            ChunkHex Exp
e  -> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"to_hstring" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
e)

instance Pretty SeqStmt where
      pretty :: forall ann. SeqStmt -> Doc ann
pretty = \ case
            SAssign LVal
lv Exp
e       -> LVal -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. LVal -> Doc ann
pretty LVal
lv Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"<=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
e Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            SWait Natural
n            -> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"wait for" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"ns" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            SWriteLn [Chunk]
chunks    -> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"write(l, " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (Doc ann
forall a. Monoid a => a
mempty Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"&") ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ (Chunk -> Doc ann) -> [Chunk] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Chunk -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Chunk -> Doc ann
pretty [Chunk]
chunks) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"); writeline(output, l)" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            SeqStmt
SFinish            -> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"std.env.finish" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            SIf [(Cond, [SeqStmt])]
brs [SeqStmt]
els        -> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Text -> (Cond, [SeqStmt]) -> Doc ann)
-> [Text] -> [(Cond, [SeqStmt])] -> [Doc ann]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Text -> (Cond, [SeqStmt]) -> Doc ann
forall an. Text -> (Cond, [SeqStmt]) -> Doc an
ppBranch [Text]
kws [(Cond, [SeqStmt])]
brs [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [SeqStmt] -> [Doc ann]
forall an. [SeqStmt] -> [Doc an]
ppElse [SeqStmt]
els [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"end if" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi]
                  where kws :: [Text]
                        kws :: [Text]
kws = Text
"if" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text]
forall a. a -> [a]
repeat Text
"elsif"

                        ppBranch :: Text -> (Cond, [SeqStmt]) -> Doc an
                        ppBranch :: forall an. Text -> (Cond, [SeqStmt]) -> Doc an
ppBranch Text
kw (Cond
c, [SeqStmt]
ss) = Int -> Doc an -> Doc an
forall ann. Int -> Doc ann -> Doc ann
nest Int
6 (Doc an -> Doc an) -> Doc an -> Doc an
forall a b. (a -> b) -> a -> b
$ [Doc an] -> Doc an
forall ann. [Doc ann] -> Doc ann
vsep ([Doc an] -> Doc an) -> [Doc an] -> Doc an
forall a b. (a -> b) -> a -> b
$ (Text -> Doc an
forall ann. Text -> Doc ann
text Text
kw Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Cond -> Doc an
forall a ann. Pretty a => a -> Doc ann
forall ann. Cond -> Doc ann
pretty Cond
c Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc an
forall ann. Text -> Doc ann
text Text
"then") Doc an -> [Doc an] -> [Doc an]
forall a. a -> [a] -> [a]
: (SeqStmt -> Doc an) -> [SeqStmt] -> [Doc an]
forall a b. (a -> b) -> [a] -> [b]
map SeqStmt -> Doc an
forall a ann. Pretty a => a -> Doc ann
forall ann. SeqStmt -> Doc ann
pretty [SeqStmt]
ss

                        ppElse :: [SeqStmt] -> [Doc an]
                        ppElse :: forall an. [SeqStmt] -> [Doc an]
ppElse = \ case
                              [] -> []
                              [SeqStmt]
ss -> [Int -> Doc an -> Doc an
forall ann. Int -> Doc ann -> Doc ann
nest Int
6 (Doc an -> Doc an) -> Doc an -> Doc an
forall a b. (a -> b) -> a -> b
$ [Doc an] -> Doc an
forall ann. [Doc ann] -> Doc ann
vsep ([Doc an] -> Doc an) -> [Doc an] -> Doc an
forall a b. (a -> b) -> a -> b
$ Text -> Doc an
forall ann. Text -> Doc ann
text Text
"else" Doc an -> [Doc an] -> [Doc an]
forall a. a -> [a] -> [a]
: (SeqStmt -> Doc an) -> [SeqStmt] -> [Doc an]
forall a b. (a -> b) -> [a] -> [b]
map SeqStmt -> Doc an
forall a ann. Pretty a => a -> Doc ann
forall ann. SeqStmt -> Doc ann
pretty [SeqStmt]
ss]

-- | Conditions appearing in generated processes.
data Cond = CondEq !Name !BV  -- ^ name = "bits"
          | CondRising !Name  -- ^ rising_edge(name(0))
      deriving (Cond -> Cond -> Bool
(Cond -> Cond -> Bool) -> (Cond -> Cond -> Bool) -> Eq Cond
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cond -> Cond -> Bool
== :: Cond -> Cond -> Bool
$c/= :: Cond -> Cond -> Bool
/= :: Cond -> Cond -> Bool
Eq, Int -> Cond -> ShowS
[Cond] -> ShowS
Cond -> String
(Int -> Cond -> ShowS)
-> (Cond -> String) -> ([Cond] -> ShowS) -> Show Cond
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cond -> ShowS
showsPrec :: Int -> Cond -> ShowS
$cshow :: Cond -> String
show :: Cond -> String
$cshowList :: [Cond] -> ShowS
showList :: [Cond] -> ShowS
Show)

instance Pretty Cond where
      pretty :: forall ann. Cond -> Doc ann
pretty = \ case
            CondEq Text
n BV
bv   -> Text -> Doc ann
forall ann. Text -> Doc ann
ppName Text
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"=" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> BV -> Doc ann
forall an. BV -> Doc an
ppLit BV
bv
            CondRising Text
n  -> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"rising_edge" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Text -> Doc ann
forall ann. Text -> Doc ann
ppName Text
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Int
0 :: Int)))

data LVal = LVName !Name
          | LVRange !Name !Index !Index -- ^ name(j downto i): low index i, high index j.
          | LVElem !Name !Index
      deriving (LVal -> LVal -> Bool
(LVal -> LVal -> Bool) -> (LVal -> LVal -> Bool) -> Eq LVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LVal -> LVal -> Bool
== :: LVal -> LVal -> Bool
$c/= :: LVal -> LVal -> Bool
/= :: LVal -> LVal -> Bool
Eq, Int -> LVal -> ShowS
[LVal] -> ShowS
LVal -> String
(Int -> LVal -> ShowS)
-> (LVal -> String) -> ([LVal] -> ShowS) -> Show LVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LVal -> ShowS
showsPrec :: Int -> LVal -> ShowS
$cshow :: LVal -> String
show :: LVal -> String
$cshowList :: [LVal] -> ShowS
showList :: [LVal] -> ShowS
Show)

instance Pretty LVal where
      pretty :: forall ann. LVal -> Doc ann
pretty = \ case
            LVName Text
n      -> Text -> Doc ann
forall ann. Text -> Doc ann
ppName Text
n
            LVRange Text
n Int
i Int
j -> Text -> Doc ann
forall ann. Text -> Doc ann
ppName Text
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
j Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"downto" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i)
            LVElem Text
n Int
i    -> Text -> Doc ann
forall ann. Text -> Doc ann
ppName Text
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"downto" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i)

data Exp = Lit !BV
         | Var !Name
         | Slice !Name !Index !Index -- ^ name(j downto i): low index i, high index j.
         | Elem !Name !Index         -- ^ name(i downto i): a 1-bit vector.
         | Cat ![Exp]
         | FunCall !Name ![Exp]
         | Num !Natural
      -- N.B.: deliberately no Ord, and Eq only for shape tests -- the bv
      -- package's BV Eq is width-blind (bitVec 4 0 == bitVec 8 0), so any
      -- instance derived through 'Lit' is too. Never key a map on this
      -- type; use the emitter's width-exact 'expKey' instead.
      deriving (Exp -> Exp -> Bool
(Exp -> Exp -> Bool) -> (Exp -> Exp -> Bool) -> Eq Exp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Exp -> Exp -> Bool
== :: Exp -> Exp -> Bool
$c/= :: Exp -> Exp -> Bool
/= :: Exp -> Exp -> Bool
Eq, Int -> Exp -> ShowS
[Exp] -> ShowS
Exp -> String
(Int -> Exp -> ShowS)
-> (Exp -> String) -> ([Exp] -> ShowS) -> Show Exp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Exp -> ShowS
showsPrec :: Int -> Exp -> ShowS
$cshow :: Exp -> String
show :: Exp -> String
$cshowList :: [Exp] -> ShowS
showList :: [Exp] -> ShowS
Show)

instance Pretty Exp where
      pretty :: forall ann. Exp -> Doc ann
pretty = \ case
            Lit BV
bv        -> BV -> Doc ann
forall an. BV -> Doc an
ppLit BV
bv
            Var Text
n         -> Text -> Doc ann
forall ann. Text -> Doc ann
ppName Text
n
            Slice Text
n Int
i Int
j   -> Text -> Doc ann
forall ann. Text -> Doc ann
ppName Text
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
j Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"downto" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i)
            Elem Text
n Int
i      -> Text -> Doc ann
forall ann. Text -> Doc ann
ppName Text
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"downto" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i)
            Cat []        -> BV -> Doc ann
forall an. BV -> Doc an
ppLit BV
forall a. Monoid a => a
mempty
            Cat [Exp
e]       -> Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
e
            Cat [Exp]
es        -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (Doc ann
forall a. Monoid a => a
mempty Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
"&") ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ (Exp -> Doc ann) -> [Exp] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty [Exp]
es
            FunCall Text
f [Exp]
es  -> Text -> Doc ann
forall ann. Text -> Doc ann
text Text
f Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ (Exp -> Doc ann) -> [Exp] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty [Exp]
es) -- only rw_helpers functions
            Num Natural
n         -> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Integer -> Doc ann) -> Integer -> Doc ann
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n

-- | A qualified bit-string literal: hex (std_logic_vector'(X"5a")) when the
--   width is a whole number of hex digits, binary (std_logic_vector'(B"0101"))
--   otherwise.
ppLit :: BV -> Doc an
ppLit :: forall an. BV -> Doc an
ppLit BV
bv | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0, Int
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Text -> Doc an
forall ann. Text -> Doc ann
text Text
"std_logic_vector'(X\"" Doc an -> Doc an -> Doc an
forall a. Semigroup a => a -> a -> a
<> Text -> Doc an
forall ann. Text -> Doc ann
text (BV -> Text
ppHex BV
bv) Doc an -> Doc an -> Doc an
forall a. Semigroup a => a -> a -> a
<> Text -> Doc an
forall ann. Text -> Doc ann
text Text
"\")"
         | Bool
otherwise             = Text -> Doc an
forall ann. Text -> Doc ann
text Text
"std_logic_vector'(B\"" Doc an -> Doc an -> Doc an
forall a. Semigroup a => a -> a -> a
<> Text -> Doc an
forall ann. Text -> Doc ann
text (BV -> Text
ppBits BV
bv) Doc an -> Doc an -> Doc an
forall a. Semigroup a => a -> a -> a
<> Text -> Doc an
forall ann. Text -> Doc ann
text Text
"\")"
      where w :: Int
            w :: Int
w = BV -> Int
width BV
bv

-- | A literal in signal-initial position: like 'ppLit', except wide all-zero
--   vectors render as an aggregate.
ppInit :: BV -> Doc an
ppInit :: forall an. BV -> Doc an
ppInit BV
bv | BV -> Int
width BV
bv Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
8, BV -> Integer
nat BV
bv Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Text -> Doc an
forall ann. Text -> Doc ann
text Text
"(others => '0')"
          | Bool
otherwise                 = BV -> Doc an
forall an. BV -> Doc an
ppLit BV
bv

-- | The value in binary, exactly the vector's width.
ppBits :: BV -> Text
ppBits :: BV -> Text
ppBits BV
bv = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Integer -> Char) -> [Integer] -> String
forall a b. (a -> b) -> [a] -> [b]
map (\ Integer
i -> if Integer -> Bool
forall a. Integral a => a -> Bool
odd (Integer -> Bool) -> Integer -> Bool
forall a b. (a -> b) -> a -> b
$ BV -> Integer
nat BV
bv Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
i) then Char
'1' else Char
'0') ([Integer] -> String) -> [Integer] -> String
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Integer]
forall a. [a] -> [a]
reverse [Integer
0 .. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (BV -> Int
width BV
bv) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1]

-- | The value in hex, zero-padded to exactly width/4 digits.
ppHex :: BV -> Text
ppHex :: BV -> Text
ppHex BV
bv = Int -> Char -> Text -> Text
T.justifyRight (BV -> Int
width BV
bv Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4) Char
'0' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> ShowS
forall a. Integral a => a -> ShowS
showHex (BV -> Integer
nat BV
bv) String
""

ppVecTy :: Size -> Doc an
ppVecTy :: forall an. Size -> Doc an
ppVecTy Size
sz = Text -> Doc an
forall ann. Text -> Doc ann
text Text
"std_logic_vector" Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc an -> Doc an
forall ann. Doc ann -> Doc ann
parens (Integer -> Doc an
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Size -> Integer
forall a. Integral a => a -> Integer
toInteger Size
sz Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc an
forall ann. Text -> Doc ann
text Text
"downto" Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc an
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Int
0 :: Int))

-- | Print a name as a VHDL identifier: a basic identifier when valid (and
--   unambiguous: all-lowercase, since basic identifiers are case-insensitive),
--   otherwise a VHDL-2008 extended identifier (\\name\\).
ppName :: Name -> Doc an
ppName :: forall ann. Text -> Doc ann
ppName = Text -> Doc an
forall ann. Text -> Doc ann
text (Text -> Doc an) -> (Text -> Text) -> Text -> Doc an
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
vhdlName

vhdlName :: Name -> Text
vhdlName :: Text -> Text
vhdlName Text
n | Bool
basicOk   = Text
n
           | Bool
otherwise = Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\"
      where basicOk :: Bool
            basicOk :: Bool
basicOk = case Text -> String
T.unpack Text
n of
                  Char
c : String
cs -> Char -> Bool
isAsciiLower Char
c
                         Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\ Char
c' -> Char -> Bool
isAsciiLower Char
c' Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c' Bool -> Bool -> Bool
|| Char
c' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') String
cs
                         Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
"__" Text -> Text -> Bool
`T.isInfixOf` Text
n)
                         Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
"_" Text -> Text -> Bool
`T.isSuffixOf` Text
n)
                         Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
"rw_" Text -> Text -> Bool
`T.isPrefixOf` Text
n)
                         Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
n Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Set.member` HashSet Text
reservedWords)
                  String
_      -> Bool
False

reservedWords :: Set.HashSet Text
reservedWords :: HashSet Text
reservedWords = [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList
      [ Text
"abs", Text
"access", Text
"after", Text
"alias", Text
"all", Text
"and", Text
"architecture", Text
"array", Text
"assert"
      , Text
"attribute", Text
"begin", Text
"block", Text
"body", Text
"buffer", Text
"bus", Text
"case", Text
"component"
      , Text
"configuration", Text
"constant", Text
"context", Text
"default", Text
"disconnect", Text
"downto", Text
"else"
      , Text
"elsif", Text
"end", Text
"entity", Text
"exit", Text
"file", Text
"for", Text
"force", Text
"function", Text
"generate"
      , Text
"generic", Text
"group", Text
"guarded", Text
"if", Text
"impure", Text
"in", Text
"inertial", Text
"inout", Text
"is"
      , Text
"label", Text
"library", Text
"linkage", Text
"literal", Text
"loop", Text
"map", Text
"mod", Text
"nand", Text
"new"
      , Text
"next", Text
"nor", Text
"not", Text
"null", Text
"of", Text
"on", Text
"open", Text
"or", Text
"others", Text
"out", Text
"package"
      , Text
"parameter", Text
"port", Text
"postponed", Text
"procedure", Text
"process", Text
"property", Text
"protected"
      , Text
"pure", Text
"range", Text
"record", Text
"register", Text
"reject", Text
"release", Text
"rem", Text
"report"
      , Text
"return", Text
"rol", Text
"ror", Text
"select", Text
"sequence", Text
"severity", Text
"shared", Text
"signal"
      , Text
"sla", Text
"sll", Text
"sra", Text
"srl", Text
"subtype", Text
"then", Text
"to", Text
"transport", Text
"type"
      , Text
"unaffected", Text
"units", Text
"until", Text
"use", Text
"variable", Text
"wait", Text
"when", Text
"while", Text
"with"
      , Text
"xnor", Text
"xor"
      ]

ppUnit :: Unit -> Doc an
ppUnit :: forall ann. Unit -> Doc ann
ppUnit (Unit Text
n [Text]
cmts [Text]
pkgs [Port]
ps [Component]
comps [Signal]
sigs [Stmt]
stmts) = [Doc an] -> Doc an
forall ann. [Doc ann] -> Doc ann
vsep ([Doc an] -> Doc an) -> [Doc an] -> Doc an
forall a b. (a -> b) -> a -> b
$
      (Text -> Doc an) -> [Text] -> [Doc an]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc an
forall ann. Text -> Doc ann
ppComment [Text]
cmts
      [Doc an] -> [Doc an] -> [Doc an]
forall a. Semigroup a => a -> a -> a
<> [ [Text] -> Doc an
forall an. [Text] -> Doc an
ppContext [Text]
pkgs
         , Int -> Doc an -> Doc an
forall ann. Int -> Doc ann -> Doc ann
nest Int
6 (Doc an -> Doc an) -> Doc an -> Doc an
forall a b. (a -> b) -> a -> b
$ [Doc an] -> Doc an
forall ann. [Doc ann] -> Doc ann
vsep ([Doc an] -> Doc an) -> [Doc an] -> Doc an
forall a b. (a -> b) -> a -> b
$ (Text -> Doc an
forall ann. Text -> Doc ann
text Text
"entity" Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc an
forall ann. Text -> Doc ann
ppName Text
n Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc an
forall ann. Text -> Doc ann
text Text
"is")
               Doc an -> [Doc an] -> [Doc an]
forall a. a -> [a] -> [a]
: [ Text -> Doc an
forall ann. Text -> Doc ann
text Text
"port" Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc an -> Doc an
forall ann. Doc ann -> Doc ann
parens (Doc an -> Doc an
forall ann. Doc ann -> Doc ann
align (Doc an -> Doc an) -> Doc an -> Doc an
forall a b. (a -> b) -> a -> b
$ [Doc an] -> Doc an
forall ann. [Doc ann] -> Doc ann
vsep ([Doc an] -> Doc an) -> [Doc an] -> Doc an
forall a b. (a -> b) -> a -> b
$ Doc an -> [Doc an] -> [Doc an]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc an
forall ann. Doc ann
semi ([Doc an] -> [Doc an]) -> [Doc an] -> [Doc an]
forall a b. (a -> b) -> a -> b
$ (Port -> Doc an) -> [Port] -> [Doc an]
forall a b. (a -> b) -> [a] -> [b]
map Port -> Doc an
forall a ann. Pretty a => a -> Doc ann
forall ann. Port -> Doc ann
pretty [Port]
ps) Doc an -> Doc an -> Doc an
forall a. Semigroup a => a -> a -> a
<> Doc an
forall ann. Doc ann
semi | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Port] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Port]
ps ]
         , Text -> Doc an
forall ann. Text -> Doc ann
text Text
"end entity" Doc an -> Doc an -> Doc an
forall a. Semigroup a => a -> a -> a
<> Doc an
forall ann. Doc ann
semi
         , Doc an
forall ann. Doc ann
empty
         , Int -> Doc an -> Doc an
forall ann. Int -> Doc ann -> Doc ann
nest Int
6 (Doc an -> Doc an) -> Doc an -> Doc an
forall a b. (a -> b) -> a -> b
$ [Doc an] -> Doc an
forall ann. [Doc ann] -> Doc ann
vsep ([Doc an] -> Doc an) -> [Doc an] -> Doc an
forall a b. (a -> b) -> a -> b
$ (Text -> Doc an
forall ann. Text -> Doc ann
text Text
"architecture rtl of" Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc an
forall ann. Text -> Doc ann
ppName Text
n Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc an
forall ann. Text -> Doc ann
text Text
"is") Doc an -> [Doc an] -> [Doc an]
forall a. a -> [a] -> [a]
: (Component -> Doc an) -> [Component] -> [Doc an]
forall a b. (a -> b) -> [a] -> [b]
map Component -> Doc an
forall a ann. Pretty a => a -> Doc ann
forall ann. Component -> Doc ann
pretty [Component]
comps [Doc an] -> [Doc an] -> [Doc an]
forall a. Semigroup a => a -> a -> a
<> (Signal -> Doc an) -> [Signal] -> [Doc an]
forall a b. (a -> b) -> [a] -> [b]
map Signal -> Doc an
forall a ann. Pretty a => a -> Doc ann
forall ann. Signal -> Doc ann
pretty [Signal]
sigs
         , Int -> Doc an -> Doc an
forall ann. Int -> Doc ann -> Doc ann
nest Int
6 (Doc an -> Doc an) -> Doc an -> Doc an
forall a b. (a -> b) -> a -> b
$ [Doc an] -> Doc an
forall ann. [Doc ann] -> Doc ann
vsep ([Doc an] -> Doc an) -> [Doc an] -> Doc an
forall a b. (a -> b) -> a -> b
$ Text -> Doc an
forall ann. Text -> Doc ann
text Text
"begin" Doc an -> [Doc an] -> [Doc an]
forall a. a -> [a] -> [a]
: (Stmt -> Doc an) -> [Stmt] -> [Doc an]
forall a b. (a -> b) -> [a] -> [b]
map Stmt -> Doc an
forall a ann. Pretty a => a -> Doc ann
forall ann. Stmt -> Doc ann
pretty [Stmt]
stmts
         , Text -> Doc an
forall ann. Text -> Doc ann
text Text
"end architecture" Doc an -> Doc an -> Doc an
forall a. Semigroup a => a -> a -> a
<> Doc an
forall ann. Doc ann
semi
         ]

-- | Library clauses are derived from the package names (the work and std
--   libraries are implicit).
ppContext :: [Text] -> Doc an
ppContext :: forall an. [Text] -> Doc an
ppContext [Text]
pkgs = [Doc an] -> Doc an
forall ann. [Doc ann] -> Doc ann
vsep ([Doc an] -> Doc an) -> [Doc an] -> Doc an
forall a b. (a -> b) -> a -> b
$
      (Text -> Doc an) -> [Text] -> [Doc an]
forall a b. (a -> b) -> [a] -> [b]
map (\ Text
l -> Text -> Doc an
forall ann. Text -> Doc ann
text Text
"library" Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc an
forall ann. Text -> Doc ann
text Text
l Doc an -> Doc an -> Doc an
forall a. Semigroup a => a -> a -> a
<> Doc an
forall ann. Doc ann
semi) [Text]
libs
      [Doc an] -> [Doc an] -> [Doc an]
forall a. Semigroup a => a -> a -> a
<> (Text -> Doc an) -> [Text] -> [Doc an]
forall a b. (a -> b) -> [a] -> [b]
map (\ Text
p -> Text -> Doc an
forall ann. Text -> Doc ann
text Text
"use" Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc an
forall ann. Text -> Doc ann
text Text
p Doc an -> Doc an -> Doc an
forall a. Semigroup a => a -> a -> a
<> Doc an
forall ann. Doc ann
semi) [Text]
pkgs
      where libs :: [Text]
            libs :: [Text]
libs = (Text -> [Text] -> [Text]) -> [Text] -> [Text] -> [Text]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ Text
l [Text]
ls -> if Text
l Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
ls then [Text]
ls else Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ls) []
                 ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"work", Text
"std"]) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.')) [Text]
pkgs