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