{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}

-- | Yosys [RTLIL](https://yosyshq.readthedocs.io/projects/yosys/en/latest/yosys_internals/formats/rtlil_text.html)
module Yosys.Rtl
  ( -- * Lexical elements
    Ident(..)
  , Value(..)
  , BinaryDigit(..)
  , -- * File
    File(..)
  , -- ** Autoindex statements
    AutoIdxStmt(..)
  , -- ** Modules
    Module(..)
  , ModuleStmt(..)
  , ModuleBody(..)
  , ParamStmt(..)
  , Constant(..)
  , ModuleEndStmt(..)
  , -- ** Attribute statements
    AttrStmt(..)
  , -- ** Signal specifications
    SigSpec(..)
  , -- ** Connections
    ConnStmt(..)
  , -- ** Wires
    Wire(..)
  , WireStmt(..)
  , WireId(..)
  , WireOption(..)
  , -- ** Memories
    Memory(..)
  , MemoryStmt(..)
  , MemoryOption(..)
  , -- ** Cells
    Cell(..)
  , CellStmt(..)
  , CellId(..)
  , CellType(..)
  , ParamType(..)
  , CellBodyStmt(..)
  , CellEndStmt(..)
  , -- *** Unary cells
    unaryCell
  , notC
  , posC
  , negC
  , reduceAndC
  , reduceOrC
  , reduceXorC
  , reduceXnorC
  , reduceBoolC
  , logicNotC
  , -- *** Binary cells
    binaryCell
  , shiftCell
  , andC
  , orC
  , xorC
  , xnorC
  , shlC
  , shrC
  , sshlC
  , sshrC
  , logicAndC
  , logicOrC
  , eqxC
  , nexC
  , powC
  , ltC
  , leC
  , eqC
  , neC
  , geC
  , gtC
  , addC
  , subC
  , mulC
  , divC
  , modC
  , divFloorC
  , modFloorC
  , -- *** Multiplexers
    muxC
  , -- *** Memories
    memRdV2C
  , memWrV2C
  , memInitV2C
  , memV2C
  , -- ** Processes
    Process(..)
  , ProcStmt(..)
  , ProcessBody(..)
  , AssignStmt(..)
  , DestSigSpec(..)
  , SrcSigSpec(..)
  , ProcEndStmt(..)
  , -- ** Switches
    Switch(..)
  , SwitchStmt(..)
  , Case(..)
  , CaseStmt(..)
  , Compare(..)
  , CaseBody(..)
  , SwitchEndStmt(..)
  , -- ** Syncs
    Sync(..)
  , SyncStmt(..)
  , SyncType(..)
  , UpdateStmt(..)
  ) where

import Data.String
import Data.Text (Text)
import Prettyprinter hiding (width)

newtype Ident = Ident Text
  deriving (Ident -> Ident -> Bool
(Ident -> Ident -> Bool) -> (Ident -> Ident -> Bool) -> Eq Ident
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ident -> Ident -> Bool
== :: Ident -> Ident -> Bool
$c/= :: Ident -> Ident -> Bool
/= :: Ident -> Ident -> Bool
Eq, String -> Ident
(String -> Ident) -> IsString Ident
forall a. (String -> a) -> IsString a
$cfromString :: String -> Ident
fromString :: String -> Ident
IsString, (forall ann. Ident -> Doc ann)
-> (forall ann. [Ident] -> Doc ann) -> Pretty Ident
forall ann. [Ident] -> Doc ann
forall ann. Ident -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. Ident -> Doc ann
pretty :: forall ann. Ident -> Doc ann
$cprettyList :: forall ann. [Ident] -> Doc ann
prettyList :: forall ann. [Ident] -> Doc ann
Pretty, ReadPrec [Ident]
ReadPrec Ident
Int -> ReadS Ident
ReadS [Ident]
(Int -> ReadS Ident)
-> ReadS [Ident]
-> ReadPrec Ident
-> ReadPrec [Ident]
-> Read Ident
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Ident
readsPrec :: Int -> ReadS Ident
$creadList :: ReadS [Ident]
readList :: ReadS [Ident]
$creadPrec :: ReadPrec Ident
readPrec :: ReadPrec Ident
$creadListPrec :: ReadPrec [Ident]
readListPrec :: ReadPrec [Ident]
Read, NonEmpty Ident -> Ident
Ident -> Ident -> Ident
(Ident -> Ident -> Ident)
-> (NonEmpty Ident -> Ident)
-> (forall b. Integral b => b -> Ident -> Ident)
-> Semigroup Ident
forall b. Integral b => b -> Ident -> Ident
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Ident -> Ident -> Ident
<> :: Ident -> Ident -> Ident
$csconcat :: NonEmpty Ident -> Ident
sconcat :: NonEmpty Ident -> Ident
$cstimes :: forall b. Integral b => b -> Ident -> Ident
stimes :: forall b. Integral b => b -> Ident -> Ident
Semigroup, Semigroup Ident
Ident
Semigroup Ident =>
Ident
-> (Ident -> Ident -> Ident) -> ([Ident] -> Ident) -> Monoid Ident
[Ident] -> Ident
Ident -> Ident -> Ident
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Ident
mempty :: Ident
$cmappend :: Ident -> Ident -> Ident
mappend :: Ident -> Ident -> Ident
$cmconcat :: [Ident] -> Ident
mconcat :: [Ident] -> Ident
Monoid, Int -> Ident -> ShowS
[Ident] -> ShowS
Ident -> String
(Int -> Ident -> ShowS)
-> (Ident -> String) -> ([Ident] -> ShowS) -> Show Ident
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ident -> ShowS
showsPrec :: Int -> Ident -> ShowS
$cshow :: Ident -> String
show :: Ident -> String
$cshowList :: [Ident] -> ShowS
showList :: [Ident] -> ShowS
Show)

data BinaryDigit = B0
                 | B1
                 | X
                 | Z
                 | M
                 | D
  deriving (BinaryDigit -> BinaryDigit -> Bool
(BinaryDigit -> BinaryDigit -> Bool)
-> (BinaryDigit -> BinaryDigit -> Bool) -> Eq BinaryDigit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinaryDigit -> BinaryDigit -> Bool
== :: BinaryDigit -> BinaryDigit -> Bool
$c/= :: BinaryDigit -> BinaryDigit -> Bool
/= :: BinaryDigit -> BinaryDigit -> Bool
Eq, ReadPrec [BinaryDigit]
ReadPrec BinaryDigit
Int -> ReadS BinaryDigit
ReadS [BinaryDigit]
(Int -> ReadS BinaryDigit)
-> ReadS [BinaryDigit]
-> ReadPrec BinaryDigit
-> ReadPrec [BinaryDigit]
-> Read BinaryDigit
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BinaryDigit
readsPrec :: Int -> ReadS BinaryDigit
$creadList :: ReadS [BinaryDigit]
readList :: ReadS [BinaryDigit]
$creadPrec :: ReadPrec BinaryDigit
readPrec :: ReadPrec BinaryDigit
$creadListPrec :: ReadPrec [BinaryDigit]
readListPrec :: ReadPrec [BinaryDigit]
Read, Int -> BinaryDigit -> ShowS
[BinaryDigit] -> ShowS
BinaryDigit -> String
(Int -> BinaryDigit -> ShowS)
-> (BinaryDigit -> String)
-> ([BinaryDigit] -> ShowS)
-> Show BinaryDigit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinaryDigit -> ShowS
showsPrec :: Int -> BinaryDigit -> ShowS
$cshow :: BinaryDigit -> String
show :: BinaryDigit -> String
$cshowList :: [BinaryDigit] -> ShowS
showList :: [BinaryDigit] -> ShowS
Show)

instance Pretty BinaryDigit where
  pretty :: forall ann. BinaryDigit -> Doc ann
pretty = \case
    BinaryDigit
B0 -> Doc ann
"0"
    BinaryDigit
B1 -> Doc ann
"1"
    BinaryDigit
X  -> Doc ann
"x"
    BinaryDigit
Z  -> Doc ann
"z"
    BinaryDigit
M  -> Doc ann
"m"
    BinaryDigit
D  -> Doc ann
"-"

instance IsString BinaryDigit where
  fromString :: String -> BinaryDigit
fromString = \case
    String
"0" -> BinaryDigit
B0
    String
"1" -> BinaryDigit
B1
    String
"x" -> BinaryDigit
X
    String
"z" -> BinaryDigit
Z
    String
"m" -> BinaryDigit
M
    String
_   -> BinaryDigit
D

data Value = Value Integer [BinaryDigit]
  deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, ReadPrec [Value]
ReadPrec Value
Int -> ReadS Value
ReadS [Value]
(Int -> ReadS Value)
-> ReadS [Value]
-> ReadPrec Value
-> ReadPrec [Value]
-> Read Value
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Value
readsPrec :: Int -> ReadS Value
$creadList :: ReadS [Value]
readList :: ReadS [Value]
$creadPrec :: ReadPrec Value
readPrec :: ReadPrec Value
$creadListPrec :: ReadPrec [Value]
readListPrec :: ReadPrec [Value]
Read, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show)

instance Pretty Value where
  pretty :: forall ann. Value -> Doc ann
pretty (Value Integer
i [BinaryDigit]
bs) = Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\'" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (BinaryDigit -> Doc ann) -> [BinaryDigit] -> Doc ann
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap BinaryDigit -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. BinaryDigit -> Doc ann
pretty [BinaryDigit]
bs

instance IsString Value where
  fromString :: String -> Value
fromString String
s = let (String
l, String
r) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'') String
s
                 in if String -> Int
forall a. Read a => String -> a
read String
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                    then String -> Value
forall a. HasCallStack => String -> a
error (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ String
"IsString " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s
                    else Integer -> [BinaryDigit] -> Value
Value (String -> Integer
forall a. Read a => String -> a
read String
l) ([BinaryDigit] -> Value) -> [BinaryDigit] -> Value
forall a b. (a -> b) -> a -> b
$ (Char -> BinaryDigit) -> String -> [BinaryDigit]
forall a b. (a -> b) -> [a] -> [b]
map (String -> BinaryDigit
forall a. IsString a => String -> a
fromString (String -> BinaryDigit) -> (Char -> String) -> Char -> BinaryDigit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (String -> [BinaryDigit]) -> String -> [BinaryDigit]
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
r

data File = File (Maybe AutoIdxStmt) [Module]
  deriving (File -> File -> Bool
(File -> File -> Bool) -> (File -> File -> Bool) -> Eq File
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: File -> File -> Bool
== :: File -> File -> Bool
$c/= :: File -> File -> Bool
/= :: File -> File -> Bool
Eq, ReadPrec [File]
ReadPrec File
Int -> ReadS File
ReadS [File]
(Int -> ReadS File)
-> ReadS [File] -> ReadPrec File -> ReadPrec [File] -> Read File
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS File
readsPrec :: Int -> ReadS File
$creadList :: ReadS [File]
readList :: ReadS [File]
$creadPrec :: ReadPrec File
readPrec :: ReadPrec File
$creadListPrec :: ReadPrec [File]
readListPrec :: ReadPrec [File]
Read, Int -> File -> ShowS
[File] -> ShowS
File -> String
(Int -> File -> ShowS)
-> (File -> String) -> ([File] -> ShowS) -> Show File
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> File -> ShowS
showsPrec :: Int -> File -> ShowS
$cshow :: File -> String
show :: File -> String
$cshowList :: [File] -> ShowS
showList :: [File] -> ShowS
Show)

instance Pretty File where
  pretty :: forall ann. File -> Doc ann
pretty (File Maybe AutoIdxStmt
iM [Module]
ms) = let ms' :: [Doc ann]
ms' = Module -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Module -> Doc ann
pretty (Module -> Doc ann) -> [Module] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Module]
ms
                        in [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vl ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ case Maybe AutoIdxStmt
iM of
                             Just AutoIdxStmt
i  -> AutoIdxStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AutoIdxStmt -> Doc ann
pretty AutoIdxStmt
i Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann]
forall {ann}. [Doc ann]
ms'
                             Maybe AutoIdxStmt
Nothing -> [Doc ann]
forall {ann}. [Doc ann]
ms'

newtype AutoIdxStmt = AutoIdxStmt Integer
  deriving (AutoIdxStmt -> AutoIdxStmt -> Bool
(AutoIdxStmt -> AutoIdxStmt -> Bool)
-> (AutoIdxStmt -> AutoIdxStmt -> Bool) -> Eq AutoIdxStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AutoIdxStmt -> AutoIdxStmt -> Bool
== :: AutoIdxStmt -> AutoIdxStmt -> Bool
$c/= :: AutoIdxStmt -> AutoIdxStmt -> Bool
/= :: AutoIdxStmt -> AutoIdxStmt -> Bool
Eq, Integer -> AutoIdxStmt
AutoIdxStmt -> AutoIdxStmt
AutoIdxStmt -> AutoIdxStmt -> AutoIdxStmt
(AutoIdxStmt -> AutoIdxStmt -> AutoIdxStmt)
-> (AutoIdxStmt -> AutoIdxStmt -> AutoIdxStmt)
-> (AutoIdxStmt -> AutoIdxStmt -> AutoIdxStmt)
-> (AutoIdxStmt -> AutoIdxStmt)
-> (AutoIdxStmt -> AutoIdxStmt)
-> (AutoIdxStmt -> AutoIdxStmt)
-> (Integer -> AutoIdxStmt)
-> Num AutoIdxStmt
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: AutoIdxStmt -> AutoIdxStmt -> AutoIdxStmt
+ :: AutoIdxStmt -> AutoIdxStmt -> AutoIdxStmt
$c- :: AutoIdxStmt -> AutoIdxStmt -> AutoIdxStmt
- :: AutoIdxStmt -> AutoIdxStmt -> AutoIdxStmt
$c* :: AutoIdxStmt -> AutoIdxStmt -> AutoIdxStmt
* :: AutoIdxStmt -> AutoIdxStmt -> AutoIdxStmt
$cnegate :: AutoIdxStmt -> AutoIdxStmt
negate :: AutoIdxStmt -> AutoIdxStmt
$cabs :: AutoIdxStmt -> AutoIdxStmt
abs :: AutoIdxStmt -> AutoIdxStmt
$csignum :: AutoIdxStmt -> AutoIdxStmt
signum :: AutoIdxStmt -> AutoIdxStmt
$cfromInteger :: Integer -> AutoIdxStmt
fromInteger :: Integer -> AutoIdxStmt
Num, ReadPrec [AutoIdxStmt]
ReadPrec AutoIdxStmt
Int -> ReadS AutoIdxStmt
ReadS [AutoIdxStmt]
(Int -> ReadS AutoIdxStmt)
-> ReadS [AutoIdxStmt]
-> ReadPrec AutoIdxStmt
-> ReadPrec [AutoIdxStmt]
-> Read AutoIdxStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AutoIdxStmt
readsPrec :: Int -> ReadS AutoIdxStmt
$creadList :: ReadS [AutoIdxStmt]
readList :: ReadS [AutoIdxStmt]
$creadPrec :: ReadPrec AutoIdxStmt
readPrec :: ReadPrec AutoIdxStmt
$creadListPrec :: ReadPrec [AutoIdxStmt]
readListPrec :: ReadPrec [AutoIdxStmt]
Read, Int -> AutoIdxStmt -> ShowS
[AutoIdxStmt] -> ShowS
AutoIdxStmt -> String
(Int -> AutoIdxStmt -> ShowS)
-> (AutoIdxStmt -> String)
-> ([AutoIdxStmt] -> ShowS)
-> Show AutoIdxStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AutoIdxStmt -> ShowS
showsPrec :: Int -> AutoIdxStmt -> ShowS
$cshow :: AutoIdxStmt -> String
show :: AutoIdxStmt -> String
$cshowList :: [AutoIdxStmt] -> ShowS
showList :: [AutoIdxStmt] -> ShowS
Show)

instance Pretty AutoIdxStmt where
  pretty :: forall ann. AutoIdxStmt -> Doc ann
pretty (AutoIdxStmt Integer
i) = Doc ann
"autoidx" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i

data Module = Module [AttrStmt] ModuleStmt [ModuleBody] ModuleEndStmt
  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, ReadPrec [Module]
ReadPrec Module
Int -> ReadS Module
ReadS [Module]
(Int -> ReadS Module)
-> ReadS [Module]
-> ReadPrec Module
-> ReadPrec [Module]
-> Read Module
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Module
readsPrec :: Int -> ReadS Module
$creadList :: ReadS [Module]
readList :: ReadS [Module]
$creadPrec :: ReadPrec Module
readPrec :: ReadPrec Module
$creadListPrec :: ReadPrec [Module]
readListPrec :: ReadPrec [Module]
Read, 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 [AttrStmt]
as ModuleStmt
m [ModuleBody]
bs ModuleEndStmt
e) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vl
    [ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vl ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ AttrStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AttrStmt -> Doc ann
pretty (AttrStmt -> Doc ann) -> [AttrStmt] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AttrStmt]
as
    , ModuleStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModuleStmt -> Doc ann
