{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
module ReWire.Verilog.Syntax where

import ReWire.Pretty (empty, text, squote, Pretty (..), parens, (<+>), vsep, hsep, semi, colon, punctuate, comma, nest, Doc, braces, brackets, hcat, line, softline)
import ReWire.BitVector (BV (..), showHex', width, ones, zeros)
import qualified ReWire.BitVector as BV

import Data.Text (Text)
import qualified Data.Text as T
import Data.List (intersperse)
import Numeric.Natural (Natural)

newtype Device = Device { Device -> [Module]
pgmModules :: [Module] }
      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 [Module]
mods) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (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
$ (Module -> Doc ann) -> [Module] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Module -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Module -> Doc ann
pretty [Module]
mods)

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

data Module = Module
      { Module -> Name
modName     :: Name
      , Module -> [Name]
modComments :: ![Text] -- ^ Header comment lines, printed above the module keyword.
      , Module -> [Port]
modPorts    :: [Port]
      , Module -> [Signal]
modSignals  :: [Signal]
      , Module -> [Stmt]
modStmt     :: [Stmt]
      }
      deriving (Module -> Module -> Bool
(Module -> Module -> Bool)
-> (Module -> Module -> Bool) -> Eq Module
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Module -> Module -> Bool
== :: Module -> Module -> Bool
$c/= :: Module -> Module -> Bool
/= :: Module -> Module -> Bool
Eq, Int -> Module -> ShowS
[Module] -> ShowS
Module -> String
(Int -> Module -> ShowS)
-> (Module -> String) -> ([Module] -> ShowS) -> Show Module
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Module -> ShowS
showsPrec :: Int -> Module -> ShowS
$cshow :: Module -> String
show :: Module -> String
$cshowList :: [Module] -> ShowS
showList :: [Module] -> ShowS
Show)

instance Pretty Module where
      pretty :: forall ann. Module -> Doc ann
pretty (Module Name
n [Name]
cmts [Port]
ps [Signal]
sigs [Stmt]
stmt) = [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
$
            (Name -> Doc ann) -> [Name] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc ann
forall an. Name -> Doc an
ppComment [Name]
cmts
            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [ Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ( [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
                            ([ Name -> Doc ann
forall an. Name -> Doc an
text Name
"module" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
n 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
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
comma ([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 ]
                            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> (Signal -> Doc ann) -> [Signal] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi) (Doc ann -> Doc ann) -> (Signal -> Doc ann) -> Signal -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Signal -> Doc ann
pretty) [Signal]
sigs
                            [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> (Stmt -> Doc ann) -> [Stmt] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Stmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Stmt -> Doc ann
pretty [Stmt]
stmt
                            )
                        )
               , Name -> Doc ann
forall an. Name -> Doc an
text Name
"endmodule"
               ]

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

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

data Port = Input  Signal -- ^ can't be reg
          | InOut  Signal -- ^ can't be reg
          | Output Signal
      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 = \ case
            Input Signal
s  -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"input"  Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Signal -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Signal -> Doc ann
pretty Signal
s
            InOut Signal
s  -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"inout"  Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Signal -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Signal -> Doc ann
pretty Signal
s
            Output Signal
s -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"output" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Signal -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Signal -> Doc ann
pretty Signal
s

ppDims :: [Size] -> Doc an
ppDims :: forall an. [Size] -> Doc an
ppDims = \ case
      [] -> Doc an
forall a. Monoid a => a
mempty
      [Size]
ds -> Doc an
forall a. Monoid a => a
mempty Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc an] -> Doc an
forall ann. [Doc ann] -> Doc ann
hcat ((Size -> Doc an) -> [Size] -> [Doc an]
forall a b. (a -> b) -> [a] -> [b]
map Size -> Doc an
forall an. Size -> Doc an
ppDim [Size]
ds)
      where ppDim :: Size -> Doc an
            ppDim :: forall an. Size -> Doc an
ppDim Size
sz = Doc an -> Doc an
forall ann. Doc ann -> Doc ann
brackets (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 a. Semigroup a => a -> a -> a
<> Doc an
forall ann. Doc ann
colon Doc an -> Doc an -> Doc an
forall a. Semigroup a => a -> a -> a
<> Name -> Doc an
forall an. Name -> Doc an
text Name
"0")

data Signal = Wire  [Size] Name [Size]
            | Logic [Size] Name [Size]
            | Reg   [Size] Name [Size]
      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
            Wire  [Size]
ds Name
n [Size]
ds' -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"wire"  Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Size] -> Doc ann
forall an. [Size] -> Doc an
ppDims [Size]
ds Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Size] -> Doc ann
forall an. [Size] -> Doc an
ppDims [Size]
ds'
            Logic [Size]
ds Name
n [Size]
ds' -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"logic" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Size] -> Doc ann
forall an. [Size] -> Doc an
ppDims [Size]
ds Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Size] -> Doc ann
forall an. [Size] -> Doc an
ppDims [Size]
ds'
            Reg   [Size]
ds Name
n [Size]
ds' -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"reg"   Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Size] -> Doc ann
forall an. [Size] -> Doc an
ppDims [Size]
ds Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Size] -> Doc ann
forall an. [Size] -> Doc an
ppDims [Size]
ds'

