{-# LANGUAGE CPP #-}
module Language.Netlist.GenVHDL(genVHDL) where
import Language.Netlist.AST
#if MIN_VERSION_base(4,11,0)
import Prelude hiding ((<>))
#endif
import Text.PrettyPrint
import Data.Maybe(catMaybes, mapMaybe)
genVHDL :: Module -> [String] -> String
genVHDL :: Module -> [String] -> String
genVHDL Module
m [String]
others = Doc -> String
render Doc
vhdl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
where
vhdl :: Doc
vhdl = [String] -> Doc
imports [String]
others Doc -> Doc -> Doc
$$
Module -> Doc
entity Module
m Doc -> Doc -> Doc
$$
Module -> Doc
architecture Module
m
imports :: [String] -> Doc
imports :: [String] -> Doc
imports [String]
others = [Doc] -> Doc
vcat
[ String -> Doc
text String
"library IEEE" Doc -> Doc -> Doc
<> Doc
semi
, String -> Doc
text String
"use IEEE.STD_LOGIC_1164.ALL" Doc -> Doc -> Doc
<> Doc
semi
, String -> Doc
text String
"use IEEE.NUMERIC_STD.ALL" Doc -> Doc -> Doc
<> Doc
semi
] Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat [
String -> Doc
text (String
"use " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
other) Doc -> Doc -> Doc
<> Doc
semi
| String
other <- [String]
others
]
entity :: Module -> Doc
entity :: Module -> Doc
entity Module
m = String -> Doc
text String
"entity" Doc -> Doc -> Doc
<+> String -> Doc
text (Module -> String
module_name Module
m) Doc -> Doc -> Doc
<+> String -> Doc
text String
"is" Doc -> Doc -> Doc
$$
Int -> Doc -> Doc
nest Int
2 (String -> Doc
text String
"port" Doc -> Doc -> Doc
<> Doc -> Doc
parens ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
semi [Doc]
ports) Doc -> Doc -> Doc
<> Doc
semi) Doc -> Doc -> Doc
$$
String -> Doc
text String
"end" Doc -> Doc -> Doc
<+> String -> Doc
text String
"entity" Doc -> Doc -> Doc
<+> String -> Doc
text (Module -> String
module_name Module
m) Doc -> Doc -> Doc
<> Doc
semi
where ports :: [Doc]
ports = [String -> Doc
text String
i Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> String -> Doc
text String
"in" Doc -> Doc -> Doc
<+> Maybe Range -> Doc
slv_type Maybe Range
ran | (String
i,Maybe Range
ran) <- Module -> [(String, Maybe Range)]
module_inputs Module
m ] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
[String -> Doc
text String
i Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> String -> Doc
text String
"out" Doc -> Doc -> Doc
<+> Maybe Range -> Doc
slv_type Maybe Range
ran | (String
i,Maybe Range
ran) <- Module -> [(String, Maybe Range)]
module_outputs Module
m ]
architecture :: Module -> Doc
architecture :: Module -> Doc
architecture Module
m = String -> Doc
text String
"architecture" Doc -> Doc -> Doc
<+> String -> Doc
text String
"str" Doc -> Doc -> Doc
<+> String -> Doc
text String
"of" Doc -> Doc -> Doc
<+> String -> Doc
text (Module -> String
module_name Module
m) Doc -> Doc -> Doc
<+> String -> Doc
text String
"is" Doc -> Doc -> Doc
$$
Int -> Doc -> Doc
nest Int
2 ([Decl] -> Doc
decls (Module -> [Decl]
module_decls Module
m)) Doc -> Doc -> Doc
$$
String -> Doc
text String
"begin" Doc -> Doc -> Doc
$$
Int -> Doc -> Doc
nest Int
2 ([Decl] -> Doc
insts (Module -> [Decl]
module_decls Module
m)) Doc -> Doc -> Doc
$$
String -> Doc
text String
"end" Doc -> Doc -> Doc
<+> String -> Doc
text String
"architecture" Doc -> Doc -> Doc
<+> String -> Doc
text String
"str" Doc -> Doc -> Doc
<> Doc
semi
decls :: [Decl] -> Doc
decls :: [Decl] -> Doc
decls = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([Decl] -> [Doc]) -> [Decl] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc -> Doc
<> Doc
semi) ([Doc] -> [Doc]) -> ([Decl] -> [Doc]) -> [Decl] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Decl -> Maybe Doc) -> [Decl] -> [Doc]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Decl -> Maybe Doc
decl
decl :: Decl -> Maybe Doc
decl :: Decl -> Maybe Doc
decl (NetDecl String
i Maybe Range
r Maybe Expr
Nothing) = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"signal" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> Maybe Range -> Doc
slv_type Maybe Range
r
decl (NetDecl String
i Maybe Range
r (Just Expr
init)) = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"signal" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> Maybe Range -> Doc
slv_type Maybe Range
r Doc -> Doc -> Doc
<+> String -> Doc
text String
":=" Doc -> Doc -> Doc
<+> Expr -> Doc
expr Expr
init
decl (MemDecl String
i Maybe Range
Nothing Maybe Range
dsize Maybe [Expr]
Nothing) = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"signal" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> Maybe Range -> Doc
slv_type Maybe Range
dsize
decl (MemDecl String
i (Just Range
asize) Maybe Range
dsize Maybe [Expr]
def) = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"type" Doc -> Doc -> Doc
<+> Doc
mtype Doc -> Doc -> Doc
<+> String -> Doc
text String
"is" Doc -> Doc -> Doc
<+>
String -> Doc
text String
"array" Doc -> Doc -> Doc
<+> Range -> Doc
range Range
asize Doc -> Doc -> Doc
<+> String -> Doc
text String
"of" Doc -> Doc -> Doc
<+> Maybe Range -> Doc
slv_type Maybe Range
dsize Doc -> Doc -> Doc
<> Doc
semi Doc -> Doc -> Doc
$$
String -> Doc
text String
"signal" Doc -> Doc -> Doc
<+> String -> Doc
text String
i Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> Doc
mtype Doc -> Doc -> Doc
<> Doc
def_txt
where mtype :: Doc
mtype = String -> Doc
text String
i Doc -> Doc -> Doc
<> String -> Doc
text String
"_type"
def_txt :: Doc
def_txt = case Maybe [Expr]
def of
Maybe [Expr]
Nothing -> Doc
empty
Just [Expr
xs] -> Doc
empty Doc -> Doc -> Doc
<+> String -> Doc
text String
":=" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (String -> Doc
text String
"0 =>" Doc -> Doc -> Doc
<+> Expr -> Doc
expr Expr
xs)
Just [Expr]
xs -> Doc
empty Doc -> Doc -> Doc
<+> String -> Doc
text String
":=" Doc -> Doc -> Doc
<+> Doc -> Doc
parens ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((Expr -> Doc) -> [Expr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc
expr [Expr]
xs))
decl Decl
_d = Maybe Doc
forall a. Maybe a
Nothing
insts :: [Decl] -> Doc
insts :: [Decl] -> Doc
insts = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([Decl] -> [Doc]) -> [Decl] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc -> Doc
<> Doc
semi) ([Doc] -> [Doc]) -> ([Decl] -> [Doc]) -> [Decl] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Doc] -> [Doc]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Doc] -> [Doc])
-> ([Decl] -> [Maybe Doc]) -> [Decl] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Decl -> Maybe Doc) -> [String] -> [Decl] -> [Maybe Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> Decl -> Maybe Doc
inst [String]
gensyms
where gensyms :: [String]
gensyms = [String
"proc" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i | Integer
i <- [(Integer
0::Integer)..]]
inst :: String -> Decl -> Maybe Doc
inst :: String -> Decl -> Maybe Doc
inst String
_ (NetAssign String
i Expr
e) = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"<=" Doc -> Doc -> Doc
<+> Expr -> Doc
expr Expr
e
inst String
_ (MemAssign String
i Expr
idx Expr
e) = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
i Doc -> Doc -> Doc
<> Doc -> Doc
parens (Expr -> Doc
expr Expr
idx) Doc -> Doc -> Doc
<+> String -> Doc
text String
"<=" Doc -> Doc -> Doc
<+> Expr -> Doc
expr Expr
e
inst String
gensym (ProcessDecl (Event Expr
clk Edge
edge) Maybe (Event, Stmt)
Nothing Stmt
s) = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
gensym Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> String -> Doc
text String
"process" Doc -> Doc -> Doc
<> Doc
senlist Doc -> Doc -> Doc
<+> String -> Doc
text String
"is" Doc -> Doc -> Doc
$$
String -> Doc
text String
"begin" Doc -> Doc -> Doc
$$
Int -> Doc -> Doc
nest Int
2 (String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest Int
2 Doc
event Doc -> Doc -> Doc
<+> String -> Doc
text String
"then" Doc -> Doc -> Doc
$$
Int -> Doc -> Doc
nest Int
2 (Stmt -> Doc
stmt Stmt
s) Doc -> Doc -> Doc
$$
String -> Doc
text String
"end if" Doc -> Doc -> Doc
<> Doc
semi) Doc -> Doc -> Doc
$$
String -> Doc
text String
"end process" Doc -> Doc -> Doc
<+> String -> Doc
text String
gensym
where
senlist :: Doc
senlist = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Expr -> Doc
expr Expr
clk
event :: Doc
event = case Edge
edge of
Edge
PosEdge -> String -> Doc
text String
"rising_edge" Doc -> Doc -> Doc
<> Doc -> Doc
parens (Expr -> Doc
expr Expr
clk)
Edge
NegEdge -> String -> Doc
text String
"falling_edge" Doc -> Doc -> Doc
<> Doc -> Doc
parens (Expr -> Doc
expr Expr
clk)
inst String
gensym (ProcessDecl (Event Expr
clk Edge
clk_edge)
(Just (Event Expr
reset Edge
reset_edge, Stmt
reset_stmt)) Stmt
s) = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
gensym Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> String -> Doc
text String
"process" Doc -> Doc -> Doc
<> Doc
senlist Doc -> Doc -> Doc
<+> String -> Doc
text String
"is" Doc -> Doc -> Doc
$$
String -> Doc
text String
"begin" Doc -> Doc -> Doc
$$
Int -> Doc -> Doc
nest Int
2 (String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest Int
2 Doc
reset_event Doc -> Doc -> Doc
<+> String -> Doc
text String
"then" Doc -> Doc -> Doc
$$
Int -> Doc -> Doc
nest Int
2 (Stmt -> Doc
stmt Stmt
reset_stmt) Doc -> Doc -> Doc
$$
String -> Doc
text String
"elsif" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest Int
2 Doc
clk_event Doc -> Doc -> Doc
<+> String -> Doc
text String
"then" Doc -> Doc -> Doc
$$
Int -> Doc -> Doc
nest Int
2 (Stmt -> Doc
stmt Stmt
s) Doc -> Doc -> Doc
$$
String -> Doc
text String
"end if" Doc -> Doc -> Doc
<> Doc
semi) Doc -> Doc -> Doc
$$
String -> Doc
text String
"end process" Doc -> Doc -> Doc
<+> String -> Doc
text String
gensym
where
senlist :: Doc
senlist = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
cat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Expr -> Doc) -> [Expr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc
expr [ Expr
clk, Expr
reset ]
clk_event :: Doc
clk_event = case Edge
clk_edge of
Edge
PosEdge -> String -> Doc
text String
"rising_edge" Doc -> Doc -> Doc
<> Doc -> Doc
parens (Expr -> Doc
expr Expr
clk)
Edge
NegEdge -> String -> Doc
text String
"falling_edge" Doc -> Doc -> Doc
<> Doc -> Doc
parens (Expr -> Doc
expr Expr
clk)
reset_event :: Doc
reset_event = case Edge
reset_edge of
Edge
PosEdge -> Expr -> Doc
expr Expr
reset Doc -> Doc -> Doc
<+> String -> Doc
text String
"= '1'"
Edge
NegEdge -> Expr -> Doc
expr Expr
reset Doc -> Doc -> Doc
<+> String -> Doc
text String
"= '0'"
inst String
_ (InstDecl String
nm String
inst [(String, Expr)]
gens [(String, Expr)]
ins [(String, Expr)]
outs) = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
inst Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> String -> Doc
text String
"entity" Doc -> Doc -> Doc
<+> String -> Doc
text String
nm Doc -> Doc -> Doc
$$
Doc
gs Doc -> Doc -> Doc
$$
Doc
ps
where
gs :: Doc
gs | [(String, Expr)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Expr)]
gens = Doc
empty
| Bool
otherwise =
String -> Doc
text String
"generic map" Doc -> Doc -> Doc
<+>
(Doc -> Doc
parens ([Doc] -> Doc
cat (Doc -> [Doc] -> [Doc]
punctuate Doc
comma [String -> Doc
text String
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"=>" Doc -> Doc -> Doc
<+> Expr -> Doc
expr Expr
e | (String
i,Expr
e) <- [(String, Expr)]
gens])))
ps :: Doc
ps = String -> Doc
text String
"port map" Doc -> Doc -> Doc
<+>
Doc -> Doc
parens ([Doc] -> Doc
cat (Doc -> [Doc] -> [Doc]
punctuate Doc
comma [String -> Doc
text String
i Doc -> Doc -> Doc
<+> String -> Doc
text String
"=>" Doc -> Doc -> Doc
<+> Expr -> Doc
expr Expr
e | (String
i,Expr
e) <- ([(String, Expr)]
ins [(String, Expr)] -> [(String, Expr)] -> [(String, Expr)]
forall a. [a] -> [a] -> [a]
++ [(String, Expr)]
outs)]))
inst String
gensym (InitProcessDecl Stmt
s) = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
String -> Doc
text String
"-- synthesis_off" Doc -> Doc -> Doc
$$
String -> Doc
text String
gensym Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> String -> Doc
text String
"process" Doc -> Doc -> Doc
<> Doc
senlist Doc -> Doc -> Doc
<+> String -> Doc
text String
"is" Doc -> Doc -> Doc
$$
String -> Doc
text String
"begin" Doc -> Doc -> Doc
$$
Int -> Doc -> Doc
nest Int
2 (Stmt -> Doc
stmt Stmt
s) Doc -> Doc -> Doc
$$
String -> Doc
text String
"wait" Doc -> Doc -> Doc
<> Doc
semi Doc -> Doc -> Doc
$$
String -> Doc
text String
"end process" Doc -> Doc -> Doc
<+> String -> Doc
text String
gensym Doc -> Doc -> Doc
$$
String -> Doc
text String
"-- synthesis_on"
where senlist :: Doc
senlist = Doc -> Doc
parens Doc
empty
inst String
_ (CommentDecl String
msg) = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
([Doc] -> Doc
vcat [ String -> Doc
text String
"--" Doc -> Doc -> Doc
<+> String -> Doc
text String
m | String
m <- String -> [String]
lines String
msg ])
inst String
_ Decl
_d = Maybe Doc
forall a. Maybe a
Nothing
stmt :: Stmt -> Doc
stmt :: Stmt -> Doc
stmt (Assign Expr
l Expr
r) = Expr -> Doc
expr Expr
l Doc -> Doc -> Doc
<+> String -> Doc
text String
"<=" Doc -> Doc -> Doc
<+> Expr -> Doc
expr Expr
r Doc -> Doc -> Doc
<> Doc
semi
stmt (Seq [Stmt]
ss) = [Doc] -> Doc
vcat ((Stmt -> Doc) -> [Stmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt -> Doc
stmt [Stmt]
ss)
stmt (If Expr
e Stmt
t Maybe Stmt
Nothing) =
String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Expr -> Doc
expr Expr
e Doc -> Doc -> Doc
<+> String -> Doc
text String
"then" Doc -> Doc -> Doc
$$
Int -> Doc -> Doc
nest Int
2 (Stmt -> Doc
stmt Stmt
t) Doc -> Doc -> Doc
$$
String -> Doc
text String
"end if" Doc -> Doc -> Doc
<> Doc
semi
stmt (If Expr
p Stmt
t (Just Stmt
e)) =
String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Expr -> Doc
expr Expr
p Doc -> Doc -> Doc
<+> String -> Doc
text String
"then" Doc -> Doc -> Doc
$$
Int -> Doc -> Doc
nest Int
2 (Stmt -> Doc
stmt Stmt
t) Doc -> Doc -> Doc
$$
String -> Doc
text String
"else" Doc -> Doc -> Doc
$$
Int -> Doc -> Doc
nest Int
2 (Stmt -> Doc
stmt Stmt
e) Doc -> Doc -> Doc
$$
String -> Doc
text String
"end if" Doc -> Doc -> Doc
<> Doc
semi
stmt (Case Expr
d [([Expr], Stmt)]
ps Maybe Stmt
def) =
String -> Doc
text String
"case" Doc -> Doc -> Doc
<+> Expr -> Doc
expr Expr
d Doc -> Doc -> Doc
<+> String -> Doc
text String
"of" Doc -> Doc -> Doc
$$
[Doc] -> Doc
vcat ((([Expr], Stmt) -> Doc) -> [([Expr], Stmt)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Expr], Stmt) -> Doc
mkAlt [([Expr], Stmt)]
ps) Doc -> Doc -> Doc
$$
Doc
defDoc Doc -> Doc -> Doc
$$
String -> Doc
text String
"end case" Doc -> Doc -> Doc
<> Doc
semi
where defDoc :: Doc
defDoc = Doc -> (Stmt -> Doc) -> Maybe Stmt -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty Stmt -> Doc
mkDefault Maybe Stmt
def
mkDefault :: Stmt -> Doc
mkDefault Stmt
s = String -> Doc
text String
"when others =>" Doc -> Doc -> Doc
$$
Int -> Doc -> Doc
nest Int
2 (Stmt -> Doc
stmt Stmt
s)
mkAlt :: ([Expr], Stmt) -> Doc
mkAlt ([Expr
g],Stmt
s) = String -> Doc
text String
"when" Doc -> Doc -> Doc
<+> Expr -> Doc
expr Expr
g Doc -> Doc -> Doc
<+> String -> Doc
text String
"=>" Doc -> Doc -> Doc
$$
Int -> Doc -> Doc
nest Int
2 (Stmt -> Doc
stmt Stmt
s)
to_bits :: Integral a => Int -> a -> [Bit]
to_bits :: forall a. Integral a => Int -> a -> [Bit]
to_bits Int
size a
val = (a -> Bit) -> [a] -> [Bit]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> if a -> Bool
forall a. Integral a => a -> Bool
odd a
x then Bit
T else Bit
F)
([a] -> [Bit]) -> [a] -> [Bit]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse
([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
size
([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
2)
([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2)
(a -> [a]) -> a -> [a]
forall a b. (a -> b) -> a -> b
$ a
val
bit_char :: Bit -> Char
bit_char :: Bit -> Char
bit_char Bit
T = Char
'1'
bit_char Bit
F = Char
'0'
bit_char Bit
U = Char
'U'
bit_char Bit
Z = Char
'Z'
bits :: [Bit] -> Doc
bits :: [Bit] -> Doc
bits = Doc -> Doc
doubleQuotes (Doc -> Doc) -> ([Bit] -> Doc) -> [Bit] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text (String -> Doc) -> ([Bit] -> String) -> [Bit] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bit -> Char) -> [Bit] -> String
forall a b. (a -> b) -> [a] -> [b]
map Bit -> Char
bit_char
expr_lit :: Maybe Size -> ExprLit -> Doc
expr_lit :: Maybe Int -> ExprLit -> Doc
expr_lit Maybe Int
Nothing (ExprNum Integer
i) = Int -> Doc
int (Int -> Doc) -> Int -> Doc
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i
expr_lit (Just Int
sz) (ExprNum Integer
i) = [Bit] -> Doc
bits (Int -> Integer -> [Bit]
forall a. Integral a => Int -> a -> [Bit]
to_bits Int
sz Integer
i)
expr_lit Maybe Int
_ (ExprBit Bit
x) = Doc -> Doc
quotes (Char -> Doc
char (Bit -> Char
bit_char Bit
x))
expr_lit Maybe Int
Nothing (ExprBitVector [Bit]
xs) = [Bit] -> Doc
bits [Bit]
xs
expr_lit (Just Int
sz) (ExprBitVector [Bit]
xs) = [Bit] -> Doc
bits ([Bit] -> Doc) -> [Bit] -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> [Bit] -> [Bit]
forall a. Int -> [a] -> [a]
take Int
sz [Bit]
xs
expr :: Expr -> Doc
expr :: Expr -> Doc
expr (ExprLit Maybe Int
mb_sz ExprLit
lit) = Maybe Int -> ExprLit -> Doc
expr_lit Maybe Int
mb_sz ExprLit
lit
expr (ExprVar String
n) = String -> Doc
text String
n
expr (ExprIndex String
s Expr
i) = String -> Doc
text String
s Doc -> Doc -> Doc
<> Doc -> Doc
parens (Expr -> Doc
expr Expr
i)
expr (ExprSlice String
s Expr
h Expr
l)
| Expr
h Expr -> Expr -> Bool
forall a. Ord a => a -> a -> Bool
>= Expr
l = String -> Doc
text String
s Doc -> Doc -> Doc
<> Doc -> Doc
parens (Expr -> Doc
expr Expr
h Doc -> Doc -> Doc
<+> String -> Doc
text String
"downto" Doc -> Doc -> Doc
<+> Expr -> Doc
expr Expr
l)
| Bool
otherwise = String -> Doc
text String
s Doc -> Doc -> Doc
<> Doc -> Doc
parens (Expr -> Doc
expr Expr
h Doc -> Doc -> Doc
<+> String -> Doc
text String
"to" Doc -> Doc -> Doc
<+> Expr -> Doc
expr Expr
l)
expr (ExprConcat [Expr]
ss) = [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text String
" & ") ((Expr -> Doc) -> [Expr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc
expr [Expr]
ss)
expr (ExprUnary UnaryOp
op Expr
e) = UnaryOp -> Doc -> Doc
lookupUnary UnaryOp
op (Expr -> Doc
expr Expr
e)
expr (ExprBinary BinaryOp
op Expr
a Expr
b) = BinaryOp -> Doc -> Doc -> Doc
lookupBinary BinaryOp
op (Expr -> Doc
expr Expr
a) (Expr -> Doc
expr Expr
b)
expr (ExprFunCall String
f [Expr]
args) = String -> Doc
text String
f Doc -> Doc -> Doc
<> Doc -> Doc
parens ([Doc] -> Doc
cat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Expr -> Doc) -> [Expr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Doc
expr [Expr]
args)
expr (ExprCond Expr
c Expr
t Expr
e) = Expr -> Doc
expr Expr
t Doc -> Doc -> Doc
<+> String -> Doc
text String
"when" Doc -> Doc -> Doc
<+> Expr -> Doc
expr Expr
c Doc -> Doc -> Doc
<+> String -> Doc
text String
"else" Doc -> Doc -> Doc
$$ Expr -> Doc
expr Expr
e
expr (ExprCase Expr
_ [] Maybe Expr
Nothing) = String -> Doc
forall a. HasCallStack => String -> a
error String
"VHDL does not support non-defaulted ExprCase"
expr (ExprCase Expr
_ [] (Just Expr
e)) = Expr -> Doc
expr Expr
e
expr (ExprCase Expr
e (([],Expr
_):[([Expr], Expr)]
alts) Maybe Expr
def) = Expr -> Doc
expr (Expr -> [([Expr], Expr)] -> Maybe Expr -> Expr
ExprCase Expr
e [([Expr], Expr)]
alts Maybe Expr
def)
expr (ExprCase Expr
e ((Expr
p:[Expr]
ps,Expr
alt):[([Expr], Expr)]
alts) Maybe Expr
def) =
Expr -> Doc
expr (Expr -> Expr -> Expr -> Expr
ExprCond (BinaryOp -> Expr -> Expr -> Expr
ExprBinary BinaryOp
Equals Expr
e Expr
p) Expr
alt (Expr -> [([Expr], Expr)] -> Maybe Expr -> Expr
ExprCase Expr
e (([Expr]
ps,Expr
alt)([Expr], Expr) -> [([Expr], Expr)] -> [([Expr], Expr)]
forall a. a -> [a] -> [a]
:[([Expr], Expr)]
alts) Maybe Expr
def))
expr Expr
x = String -> Doc
text (Expr -> String
forall a. Show a => a -> String
show Expr
x)
lookupUnary :: UnaryOp -> Doc -> Doc
lookupUnary :: UnaryOp -> Doc -> Doc
lookupUnary UnaryOp
op Doc
e = String -> Doc
text (UnaryOp -> String
unOp UnaryOp
op) Doc -> Doc -> Doc
<> Doc -> Doc
parens Doc
e
unOp :: UnaryOp -> String
unOp :: UnaryOp -> String
unOp UnaryOp
UPlus = String
""
unOp UnaryOp
UMinus = String
"-"
unOp UnaryOp
LNeg = String
"not"
unOp UnaryOp
UAnd = String
"and"
unOp UnaryOp
UNand = String
"nand"
unOp UnaryOp
UOr = String
"or"
unOp UnaryOp
UNor = String
"nor"
unOp UnaryOp
UXor = String
"xor"
unOp UnaryOp
UXnor = String
"xnor"
unOp UnaryOp
Neg = String
"-"
lookupBinary :: BinaryOp -> Doc -> Doc -> Doc
lookupBinary :: BinaryOp -> Doc -> Doc -> Doc
lookupBinary BinaryOp
op Doc
a Doc
b = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
a Doc -> Doc -> Doc
<+> String -> Doc
text (BinaryOp -> String
binOp BinaryOp
op) Doc -> Doc -> Doc
<+> Doc
b
binOp :: BinaryOp -> String
binOp :: BinaryOp -> String
binOp BinaryOp
Pow = String
"**"
binOp BinaryOp
Plus = String
"+"
binOp BinaryOp
Minus = String
"-"
binOp BinaryOp
Times = String
"*"
binOp BinaryOp
Divide = String
"/"
binOp BinaryOp
Modulo = String
"mod"
binOp BinaryOp
Equals = String
"="
binOp BinaryOp
NotEquals = String
"!="
binOp BinaryOp
CEquals = String
"="
binOp BinaryOp
CNotEquals = String
"!="
binOp BinaryOp
LAnd = String
"and"
binOp BinaryOp
LOr = String
"or"
binOp BinaryOp
LessThan = String
"<"
binOp BinaryOp
LessEqual = String
"<="
binOp BinaryOp
GreaterThan = String
">"
binOp BinaryOp
GreaterEqual = String
">="
binOp BinaryOp
And = String
"and"
binOp BinaryOp
Nand = String
"nand"
binOp BinaryOp
Or = String
"or"
binOp BinaryOp
Nor = String
"nor"
binOp BinaryOp
Xor = String
"xor"
binOp BinaryOp
Xnor = String
"xnor"
binOp BinaryOp
ShiftLeft = String
"sll"
binOp BinaryOp
ShiftRight = String
"srl"
binOp BinaryOp
RotateLeft = String
"rol"
binOp BinaryOp
RotateRight = String
"ror"
binOp BinaryOp
ShiftLeftArith = String
"sla"
binOp BinaryOp
ShiftRightArith = String
"sra"
slv_type :: Maybe Range -> Doc
slv_type :: Maybe Range -> Doc
slv_type Maybe Range
Nothing = String -> Doc
text String
"std_logic"
slv_type (Just Range
r) = String -> Doc
text String
"std_logic_vector" Doc -> Doc -> Doc
<> Range -> Doc
range Range
r
range :: Range -> Doc
range :: Range -> Doc
range (Range Expr
high Expr
low) = Doc -> Doc
parens (Expr -> Doc
expr Expr
high Doc -> Doc -> Doc
<+> String -> Doc
text String
"downto" Doc -> Doc -> Doc
<+> Expr -> Doc
expr Expr
low)