pretty ModuleStmt
m
    , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent 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
vl ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ ModuleBody -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModuleBody -> Doc ann
pretty (ModuleBody -> Doc ann) -> [ModuleBody] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ModuleBody]
bs
    , ModuleEndStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ModuleEndStmt -> Doc ann
pretty ModuleEndStmt
e
    ]

newtype ModuleStmt = ModuleStmt Ident
  deriving (ModuleStmt -> ModuleStmt -> Bool
(ModuleStmt -> ModuleStmt -> Bool)
-> (ModuleStmt -> ModuleStmt -> Bool) -> Eq ModuleStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleStmt -> ModuleStmt -> Bool
== :: ModuleStmt -> ModuleStmt -> Bool
$c/= :: ModuleStmt -> ModuleStmt -> Bool
/= :: ModuleStmt -> ModuleStmt -> Bool
Eq, String -> ModuleStmt
(String -> ModuleStmt) -> IsString ModuleStmt
forall a. (String -> a) -> IsString a
$cfromString :: String -> ModuleStmt
fromString :: String -> ModuleStmt
IsString, ReadPrec [ModuleStmt]
ReadPrec ModuleStmt
Int -> ReadS ModuleStmt
ReadS [ModuleStmt]
(Int -> ReadS ModuleStmt)
-> ReadS [ModuleStmt]
-> ReadPrec ModuleStmt
-> ReadPrec [ModuleStmt]
-> Read ModuleStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ModuleStmt
readsPrec :: Int -> ReadS ModuleStmt
$creadList :: ReadS [ModuleStmt]
readList :: ReadS [ModuleStmt]
$creadPrec :: ReadPrec ModuleStmt
readPrec :: ReadPrec ModuleStmt
$creadListPrec :: ReadPrec [ModuleStmt]
readListPrec :: ReadPrec [ModuleStmt]
Read, Int -> ModuleStmt -> ShowS
[ModuleStmt] -> ShowS
ModuleStmt -> String
(Int -> ModuleStmt -> ShowS)
-> (ModuleStmt -> String)
-> ([ModuleStmt] -> ShowS)
-> Show ModuleStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleStmt -> ShowS
showsPrec :: Int -> ModuleStmt -> ShowS
$cshow :: ModuleStmt -> String
show :: ModuleStmt -> String
$cshowList :: [ModuleStmt] -> ShowS
showList :: [ModuleStmt] -> ShowS
Show)

instance Pretty ModuleStmt where
  pretty :: forall ann. ModuleStmt -> Doc ann
pretty (ModuleStmt Ident
i) = Doc ann
"module" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Ident -> Doc ann
pretty Ident
i

data ModuleBody = ModuleBodyParamStmt ParamStmt
                | ModuleBodyWire Wire
                | ModuleBodyMemory Memory
                | ModuleBodyCell Cell
                | ModuleBodyProcess Process
                | ModuleBodyConnStmt ConnStmt
  deriving (ModuleBody -> ModuleBody -> Bool
(ModuleBody -> ModuleBody -> Bool)
-> (ModuleBody -> ModuleBody -> Bool) -> Eq ModuleBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleBody -> ModuleBody -> Bool
== :: ModuleBody -> ModuleBody -> Bool
$c/= :: ModuleBody -> ModuleBody -> Bool
/= :: ModuleBody -> ModuleBody -> Bool
Eq, ReadPrec [ModuleBody]
ReadPrec ModuleBody
Int -> ReadS ModuleBody
ReadS [ModuleBody]
(Int -> ReadS ModuleBody)
-> ReadS [ModuleBody]
-> ReadPrec ModuleBody
-> ReadPrec [ModuleBody]
-> Read ModuleBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ModuleBody
readsPrec :: Int -> ReadS ModuleBody
$creadList :: ReadS [ModuleBody]
readList :: ReadS [ModuleBody]
$creadPrec :: ReadPrec ModuleBody
readPrec :: ReadPrec ModuleBody
$creadListPrec :: ReadPrec [ModuleBody]
readListPrec :: ReadPrec [ModuleBody]
Read, Int -> ModuleBody -> ShowS
[ModuleBody] -> ShowS
ModuleBody -> String
(Int -> ModuleBody -> ShowS)
-> (ModuleBody -> String)
-> ([ModuleBody] -> ShowS)
-> Show ModuleBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleBody -> ShowS
showsPrec :: Int -> ModuleBody -> ShowS
$cshow :: ModuleBody -> String
show :: ModuleBody -> String
$cshowList :: [ModuleBody] -> ShowS
showList :: [ModuleBody] -> ShowS
Show)

instance Pretty ModuleBody where
  pretty :: forall ann. ModuleBody -> Doc ann
pretty = \case
    ModuleBodyParamStmt ParamStmt
p -> ParamStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ParamStmt -> Doc ann
pretty ParamStmt
p
    ModuleBodyWire      Wire
w -> Wire -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Wire -> Doc ann
pretty Wire
w
    ModuleBodyMemory    Memory
m -> Memory -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Memory -> Doc ann
pretty Memory
m
    ModuleBodyCell      Cell
c -> Cell -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Cell -> Doc ann
pretty Cell
c
    ModuleBodyProcess   Process
p -> Process -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Process -> Doc ann
pretty Process
p
    ModuleBodyConnStmt  ConnStmt
c -> ConnStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ConnStmt -> Doc ann
pretty ConnStmt
c


data ParamStmt = ParamStmt Ident (Maybe Constant)
  deriving (ParamStmt -> ParamStmt -> Bool
(ParamStmt -> ParamStmt -> Bool)
-> (ParamStmt -> ParamStmt -> Bool) -> Eq ParamStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParamStmt -> ParamStmt -> Bool
== :: ParamStmt -> ParamStmt -> Bool
$c/= :: ParamStmt -> ParamStmt -> Bool
/= :: ParamStmt -> ParamStmt -> Bool
Eq, ReadPrec [ParamStmt]
ReadPrec ParamStmt
Int -> ReadS ParamStmt
ReadS [ParamStmt]
(Int -> ReadS ParamStmt)
-> ReadS [ParamStmt]
-> ReadPrec ParamStmt
-> ReadPrec [ParamStmt]
-> Read ParamStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ParamStmt
readsPrec :: Int -> ReadS ParamStmt
$creadList :: ReadS [ParamStmt]
readList :: ReadS [ParamStmt]
$creadPrec :: ReadPrec ParamStmt
readPrec :: ReadPrec ParamStmt
$creadListPrec :: ReadPrec [ParamStmt]
readListPrec :: ReadPrec [ParamStmt]
Read, Int -> ParamStmt -> ShowS
[ParamStmt] -> ShowS
ParamStmt -> String
(Int -> ParamStmt -> ShowS)
-> (ParamStmt -> String)
-> ([ParamStmt] -> ShowS)
-> Show ParamStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParamStmt -> ShowS
showsPrec :: Int -> ParamStmt -> ShowS
$cshow :: ParamStmt -> String
show :: ParamStmt -> String
$cshowList :: [ParamStmt] -> ShowS
showList :: [ParamStmt] -> ShowS
Show)

instance Pretty ParamStmt where
  pretty :: forall ann. ParamStmt -> Doc ann
pretty (ParamStmt Ident
i Maybe Constant
cM) = [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
    [ Doc ann
"parameter" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Ident -> Doc ann
pretty Ident
i
    , Doc ann -> (Constant -> Doc ann) -> Maybe Constant -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty (Doc ann -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
surround Doc ann
" " Doc ann
" " (Doc ann -> Doc ann)
-> (Constant -> Doc ann) -> Constant -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constant -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Constant -> Doc ann
pretty) Maybe Constant
cM
    ]

data Constant = ConstantValue Value
              | ConstantInteger Integer
              | ConstantString Text
  deriving (Constant -> Constant -> Bool
(Constant -> Constant -> Bool)
-> (Constant -> Constant -> Bool) -> Eq Constant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Constant -> Constant -> Bool
== :: Constant -> Constant -> Bool
$c/= :: Constant -> Constant -> Bool
/= :: Constant -> Constant -> Bool
Eq, ReadPrec [Constant]
ReadPrec Constant
Int -> ReadS Constant
ReadS [Constant]
(Int -> ReadS Constant)
-> ReadS [Constant]
-> ReadPrec Constant
-> ReadPrec [Constant]
-> Read Constant
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Constant
readsPrec :: Int -> ReadS Constant
$creadList :: ReadS [Constant]
readList :: ReadS [Constant]
$creadPrec :: ReadPrec Constant
readPrec :: ReadPrec Constant
$creadListPrec :: ReadPrec [Constant]
readListPrec :: ReadPrec [Constant]
Read, Int -> Constant -> ShowS
[Constant] -> ShowS
Constant -> String
(Int -> Constant -> ShowS)
-> (Constant -> String) -> ([Constant] -> ShowS) -> Show Constant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Constant -> ShowS
showsPrec :: Int -> Constant -> ShowS
$cshow :: Constant -> String
show :: Constant -> String
$cshowList :: [Constant] -> ShowS
showList :: [Constant] -> ShowS
Show)

instance Pretty Constant where
  pretty :: forall ann. Constant -> Doc ann
pretty = \case
    ConstantValue   Value
v -> Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Value -> Doc ann
pretty Value
v
    ConstantInteger Integer
i -> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i
    ConstantString  Text
t -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
dquotes (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
t

instance IsString Constant where
  fromString :: String -> Constant
fromString = Value -> Constant
ConstantValue (Value -> Constant) -> (String -> Value) -> String -> Constant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value
forall a. IsString a => String -> a
fromString

data ModuleEndStmt = ModuleEndStmt
  deriving (ModuleEndStmt -> ModuleEndStmt -> Bool
(ModuleEndStmt -> ModuleEndStmt -> Bool)
-> (ModuleEndStmt -> ModuleEndStmt -> Bool) -> Eq ModuleEndStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleEndStmt -> ModuleEndStmt -> Bool
== :: ModuleEndStmt -> ModuleEndStmt -> Bool
$c/= :: ModuleEndStmt -> ModuleEndStmt -> Bool
/= :: ModuleEndStmt -> ModuleEndStmt -> Bool
Eq, ReadPrec [ModuleEndStmt]
ReadPrec ModuleEndStmt
Int -> ReadS ModuleEndStmt
ReadS [ModuleEndStmt]
(Int -> ReadS ModuleEndStmt)
-> ReadS [ModuleEndStmt]
-> ReadPrec ModuleEndStmt
-> ReadPrec [ModuleEndStmt]
-> Read ModuleEndStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ModuleEndStmt
readsPrec :: Int -> ReadS ModuleEndStmt
$creadList :: ReadS [ModuleEndStmt]
readList :: ReadS [ModuleEndStmt]
$creadPrec :: ReadPrec ModuleEndStmt
readPrec :: ReadPrec ModuleEndStmt
$creadListPrec :: ReadPrec [ModuleEndStmt]
readListPrec :: ReadPrec [ModuleEndStmt]
Read, Int -> ModuleEndStmt -> ShowS
[ModuleEndStmt] -> ShowS
ModuleEndStmt -> String
(Int -> ModuleEndStmt -> ShowS)
-> (ModuleEndStmt -> String)
-> ([ModuleEndStmt] -> ShowS)
-> Show ModuleEndStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModuleEndStmt -> ShowS
showsPrec :: Int -> ModuleEndStmt -> ShowS
$cshow :: ModuleEndStmt -> String
show :: ModuleEndStmt -> String
$cshowList :: [ModuleEndStmt] -> ShowS
showList :: [ModuleEndStmt] -> ShowS
Show)

instance Pretty ModuleEndStmt where
  pretty :: forall ann. ModuleEndStmt -> Doc ann
pretty ModuleEndStmt
_ = Doc ann
"end" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline

data AttrStmt = AttrStmt Ident Constant
  deriving (AttrStmt -> AttrStmt -> Bool
(AttrStmt -> AttrStmt -> Bool)
-> (AttrStmt -> AttrStmt -> Bool) -> Eq AttrStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AttrStmt -> AttrStmt -> Bool
== :: AttrStmt -> AttrStmt -> Bool
$c/= :: AttrStmt -> AttrStmt -> Bool
/= :: AttrStmt -> AttrStmt -> Bool
Eq, ReadPrec [AttrStmt]
ReadPrec AttrStmt
Int -> ReadS AttrStmt
ReadS [AttrStmt]
(Int -> ReadS AttrStmt)
-> ReadS [AttrStmt]
-> ReadPrec AttrStmt
-> ReadPrec [AttrStmt]
-> Read AttrStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AttrStmt
readsPrec :: Int -> ReadS AttrStmt
$creadList :: ReadS [AttrStmt]
readList :: ReadS [AttrStmt]
$creadPrec :: ReadPrec AttrStmt
readPrec :: ReadPrec AttrStmt
$creadListPrec :: ReadPrec [AttrStmt]
readListPrec :: ReadPrec [AttrStmt]
Read, Int -> AttrStmt -> ShowS
[AttrStmt] -> ShowS
AttrStmt -> String
(Int -> AttrStmt -> ShowS)
-> (AttrStmt -> String) -> ([AttrStmt] -> ShowS) -> Show AttrStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttrStmt -> ShowS
showsPrec :: Int -> AttrStmt -> ShowS
$cshow :: AttrStmt -> String
show :: AttrStmt -> String
$cshowList :: [AttrStmt] -> ShowS
showList :: [AttrStmt] -> ShowS
Show)

instance Pretty AttrStmt where
  pretty :: forall ann. AttrStmt -> Doc ann
pretty (AttrStmt Ident
i Constant
c) = Doc ann
"attribute" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Ident -> Doc ann
pretty Ident
i Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Constant -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Constant -> Doc ann
pretty Constant
c

data SigSpec = SigSpecConstant Constant
             | SigSpecWireId   WireId
             | SigSpecSlice    SigSpec Integer (Maybe Integer)
             | SigSpecCat      [SigSpec]
  deriving (SigSpec -> SigSpec -> Bool
(SigSpec -> SigSpec -> Bool)
-> (SigSpec -> SigSpec -> Bool) -> Eq SigSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SigSpec -> SigSpec -> Bool
== :: SigSpec -> SigSpec -> Bool
$c/= :: SigSpec -> SigSpec -> Bool
/= :: SigSpec -> SigSpec -> Bool
Eq, ReadPrec [SigSpec]
ReadPrec SigSpec
Int -> ReadS SigSpec
ReadS [SigSpec]
(Int -> ReadS SigSpec)
-> ReadS [SigSpec]
-> ReadPrec SigSpec
-> ReadPrec [SigSpec]
-> Read SigSpec
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SigSpec
readsPrec :: Int -> ReadS SigSpec
$creadList :: ReadS [SigSpec]
readList :: ReadS [SigSpec]
$creadPrec :: ReadPrec SigSpec
readPrec :: ReadPrec SigSpec
$creadListPrec :: ReadPrec [SigSpec]
readListPrec :: ReadPrec [SigSpec]
Read, Int -> SigSpec -> ShowS
[SigSpec] -> ShowS
SigSpec -> String
(Int -> SigSpec -> ShowS)
-> (SigSpec -> String) -> ([SigSpec] -> ShowS) -> Show SigSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigSpec -> ShowS
showsPrec :: Int -> SigSpec -> ShowS
$cshow :: SigSpec -> String
show :: SigSpec -> String
$cshowList :: [SigSpec] -> ShowS
showList :: [SigSpec] -> ShowS
Show)

instance Pretty SigSpec where
  pretty :: forall ann. SigSpec -> Doc ann
pretty = \case
    SigSpecConstant Constant
c   -> Constant -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Constant -> Doc ann
pretty Constant
c
    SigSpecWireId WireId
w     -> WireId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. WireId -> Doc ann
pretty WireId
w
    SigSpecSlice SigSpec
s Integer
x Maybe Integer
yM -> SigSpec -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SigSpec -> Doc ann
pretty SigSpec
s Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> (Integer -> Doc ann) -> Maybe Integer -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty ((Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>) (Doc ann -> Doc ann) -> (Integer -> Doc ann) -> Integer -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty) Maybe Integer
yM)
    SigSpecCat [SigSpec]
ss       -> 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 -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
" " ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ SigSpec -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SigSpec -> Doc ann
pretty (SigSpec -> Doc ann) -> [SigSpec] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SigSpec]
ss) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" "