sigName :: Signal -> Name
sigName :: Signal -> Name
sigName = \ case
      Wire  [Size]
_ Name
n [Size]
_ -> Name
n
      Logic [Size]
_ Name
n [Size]
_ -> Name
n
      Reg   [Size]
_ Name
n [Size]
_ -> Name
n

data Stmt = Always [Sensitivity] Stmt
          | AlwaysComb Stmt
          | Initial Stmt
          | IfElse Exp Stmt Stmt
          | If Exp Stmt
          | Case Exp [(Exp, Stmt)] Stmt -- ^ Scrutinee, case items, default item.
          | Assign LVal Exp
          | SeqAssign LVal Exp
          | ParAssign LVal Exp
          | WireAssign Size Name Exp    -- ^ Net declaration assignment: wire [n-1:0] x = e;
          | Decl Signal                 -- ^ A signal declaration in statement position.
          | LocalParam Size Name BV
          | Comment Text
          | Block [Stmt]
          | Instantiate Name Name [(Name, Exp)] [(Name, Exp)] -- Exp for convenience, should be LVal?
          -- Procedural statements for testbenches.
          | Delay Natural           -- ^ #n;
          | Display Text [Exp]      -- ^ $display("fmt", args);
          | Finish                  -- ^ $finish;
      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)

instance Pretty Stmt where
      pretty :: forall ann. Stmt -> Doc ann
pretty = \ case
            Always [Sensitivity]
sens Stmt
stmt         -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"always" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
"@" 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 (Name -> Doc ann
forall an. Name -> Doc an
text Name
" or") ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ (Sensitivity -> Doc ann) -> [Sensitivity] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Sensitivity -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Sensitivity -> Doc ann
pretty [Sensitivity]
sens) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Stmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Stmt -> Doc ann
pretty Stmt
stmt
            AlwaysComb Stmt
stmt          -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"always_comb" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Stmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Stmt -> Doc ann
pretty Stmt
stmt
            Initial Stmt
stmt             -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"initial" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Stmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Stmt -> Doc ann
pretty Stmt
stmt
            IfElse Exp
