{-# 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
    memInitV2C
  , -- ** 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

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

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