instance Semigroup SigSpec where
  SigSpecCat [SigSpec]
a <> :: SigSpec -> SigSpec -> SigSpec
<> SigSpecCat [SigSpec]
b = [SigSpec] -> SigSpec
SigSpecCat ([SigSpec] -> SigSpec) -> [SigSpec] -> SigSpec
forall a b. (a -> b) -> a -> b
$ [SigSpec]
a   [SigSpec] -> [SigSpec] -> [SigSpec]
forall a. Semigroup a => a -> a -> a
<> [SigSpec]
b
  SigSpecCat [SigSpec]
a <> SigSpec
b            = [SigSpec] -> SigSpec
SigSpecCat ([SigSpec] -> SigSpec) -> [SigSpec] -> SigSpec
forall a b. (a -> b) -> a -> b
$ [SigSpec]
a   [SigSpec] -> [SigSpec] -> [SigSpec]
forall a. Semigroup a => a -> a -> a
<> [SigSpec
b]
  SigSpec
a <> SigSpecCat [SigSpec]
b            = [SigSpec] -> SigSpec
SigSpecCat ([SigSpec] -> SigSpec) -> [SigSpec] -> SigSpec
forall a b. (a -> b) -> a -> b
$ [SigSpec
a] [SigSpec] -> [SigSpec] -> [SigSpec]
forall a. Semigroup a => a -> a -> a
<> [SigSpec]
b
  SigSpec
a <> SigSpec
b                       = [SigSpec] -> SigSpec
SigSpecCat [SigSpec
a, SigSpec
b]

instance Monoid SigSpec where
  mempty :: SigSpec
mempty = [SigSpec] -> SigSpec
SigSpecCat [SigSpec]
forall a. Monoid a => a
mempty

instance IsString SigSpec where
  fromString :: String -> SigSpec
fromString = Constant -> SigSpec
SigSpecConstant (Constant -> SigSpec) -> (String -> Constant) -> String -> SigSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Constant
forall a. IsString a => String -> a
fromString

data ConnStmt = ConnStmt SigSpec SigSpec
  deriving (ConnStmt -> ConnStmt -> Bool
(ConnStmt -> ConnStmt -> Bool)
-> (ConnStmt -> ConnStmt -> Bool) -> Eq ConnStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnStmt -> ConnStmt -> Bool
== :: ConnStmt -> ConnStmt -> Bool
$c/= :: ConnStmt -> ConnStmt -> Bool
/= :: ConnStmt -> ConnStmt -> Bool
Eq, ReadPrec [ConnStmt]
ReadPrec ConnStmt
Int -> ReadS ConnStmt
ReadS [ConnStmt]
(Int -> ReadS ConnStmt)
-> ReadS [ConnStmt]
-> ReadPrec ConnStmt
-> ReadPrec [ConnStmt]
-> Read ConnStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ConnStmt
readsPrec :: Int -> ReadS ConnStmt
$creadList :: ReadS [ConnStmt]
readList :: ReadS [ConnStmt]
$creadPrec :: ReadPrec ConnStmt
readPrec :: ReadPrec ConnStmt
$creadListPrec :: ReadPrec [ConnStmt]
readListPrec :: ReadPrec [ConnStmt]
Read, Int -> ConnStmt -> ShowS
[ConnStmt] -> ShowS
ConnStmt -> String
(Int -> ConnStmt -> ShowS)
-> (ConnStmt -> String) -> ([ConnStmt] -> ShowS) -> Show ConnStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnStmt -> ShowS
showsPrec :: Int -> ConnStmt -> ShowS
$cshow :: ConnStmt -> String
show :: ConnStmt -> String
$cshowList :: [ConnStmt] -> ShowS
showList :: [ConnStmt] -> ShowS
Show)

instance Pretty ConnStmt where
  pretty :: forall ann. ConnStmt -> Doc ann
pretty (ConnStmt SigSpec
x SigSpec
y) = Doc ann
"connect" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> SigSpec -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SigSpec -> Doc ann
pretty SigSpec
x Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> SigSpec -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SigSpec -> Doc ann
pretty SigSpec
y

data Wire = Wire [AttrStmt] WireStmt
  deriving (Wire -> Wire -> Bool
(Wire -> Wire -> Bool) -> (Wire -> Wire -> Bool) -> Eq Wire
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Wire -> Wire -> Bool
== :: Wire -> Wire -> Bool
$c/= :: Wire -> Wire -> Bool
/= :: Wire -> Wire -> Bool
Eq, ReadPrec [Wire]
ReadPrec Wire
Int -> ReadS Wire
ReadS [Wire]
(Int -> ReadS Wire)
-> ReadS [Wire] -> ReadPrec Wire -> ReadPrec [Wire] -> Read Wire
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Wire
readsPrec :: Int -> ReadS Wire
$creadList :: ReadS [Wire]
readList :: ReadS [Wire]
$creadPrec :: ReadPrec Wire
readPrec :: ReadPrec Wire
$creadListPrec :: ReadPrec [Wire]
readListPrec :: ReadPrec [Wire]
Read, Int -> Wire -> ShowS
[Wire] -> ShowS
Wire -> String
(Int -> Wire -> ShowS)
-> (Wire -> String) -> ([Wire] -> ShowS) -> Show Wire
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Wire -> ShowS
showsPrec :: Int -> Wire -> ShowS
$cshow :: Wire -> String
show :: Wire -> String
$cshowList :: [Wire] -> ShowS
showList :: [Wire] -> ShowS
Show)

instance Pretty Wire where
  pretty :: forall ann. Wire -> Doc ann
pretty (Wire [AttrStmt]
as WireStmt
s) = (AttrStmt -> Doc ann) -> [AttrStmt] -> Doc ann
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap AttrStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AttrStmt -> Doc ann
pretty [AttrStmt]
as Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> WireStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. WireStmt -> Doc ann
pretty WireStmt
s

data WireStmt = WireStmt [WireOption] WireId
  deriving (WireStmt -> WireStmt -> Bool
(WireStmt -> WireStmt -> Bool)
-> (WireStmt -> WireStmt -> Bool) -> Eq WireStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WireStmt -> WireStmt -> Bool
== :: WireStmt -> WireStmt -> Bool
$c/= :: WireStmt -> WireStmt -> Bool
/= :: WireStmt -> WireStmt -> Bool
Eq, ReadPrec [WireStmt]
ReadPrec WireStmt
Int -> ReadS WireStmt
ReadS [WireStmt]
(Int -> ReadS WireStmt)
-> ReadS [WireStmt]
-> ReadPrec WireStmt
-> ReadPrec [WireStmt]
-> Read WireStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS WireStmt
readsPrec :: Int -> ReadS WireStmt
$creadList :: ReadS [WireStmt]
readList :: ReadS [WireStmt]
$creadPrec :: ReadPrec WireStmt
readPrec :: ReadPrec WireStmt
$creadListPrec :: ReadPrec [WireStmt]
readListPrec :: ReadPrec [WireStmt]
Read, Int -> WireStmt -> ShowS
[WireStmt] -> ShowS
WireStmt -> String
(Int -> WireStmt -> ShowS)
-> (WireStmt -> String) -> ([WireStmt] -> ShowS) -> Show WireStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WireStmt -> ShowS
showsPrec :: Int -> WireStmt -> ShowS
$cshow :: WireStmt -> String
show :: WireStmt -> String
$cshowList :: [WireStmt] -> ShowS
showList :: [WireStmt] -> ShowS
Show)

instance Pretty WireStmt where
  pretty :: forall ann. WireStmt -> Doc ann
pretty (WireStmt [WireOption]
os WireId
i) = Doc ann
"wire" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep (WireOption -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. WireOption -> Doc ann
pretty (WireOption -> Doc ann) -> [WireOption] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WireOption]
os) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> WireId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. WireId -> Doc ann
pretty WireId
i

newtype WireId = WireId Ident
  deriving (WireId -> WireId -> Bool
(WireId -> WireId -> Bool)
-> (WireId -> WireId -> Bool) -> Eq WireId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WireId -> WireId -> Bool
== :: WireId -> WireId -> Bool
$c/= :: WireId -> WireId -> Bool
/= :: WireId -> WireId -> Bool
Eq, String -> WireId
(String -> WireId) -> IsString WireId
forall a. (String -> a) -> IsString a
$cfromString :: String -> WireId
fromString :: String -> WireId
IsString, Semigroup WireId
WireId
Semigroup WireId =>
WireId
-> (WireId -> WireId -> WireId)
-> ([WireId] -> WireId)
-> Monoid WireId
[WireId] -> WireId
WireId -> WireId -> WireId
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: WireId
mempty :: WireId
$cmappend :: WireId -> WireId -> WireId
mappend :: WireId -> WireId -> WireId
$cmconcat :: [WireId] -> WireId
mconcat :: [WireId] -> WireId
Monoid, (forall ann. WireId -> Doc ann)
-> (forall ann. [WireId] -> Doc ann) -> Pretty WireId
forall ann. [WireId] -> Doc ann
forall ann. WireId -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. WireId -> Doc ann
pretty :: forall ann. WireId -> Doc ann
$cprettyList :: forall ann. [WireId] -> Doc ann
prettyList :: forall ann. [WireId] -> Doc ann
Pretty, ReadPrec [WireId]
ReadPrec WireId
Int -> ReadS WireId
ReadS [WireId]
(Int -> ReadS WireId)
-> ReadS [WireId]
-> ReadPrec WireId
-> ReadPrec [WireId]
-> Read WireId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS WireId
readsPrec :: Int -> ReadS WireId
$creadList :: ReadS [WireId]
readList :: ReadS [WireId]
$creadPrec :: ReadPrec WireId
readPrec :: ReadPrec WireId
$creadListPrec :: ReadPrec [WireId]
readListPrec :: ReadPrec [WireId]
Read, NonEmpty WireId -> WireId
WireId -> WireId -> WireId
(WireId -> WireId -> WireId)
-> (NonEmpty WireId -> WireId)
-> (forall b. Integral b => b -> WireId -> WireId)
-> Semigroup WireId
forall b. Integral b => b -> WireId -> WireId
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: WireId -> WireId -> WireId
<> :: WireId -> WireId -> WireId
$csconcat :: NonEmpty WireId -> WireId
sconcat :: NonEmpty WireId -> WireId
$cstimes :: forall b. Integral b => b -> WireId -> WireId
stimes :: forall b. Integral b => b -> WireId -> WireId
Semigroup, Int -> WireId -> ShowS
[WireId] -> ShowS
WireId -> String
(Int -> WireId -> ShowS)
-> (WireId -> String) -> ([WireId] -> ShowS) -> Show WireId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WireId -> ShowS
showsPrec :: Int -> WireId -> ShowS
$cshow :: WireId -> String
show :: WireId -> String
$cshowList :: [WireId] -> ShowS
showList :: [WireId] -> ShowS
Show)

data WireOption = WireOptionWidth  Integer
                | WireOptionOffset Integer
                | WireOptionInput  Integer
                | WireOptionOutput Integer
                | WireOptionInout  Integer
                | WireOptionUpto
                | WireOptionSigned
  deriving (WireOption -> WireOption -> Bool
(WireOption -> WireOption -> Bool)
-> (WireOption -> WireOption -> Bool) -> Eq WireOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WireOption -> WireOption -> Bool
== :: WireOption -> WireOption -> Bool
$c/= :: WireOption -> WireOption -> Bool
/= :: WireOption -> WireOption -> Bool
Eq, ReadPrec [WireOption]
ReadPrec WireOption
Int -> ReadS WireOption
ReadS [WireOption]
(Int -> ReadS WireOption)
-> ReadS [WireOption]
-> ReadPrec WireOption
-> ReadPrec [WireOption]
-> Read WireOption
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS WireOption
readsPrec :: Int -> ReadS WireOption
$creadList :: ReadS [WireOption]
readList :: ReadS [WireOption]
$creadPrec :: ReadPrec WireOption
readPrec :: ReadPrec WireOption
$creadListPrec :: ReadPrec [WireOption]
readListPrec :: ReadPrec [WireOption]
Read, Int -> WireOption -> ShowS
[WireOption] -> ShowS
WireOption -> String
(Int -> WireOption -> ShowS)
-> (WireOption -> String)
-> ([WireOption] -> ShowS)
-> Show WireOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WireOption -> ShowS
showsPrec :: Int -> WireOption -> ShowS
$cshow :: WireOption -> String
show :: WireOption -> String
$cshowList :: [WireOption] -> ShowS
showList :: [WireOption] -> ShowS
Show)

instance Pretty WireOption where
  pretty :: forall ann. WireOption -> Doc ann
pretty = \case
    WireOptionWidth  Integer
i -> Doc ann
"width"  Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i
    WireOptionOffset Integer
i -> Doc ann
"offset" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i
    WireOptionInput  Integer
i -> Doc ann
"input"  Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i
    WireOptionOutput Integer
i -> Doc ann
"output" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i
    WireOptionInout  Integer
i -> Doc ann
"inout"  Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i
    WireOption
WireOptionUpto     -> Doc ann
"upto"
    WireOption
WireOptionSigned   -> Doc ann
"signed"

data Memory = Memory [AttrStmt] MemoryStmt
  deriving (Memory -> Memory -> Bool
(Memory -> Memory -> Bool)
-> (Memory -> Memory -> Bool) -> Eq Memory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Memory -> Memory -> Bool
== :: Memory -> Memory -> Bool
$c/= :: Memory -> Memory -> Bool
/= :: Memory -> Memory -> Bool
Eq, ReadPrec [Memory]
ReadPrec Memory
Int -> ReadS Memory
ReadS [Memory]
(Int -> ReadS Memory)
-> ReadS [Memory]
-> ReadPrec Memory
-> ReadPrec [Memory]
-> Read Memory
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Memory
readsPrec :: Int -> ReadS Memory
$creadList :: ReadS [Memory]
readList :: ReadS [Memory]
$creadPrec :: ReadPrec Memory
readPrec :: ReadPrec Memory
$creadListPrec :: ReadPrec [Memory]
readListPrec :: ReadPrec [Memory]
Read, Int -> Memory -> ShowS
[Memory] -> ShowS
Memory -> String
(Int -> Memory -> ShowS)
-> (Memory -> String) -> ([Memory] -> ShowS) -> Show Memory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Memory -> ShowS
showsPrec :: Int -> Memory -> ShowS
$cshow :: Memory -> String
show :: Memory -> String
$cshowList :: [Memory] -> ShowS
showList :: [Memory] -> ShowS
Show)