c Stmt
thn Stmt
els         -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"if" 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 (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
<+> Stmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Stmt -> Doc ann
pretty Stmt
thn Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
"else" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Stmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Stmt -> Doc ann
pretty Stmt
els
            If Exp
c Stmt
thn                 -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"if" 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 (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
<+> Stmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Stmt -> Doc ann
pretty Stmt
thn
            Case Exp
c [(Exp, Stmt)]
items Stmt
dflt        -> [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
2 (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
$ (Name -> Doc ann
forall an. Name -> Doc an
text Name
"case" 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 (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 a. a -> [a] -> [a]
: ((Exp, Stmt) -> Doc ann) -> [(Exp, Stmt)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Exp, Stmt) -> Doc ann
forall an. (Exp, Stmt) -> Doc an
ppItem [(Exp, Stmt)]
items [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Name -> Doc ann
forall an. Name -> Doc an
text Name
"default:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Stmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Stmt -> Doc ann
pretty Stmt
dflt]
                  , Name -> Doc ann
forall an. Name -> Doc an
text Name
"endcase"
                  ]
            Assign LVal
lv Exp
v              -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"assign" 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
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
"="  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
v Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            SeqAssign LVal
lv Exp
v           ->                   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
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
"="  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
v Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            ParAssign LVal
lv Exp
v           ->                   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
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
"<=" 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
v Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            WireAssign Size
sz Name
n Exp
v        -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"wire" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Size] -> Doc ann
forall an. [Size] -> Doc an
ppDims [Size
sz] Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
"=" 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
v Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            Decl Signal
sig                 -> Signal -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Signal -> Doc ann
pretty Signal
sig Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            LocalParam Size
sz Name
n BV
v        -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"localparam" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Size] -> Doc ann
forall an. [Size] -> Doc an
ppDims [Size
sz] Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
"=" 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 (BV -> Exp
LitBits BV
v) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            Comment Name
c                -> Name -> Doc ann
forall an. Name -> Doc an
ppComment Name
c
            Block [Stmt]
stmts              -> [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
2 (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 (Name -> Doc ann
forall an. Name -> Doc an
text Name
"begin" Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Stmt -> Doc ann) -> [Stmt] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Stmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Stmt -> Doc ann
pretty [Stmt]
stmts), Name -> Doc ann
forall an. Name -> Doc an
text Name
"end"]
            Delay Natural
n                  -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"#" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> 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 a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            Display Name
fmt [Exp]
args         -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"$display(\"" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Name -> Doc ann
forall an. Name -> Doc an
text Name
fmt Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Name -> Doc ann
forall an. Name -> Doc an
text Name
"\"" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat ((Exp -> Doc ann) -> [Exp] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc ann
forall ann. Doc ann
comma Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (Doc ann -> Doc ann) -> (Exp -> Doc ann) -> Exp -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty) [Exp]
args) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Name -> Doc ann
forall an. Name -> Doc an
text Name
")" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            Stmt
Finish                   -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"$finish" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
            Instantiate Name
m Name
inst [(Name, Exp)]
ps [(Name, Exp)]
ss -> Name -> Doc ann
forall an. Name -> Doc an
text Name
m Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> (if [(Name, Exp)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Name, Exp)]
ps then Doc ann
forall a. Monoid a => a
mempty else Name -> Doc ann
forall an. Name -> Doc an
text Name
"#" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [(Name, Exp)] -> Doc ann
forall an. [(Name, Exp)] -> Doc an
params [(Name, Exp)]
ps) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
inst Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [(Name, Exp)] -> Doc ann
forall an. [(Name, Exp)] -> Doc an
params [(Name, Exp)]
ss Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
                  where param :: (Name, Exp) -> Doc an
                        param :: forall an. (Name, Exp) -> Doc an
param = \ case
                              (Name
"", Exp
e) -> Exp -> Doc an
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
e
                              (Name
n, Exp
e)  -> Name -> Doc an
forall an. Name -> Doc an
text Name
"." Doc an -> Doc an -> Doc an
forall a. Semigroup a => a -> a -> a
<> Name -> Doc an
forall a ann. Pretty a => a -> Doc ann
forall an. Name -> Doc an
pretty Name
n Doc an -> Doc an -> Doc an
forall a. Semigroup a => a -> a -> a
<> Doc an -> Doc an
forall ann. Doc ann -> Doc ann
parens (Exp -> Doc an
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
e)

                        params :: [(Name, Exp)] -> Doc an
                        params :: forall an. [(Name, Exp)] -> Doc an
params = Doc an -> Doc an
forall ann. Doc ann -> Doc ann
parens (Doc an -> Doc an)
-> ([(Name, Exp)] -> Doc an) -> [(Name, Exp)] -> Doc an
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc an] -> Doc an
forall ann. [Doc ann] -> Doc ann
hsep ([Doc an] -> Doc an)
-> ([(Name, Exp)] -> [Doc an]) -> [(Name, Exp)] -> Doc an
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc an -> [Doc an] -> [Doc an]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc an
forall ann. Doc ann
comma ([Doc an] -> [Doc an])
-> ([(Name, Exp)] -> [Doc an]) -> [(Name, Exp)] -> [Doc an]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, Exp) -> Doc an) -> [(Name, Exp)] -> [Doc an]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Exp) -> Doc an
forall an. (Name, Exp) -> Doc an
param

ppItem :: (Exp, Stmt) -> Doc an
ppItem :: forall an. (Exp, Stmt) -> Doc an
ppItem (Exp
l, Stmt
s) = Exp -> Doc an
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
l Doc an -> Doc an -> Doc an
forall a. Semigroup a => a -> a -> a
<> Doc an
forall ann. Doc ann
colon Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Stmt -> Doc an
forall a ann. Pretty a => a -> Doc ann
forall ann. Stmt -> Doc ann
pretty Stmt
s

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