instance Pretty Memory where
  pretty :: forall ann. Memory -> Doc ann
pretty (Memory [AttrStmt]
as MemoryStmt
s) = [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
$ AttrStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AttrStmt -> Doc ann
pretty (AttrStmt -> Doc ann) -> [AttrStmt] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [AttrStmt]
as [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [MemoryStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. MemoryStmt -> Doc ann
pretty MemoryStmt
s]

data MemoryStmt = MemoryStmt [MemoryOption] Ident
  deriving (MemoryStmt -> MemoryStmt -> Bool
(MemoryStmt -> MemoryStmt -> Bool)
-> (MemoryStmt -> MemoryStmt -> Bool) -> Eq MemoryStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MemoryStmt -> MemoryStmt -> Bool
== :: MemoryStmt -> MemoryStmt -> Bool
$c/= :: MemoryStmt -> MemoryStmt -> Bool
/= :: MemoryStmt -> MemoryStmt -> Bool
Eq, ReadPrec [MemoryStmt]
ReadPrec MemoryStmt
Int -> ReadS MemoryStmt
ReadS [MemoryStmt]
(Int -> ReadS MemoryStmt)
-> ReadS [MemoryStmt]
-> ReadPrec MemoryStmt
-> ReadPrec [MemoryStmt]
-> Read MemoryStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MemoryStmt
readsPrec :: Int -> ReadS MemoryStmt
$creadList :: ReadS [MemoryStmt]
readList :: ReadS [MemoryStmt]
$creadPrec :: ReadPrec MemoryStmt
readPrec :: ReadPrec MemoryStmt
$creadListPrec :: ReadPrec [MemoryStmt]
readListPrec :: ReadPrec [MemoryStmt]
Read, Int -> MemoryStmt -> ShowS
[MemoryStmt] -> ShowS
MemoryStmt -> String
(Int -> MemoryStmt -> ShowS)
-> (MemoryStmt -> String)
-> ([MemoryStmt] -> ShowS)
-> Show MemoryStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemoryStmt -> ShowS
showsPrec :: Int -> MemoryStmt -> ShowS
$cshow :: MemoryStmt -> String
show :: MemoryStmt -> String
$cshowList :: [MemoryStmt] -> ShowS
showList :: [MemoryStmt] -> ShowS
Show)

instance Pretty MemoryStmt where
  pretty :: forall ann. MemoryStmt -> Doc ann
pretty (MemoryStmt [MemoryOption]
os Ident
i) = Doc ann
"memory" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (MemoryOption -> Doc ann) -> [MemoryOption] -> Doc ann
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap MemoryOption -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. MemoryOption -> Doc ann
pretty [MemoryOption]
os Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Ident -> Doc ann
pretty Ident
i

data MemoryOption = MemoryOptionWidth  Integer
                  | MemoryOptionSize   Integer
                  | MemoryOptionOffset Integer
  deriving (MemoryOption -> MemoryOption -> Bool
(MemoryOption -> MemoryOption -> Bool)
-> (MemoryOption -> MemoryOption -> Bool) -> Eq MemoryOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MemoryOption -> MemoryOption -> Bool
== :: MemoryOption -> MemoryOption -> Bool
$c/= :: MemoryOption -> MemoryOption -> Bool
/= :: MemoryOption -> MemoryOption -> Bool
Eq, ReadPrec [MemoryOption]
ReadPrec MemoryOption
Int -> ReadS MemoryOption
ReadS [MemoryOption]
(Int -> ReadS MemoryOption)
-> ReadS [MemoryOption]
-> ReadPrec MemoryOption
-> ReadPrec [MemoryOption]
-> Read MemoryOption
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MemoryOption
readsPrec :: Int -> ReadS MemoryOption
$creadList :: ReadS [MemoryOption]
readList :: ReadS [MemoryOption]
$creadPrec :: ReadPrec MemoryOption
readPrec :: ReadPrec MemoryOption
$creadListPrec :: ReadPrec [MemoryOption]
readListPrec :: ReadPrec [MemoryOption]
Read, Int -> MemoryOption -> ShowS
[MemoryOption] -> ShowS
MemoryOption -> String
(Int -> MemoryOption -> ShowS)
-> (MemoryOption -> String)
-> ([MemoryOption] -> ShowS)
-> Show MemoryOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemoryOption -> ShowS
showsPrec :: Int -> MemoryOption -> ShowS
$cshow :: MemoryOption -> String
show :: MemoryOption -> String
$cshowList :: [MemoryOption] -> ShowS
showList :: [MemoryOption] -> ShowS
Show)

instance Pretty MemoryOption where
  pretty :: forall ann. MemoryOption -> Doc ann
pretty = \case
    MemoryOptionWidth  Integer
i -> Doc ann
"width"  Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i
    MemoryOptionSize   Integer
i -> Doc ann
"size"   Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i
    MemoryOptionOffset Integer
i -> Doc ann
"offset" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
i

data Cell = Cell [AttrStmt] CellStmt [CellBodyStmt] CellEndStmt
  deriving (Cell -> Cell -> Bool
(Cell -> Cell -> Bool) -> (Cell -> Cell -> Bool) -> Eq Cell
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cell -> Cell -> Bool
== :: Cell -> Cell -> Bool
$c/= :: Cell -> Cell -> Bool
/= :: Cell -> Cell -> Bool
Eq, ReadPrec [Cell]
ReadPrec Cell
Int -> ReadS Cell
ReadS [Cell]
(Int -> ReadS Cell)
-> ReadS [Cell] -> ReadPrec Cell -> ReadPrec [Cell] -> Read Cell
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Cell
readsPrec :: Int -> ReadS Cell
$creadList :: ReadS [Cell]
readList :: ReadS [Cell]
$creadPrec :: ReadPrec Cell
readPrec :: ReadPrec Cell
$creadListPrec :: ReadPrec [Cell]
readListPrec :: ReadPrec [Cell]
Read, Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> String
(Int -> Cell -> ShowS)
-> (Cell -> String) -> ([Cell] -> ShowS) -> Show Cell
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cell -> ShowS
showsPrec :: Int -> Cell -> ShowS
$cshow :: Cell -> String
show :: Cell -> String
$cshowList :: [Cell] -> ShowS
showList :: [Cell] -> ShowS
Show)

instance Pretty Cell where
  pretty :: forall ann. Cell -> Doc ann
pretty (Cell [AttrStmt]
as CellStmt
s [CellBodyStmt]
bs CellEndStmt
e) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vl
    [ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vl ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ AttrStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AttrStmt -> Doc ann
pretty (AttrStmt -> Doc ann) -> [AttrStmt] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AttrStmt]
as
    , CellStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CellStmt -> Doc ann
pretty CellStmt
s
    , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent 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
vl ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ CellBodyStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CellBodyStmt -> Doc ann
pretty (CellBodyStmt -> Doc ann) -> [CellBodyStmt] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CellBodyStmt]
bs
    , CellEndStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CellEndStmt -> Doc ann
pretty CellEndStmt
e
    ]