instance Pretty Sensitivity where
      pretty :: forall ann. Sensitivity -> Doc ann
pretty = \ case
            Pos Name
n -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"posedge" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
n
            Neg Name
n -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"negedge" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
n

data Exp = Add Exp Exp
         | Sub Exp Exp
         | Mul Exp Exp
         | Div Exp Exp
         | Mod Exp Exp
         | Pow Exp Exp
         | LAnd Exp Exp
         | LOr Exp Exp
         | And Exp Exp
         | Or Exp Exp
         | XOr Exp Exp
         | XNor Exp Exp
         | LShift Exp Exp
         | RShift Exp Exp
         | LShiftArith Exp Exp
         | RShiftArith Exp Exp
         | Not Exp
         | LNot Exp
         | RAnd Exp
         | RNAnd Exp
         | ROr Exp
         | RNor Exp
         | RXOr Exp
         | RXNor Exp
         | Eq  Exp Exp
         | NEq Exp Exp
         | CEq  Exp Exp
         | CNEq Exp Exp
         | Lt  Exp Exp
         | Gt  Exp Exp
         | LtEq  Exp Exp
         | GtEq  Exp Exp
         | Cond Exp Exp Exp
         | Concat [Exp]
         | Repl Exp Exp
         | WCast Size Exp
         | Signed Exp   -- ^ > $signed(e)
         | Unsigned Exp -- ^ > $unsigned(e)
         | LitBits BV
         | LVal LVal
      -- 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 'LitBits' is too. Never key a map on
      -- this type; use the emitters' 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)

class Parenless a where
      parenless :: a -> Bool

instance Parenless Exp where
      parenless :: Exp -> Bool
parenless = \ case
            LVal    {} -> Bool
True
            LitBits {} -> Bool
True
            Repl    {} -> Bool
True
            WCast   {} -> Bool
True
            Concat  {} -> Bool
True
            Signed  {} -> Bool
True -- self-parenthesizing
            Unsigned {} -> Bool
True
            Exp
_          -> Bool
False

mparens :: (Pretty a, Parenless a) => a -> Doc an
mparens :: forall a an. (Pretty a, Parenless a) => a -> Doc an
mparens a
a | a -> Bool
forall a. Parenless a => a -> Bool
parenless a
a = a -> Doc an
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
a
          | Bool
otherwise   = Doc an -> Doc an
forall ann. Doc ann -> Doc ann
parens (Doc an -> Doc an) -> Doc an -> Doc an
forall a b. (a -> b) -> a -> b
$ a -> Doc an
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
a

ppBinOp :: Exp -> Text -> Exp -> Doc an
ppBinOp :: forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
op Exp
b = Exp -> Doc an
forall a an. (Pretty a, Parenless a) => a -> Doc an
mparens Exp
a Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc an
forall an. Name -> Doc an
text Name
op Doc an -> Doc an -> Doc an
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Exp -> Doc an
forall a an. (Pretty a, Parenless a) => a -> Doc an
mparens Exp
b

ppUnOp :: Text -> Exp -> Doc an
ppUnOp :: forall an. Name -> Exp -> Doc an
ppUnOp Name
op Exp
a = Name -> Doc an
forall an. Name -> Doc an
text Name
op Doc an -> Doc an -> Doc an
forall a. Semigroup a => a -> a -> a
<> Exp -> Doc an
forall a an. (Pretty a, Parenless a) => a -> Doc an
mparens Exp
a

instance Pretty Exp where
      pretty :: forall ann. Exp -> Doc ann
pretty = \ case
            Add Exp
a Exp
b         -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"+"   Exp
b
            Sub Exp
a Exp
b         -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"-"   Exp
b
            Mul Exp
a Exp
b         -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"*"   Exp
b
            Div Exp
a Exp
b         -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"/"   Exp
b
            Mod Exp
a Exp
b         -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"%"   Exp
b
            Pow Exp
a Exp
b         -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"**"  Exp
b
            LAnd Exp
a Exp
b        -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"&&"  Exp
b
            LOr Exp
a Exp
b         -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"||"  Exp
b
            And Exp
a Exp
b         -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"&"   Exp
b
            Or Exp