vl :: [Doc ann] -> Doc ann
vl :: forall ann. [Doc ann] -> Doc ann
vl = (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith ((Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann)
-> (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ \Doc ann
x Doc ann
y -> Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
y

data CellStmt = CellStmt CellType CellId
  deriving (CellStmt -> CellStmt -> Bool
(CellStmt -> CellStmt -> Bool)
-> (CellStmt -> CellStmt -> Bool) -> Eq CellStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CellStmt -> CellStmt -> Bool
== :: CellStmt -> CellStmt -> Bool
$c/= :: CellStmt -> CellStmt -> Bool
/= :: CellStmt -> CellStmt -> Bool
Eq, ReadPrec [CellStmt]
ReadPrec CellStmt
Int -> ReadS CellStmt
ReadS [CellStmt]
(Int -> ReadS CellStmt)
-> ReadS [CellStmt]
-> ReadPrec CellStmt
-> ReadPrec [CellStmt]
-> Read CellStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CellStmt
readsPrec :: Int -> ReadS CellStmt
$creadList :: ReadS [CellStmt]
readList :: ReadS [CellStmt]
$creadPrec :: ReadPrec CellStmt
readPrec :: ReadPrec CellStmt
$creadListPrec :: ReadPrec [CellStmt]
readListPrec :: ReadPrec [CellStmt]
Read, Int -> CellStmt -> ShowS
[CellStmt] -> ShowS
CellStmt -> String
(Int -> CellStmt -> ShowS)
-> (CellStmt -> String) -> ([CellStmt] -> ShowS) -> Show CellStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CellStmt -> ShowS
showsPrec :: Int -> CellStmt -> ShowS
$cshow :: CellStmt -> String
show :: CellStmt -> String
$cshowList :: [CellStmt] -> ShowS
showList :: [CellStmt] -> ShowS
Show)

instance Pretty CellStmt where
  pretty :: forall ann. CellStmt -> Doc ann
pretty (CellStmt CellType
t CellId
i) = Doc ann
"cell" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> CellType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CellType -> Doc ann
pretty CellType
t Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> CellId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CellId -> Doc ann
pretty CellId
i

newtype CellId = CellId Ident
  deriving (CellId -> CellId -> Bool
(CellId -> CellId -> Bool)
-> (CellId -> CellId -> Bool) -> Eq CellId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CellId -> CellId -> Bool
== :: CellId -> CellId -> Bool
$c/= :: CellId -> CellId -> Bool
/= :: CellId -> CellId -> Bool
Eq, String -> CellId
(String -> CellId) -> IsString CellId
forall a. (String -> a) -> IsString a
$cfromString :: String -> CellId
fromString :: String -> CellId
IsString, Semigroup CellId
CellId
Semigroup CellId =>
CellId
-> (CellId -> CellId -> CellId)
-> ([CellId] -> CellId)
-> Monoid CellId
[CellId] -> CellId
CellId -> CellId -> CellId
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: CellId
mempty :: CellId
$cmappend :: CellId -> CellId -> CellId
mappend :: CellId -> CellId -> CellId
$cmconcat :: [CellId] -> CellId
mconcat :: [CellId] -> CellId
Monoid, (forall ann. CellId -> Doc ann)
-> (forall ann. [CellId] -> Doc ann) -> Pretty CellId
forall ann. [CellId] -> Doc ann
forall ann. CellId -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. CellId -> Doc ann
pretty :: forall ann. CellId -> Doc ann
$cprettyList :: forall ann. [CellId] -> Doc ann
prettyList :: forall ann. [CellId] -> Doc ann
Pretty, ReadPrec [CellId]
ReadPrec CellId
Int -> ReadS CellId
ReadS [CellId]
(Int -> ReadS CellId)
-> ReadS [CellId]
-> ReadPrec CellId
-> ReadPrec [CellId]
-> Read CellId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CellId
readsPrec :: Int -> ReadS CellId
$creadList :: ReadS [CellId]
readList :: ReadS [CellId]
$creadPrec :: ReadPrec CellId
readPrec :: ReadPrec CellId
$creadListPrec :: ReadPrec [CellId]
readListPrec :: ReadPrec [CellId]
Read, NonEmpty CellId -> CellId
CellId -> CellId -> CellId
(CellId -> CellId -> CellId)
-> (NonEmpty CellId -> CellId)
-> (forall b. Integral b => b -> CellId -> CellId)
-> Semigroup CellId
forall b. Integral b => b -> CellId -> CellId
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: CellId -> CellId -> CellId
<> :: CellId -> CellId -> CellId
$csconcat :: NonEmpty CellId -> CellId
sconcat :: NonEmpty CellId -> CellId
$cstimes :: forall b. Integral b => b -> CellId -> CellId
stimes :: forall b. Integral b => b -> CellId -> CellId
Semigroup, Int -> CellId -> ShowS
[CellId] -> ShowS
CellId -> String
(Int -> CellId -> ShowS)
-> (CellId -> String) -> ([CellId] -> ShowS) -> Show CellId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CellId -> ShowS
showsPrec :: Int -> CellId -> ShowS
$cshow :: CellId -> String
show :: CellId -> String
$cshowList :: [CellId] -> ShowS
showList :: [CellId] -> ShowS
Show)

newtype CellType = CellType Ident
  deriving (CellType -> CellType -> Bool
(CellType -> CellType -> Bool)
-> (CellType -> CellType -> Bool) -> Eq CellType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CellType -> CellType -> Bool
== :: CellType -> CellType -> Bool
$c/= :: CellType -> CellType -> Bool
/= :: CellType -> CellType -> Bool
Eq, String -> CellType
(String -> CellType) -> IsString CellType
forall a. (String -> a) -> IsString a
$cfromString :: String -> CellType
fromString :: String -> CellType
IsString, (forall ann. CellType -> Doc ann)
-> (forall ann. [CellType] -> Doc ann) -> Pretty CellType
forall ann. [CellType] -> Doc ann
forall ann. CellType -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. CellType -> Doc ann
pretty :: forall ann. CellType -> Doc ann
$cprettyList :: forall ann. [CellType] -> Doc ann
prettyList :: forall ann. [CellType] -> Doc ann
Pretty, ReadPrec [CellType]
ReadPrec CellType
Int -> ReadS CellType
ReadS [CellType]
(Int -> ReadS CellType)
-> ReadS [CellType]
-> ReadPrec CellType
-> ReadPrec [CellType]
-> Read CellType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CellType
readsPrec :: Int -> ReadS CellType
$creadList :: ReadS [CellType]
readList :: ReadS [CellType]
$creadPrec :: ReadPrec CellType
readPrec :: ReadPrec CellType
$creadListPrec :: ReadPrec [CellType]
readListPrec :: ReadPrec [CellType]
Read, Int -> CellType -> ShowS
[CellType] -> ShowS
CellType -> String
(Int -> CellType -> ShowS)
-> (CellType -> String) -> ([CellType] -> ShowS) -> Show CellType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CellType -> ShowS
showsPrec :: Int -> CellType -> ShowS
$cshow :: CellType -> String
show :: CellType -> String
$cshowList :: [CellType] -> ShowS
showList :: [CellType] -> ShowS
Show)

data ParamType = Signed | Real
  deriving (ParamType -> ParamType -> Bool
(ParamType -> ParamType -> Bool)
-> (ParamType -> ParamType -> Bool) -> Eq ParamType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParamType -> ParamType -> Bool
== :: ParamType -> ParamType -> Bool
$c/= :: ParamType -> ParamType -> Bool
/= :: ParamType -> ParamType -> Bool
Eq, ReadPrec [ParamType]
ReadPrec ParamType
Int -> ReadS ParamType
ReadS [ParamType]
(Int -> ReadS ParamType)
-> ReadS [ParamType]
-> ReadPrec ParamType
-> ReadPrec [ParamType]
-> Read ParamType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ParamType
readsPrec :: Int -> ReadS ParamType
$creadList :: ReadS [ParamType]
readList :: ReadS [ParamType]
$creadPrec :: ReadPrec ParamType
readPrec :: ReadPrec ParamType
$creadListPrec :: ReadPrec [ParamType]
readListPrec :: ReadPrec [ParamType]
Read, Int -> ParamType -> ShowS
[ParamType] -> ShowS
ParamType -> String
(Int -> ParamType -> ShowS)
-> (ParamType -> String)
-> ([ParamType] -> ShowS)
-> Show ParamType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParamType -> ShowS
showsPrec :: Int -> ParamType -> ShowS
$cshow :: ParamType -> String
show :: ParamType -> String
$cshowList :: [ParamType] -> ShowS
showList :: [ParamType] -> ShowS
Show)

instance Pretty ParamType where
  pretty :: forall ann. ParamType -> Doc ann
pretty ParamType
Signed = Doc ann
"signed"
  pretty ParamType
Real   = Doc ann
"real"

data CellBodyStmt = CellParameter (Maybe ParamType) Ident Constant
                  | CellConnect Ident SigSpec
  deriving (CellBodyStmt -> CellBodyStmt -> Bool
(CellBodyStmt -> CellBodyStmt -> Bool)
-> (CellBodyStmt -> CellBodyStmt -> Bool) -> Eq CellBodyStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CellBodyStmt -> CellBodyStmt -> Bool
== :: CellBodyStmt -> CellBodyStmt -> Bool
$c/= :: CellBodyStmt -> CellBodyStmt -> Bool
/= :: CellBodyStmt -> CellBodyStmt -> Bool
Eq, ReadPrec [CellBodyStmt]
ReadPrec CellBodyStmt
Int -> ReadS CellBodyStmt
ReadS [CellBodyStmt]
(Int -> ReadS CellBodyStmt)
-> ReadS [CellBodyStmt]
-> ReadPrec CellBodyStmt
-> ReadPrec [CellBodyStmt]
-> Read CellBodyStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CellBodyStmt
readsPrec :: Int -> ReadS CellBodyStmt
$creadList :: ReadS [CellBodyStmt]
readList :: ReadS [CellBodyStmt]
$creadPrec :: ReadPrec CellBodyStmt
readPrec :: ReadPrec CellBodyStmt
$creadListPrec :: ReadPrec [CellBodyStmt]
readListPrec :: ReadPrec [CellBodyStmt]
Read, Int -> CellBodyStmt -> ShowS
[CellBodyStmt] -> ShowS
CellBodyStmt -> String
(Int -> CellBodyStmt -> ShowS)
-> (CellBodyStmt -> String)
-> ([CellBodyStmt] -> ShowS)
-> Show CellBodyStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CellBodyStmt -> ShowS
showsPrec :: Int -> CellBodyStmt -> ShowS
$cshow :: CellBodyStmt -> String
show :: CellBodyStmt -> String
$cshowList :: [CellBodyStmt] -> ShowS
showList :: [CellBodyStmt] -> ShowS
Show)

instance Pretty CellBodyStmt where
  pretty :: forall ann. CellBodyStmt -> Doc ann
pretty = \case
    CellParameter Maybe ParamType
Nothing Ident
i Constant
c -> Doc ann
"parameter" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Ident -> Doc ann
pretty Ident
i Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Constant -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Constant -> Doc ann
pretty Constant
c
    CellParameter (Just ParamType
p) Ident
i Constant
c -> Doc ann
"parameter" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ParamType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ParamType -> Doc ann
pretty ParamType
p Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Ident -> Doc ann
pretty Ident
i Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Constant -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Constant -> Doc ann
pretty Constant
c
    CellConnect Ident
i SigSpec
s -> Doc ann
"connect" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Ident -> Doc ann
pretty Ident
i Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> SigSpec -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SigSpec -> Doc ann
pretty SigSpec
s

data CellEndStmt = CellEndStmt
  deriving (CellEndStmt -> CellEndStmt -> Bool
(CellEndStmt -> CellEndStmt -> Bool)
-> (CellEndStmt -> CellEndStmt -> Bool) -> Eq CellEndStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CellEndStmt -> CellEndStmt -> Bool
== :: CellEndStmt -> CellEndStmt -> Bool
$c/= :: CellEndStmt -> CellEndStmt -> Bool
/= :: CellEndStmt -> CellEndStmt -> Bool
Eq, ReadPrec [CellEndStmt]
ReadPrec CellEndStmt
Int -> ReadS CellEndStmt
ReadS [CellEndStmt]
(Int -> ReadS CellEndStmt)
-> ReadS [CellEndStmt]
-> ReadPrec CellEndStmt
-> ReadPrec [CellEndStmt]
-> Read CellEndStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CellEndStmt
readsPrec :: Int -> ReadS CellEndStmt
$creadList :: ReadS [CellEndStmt]
readList :: ReadS [CellEndStmt]
$creadPrec :: ReadPrec CellEndStmt
readPrec :: ReadPrec CellEndStmt
$creadListPrec :: ReadPrec [CellEndStmt]
readListPrec :: ReadPrec [CellEndStmt]
Read, Int -> CellEndStmt -> ShowS
[CellEndStmt] -> ShowS
CellEndStmt -> String
(Int -> CellEndStmt -> ShowS)
-> (CellEndStmt -> String)
-> ([CellEndStmt] -> ShowS)
-> Show CellEndStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CellEndStmt -> ShowS
showsPrec :: Int -> CellEndStmt -> ShowS
$cshow :: CellEndStmt -> String
show :: CellEndStmt -> String
$cshowList :: [CellEndStmt] -> ShowS
showList :: [CellEndStmt] -> ShowS
Show)

instance Pretty CellEndStmt where
  pretty :: forall ann. CellEndStmt -> Doc ann
pretty CellEndStmt
_ = Doc ann
"end" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline

unaryCell
  :: CellStmt
  -> Bool    -- ^ \\A_SIGNED
  -> Integer -- ^ \\A_WIDTH
  -> Integer -- ^ \\Y_WIDTH
  -> SigSpec -- ^ A
  -> SigSpec -- ^ Y
  -> Cell
unaryCell :: CellStmt
-> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
unaryCell CellStmt
cellStmt Bool
aSigned Integer
aWidth Integer
yWidth SigSpec
a SigSpec
y = [AttrStmt] -> CellStmt -> [CellBodyStmt] -> CellEndStmt -> Cell
Cell
  []
  CellStmt
cellStmt
  [ Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\A_SIGNED" (Constant -> CellBodyStmt) -> Constant -> CellBodyStmt
forall a b. (a -> b) -> a -> b
$ Integer -> Constant
ConstantInteger (Integer -> Constant) -> Integer -> Constant
forall a b. (a -> b) -> a -> b
$ Bool -> Integer
fromBool Bool
aSigned
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\A_WIDTH" (Constant -> CellBodyStmt) -> Constant -> CellBodyStmt
forall a b. (a -> b) -> a -> b
$ Integer -> Constant
ConstantInteger Integer
aWidth
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\Y_WIDTH" (Constant -> CellBodyStmt) -> Constant -> CellBodyStmt
forall a b. (a -> b) -> a -> b
$ Integer -> Constant
ConstantInteger Integer
yWidth
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\A" SigSpec
a
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\Y" SigSpec
y
  ]
  CellEndStmt
CellEndStmt

-- unary cells
notC, posC, negC, reduceAndC, reduceOrC, reduceXorC, reduceXnorC, reduceBoolC, logicNotC
  :: CellId
  -> Bool
  -> Integer
  -> Integer
  -> SigSpec
  -> SigSpec
  -> Cell

notC :: CellId -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
notC        = CellStmt
-> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
unaryCell (CellStmt
 -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$not"
posC :: CellId -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
posC        = CellStmt
-> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
unaryCell (CellStmt
 -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$pos"
negC :: CellId -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
negC        = CellStmt
-> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
unaryCell (CellStmt
 -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$neg"
reduceAndC :: CellId -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
reduceAndC  = CellStmt
-> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
unaryCell (CellStmt
 -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$reduce_and"
reduceOrC :: CellId -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
reduceOrC   = CellStmt
-> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
unaryCell (CellStmt
 -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$reduce_or"
reduceXorC :: CellId -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
reduceXorC  = CellStmt
-> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
unaryCell (CellStmt
 -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$reduce_xor"
reduceXnorC :: CellId -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
reduceXnorC = CellStmt
-> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
unaryCell (CellStmt
 -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$reduce_xnor"
reduceBoolC :: CellId -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
reduceBoolC = CellStmt
-> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
unaryCell (CellStmt
 -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$reduce_bool"
logicNotC :: CellId -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
logicNotC   = CellStmt
-> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell
unaryCell (CellStmt
 -> Bool -> Integer -> Integer -> SigSpec -> SigSpec -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$logic_not"

binaryCell
  :: CellStmt
  -> Bool    -- ^ \\A_SIGNED
  -> Integer -- ^ \\A_WIDTH
  -> Bool    -- ^ \\B_SIGNED
  -> Integer -- ^ \\B_WIDTH
  -> Integer -- ^ \\Y_WIDTH
  -> SigSpec -- ^ A
  -> SigSpec -- ^ B
  -> SigSpec -- ^ Y
  -> Cell
binaryCell :: CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell CellStmt
cellStmt Bool
aSigned Integer
aWidth Bool
bSigned Integer
bWidth Integer
yWidth SigSpec
a SigSpec
b SigSpec
y = [AttrStmt] -> CellStmt -> [CellBodyStmt] -> CellEndStmt -> Cell
Cell
  []
  CellStmt
cellStmt
  [ Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\A_SIGNED" (Constant -> CellBodyStmt) -> Constant -> CellBodyStmt
forall a b. (a -> b) -> a -> b
$ Integer -> Constant
ConstantInteger (Integer -> Constant) -> Integer -> Constant
forall a b. (a -> b) -> a -> b
$ Bool -> Integer
fromBool Bool
aSigned
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\A_WIDTH"  (Constant -> CellBodyStmt) -> Constant -> CellBodyStmt
forall a b. (a -> b) -> a -> b
$ Integer -> Constant
ConstantInteger Integer
aWidth
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\B_SIGNED" (Constant -> CellBodyStmt) -> Constant -> CellBodyStmt
forall a b. (a -> b) -> a -> b
$ Integer -> Constant
ConstantInteger (Integer -> Constant) -> Integer -> Constant
forall a b. (a -> b) -> a -> b
$ Bool -> Integer
fromBool Bool
bSigned
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\B_WIDTH"  (Constant -> CellBodyStmt) -> Constant -> CellBodyStmt
forall a b. (a -> b) -> a -> b
$ Integer -> Constant
ConstantInteger Integer
bWidth
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\Y_WIDTH"  (Constant -> CellBodyStmt) -> Constant -> CellBodyStmt
forall a b. (a -> b) -> a -> b
$ Integer -> Constant
ConstantInteger Integer
yWidth
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\A" SigSpec
a
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\B" SigSpec
b
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\Y" SigSpec
y
  ]
  CellEndStmt
CellEndStmt

fromBool :: Bool -> Integer
fromBool :: Bool -> Integer
fromBool Bool
True  = Integer
1
fromBool Bool
False = Integer
0

shiftCell
  :: CellStmt
  -> Bool
  -> Integer
  -> Integer
  -> Integer
  -> SigSpec
  -> SigSpec
  -> SigSpec
  -> Cell
shiftCell :: CellStmt
-> Bool
-> Integer
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
shiftCell CellStmt
cellStmt Bool
aSigned Integer
aWidth = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell CellStmt
cellStmt Bool
aSigned Integer
aWidth Bool
False

-- binary cells
andC, orC, xorC, xnorC, logicAndC, logicOrC, eqxC, nexC, powC, ltC, leC, eqC, neC, geC, gtC, addC, subC, mulC, divC, modC, divFloorC, modFloorC
  :: CellId
  -> Bool
  -> Integer
  -> Bool
  -> Integer
  -> Integer
  -> SigSpec
  -> SigSpec
  -> SigSpec
  -> Cell

shlC, shrC, sshlC, sshrC
  :: CellId
  -> Bool
  -> Integer
  -> Integer
  -> Integer
  -> SigSpec
  -> SigSpec
  -> SigSpec
  -> Cell

andC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
andC      = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$and"
orC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
orC       = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$or"
xorC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
xorC      = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$xor"
xnorC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
xnorC     = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$xnor"
shlC :: CellId
-> Bool
-> Integer
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
shlC      = CellStmt
-> Bool
-> Integer
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
shiftCell  (CellStmt
 -> Bool
 -> Integer
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$shl"
shrC :: CellId
-> Bool
-> Integer
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
shrC      = CellStmt
-> Bool
-> Integer
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
shiftCell  (CellStmt
 -> Bool
 -> Integer
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$shr"
sshlC :: CellId
-> Bool
-> Integer
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
sshlC     = CellStmt
-> Bool
-> Integer
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
shiftCell  (CellStmt
 -> Bool
 -> Integer
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$sshl"
sshrC :: CellId
-> Bool
-> Integer
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
sshrC     = CellStmt
-> Bool
-> Integer
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
shiftCell  (CellStmt
 -> Bool
 -> Integer
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$sshr"
logicAndC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
logicAndC = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$logic_and"
logicOrC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
logicOrC  = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$logic_or"
eqxC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
eqxC      = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$eqx"
nexC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
nexC      = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$nex"
powC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
powC      = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$pow"
ltC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
ltC       = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$lt"
leC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
leC       = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$le"
eqC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
eqC       = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$eq"
neC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
neC       = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$ne"
geC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
geC       = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$ge"
gtC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
gtC       = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$gt"
addC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
addC      = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$add"
subC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
subC      = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$sub"
mulC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
mulC      = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$mul"
divC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
divC      = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$div"
modC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
modC      = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$mod"
divFloorC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
divFloorC = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$divfloor"
modFloorC :: CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
modFloorC = CellStmt
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
binaryCell (CellStmt
 -> Bool
 -> Integer
 -> Bool
 -> Integer
 -> Integer
 -> SigSpec
 -> SigSpec
 -> SigSpec
 -> Cell)
-> (CellId -> CellStmt)
-> CellId
-> Bool
-> Integer
-> Bool
-> Integer
-> Integer
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellType -> CellId -> CellStmt
CellStmt CellType
"$modfloor"

-- | Y = S ? B : A
muxC
  :: CellId
  -> Integer -- ^ WIDTH
  -> SigSpec -- ^ A
  -> SigSpec -- ^ B
  -> SigSpec -- ^ S
  -> SigSpec -- ^ Y
  -> Cell
muxC :: CellId
-> Integer -> SigSpec -> SigSpec -> SigSpec -> SigSpec -> Cell
muxC CellId
cellId Integer
w SigSpec
a SigSpec
b SigSpec
s SigSpec
y = [AttrStmt] -> CellStmt -> [CellBodyStmt] -> CellEndStmt -> Cell
Cell
  []
  (CellType -> CellId -> CellStmt
CellStmt CellType
"$mux" CellId
cellId)
  [ Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\WIDTH" (Constant -> CellBodyStmt) -> Constant -> CellBodyStmt
forall a b. (a -> b) -> a -> b
$ Integer -> Constant
ConstantInteger Integer
w
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\A" SigSpec
a
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\B" SigSpec
b
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\S" SigSpec
s
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\Y" SigSpec
y
  ]
  CellEndStmt
CellEndStmt

memRdV2C
  :: CellId
  -> Constant -- ^ MEMID
  -> Constant -- ^ ABITS
  -> Constant -- ^ WIDTH
  -> Constant -- ^ CLK_ENABLE
  -> Constant -- ^ CLK_POLARITY
  -> Constant -- ^ TRANSPARENCY_MASK
  -> Constant -- ^ COLLISION_X_MASK
  -> Constant -- ^ ARST_VALUE
  -> Constant -- ^ SRST_VALUE
  -> Constant -- ^ INIT_VALUE
  -> Constant -- ^ CE_OVER_SRST
  -> SigSpec  -- ^ CLK
  -> SigSpec  -- ^ EN
  -> SigSpec  -- ^ ADDR
  -> SigSpec  -- ^ DATA
  -> SigSpec  -- ^ ARST
  -> SigSpec  -- ^ SRST
  -> Cell
memRdV2C :: CellId
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> SigSpec
-> SigSpec
-> SigSpec
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
memRdV2C CellId
cid Constant
mid Constant
abits Constant
w Constant
ce Constant
cpol Constant
tmask Constant
xmask Constant
arstVal Constant
srstVal Constant
initVal Constant
ceSrst SigSpec
clk SigSpec
en SigSpec
a SigSpec
d SigSpec
arst SigSpec
srst = [AttrStmt] -> CellStmt -> [CellBodyStmt] -> CellEndStmt -> Cell
Cell
  []
  (CellType -> CellId -> CellStmt
CellStmt CellType
"$memrd_v2" CellId
cid)
  [ Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\MEMID"             Constant
mid
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\ABITS"             Constant
abits
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\WIDTH"             Constant
w
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\CLK_ENABLE"        Constant
ce
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\CLK_POLARITY"      Constant
cpol
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\TRANSPARENCY_MASK" Constant
tmask
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\COLLISION_X_MASK"  Constant
xmask
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\ARST_VALUE"        Constant
arstVal
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\SRST_VALUE"        Constant
srstVal
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\INIT_VALUE"        Constant
initVal
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\CE_OVER_SRST"      Constant
ceSrst
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\CLK"  SigSpec
clk
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\EN"   SigSpec
en
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\ADDR" SigSpec
a
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\DATA" SigSpec
d
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\ARST" SigSpec
arst
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\SRST" SigSpec
srst
  ]
  CellEndStmt
CellEndStmt

memWrV2C
  :: CellId
  -> Constant -- ^ MEMID
  -> Constant -- ^ ABITS
  -> Constant -- ^ WIDTH
  -> Constant -- ^ CLK_ENABLE
  -> Constant -- ^ CLK_POLARITY
  -> Constant -- ^ PORTID
  -> Constant -- ^ PRIORITY_MASK
  -> SigSpec  -- ^ CLK
  -> SigSpec  -- ^ EN
  -> SigSpec  -- ^ ADDR
  -> SigSpec  -- ^ DATA
  -> Cell
memWrV2C :: CellId
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> SigSpec
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
memWrV2C CellId
cid Constant
mid Constant
abits Constant
w Constant
ce Constant
cpol Constant
pid Constant
pmask SigSpec
clk SigSpec
en SigSpec
a SigSpec
d = [AttrStmt] -> CellStmt -> [CellBodyStmt] -> CellEndStmt -> Cell
Cell
  []
  (CellType -> CellId -> CellStmt
CellStmt CellType
"$memwr_v2" CellId
cid)
  [ Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\MEMID"         Constant
mid
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\ABITS"         Constant
abits
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\WIDTH"         Constant
w
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\CLK_ENABLE"    Constant
ce
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\CLK_POLARITY"  Constant
cpol
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\PORTID"        Constant
pid
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\PRIORITY_MASK" Constant
pmask
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\CLK"  SigSpec
clk
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\EN"   SigSpec
en
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\ADDR" SigSpec
a
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\DATA" SigSpec
d
  ]
  CellEndStmt
CellEndStmt

memInitV2C
  :: CellId
  -> Constant -- ^ MEMID
  -> Constant -- ^ ABITS
  -> Constant -- ^ WIDTH
  -> Constant -- ^ WORDS
  -> Constant -- ^ PRIORITY
  -> SigSpec  -- ^ ADDR
  -> SigSpec  -- ^ DATA
  -> Cell
memInitV2C :: CellId
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> SigSpec
-> SigSpec
-> Cell
memInitV2C CellId
cellId Constant
memId Constant
aBits Constant
w Constant
wrds Constant
p SigSpec
a SigSpec
d= [AttrStmt] -> CellStmt -> [CellBodyStmt] -> CellEndStmt -> Cell
Cell
  []
  (CellType -> CellId -> CellStmt
CellStmt CellType
"$meminit_v2" CellId
cellId)
  [ Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\MEMID"    Constant
memId
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\ABITS"    Constant
aBits
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\WIDTH"    Constant
w
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\WORDS"    Constant
wrds
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\PRIORITY" Constant
p
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\ADDR" SigSpec
a
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\DATA" SigSpec
d
  ]
  CellEndStmt
CellEndStmt

memV2C
  :: CellId
  -> Constant -- ^ MEMID
  -> Constant -- ^ SIZE
  -> Constant -- ^ ABITS
  -> Constant -- ^ WIDTH
  -> Constant -- ^ INIT
  -> Constant -- ^ RD_PORTS
  -> Constant -- ^ RD_WIDE_CONTINUATION
  -> Constant -- ^ RD_CLK_ENABLE
  -> Constant -- ^ RD_CLK_POLARITY
  -> Constant -- ^ RD_TRANSPARENCY_MASK
  -> Constant -- ^ RD_COLLISION_X_MASK
  -> Constant -- ^ RD_CE_OVER_SRST
  -> Constant -- ^ RD_INIT_VALUE
  -> Constant -- ^ RD_ARST_VALUE
  -> Constant -- ^ RD_SRST_VALUE
  -> Constant -- ^ WR_PORTS
  -> Constant -- ^ WR_WIDE_CONTINUATION
  -> Constant -- ^ WR_CLK_ENABLE
  -> Constant -- ^ WR_CLK_POLARITY
  -> Constant -- ^ WR_PRIORITY_MASK
  -> SigSpec  -- ^ RD_CLK
  -> SigSpec  -- ^ RD_EN
  -> SigSpec  -- ^ RD_ADDR
  -> SigSpec  -- ^ RD_DATA
  -> SigSpec  -- ^ RD_ARST
  -> SigSpec  -- ^ RD_SRST
  -> SigSpec  -- ^ WR_CLK
  -> SigSpec  -- ^ WR_EN
  -> SigSpec  -- ^ WR_ADDR
  -> SigSpec  -- ^ WR_DATA
  -> Cell
memV2C :: CellId
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> Constant
-> SigSpec
-> SigSpec
-> SigSpec
-> SigSpec
-> SigSpec
-> SigSpec
-> SigSpec
-> SigSpec
-> SigSpec
-> SigSpec
-> Cell
memV2C CellId
ci Constant
mid Constant
s Constant
abits Constant
w Constant
ini Constant
rps Constant
rwc Constant
rce Constant
rcpol Constant
rtm Constant
rcxm Constant
rcos Constant
riv Constant
rav Constant
rsv Constant
wps Constant
wwc Constant
wce Constant
wcpol Constant
wpm SigSpec
rclk SigSpec
ren SigSpec
raddr SigSpec
rdata SigSpec
rarst SigSpec
rsrst SigSpec
wclk SigSpec
wen SigSpec
waddr SigSpec
wdata = [AttrStmt] -> CellStmt -> [CellBodyStmt] -> CellEndStmt -> Cell
Cell
  []
  (CellType -> CellId -> CellStmt
CellStmt CellType
"$mem_v2" CellId
ci)
  [ Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\MEMID"                Constant
mid
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\SIZE"                 Constant
s
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\ABITS"                Constant
abits
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\WIDTH"                Constant
w
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\INIT"                 Constant
ini
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\RD_PORTS"             Constant
rps
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\RD_WIDE_CONTINUATION" Constant
rwc
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\RD_CLK_ENABLE"        Constant
rce
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\RD_CLK_POLARITY"      Constant
rcpol
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\RD_TRANSPARENCY_MASK" Constant
rtm
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\RD_COLLISION_X_MASK"  Constant
rcxm
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\RD_CE_OVER_SRST"      Constant
rcos
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\RD_INIT_VALUE"        Constant
riv
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\RD_ARST_VALUE"        Constant
rav
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\RD_SRST_VALUE"        Constant
rsv
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\WR_PORTS"             Constant
wps
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\WR_WIDE_CONTINUATION" Constant
wwc
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\WR_CLK_ENABLE"        Constant
wce
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\WR_CLK_POLARITY"      Constant
wcpol
  , Maybe ParamType -> Ident -> Constant -> CellBodyStmt
CellParameter Maybe ParamType
forall a. Maybe a
Nothing Ident
"\\WR_PRIORITY_MASK"     Constant
wpm
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\RD_CLK"  SigSpec
rclk
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\RD_EN"   SigSpec
ren
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\RD_ADDR" SigSpec
raddr
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\RD_DATA" SigSpec
rdata
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\RD_ARST" SigSpec
rarst
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\RD_SRST" SigSpec
rsrst
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\WR_CLK"  SigSpec
wclk
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\WR_EN"   SigSpec
wen
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\WR_ADDR" SigSpec
waddr
  , Ident -> SigSpec -> CellBodyStmt
CellConnect Ident
"\\WR_DATA" SigSpec
wdata
  ]
  CellEndStmt
CellEndStmt

data Process = Process [AttrStmt] ProcStmt ProcessBody ProcEndStmt
  deriving (Process -> Process -> Bool
(Process -> Process -> Bool)
-> (Process -> Process -> Bool) -> Eq Process
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Process -> Process -> Bool
== :: Process -> Process -> Bool
$c/= :: Process -> Process -> Bool
/= :: Process -> Process -> Bool
Eq, ReadPrec [Process]
ReadPrec Process
Int -> ReadS Process
ReadS [Process]
(Int -> ReadS Process)
-> ReadS [Process]
-> ReadPrec Process
-> ReadPrec [Process]
-> Read Process
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Process
readsPrec :: Int -> ReadS Process
$creadList :: ReadS [Process]
readList :: ReadS [Process]
$creadPrec :: ReadPrec Process
readPrec :: ReadPrec Process
$creadListPrec :: ReadPrec [Process]
readListPrec :: ReadPrec [Process]
Read, Int -> Process -> ShowS
[Process] -> ShowS
Process -> String
(Int -> Process -> ShowS)
-> (Process -> String) -> ([Process] -> ShowS) -> Show Process
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Process -> ShowS
showsPrec :: Int -> Process -> ShowS
$cshow :: Process -> String
show :: Process -> String
$cshowList :: [Process] -> ShowS
showList :: [Process] -> ShowS
Show)

instance Pretty Process where
  pretty :: forall ann. Process -> Doc ann
pretty (Process [AttrStmt]
as ProcStmt
s ProcessBody
b ProcEndStmt
e) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vl
    [ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vl ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ AttrStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AttrStmt -> Doc ann
pretty (AttrStmt -> Doc ann) -> [AttrStmt] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AttrStmt]
as
    , ProcStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ProcStmt -> Doc ann
pretty ProcStmt
s
    , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ ProcessBody -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ProcessBody -> Doc ann
pretty ProcessBody
b
    , ProcEndStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ProcEndStmt -> Doc ann
pretty ProcEndStmt
e
    ]

newtype ProcStmt = ProcStmt Ident
  deriving (ProcStmt -> ProcStmt -> Bool
(ProcStmt -> ProcStmt -> Bool)
-> (ProcStmt -> ProcStmt -> Bool) -> Eq ProcStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProcStmt -> ProcStmt -> Bool
== :: ProcStmt -> ProcStmt -> Bool
$c/= :: ProcStmt -> ProcStmt -> Bool
/= :: ProcStmt -> ProcStmt -> Bool
Eq, String -> ProcStmt
(String -> ProcStmt) -> IsString ProcStmt
forall a. (String -> a) -> IsString a
$cfromString :: String -> ProcStmt
fromString :: String -> ProcStmt
IsString, Semigroup ProcStmt
ProcStmt
Semigroup ProcStmt =>
ProcStmt
-> (ProcStmt -> ProcStmt -> ProcStmt)
-> ([ProcStmt] -> ProcStmt)
-> Monoid ProcStmt
[ProcStmt] -> ProcStmt
ProcStmt -> ProcStmt -> ProcStmt
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: ProcStmt
mempty :: ProcStmt
$cmappend :: ProcStmt -> ProcStmt -> ProcStmt
mappend :: ProcStmt -> ProcStmt -> ProcStmt
$cmconcat :: [ProcStmt] -> ProcStmt
mconcat :: [ProcStmt] -> ProcStmt
Monoid, ReadPrec [ProcStmt]
ReadPrec ProcStmt
Int -> ReadS ProcStmt
ReadS [ProcStmt]
(Int -> ReadS ProcStmt)
-> ReadS [ProcStmt]
-> ReadPrec ProcStmt
-> ReadPrec [ProcStmt]
-> Read ProcStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ProcStmt
readsPrec :: Int -> ReadS ProcStmt
$creadList :: ReadS [ProcStmt]
readList :: ReadS [ProcStmt]
$creadPrec :: ReadPrec ProcStmt
readPrec :: ReadPrec ProcStmt
$creadListPrec :: ReadPrec [ProcStmt]
readListPrec :: ReadPrec [ProcStmt]
Read, NonEmpty ProcStmt -> ProcStmt
ProcStmt -> ProcStmt -> ProcStmt
(ProcStmt -> ProcStmt -> ProcStmt)
-> (NonEmpty ProcStmt -> ProcStmt)
-> (forall b. Integral b => b -> ProcStmt -> ProcStmt)
-> Semigroup ProcStmt
forall b. Integral b => b -> ProcStmt -> ProcStmt
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: ProcStmt -> ProcStmt -> ProcStmt
<> :: ProcStmt -> ProcStmt -> ProcStmt
$csconcat :: NonEmpty ProcStmt -> ProcStmt
sconcat :: NonEmpty ProcStmt -> ProcStmt
$cstimes :: forall b. Integral b => b -> ProcStmt -> ProcStmt
stimes :: forall b. Integral b => b -> ProcStmt -> ProcStmt
Semigroup, Int -> ProcStmt -> ShowS
[ProcStmt] -> ShowS
ProcStmt -> String
(Int -> ProcStmt -> ShowS)
-> (ProcStmt -> String) -> ([ProcStmt] -> ShowS) -> Show ProcStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcStmt -> ShowS
showsPrec :: Int -> ProcStmt -> ShowS
$cshow :: ProcStmt -> String
show :: ProcStmt -> String
$cshowList :: [ProcStmt] -> ShowS
showList :: [ProcStmt] -> ShowS
Show)

instance Pretty ProcStmt where
  pretty :: forall ann. ProcStmt -> Doc ann
pretty (ProcStmt Ident
i) = Doc ann
"process" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ident -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Ident -> Doc ann
pretty Ident
i

data ProcessBody = ProcessBody [AssignStmt] (Maybe Switch) [AssignStmt] [Sync]
  deriving (ProcessBody -> ProcessBody -> Bool
(ProcessBody -> ProcessBody -> Bool)
-> (ProcessBody -> ProcessBody -> Bool) -> Eq ProcessBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProcessBody -> ProcessBody -> Bool
== :: ProcessBody -> ProcessBody -> Bool
$c/= :: ProcessBody -> ProcessBody -> Bool
/= :: ProcessBody -> ProcessBody -> Bool
Eq, ReadPrec [ProcessBody]
ReadPrec ProcessBody
Int -> ReadS ProcessBody
ReadS [ProcessBody]
(Int -> ReadS ProcessBody)
-> ReadS [ProcessBody]
-> ReadPrec ProcessBody
-> ReadPrec [ProcessBody]
-> Read ProcessBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ProcessBody
readsPrec :: Int -> ReadS ProcessBody
$creadList :: ReadS [ProcessBody]
readList :: ReadS [ProcessBody]
$creadPrec :: ReadPrec ProcessBody
readPrec :: ReadPrec ProcessBody
$creadListPrec :: ReadPrec [ProcessBody]
readListPrec :: ReadPrec [ProcessBody]
Read, Int -> ProcessBody -> ShowS
[ProcessBody] -> ShowS
ProcessBody -> String
(Int -> ProcessBody -> ShowS)
-> (ProcessBody -> String)
-> ([ProcessBody] -> ShowS)
-> Show ProcessBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcessBody -> ShowS
showsPrec :: Int -> ProcessBody -> ShowS
$cshow :: ProcessBody -> String
show :: ProcessBody -> String
$cshowList :: [ProcessBody] -> ShowS
showList :: [ProcessBody] -> ShowS
Show)

instance Pretty ProcessBody where
  pretty :: forall ann. ProcessBody -> Doc ann
pretty (ProcessBody [AssignStmt]
as Maybe Switch
sM [AssignStmt]
bs [Sync]
ss) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vl
    [ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vl ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ AssignStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AssignStmt -> Doc ann
pretty (AssignStmt -> Doc ann) -> [AssignStmt] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AssignStmt]
as
    , Doc ann -> (Switch -> Doc ann) -> Maybe Switch -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty Switch -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Switch -> Doc ann
pretty Maybe Switch
sM
    , [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vl ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ AssignStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AssignStmt -> Doc ann
pretty (AssignStmt -> Doc ann) -> [AssignStmt] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AssignStmt]
bs
    , [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vl ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Sync -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Sync -> Doc ann
pretty (Sync -> Doc ann) -> [Sync] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Sync]
ss
    ]

data AssignStmt = AssignStmt DestSigSpec SrcSigSpec
  deriving (AssignStmt -> AssignStmt -> Bool
(AssignStmt -> AssignStmt -> Bool)
-> (AssignStmt -> AssignStmt -> Bool) -> Eq AssignStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssignStmt -> AssignStmt -> Bool
== :: AssignStmt -> AssignStmt -> Bool
$c/= :: AssignStmt -> AssignStmt -> Bool
/= :: AssignStmt -> AssignStmt -> Bool
Eq, ReadPrec [AssignStmt]
ReadPrec AssignStmt
Int -> ReadS AssignStmt
ReadS [AssignStmt]
(Int -> ReadS AssignStmt)
-> ReadS [AssignStmt]
-> ReadPrec AssignStmt
-> ReadPrec [AssignStmt]
-> Read AssignStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AssignStmt
readsPrec :: Int -> ReadS AssignStmt
$creadList :: ReadS [AssignStmt]
readList :: ReadS [AssignStmt]
$creadPrec :: ReadPrec AssignStmt
readPrec :: ReadPrec AssignStmt
$creadListPrec :: ReadPrec [AssignStmt]
readListPrec :: ReadPrec [AssignStmt]
Read, Int -> AssignStmt -> ShowS
[AssignStmt] -> ShowS
AssignStmt -> String
(Int -> AssignStmt -> ShowS)
-> (AssignStmt -> String)
-> ([AssignStmt] -> ShowS)
-> Show AssignStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssignStmt -> ShowS
showsPrec :: Int -> AssignStmt -> ShowS
$cshow :: AssignStmt -> String
show :: AssignStmt -> String
$cshowList :: [AssignStmt] -> ShowS
showList :: [AssignStmt] -> ShowS
Show)

instance Pretty AssignStmt where
  pretty :: forall ann. AssignStmt -> Doc ann
pretty (AssignStmt DestSigSpec
d SrcSigSpec
s) = Doc ann
"assign" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DestSigSpec -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. DestSigSpec -> Doc ann
pretty DestSigSpec
d Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> SrcSigSpec -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SrcSigSpec -> Doc ann
pretty SrcSigSpec
s

newtype DestSigSpec = DestSigSpec SigSpec
  deriving (DestSigSpec -> DestSigSpec -> Bool
(DestSigSpec -> DestSigSpec -> Bool)
-> (DestSigSpec -> DestSigSpec -> Bool) -> Eq DestSigSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DestSigSpec -> DestSigSpec -> Bool
== :: DestSigSpec -> DestSigSpec -> Bool
$c/= :: DestSigSpec -> DestSigSpec -> Bool
/= :: DestSigSpec -> DestSigSpec -> Bool
Eq, (forall ann. DestSigSpec -> Doc ann)
-> (forall ann. [DestSigSpec] -> Doc ann) -> Pretty DestSigSpec
forall ann. [DestSigSpec] -> Doc ann
forall ann. DestSigSpec -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. DestSigSpec -> Doc ann
pretty :: forall ann. DestSigSpec -> Doc ann
$cprettyList :: forall ann. [DestSigSpec] -> Doc ann
prettyList :: forall ann. [DestSigSpec] -> Doc ann
Pretty, ReadPrec [DestSigSpec]
ReadPrec DestSigSpec
Int -> ReadS DestSigSpec
ReadS [DestSigSpec]
(Int -> ReadS DestSigSpec)
-> ReadS [DestSigSpec]
-> ReadPrec DestSigSpec
-> ReadPrec [DestSigSpec]
-> Read DestSigSpec
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DestSigSpec
readsPrec :: Int -> ReadS DestSigSpec
$creadList :: ReadS [DestSigSpec]
readList :: ReadS [DestSigSpec]
$creadPrec :: ReadPrec DestSigSpec
readPrec :: ReadPrec DestSigSpec
$creadListPrec :: ReadPrec [DestSigSpec]
readListPrec :: ReadPrec [DestSigSpec]
Read, Int -> DestSigSpec -> ShowS
[DestSigSpec] -> ShowS
DestSigSpec -> String
(Int -> DestSigSpec -> ShowS)
-> (DestSigSpec -> String)
-> ([DestSigSpec] -> ShowS)
-> Show DestSigSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DestSigSpec -> ShowS
showsPrec :: Int -> DestSigSpec -> ShowS
$cshow :: DestSigSpec -> String
show :: DestSigSpec -> String
$cshowList :: [DestSigSpec] -> ShowS
showList :: [DestSigSpec] -> ShowS
Show)

newtype SrcSigSpec = SrcSigSpec SigSpec
  deriving (SrcSigSpec -> SrcSigSpec -> Bool
(SrcSigSpec -> SrcSigSpec -> Bool)
-> (SrcSigSpec -> SrcSigSpec -> Bool) -> Eq SrcSigSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SrcSigSpec -> SrcSigSpec -> Bool
== :: SrcSigSpec -> SrcSigSpec -> Bool
$c/= :: SrcSigSpec -> SrcSigSpec -> Bool
/= :: SrcSigSpec -> SrcSigSpec -> Bool
Eq, (forall ann. SrcSigSpec -> Doc ann)
-> (forall ann. [SrcSigSpec] -> Doc ann) -> Pretty SrcSigSpec
forall ann. [SrcSigSpec] -> Doc ann
forall ann. SrcSigSpec -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. SrcSigSpec -> Doc ann
pretty :: forall ann. SrcSigSpec -> Doc ann
$cprettyList :: forall ann. [SrcSigSpec] -> Doc ann
prettyList :: forall ann. [SrcSigSpec] -> Doc ann
Pretty, ReadPrec [SrcSigSpec]
ReadPrec SrcSigSpec
Int -> ReadS SrcSigSpec
ReadS [SrcSigSpec]
(Int -> ReadS SrcSigSpec)
-> ReadS [SrcSigSpec]
-> ReadPrec SrcSigSpec
-> ReadPrec [SrcSigSpec]
-> Read SrcSigSpec
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SrcSigSpec
readsPrec :: Int -> ReadS SrcSigSpec
$creadList :: ReadS [SrcSigSpec]
readList :: ReadS [SrcSigSpec]
$creadPrec :: ReadPrec SrcSigSpec
readPrec :: ReadPrec SrcSigSpec
$creadListPrec :: ReadPrec [SrcSigSpec]
readListPrec :: ReadPrec [SrcSigSpec]
Read, Int -> SrcSigSpec -> ShowS
[SrcSigSpec] -> ShowS
SrcSigSpec -> String
(Int -> SrcSigSpec -> ShowS)
-> (SrcSigSpec -> String)
-> ([SrcSigSpec] -> ShowS)
-> Show SrcSigSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SrcSigSpec -> ShowS
showsPrec :: Int -> SrcSigSpec -> ShowS
$cshow :: SrcSigSpec -> String
show :: SrcSigSpec -> String
$cshowList :: [SrcSigSpec] -> ShowS
showList :: [SrcSigSpec] -> ShowS
Show)

data ProcEndStmt = ProcEndStmt
  deriving (ProcEndStmt -> ProcEndStmt -> Bool
(ProcEndStmt -> ProcEndStmt -> Bool)
-> (ProcEndStmt -> ProcEndStmt -> Bool) -> Eq ProcEndStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProcEndStmt -> ProcEndStmt -> Bool
== :: ProcEndStmt -> ProcEndStmt -> Bool
$c/= :: ProcEndStmt -> ProcEndStmt -> Bool
/= :: ProcEndStmt -> ProcEndStmt -> Bool
Eq, ReadPrec [ProcEndStmt]
ReadPrec ProcEndStmt
Int -> ReadS ProcEndStmt
ReadS [ProcEndStmt]
(Int -> ReadS ProcEndStmt)
-> ReadS [ProcEndStmt]
-> ReadPrec ProcEndStmt
-> ReadPrec [ProcEndStmt]
-> Read ProcEndStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ProcEndStmt
readsPrec :: Int -> ReadS ProcEndStmt
$creadList :: ReadS [ProcEndStmt]
readList :: ReadS [ProcEndStmt]
$creadPrec :: ReadPrec ProcEndStmt
readPrec :: ReadPrec ProcEndStmt
$creadListPrec :: ReadPrec [ProcEndStmt]
readListPrec :: ReadPrec [ProcEndStmt]
Read, Int -> ProcEndStmt -> ShowS
[ProcEndStmt] -> ShowS
ProcEndStmt -> String
(Int -> ProcEndStmt -> ShowS)
-> (ProcEndStmt -> String)
-> ([ProcEndStmt] -> ShowS)
-> Show ProcEndStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcEndStmt -> ShowS
showsPrec :: Int -> ProcEndStmt -> ShowS
$cshow :: ProcEndStmt -> String
show :: ProcEndStmt -> String
$cshowList :: [ProcEndStmt] -> ShowS
showList :: [ProcEndStmt] -> ShowS
Show)

instance Pretty ProcEndStmt where
  pretty :: forall ann. ProcEndStmt -> Doc ann
pretty ProcEndStmt
_ = Doc ann
"end" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline

data Switch = Switch SwitchStmt [Case] SwitchEndStmt
  deriving (Switch -> Switch -> Bool
(Switch -> Switch -> Bool)
-> (Switch -> Switch -> Bool) -> Eq Switch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Switch -> Switch -> Bool
== :: Switch -> Switch -> Bool
$c/= :: Switch -> Switch -> Bool
/= :: Switch -> Switch -> Bool
Eq, ReadPrec [Switch]
ReadPrec Switch
Int -> ReadS Switch
ReadS [Switch]
(Int -> ReadS Switch)
-> ReadS [Switch]
-> ReadPrec Switch
-> ReadPrec [Switch]
-> Read Switch
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Switch
readsPrec :: Int -> ReadS Switch
$creadList :: ReadS [Switch]
readList :: ReadS [Switch]
$creadPrec :: ReadPrec Switch
readPrec :: ReadPrec Switch
$creadListPrec :: ReadPrec [Switch]
readListPrec :: ReadPrec [Switch]
Read, Int -> Switch -> ShowS
[Switch] -> ShowS
Switch -> String
(Int -> Switch -> ShowS)
-> (Switch -> String) -> ([Switch] -> ShowS) -> Show Switch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Switch -> ShowS
showsPrec :: Int -> Switch -> ShowS
$cshow :: Switch -> String
show :: Switch -> String
$cshowList :: [Switch] -> ShowS
showList :: [Switch] -> ShowS
Show)

instance Pretty Switch where
  pretty :: forall ann. Switch -> Doc ann
pretty (Switch SwitchStmt
s [Case]
cs SwitchEndStmt
e) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vl
    [ SwitchStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SwitchStmt -> Doc ann
pretty SwitchStmt
s
    , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent 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
vl ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Case -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Case -> Doc ann
pretty (Case -> Doc ann) -> [Case] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Case]
cs
    , SwitchEndStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SwitchEndStmt -> Doc ann
pretty SwitchEndStmt
e
    ]

data SwitchStmt = SwitchStmt [AttrStmt] SigSpec
  deriving (SwitchStmt -> SwitchStmt -> Bool
(SwitchStmt -> SwitchStmt -> Bool)
-> (SwitchStmt -> SwitchStmt -> Bool) -> Eq SwitchStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SwitchStmt -> SwitchStmt -> Bool
== :: SwitchStmt -> SwitchStmt -> Bool
$c/= :: SwitchStmt -> SwitchStmt -> Bool
/= :: SwitchStmt -> SwitchStmt -> Bool
Eq, ReadPrec [SwitchStmt]
ReadPrec SwitchStmt
Int -> ReadS SwitchStmt
ReadS [SwitchStmt]
(Int -> ReadS SwitchStmt)
-> ReadS [SwitchStmt]
-> ReadPrec SwitchStmt
-> ReadPrec [SwitchStmt]
-> Read SwitchStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SwitchStmt
readsPrec :: Int -> ReadS SwitchStmt
$creadList :: ReadS [SwitchStmt]
readList :: ReadS [SwitchStmt]
$creadPrec :: ReadPrec SwitchStmt
readPrec :: ReadPrec SwitchStmt
$creadListPrec :: ReadPrec [SwitchStmt]
readListPrec :: ReadPrec [SwitchStmt]
Read, Int -> SwitchStmt -> ShowS
[SwitchStmt] -> ShowS
SwitchStmt -> String
(Int -> SwitchStmt -> ShowS)
-> (SwitchStmt -> String)
-> ([SwitchStmt] -> ShowS)
-> Show SwitchStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SwitchStmt -> ShowS
showsPrec :: Int -> SwitchStmt -> ShowS
$cshow :: SwitchStmt -> String
show :: SwitchStmt -> String
$cshowList :: [SwitchStmt] -> ShowS
showList :: [SwitchStmt] -> ShowS
Show)

instance Pretty SwitchStmt where
  pretty :: forall ann. SwitchStmt -> Doc ann
pretty (SwitchStmt [AttrStmt]
as SigSpec
s) = (AttrStmt -> Doc ann) -> [AttrStmt] -> Doc ann
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap AttrStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AttrStmt -> Doc ann
pretty [AttrStmt]
as Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"switch" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> SigSpec -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SigSpec -> Doc ann
pretty SigSpec
s

data Case = Case [AttrStmt] CaseStmt CaseBody
  deriving (Case -> Case -> Bool
(Case -> Case -> Bool) -> (Case -> Case -> Bool) -> Eq Case
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Case -> Case -> Bool
== :: Case -> Case -> Bool
$c/= :: Case -> Case -> Bool
/= :: Case -> Case -> Bool
Eq, ReadPrec [Case]
ReadPrec Case
Int -> ReadS Case
ReadS [Case]
(Int -> ReadS Case)
-> ReadS [Case] -> ReadPrec Case -> ReadPrec [Case] -> Read Case
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Case
readsPrec :: Int -> ReadS Case
$creadList :: ReadS [Case]
readList :: ReadS [Case]
$creadPrec :: ReadPrec Case
readPrec :: ReadPrec Case
$creadListPrec :: ReadPrec [Case]
readListPrec :: ReadPrec [Case]
Read, Int -> Case -> ShowS
[Case] -> ShowS
Case -> String
(Int -> Case -> ShowS)
-> (Case -> String) -> ([Case] -> ShowS) -> Show Case
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Case -> ShowS
showsPrec :: Int -> Case -> ShowS
$cshow :: Case -> String
show :: Case -> String
$cshowList :: [Case] -> ShowS
showList :: [Case] -> ShowS
Show)

instance Pretty Case where
  pretty :: forall ann. Case -> Doc ann
pretty (Case [AttrStmt]
as CaseStmt
s CaseBody
b) = (AttrStmt -> Doc ann) -> [AttrStmt] -> Doc ann
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap AttrStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AttrStmt -> Doc ann
pretty [AttrStmt]
as Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> CaseStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CaseStmt -> Doc ann
pretty CaseStmt
s Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> CaseBody -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CaseBody -> Doc ann
pretty CaseBody
b

newtype CaseStmt = CaseStmt (Maybe Compare)
  deriving (CaseStmt -> CaseStmt -> Bool
(CaseStmt -> CaseStmt -> Bool)
-> (CaseStmt -> CaseStmt -> Bool) -> Eq CaseStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CaseStmt -> CaseStmt -> Bool
== :: CaseStmt -> CaseStmt -> Bool
$c/= :: CaseStmt -> CaseStmt -> Bool
/= :: CaseStmt -> CaseStmt -> Bool
Eq, ReadPrec [CaseStmt]
ReadPrec CaseStmt
Int -> ReadS CaseStmt
ReadS [CaseStmt]
(Int -> ReadS CaseStmt)
-> ReadS [CaseStmt]
-> ReadPrec CaseStmt
-> ReadPrec [CaseStmt]
-> Read CaseStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CaseStmt
readsPrec :: Int -> ReadS CaseStmt
$creadList :: ReadS [CaseStmt]
readList :: ReadS [CaseStmt]
$creadPrec :: ReadPrec CaseStmt
readPrec :: ReadPrec CaseStmt
$creadListPrec :: ReadPrec [CaseStmt]
readListPrec :: ReadPrec [CaseStmt]
Read, Int -> CaseStmt -> ShowS
[CaseStmt] -> ShowS
CaseStmt -> String
(Int -> CaseStmt -> ShowS)
-> (CaseStmt -> String) -> ([CaseStmt] -> ShowS) -> Show CaseStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CaseStmt -> ShowS
showsPrec :: Int -> CaseStmt -> ShowS
$cshow :: CaseStmt -> String
show :: CaseStmt -> String
$cshowList :: [CaseStmt] -> ShowS
showList :: [CaseStmt] -> ShowS
Show)

instance Pretty CaseStmt where
  pretty :: forall ann. CaseStmt -> Doc ann
pretty (CaseStmt Maybe Compare
Nothing)  = Doc ann
"case"
  pretty (CaseStmt (Just Compare
c)) = Doc ann
"case" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Compare -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Compare -> Doc ann
pretty Compare
c

data Compare = Compare SigSpec [SigSpec]
  deriving (Compare -> Compare -> Bool
(Compare -> Compare -> Bool)
-> (Compare -> Compare -> Bool) -> Eq Compare
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Compare -> Compare -> Bool
== :: Compare -> Compare -> Bool
$c/= :: Compare -> Compare -> Bool
/= :: Compare -> Compare -> Bool
Eq, ReadPrec [Compare]
ReadPrec Compare
Int -> ReadS Compare
ReadS [Compare]
(Int -> ReadS Compare)
-> ReadS [Compare]
-> ReadPrec Compare
-> ReadPrec [Compare]
-> Read Compare
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Compare
readsPrec :: Int -> ReadS Compare
$creadList :: ReadS [Compare]
readList :: ReadS [Compare]
$creadPrec :: ReadPrec Compare
readPrec :: ReadPrec Compare
$creadListPrec :: ReadPrec [Compare]
readListPrec :: ReadPrec [Compare]
Read, Int -> Compare -> ShowS
[Compare] -> ShowS
Compare -> String
(Int -> Compare -> ShowS)
-> (Compare -> String) -> ([Compare] -> ShowS) -> Show Compare
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Compare -> ShowS
showsPrec :: Int -> Compare -> ShowS
$cshow :: Compare -> String
show :: Compare -> String
$cshowList :: [Compare] -> ShowS
showList :: [Compare] -> ShowS
Show)

instance Pretty Compare where
  pretty :: forall ann. Compare -> Doc ann
pretty (Compare SigSpec
s [SigSpec]
ss) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
"," ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ SigSpec -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SigSpec -> Doc ann
pretty (SigSpec -> Doc ann) -> [SigSpec] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SigSpec
s SigSpec -> [SigSpec] -> [SigSpec]
forall a. a -> [a] -> [a]
: [SigSpec]
ss

newtype CaseBody = CaseBody [Either Switch AssignStmt]
  deriving (CaseBody -> CaseBody -> Bool
(CaseBody -> CaseBody -> Bool)
-> (CaseBody -> CaseBody -> Bool) -> Eq CaseBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CaseBody -> CaseBody -> Bool
== :: CaseBody -> CaseBody -> Bool
$c/= :: CaseBody -> CaseBody -> Bool
/= :: CaseBody -> CaseBody -> Bool
Eq, ReadPrec [CaseBody]
ReadPrec CaseBody
Int -> ReadS CaseBody
ReadS [CaseBody]
(Int -> ReadS CaseBody)
-> ReadS [CaseBody]
-> ReadPrec CaseBody
-> ReadPrec [CaseBody]
-> Read CaseBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CaseBody
readsPrec :: Int -> ReadS CaseBody
$creadList :: ReadS [CaseBody]
readList :: ReadS [CaseBody]
$creadPrec :: ReadPrec CaseBody
readPrec :: ReadPrec CaseBody
$creadListPrec :: ReadPrec [CaseBody]
readListPrec :: ReadPrec [CaseBody]
Read, Int -> CaseBody -> ShowS
[CaseBody] -> ShowS
CaseBody -> String
(Int -> CaseBody -> ShowS)
-> (CaseBody -> String) -> ([CaseBody] -> ShowS) -> Show CaseBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CaseBody -> ShowS
showsPrec :: Int -> CaseBody -> ShowS
$cshow :: CaseBody -> String
show :: CaseBody -> String
$cshowList :: [CaseBody] -> ShowS
showList :: [CaseBody] -> ShowS
Show)

instance Pretty CaseBody where
  pretty :: forall ann. CaseBody -> Doc ann
pretty (CaseBody [Either Switch AssignStmt]
es) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vl ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Switch -> Doc ann)
-> (AssignStmt -> Doc ann) -> Either Switch AssignStmt -> Doc ann
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Switch -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Switch -> Doc ann
pretty AssignStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AssignStmt -> Doc ann
pretty (Either Switch AssignStmt -> Doc ann)
-> [Either Switch AssignStmt] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either Switch AssignStmt]
es

data SwitchEndStmt = SwitchEndStmt
  deriving (SwitchEndStmt -> SwitchEndStmt -> Bool
(SwitchEndStmt -> SwitchEndStmt -> Bool)
-> (SwitchEndStmt -> SwitchEndStmt -> Bool) -> Eq SwitchEndStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SwitchEndStmt -> SwitchEndStmt -> Bool
== :: SwitchEndStmt -> SwitchEndStmt -> Bool
$c/= :: SwitchEndStmt -> SwitchEndStmt -> Bool
/= :: SwitchEndStmt -> SwitchEndStmt -> Bool
Eq, ReadPrec [SwitchEndStmt]
ReadPrec SwitchEndStmt
Int -> ReadS SwitchEndStmt
ReadS [SwitchEndStmt]
(Int -> ReadS SwitchEndStmt)
-> ReadS [SwitchEndStmt]
-> ReadPrec SwitchEndStmt
-> ReadPrec [SwitchEndStmt]
-> Read SwitchEndStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SwitchEndStmt
readsPrec :: Int -> ReadS SwitchEndStmt
$creadList :: ReadS [SwitchEndStmt]
readList :: ReadS [SwitchEndStmt]
$creadPrec :: ReadPrec SwitchEndStmt
readPrec :: ReadPrec SwitchEndStmt
$creadListPrec :: ReadPrec [SwitchEndStmt]
readListPrec :: ReadPrec [SwitchEndStmt]
Read, Int -> SwitchEndStmt -> ShowS
[SwitchEndStmt] -> ShowS
SwitchEndStmt -> String
(Int -> SwitchEndStmt -> ShowS)
-> (SwitchEndStmt -> String)
-> ([SwitchEndStmt] -> ShowS)
-> Show SwitchEndStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SwitchEndStmt -> ShowS
showsPrec :: Int -> SwitchEndStmt -> ShowS
$cshow :: SwitchEndStmt -> String
show :: SwitchEndStmt -> String
$cshowList :: [SwitchEndStmt] -> ShowS
showList :: [SwitchEndStmt] -> ShowS
Show)

instance Pretty SwitchEndStmt where
  pretty :: forall ann. SwitchEndStmt -> Doc ann
pretty SwitchEndStmt
_ = Doc ann
"end" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline

data Sync = Sync SyncStmt [UpdateStmt]
  deriving (Sync -> Sync -> Bool
(Sync -> Sync -> Bool) -> (Sync -> Sync -> Bool) -> Eq Sync
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sync -> Sync -> Bool
== :: Sync -> Sync -> Bool
$c/= :: Sync -> Sync -> Bool
/= :: Sync -> Sync -> Bool
Eq, ReadPrec [Sync]
ReadPrec Sync
Int -> ReadS Sync
ReadS [Sync]
(Int -> ReadS Sync)
-> ReadS [Sync] -> ReadPrec Sync -> ReadPrec [Sync] -> Read Sync
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Sync
readsPrec :: Int -> ReadS Sync
$creadList :: ReadS [Sync]
readList :: ReadS [Sync]
$creadPrec :: ReadPrec Sync
readPrec :: ReadPrec Sync
$creadListPrec :: ReadPrec [Sync]
readListPrec :: ReadPrec [Sync]
Read, Int -> Sync -> ShowS
[Sync] -> ShowS
Sync -> String
(Int -> Sync -> ShowS)
-> (Sync -> String) -> ([Sync] -> ShowS) -> Show Sync
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sync -> ShowS
showsPrec :: Int -> Sync -> ShowS
$cshow :: Sync -> String
show :: Sync -> String
$cshowList :: [Sync] -> ShowS
showList :: [Sync] -> ShowS
Show)

instance Pretty Sync where
  pretty :: forall ann. Sync -> Doc ann
pretty (Sync SyncStmt
s [UpdateStmt]
us) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vl
    [ SyncStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SyncStmt -> Doc ann
pretty SyncStmt
s
    , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent 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
vl ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ UpdateStmt -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. UpdateStmt -> Doc ann
pretty (UpdateStmt -> Doc ann) -> [UpdateStmt] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UpdateStmt]
us
    ]

data SyncStmt = SyncStmt SyncType SigSpec
              | SyncStmtGlobal
              | SyncStmtInit
              | SyncStmtAlways
  deriving (SyncStmt -> SyncStmt -> Bool
(SyncStmt -> SyncStmt -> Bool)
-> (SyncStmt -> SyncStmt -> Bool) -> Eq SyncStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SyncStmt -> SyncStmt -> Bool
== :: SyncStmt -> SyncStmt -> Bool
$c/= :: SyncStmt -> SyncStmt -> Bool
/= :: SyncStmt -> SyncStmt -> Bool
Eq, ReadPrec [SyncStmt]
ReadPrec SyncStmt
Int -> ReadS SyncStmt
ReadS [SyncStmt]
(Int -> ReadS SyncStmt)
-> ReadS [SyncStmt]
-> ReadPrec SyncStmt
-> ReadPrec [SyncStmt]
-> Read SyncStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SyncStmt
readsPrec :: Int -> ReadS SyncStmt
$creadList :: ReadS [SyncStmt]
readList :: ReadS [SyncStmt]
$creadPrec :: ReadPrec SyncStmt
readPrec :: ReadPrec SyncStmt
$creadListPrec :: ReadPrec [SyncStmt]
readListPrec :: ReadPrec [SyncStmt]
Read, Int -> SyncStmt -> ShowS
[SyncStmt] -> ShowS
SyncStmt -> String
(Int -> SyncStmt -> ShowS)
-> (SyncStmt -> String) -> ([SyncStmt] -> ShowS) -> Show SyncStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SyncStmt -> ShowS
showsPrec :: Int -> SyncStmt -> ShowS
$cshow :: SyncStmt -> String
show :: SyncStmt -> String
$cshowList :: [SyncStmt] -> ShowS
showList :: [SyncStmt] -> ShowS
Show)

instance Pretty SyncStmt where
  pretty :: forall ann. SyncStmt -> Doc ann
pretty = (Doc ann
"sync" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (Doc ann -> Doc ann)
-> (SyncStmt -> Doc ann) -> SyncStmt -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    SyncStmt SyncType
t SigSpec
s   -> SyncType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SyncType -> Doc ann
pretty SyncType
t Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> SigSpec -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SigSpec -> Doc ann
pretty SigSpec
s
    SyncStmt
SyncStmtGlobal -> Doc ann
"global"
    SyncStmt
SyncStmtInit   -> Doc ann
"init"
    SyncStmt
SyncStmtAlways -> Doc ann
"always"

data SyncType = Low
              | High
              | Posedge
              | Negedge
              | Edge
  deriving (SyncType -> SyncType -> Bool
(SyncType -> SyncType -> Bool)
-> (SyncType -> SyncType -> Bool) -> Eq SyncType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SyncType -> SyncType -> Bool
== :: SyncType -> SyncType -> Bool
$c/= :: SyncType -> SyncType -> Bool
/= :: SyncType -> SyncType -> Bool
Eq, ReadPrec [SyncType]
ReadPrec SyncType
Int -> ReadS SyncType
ReadS [SyncType]
(Int -> ReadS SyncType)
-> ReadS [SyncType]
-> ReadPrec SyncType
-> ReadPrec [SyncType]
-> Read SyncType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SyncType
readsPrec :: Int -> ReadS SyncType
$creadList :: ReadS [SyncType]
readList :: ReadS [SyncType]
$creadPrec :: ReadPrec SyncType
readPrec :: ReadPrec SyncType
$creadListPrec :: ReadPrec [SyncType]
readListPrec :: ReadPrec [SyncType]
Read, Int -> SyncType -> ShowS
[SyncType] -> ShowS
SyncType -> String
(Int -> SyncType -> ShowS)
-> (SyncType -> String) -> ([SyncType] -> ShowS) -> Show SyncType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SyncType -> ShowS
showsPrec :: Int -> SyncType -> ShowS
$cshow :: SyncType -> String
show :: SyncType -> String
$cshowList :: [SyncType] -> ShowS
showList :: [SyncType] -> ShowS
Show)

instance Pretty SyncType where
  pretty :: forall ann. SyncType -> Doc ann
pretty = \case
    SyncType
Low     -> Doc ann
"low"
    SyncType
High    -> Doc ann
"high"
    SyncType
Posedge -> Doc ann
"posedge"
    SyncType
Negedge -> Doc ann
"negedge"
    SyncType
Edge    -> Doc ann
"edge"

data UpdateStmt = UpdateStmt DestSigSpec SrcSigSpec
  deriving (UpdateStmt -> UpdateStmt -> Bool
(UpdateStmt -> UpdateStmt -> Bool)
-> (UpdateStmt -> UpdateStmt -> Bool) -> Eq UpdateStmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateStmt -> UpdateStmt -> Bool
== :: UpdateStmt -> UpdateStmt -> Bool
$c/= :: UpdateStmt -> UpdateStmt -> Bool
/= :: UpdateStmt -> UpdateStmt -> Bool
Eq, ReadPrec [UpdateStmt]
ReadPrec UpdateStmt
Int -> ReadS UpdateStmt
ReadS [UpdateStmt]
(Int -> ReadS UpdateStmt)
-> ReadS [UpdateStmt]
-> ReadPrec UpdateStmt
-> ReadPrec [UpdateStmt]
-> Read UpdateStmt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS UpdateStmt
readsPrec :: Int -> ReadS UpdateStmt
$creadList :: ReadS [UpdateStmt]
readList :: ReadS [UpdateStmt]
$creadPrec :: ReadPrec UpdateStmt
readPrec :: ReadPrec UpdateStmt
$creadListPrec :: ReadPrec [UpdateStmt]
readListPrec :: ReadPrec [UpdateStmt]
Read, Int -> UpdateStmt -> ShowS
[UpdateStmt] -> ShowS
UpdateStmt -> String
(Int -> UpdateStmt -> ShowS)
-> (UpdateStmt -> String)
-> ([UpdateStmt] -> ShowS)
-> Show UpdateStmt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateStmt -> ShowS
showsPrec :: Int -> UpdateStmt -> ShowS
$cshow :: UpdateStmt -> String
show :: UpdateStmt -> String
$cshowList :: [UpdateStmt] -> ShowS
showList :: [UpdateStmt] -> ShowS
Show)

instance Pretty UpdateStmt where
  pretty :: forall ann. UpdateStmt -> Doc ann
pretty (UpdateStmt DestSigSpec
d SrcSigSpec
s) = Doc ann
"update" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DestSigSpec -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. DestSigSpec -> Doc ann
pretty DestSigSpec
d Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> SrcSigSpec -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SrcSigSpec -> Doc ann
pretty SrcSigSpec
s