a Exp
b          -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"|"   Exp
b
            XOr Exp
a Exp
b         -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"^"   Exp
b
            XNor Exp
a Exp
b        -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"~^"  Exp
b
            LShift Exp
a Exp
b      -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"<<"  Exp
b
            RShift Exp
a Exp
b      -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
">>"  Exp
b
            LShiftArith Exp
a Exp
b -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"<<<" Exp
b
            -- | The left operand must be cast to signed for >>> to actually
            --   sign-extend (matching the interpreter's semantics; doc/hyle.md 5.2).
            RShiftArith Exp
a Exp
b -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"$signed" 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
a) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
">>>" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Exp -> Doc ann
forall a an. (Pretty a, Parenless a) => a -> Doc an
mparens Exp
b
            LNot Exp
a          -> Name -> Exp -> Doc ann
forall an. Name -> Exp -> Doc an
ppUnOp    Name
"!"   Exp
a
            Not Exp
a           -> Name -> Exp -> Doc ann
forall an. Name -> Exp -> Doc an
ppUnOp    Name
"~"   Exp
a
            RAnd Exp
a          -> Name -> Exp -> Doc ann
forall an. Name -> Exp -> Doc an
ppUnOp    Name
"&"   Exp
a
            RNAnd Exp
a         -> Name -> Exp -> Doc ann
forall an. Name -> Exp -> Doc an
ppUnOp    Name
"~&"  Exp
a
            ROr Exp
a           -> Name -> Exp -> Doc ann
forall an. Name -> Exp -> Doc an
ppUnOp    Name
"|"   Exp
a
            RNor Exp
a          -> Name -> Exp -> Doc ann
forall an. Name -> Exp -> Doc an
ppUnOp    Name
"~|"  Exp
a
            RXOr Exp
a          -> Name -> Exp -> Doc ann
forall an. Name -> Exp -> Doc an
ppUnOp    Name
"^"   Exp
a
            RXNor Exp
a         -> Name -> Exp -> Doc ann
forall an. Name -> Exp -> Doc an
ppUnOp    Name
"~^"  Exp
a
            Eq Exp
a Exp
b          -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"=="  Exp
b
            NEq Exp
a Exp
b         -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"!="  Exp
b
            CEq Exp
a Exp
b         -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"===" Exp
b
            CNEq Exp
a Exp
b        -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"!==" Exp
b
            Lt Exp
a Exp
b          -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"<"   Exp
b
            Gt Exp
a Exp
b          -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
">"   Exp
b
            LtEq Exp
a Exp
b        -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
"<="  Exp
b
            GtEq Exp
a Exp
b        -> Exp -> Name -> Exp -> Doc ann
forall an. Exp -> Name -> Exp -> Doc an
ppBinOp Exp
a Name
">="  Exp
b
            -- | A chained conditional lays out vertically, one arm per line
            --   (layout only: parenthesization is exactly the single-line
            --   form's).
            Cond Exp
e1 Exp
e2 e3 :: Exp
e3@Cond {} -> Exp -> Doc ann
forall a an. (Pretty a, Parenless a) => a -> Doc an
mparens Exp
e1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
"?" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Exp -> Doc ann
forall a an. (Pretty a, Parenless a) => a -> Doc an
mparens Exp
e2 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 a. Semigroup a => a -> a -> a
<> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Exp -> Doc ann
forall a an. (Pretty a, Parenless a) => a -> Doc an
mparens Exp
e3)
            Cond Exp
e1 Exp
e2 Exp
e3   -> Exp -> Doc ann
forall a an. (Pretty a, Parenless a) => a -> Doc an
mparens Exp
e1 Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Name -> Doc ann
forall an. Name -> Doc an
text Name
"?" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Exp -> Doc ann
forall a an. (Pretty a, Parenless a) => a -> Doc an
mparens Exp
e2 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
<+> Exp -> Doc ann
forall a an. (Pretty a, Parenless a) => a -> Doc an
mparens Exp
e3
            Signed Exp
e        -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"$signed" 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)
            Unsigned Exp
e      -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"$unsigned" 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)
            Concat [Exp
e]      -> Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
e
            Concat [Exp]
es       -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (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
ppCommaList ([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
            Repl Exp
e1 Exp
e2      -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
e1 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
e2)
            WCast Size
sz Exp
e      -> Size -> Doc ann
forall an. Size -> Doc an
forall a ann. Pretty a => a -> Doc ann
pretty Size
sz Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Name -> Doc ann
forall an. Name -> Doc an
text Name
"'" 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)
            LitBits BV
bv | BV -> Int
width BV
bv Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"0'h0"
            LitBits BV
bv      -> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (BV -> Int
width BV
bv) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
squote Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Name -> Doc ann
forall an. Name -> Doc an
text (BV -> Name
showHex' BV
bv)
            LVal LVal
x          -> LVal -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. LVal -> Doc ann
pretty LVal
x

bTrue :: Exp
bTrue :: Exp
bTrue = BV -> Exp
LitBits (BV -> Exp) -> BV -> Exp
forall a b. (a -> b) -> a -> b
$ Int -> BV
ones Int
1

bFalse :: Exp
bFalse :: Exp
bFalse = BV -> Exp
LitBits (BV -> Exp) -> BV -> Exp
forall a b. (a -> b) -> a -> b
$ Int -> BV
zeros Int
1

data Bit = Zero | One | X | Z
      deriving (Bit -> Bit -> Bool
(Bit -> Bit -> Bool) -> (Bit -> Bit -> Bool) -> Eq Bit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bit -> Bit -> Bool
== :: Bit -> Bit -> Bool
$c/= :: Bit -> Bit -> Bool
/= :: Bit -> Bit -> Bool
Eq, Int -> Bit -> ShowS
[Bit] -> ShowS
Bit -> String
(Int -> Bit -> ShowS)
-> (Bit -> String) -> ([Bit] -> ShowS) -> Show Bit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bit -> ShowS
showsPrec :: Int -> Bit -> ShowS
$cshow :: Bit -> String
show :: Bit -> String
$cshowList :: [Bit] -> ShowS
showList :: [Bit] -> ShowS
Show)

instance Pretty Bit where
      pretty :: forall ann. Bit -> Doc ann
pretty = \ case
            Bit
Zero -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"0"
            Bit
One  -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"1"
            Bit
X    -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"x"
            Bit
Z    -> Name -> Doc ann
forall an. Name -> Doc an
text Name
"z"

data LVal = Element Name Index
          | Range Name Index Index
          | Name Name
          | LVals [LVal]
      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
            Element Name
x Int
i -> Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall an. Name -> Doc an
pretty Name
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i)
            Range Name
x Int
i Int
j -> Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall an. Name -> Doc an
pretty Name
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (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 a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i)
            Name Name
x      -> Name -> Doc ann
forall an. Name -> Doc an
text Name
x
            LVals [LVal]
lvs   -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (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
ppCommaList ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (LVal -> Doc ann) -> [LVal] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map LVal -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. LVal -> Doc ann
pretty [LVal]
lvs

-- | A comma-separated list; long lists (> 4 elements) may wrap at the page
--   width (each separator is a softline, giving line-filling behavior).
ppCommaList :: [Doc an] -> Doc an
ppCommaList :: forall ann. [Doc ann] -> Doc ann
ppCommaList [Doc an]
ds | [Doc an] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc an]
ds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4 = Int -> Doc an -> Doc an
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (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
hcat ([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
comma Doc an -> Doc an -> Doc an
forall a. Semigroup a => a -> a -> a
<> Doc an
forall ann. Doc ann
softline) [Doc an]
ds
               | Bool
otherwise     = [Doc an] -> Doc an
forall ann. [Doc ann] -> Doc ann
hsep ([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
comma [Doc an]
ds

cat :: [Exp] -> Exp
cat :: [Exp] -> Exp
cat = (\ case
            [] -> Exp
nil
            [Exp]
es -> [Exp] -> Exp
Concat [Exp]
es
      ) ([Exp] -> Exp) -> ([Exp] -> [Exp]) -> [Exp] -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp -> Bool) -> [Exp] -> [Exp]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Exp -> Bool) -> Exp -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> Bool
isNil)

nil :: Exp
nil :: Exp
nil = BV -> Exp
LitBits BV
BV.nil

isNil :: Exp -> Bool
isNil :: Exp -> Bool
isNil = \ case
      LitBits BV
bv -> BV -> Int
width BV
bv Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
      WCast Size
sz Exp
_ -> Size
sz Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= Size
0
      Exp
_          -> Bool
False