{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_DERIVE --append -d Binary #-}
module Language.Netlist.AST where
import Data.Binary ( Binary(..), putWord8, getWord8 )
import Data.Generics ( Data, Typeable )
data Module = Module
{ Module -> Ident
module_name :: Ident
, Module -> [(Ident, Maybe Range)]
module_inputs :: [(Ident, Maybe Range)]
, Module -> [(Ident, Maybe Range)]
module_outputs :: [(Ident, Maybe Range)]
, Module -> [(Ident, Expr)]
module_statics :: [(Ident, ConstExpr)]
, Module -> [Decl]
module_decls :: [Decl]
}
deriving (Module -> Module -> Bool
(Module -> Module -> Bool)
-> (Module -> Module -> Bool) -> Eq Module
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Module -> Module -> Bool
$c/= :: Module -> Module -> Bool
== :: Module -> Module -> Bool
$c== :: Module -> Module -> Bool
Eq, Eq Module
Eq Module =>
(Module -> Module -> Ordering)
-> (Module -> Module -> Bool)
-> (Module -> Module -> Bool)
-> (Module -> Module -> Bool)
-> (Module -> Module -> Bool)
-> (Module -> Module -> Module)
-> (Module -> Module -> Module)
-> Ord Module
Module -> Module -> Bool
Module -> Module -> Ordering
Module -> Module -> Module
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Module -> Module -> Module
$cmin :: Module -> Module -> Module
max :: Module -> Module -> Module
$cmax :: Module -> Module -> Module
>= :: Module -> Module -> Bool
$c>= :: Module -> Module -> Bool
> :: Module -> Module -> Bool
$c> :: Module -> Module -> Bool
<= :: Module -> Module -> Bool
$c<= :: Module -> Module -> Bool
< :: Module -> Module -> Bool
$c< :: Module -> Module -> Bool
compare :: Module -> Module -> Ordering
$ccompare :: Module -> Module -> Ordering
$cp1Ord :: Eq Module
Ord, Int -> Module -> ShowS
[Module] -> ShowS
Module -> Ident
(Int -> Module -> ShowS)
-> (Module -> Ident) -> ([Module] -> ShowS) -> Show Module
forall a.
(Int -> a -> ShowS) -> (a -> Ident) -> ([a] -> ShowS) -> Show a
showList :: [Module] -> ShowS
$cshowList :: [Module] -> ShowS
show :: Module -> Ident
$cshow :: Module -> Ident
showsPrec :: Int -> Module -> ShowS
$cshowsPrec :: Int -> Module -> ShowS
Show, Typeable Module
Constr
DataType
Typeable Module =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Module -> c Module)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Module)
-> (Module -> Constr)
-> (Module -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Module))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Module))
-> ((forall b. Data b => b -> b) -> Module -> Module)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Module -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Module -> r)
-> (forall u. (forall d. Data d => d -> u) -> Module -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Module -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Module -> m Module)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Module -> m Module)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Module -> m Module)
-> Data Module
Module -> Constr
Module -> DataType
(forall b. Data b => b -> b) -> Module -> Module
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Module -> c Module
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Module
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Module -> u
forall u. (forall d. Data d => d -> u) -> Module -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Module -> m Module
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Module -> m Module
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Module
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Module -> c Module
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Module)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Module)
$cModule :: Constr
$tModule :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Module -> m Module
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Module -> m Module
gmapMp :: (forall d. Data d => d -> m d) -> Module -> m Module
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Module -> m Module
gmapM :: (forall d. Data d => d -> m d) -> Module -> m Module
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Module -> m Module
gmapQi :: Int -> (forall d. Data d => d -> u) -> Module -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Module -> u
gmapQ :: (forall d. Data d => d -> u) -> Module -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Module -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r
gmapT :: (forall b. Data b => b -> b) -> Module -> Module
$cgmapT :: (forall b. Data b => b -> b) -> Module -> Module
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Module)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Module)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Module)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Module)
dataTypeOf :: Module -> DataType
$cdataTypeOf :: Module -> DataType
toConstr :: Module -> Constr
$ctoConstr :: Module -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Module
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Module
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Module -> c Module
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Module -> c Module
$cp1Data :: Typeable Module
Data, Typeable)
type Ident = String
type Size = Int
data Decl
= NetDecl Ident (Maybe Range) (Maybe Expr)
| NetAssign Ident Expr
| MemDecl Ident (Maybe Range) (Maybe Range) (Maybe [Expr])
| MemAssign Ident Expr Expr
| InstDecl Ident
Ident
[(Ident, Expr)]
[(Ident, Expr)]
[(Ident, Expr)]
| ProcessDecl Event (Maybe (Event, Stmt)) Stmt
| InitProcessDecl Stmt
| String
deriving (Decl -> Decl -> Bool
(Decl -> Decl -> Bool) -> (Decl -> Decl -> Bool) -> Eq Decl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Decl -> Decl -> Bool
$c/= :: Decl -> Decl -> Bool
== :: Decl -> Decl -> Bool
$c== :: Decl -> Decl -> Bool
Eq, Eq Decl
Eq Decl =>
(Decl -> Decl -> Ordering)
-> (Decl -> Decl -> Bool)
-> (Decl -> Decl -> Bool)
-> (Decl -> Decl -> Bool)
-> (Decl -> Decl -> Bool)
-> (Decl -> Decl -> Decl)
-> (Decl -> Decl -> Decl)
-> Ord Decl
Decl -> Decl -> Bool
Decl -> Decl -> Ordering
Decl -> Decl -> Decl
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Decl -> Decl -> Decl
$cmin :: Decl -> Decl -> Decl
max :: Decl -> Decl -> Decl
$cmax :: Decl -> Decl -> Decl
>= :: Decl -> Decl -> Bool
$c>= :: Decl -> Decl -> Bool
> :: Decl -> Decl -> Bool
$c> :: Decl -> Decl -> Bool
<= :: Decl -> Decl -> Bool
$c<= :: Decl -> Decl -> Bool
< :: Decl -> Decl -> Bool
$c< :: Decl -> Decl -> Bool
compare :: Decl -> Decl -> Ordering
$ccompare :: Decl -> Decl -> Ordering
$cp1Ord :: Eq Decl
Ord, Int -> Decl -> ShowS
[Decl] -> ShowS
Decl -> Ident
(Int -> Decl -> ShowS)
-> (Decl -> Ident) -> ([Decl] -> ShowS) -> Show Decl
forall a.
(Int -> a -> ShowS) -> (a -> Ident) -> ([a] -> ShowS) -> Show a
showList :: [Decl] -> ShowS
$cshowList :: [Decl] -> ShowS
show :: Decl -> Ident
$cshow :: Decl -> Ident
showsPrec :: Int -> Decl -> ShowS
$cshowsPrec :: Int -> Decl -> ShowS
Show, , Typeable)
data Range
= Range ConstExpr ConstExpr
deriving (Range -> Range -> Bool
(Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c== :: Range -> Range -> Bool
Eq, Eq Range
Eq Range =>
(Range -> Range -> Ordering)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Range)
-> (Range -> Range -> Range)
-> Ord Range
Range -> Range -> Bool
Range -> Range -> Ordering
Range -> Range -> Range
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Range -> Range -> Range
$cmin :: Range -> Range -> Range
max :: Range -> Range -> Range
$cmax :: Range -> Range -> Range
>= :: Range -> Range -> Bool
$c>= :: Range -> Range -> Bool
> :: Range -> Range -> Bool
$c> :: Range -> Range -> Bool
<= :: Range -> Range -> Bool
$c<= :: Range -> Range -> Bool
< :: Range -> Range -> Bool
$c< :: Range -> Range -> Bool
compare :: Range -> Range -> Ordering
$ccompare :: Range -> Range -> Ordering
$cp1Ord :: Eq Range
Ord, Int -> Range -> ShowS
[Range] -> ShowS
Range -> Ident
(Int -> Range -> ShowS)
-> (Range -> Ident) -> ([Range] -> ShowS) -> Show Range
forall a.
(Int -> a -> ShowS) -> (a -> Ident) -> ([a] -> ShowS) -> Show a
showList :: [Range] -> ShowS
$cshowList :: [Range] -> ShowS
show :: Range -> Ident
$cshow :: Range -> Ident
showsPrec :: Int -> Range -> ShowS
$cshowsPrec :: Int -> Range -> ShowS
Show, Typeable Range
Constr
DataType
Typeable Range =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Range -> c Range)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Range)
-> (Range -> Constr)
-> (Range -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Range))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Range))
-> ((forall b. Data b => b -> b) -> Range -> Range)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Range -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Range -> r)
-> (forall u. (forall d. Data d => d -> u) -> Range -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Range -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Range -> m Range)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Range -> m Range)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Range -> m Range)
-> Data Range
Range -> Constr
Range -> DataType
(forall b. Data b => b -> b) -> Range -> Range
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Range -> c Range
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Range
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Range -> u
forall u. (forall d. Data d => d -> u) -> Range -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Range -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Range -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Range -> m Range
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Range -> m Range
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Range
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Range -> c Range
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Range)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Range)
$cRange :: Constr
$tRange :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Range -> m Range
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Range -> m Range
gmapMp :: (forall d. Data d => d -> m d) -> Range -> m Range
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Range -> m Range
gmapM :: (forall d. Data d => d -> m d) -> Range -> m Range
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Range -> m Range
gmapQi :: Int -> (forall d. Data d => d -> u) -> Range -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Range -> u
gmapQ :: (forall d. Data d => d -> u) -> Range -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Range -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Range -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Range -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Range -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Range -> r
gmapT :: (forall b. Data b => b -> b) -> Range -> Range
$cgmapT :: (forall b. Data b => b -> b) -> Range -> Range
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Range)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Range)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Range)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Range)
dataTypeOf :: Range -> DataType
$cdataTypeOf :: Range -> DataType
toConstr :: Range -> Constr
$ctoConstr :: Range -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Range
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Range
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Range -> c Range
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Range -> c Range
$cp1Data :: Typeable Range
Data, Typeable)
type ConstExpr = Expr
data Event
= Event Expr Edge
deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, Eq Event
Eq Event =>
(Event -> Event -> Ordering)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Event)
-> (Event -> Event -> Event)
-> Ord Event
Event -> Event -> Bool
Event -> Event -> Ordering
Event -> Event -> Event
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Event -> Event -> Event
$cmin :: Event -> Event -> Event
max :: Event -> Event -> Event
$cmax :: Event -> Event -> Event
>= :: Event -> Event -> Bool
$c>= :: Event -> Event -> Bool
> :: Event -> Event -> Bool
$c> :: Event -> Event -> Bool
<= :: Event -> Event -> Bool
$c<= :: Event -> Event -> Bool
< :: Event -> Event -> Bool
$c< :: Event -> Event -> Bool
compare :: Event -> Event -> Ordering
$ccompare :: Event -> Event -> Ordering
$cp1Ord :: Eq Event
Ord, Int -> Event -> ShowS
[Event] -> ShowS
Event -> Ident
(Int -> Event -> ShowS)
-> (Event -> Ident) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> Ident) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> Ident
$cshow :: Event -> Ident
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show, Typeable Event
Constr
DataType
Typeable Event =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Event -> c Event)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Event)
-> (Event -> Constr)
-> (Event -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Event))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Event))
-> ((forall b. Data b => b -> b) -> Event -> Event)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r)
-> (forall u. (forall d. Data d => d -> u) -> Event -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Event -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Event -> m Event)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Event -> m Event)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Event -> m Event)
-> Data Event
Event -> Constr
Event -> DataType
(forall b. Data b => b -> b) -> Event -> Event
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Event -> c Event
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Event
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Event -> u
forall u. (forall d. Data d => d -> u) -> Event -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Event -> m Event
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Event -> m Event
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Event
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Event -> c Event
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Event)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Event)
$cEvent :: Constr
$tEvent :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Event -> m Event
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Event -> m Event
gmapMp :: (forall d. Data d => d -> m d) -> Event -> m Event
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Event -> m Event
gmapM :: (forall d. Data d => d -> m d) -> Event -> m Event
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Event -> m Event
gmapQi :: Int -> (forall d. Data d => d -> u) -> Event -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Event -> u
gmapQ :: (forall d. Data d => d -> u) -> Event -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Event -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Event -> r
gmapT :: (forall b. Data b => b -> b) -> Event -> Event
$cgmapT :: (forall b. Data b => b -> b) -> Event -> Event
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Event)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Event)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Event)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Event)
dataTypeOf :: Event -> DataType
$cdataTypeOf :: Event -> DataType
toConstr :: Event -> Constr
$ctoConstr :: Event -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Event
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Event
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Event -> c Event
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Event -> c Event
$cp1Data :: Typeable Event
Data, Typeable)
data Edge
= PosEdge
| NegEdge
deriving (Edge -> Edge -> Bool
(Edge -> Edge -> Bool) -> (Edge -> Edge -> Bool) -> Eq Edge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Edge -> Edge -> Bool
$c/= :: Edge -> Edge -> Bool
== :: Edge -> Edge -> Bool
$c== :: Edge -> Edge -> Bool
Eq, Eq Edge
Eq Edge =>
(Edge -> Edge -> Ordering)
-> (Edge -> Edge -> Bool)
-> (Edge -> Edge -> Bool)
-> (Edge -> Edge -> Bool)
-> (Edge -> Edge -> Bool)
-> (Edge -> Edge -> Edge)
-> (Edge -> Edge -> Edge)
-> Ord Edge
Edge -> Edge -> Bool
Edge -> Edge -> Ordering
Edge -> Edge -> Edge
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Edge -> Edge -> Edge
$cmin :: Edge -> Edge -> Edge
max :: Edge -> Edge -> Edge
$cmax :: Edge -> Edge -> Edge
>= :: Edge -> Edge -> Bool
$c>= :: Edge -> Edge -> Bool
> :: Edge -> Edge -> Bool
$c> :: Edge -> Edge -> Bool
<= :: Edge -> Edge -> Bool
$c<= :: Edge -> Edge -> Bool
< :: Edge -> Edge -> Bool
$c< :: Edge -> Edge -> Bool
compare :: Edge -> Edge -> Ordering
$ccompare :: Edge -> Edge -> Ordering
$cp1Ord :: Eq Edge
Ord, Int -> Edge -> ShowS
[Edge] -> ShowS
Edge -> Ident
(Int -> Edge -> ShowS)
-> (Edge -> Ident) -> ([Edge] -> ShowS) -> Show Edge
forall a.
(Int -> a -> ShowS) -> (a -> Ident) -> ([a] -> ShowS) -> Show a
showList :: [Edge] -> ShowS
$cshowList :: [Edge] -> ShowS
show :: Edge -> Ident
$cshow :: Edge -> Ident
showsPrec :: Int -> Edge -> ShowS
$cshowsPrec :: Int -> Edge -> ShowS
Show, Typeable Edge
Constr
DataType
Typeable Edge =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Edge -> c Edge)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Edge)
-> (Edge -> Constr)
-> (Edge -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Edge))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Edge))
-> ((forall b. Data b => b -> b) -> Edge -> Edge)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Edge -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Edge -> r)
-> (forall u. (forall d. Data d => d -> u) -> Edge -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Edge -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Edge -> m Edge)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Edge -> m Edge)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Edge -> m Edge)
-> Data Edge
Edge -> Constr
Edge -> DataType
(forall b. Data b => b -> b) -> Edge -> Edge
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Edge -> c Edge
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Edge
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Edge -> u
forall u. (forall d. Data d => d -> u) -> Edge -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Edge -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Edge -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Edge -> m Edge
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Edge -> m Edge
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Edge
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Edge -> c Edge
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Edge)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Edge)
$cNegEdge :: Constr
$cPosEdge :: Constr
$tEdge :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Edge -> m Edge
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Edge -> m Edge
gmapMp :: (forall d. Data d => d -> m d) -> Edge -> m Edge
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Edge -> m Edge
gmapM :: (forall d. Data d => d -> m d) -> Edge -> m Edge
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Edge -> m Edge
gmapQi :: Int -> (forall d. Data d => d -> u) -> Edge -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Edge -> u
gmapQ :: (forall d. Data d => d -> u) -> Edge -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Edge -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Edge -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Edge -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Edge -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Edge -> r
gmapT :: (forall b. Data b => b -> b) -> Edge -> Edge
$cgmapT :: (forall b. Data b => b -> b) -> Edge -> Edge
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Edge)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Edge)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Edge)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Edge)
dataTypeOf :: Edge -> DataType
$cdataTypeOf :: Edge -> DataType
toConstr :: Edge -> Constr
$ctoConstr :: Edge -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Edge
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Edge
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Edge -> c Edge
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Edge -> c Edge
$cp1Data :: Typeable Edge
Data, Typeable)
data Expr
= ExprLit (Maybe Size) ExprLit
| ExprVar Ident
| ExprString String
| ExprIndex Ident Expr
| ExprSlice Ident Expr Expr
| ExprSliceOff Ident Expr Int
| ExprCase Expr [([ConstExpr], Expr)] (Maybe Expr)
| ExprConcat [Expr]
| ExprCond Expr Expr Expr
| ExprUnary UnaryOp Expr
| ExprBinary BinaryOp Expr Expr
| ExprFunCall Ident [Expr]
deriving (Expr -> Expr -> Bool
(Expr -> Expr -> Bool) -> (Expr -> Expr -> Bool) -> Eq Expr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c== :: Expr -> Expr -> Bool
Eq, Eq Expr
Eq Expr =>
(Expr -> Expr -> Ordering)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Bool)
-> (Expr -> Expr -> Expr)
-> (Expr -> Expr -> Expr)
-> Ord Expr
Expr -> Expr -> Bool
Expr -> Expr -> Ordering
Expr -> Expr -> Expr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Expr -> Expr -> Expr
$cmin :: Expr -> Expr -> Expr
max :: Expr -> Expr -> Expr
$cmax :: Expr -> Expr -> Expr
>= :: Expr -> Expr -> Bool
$c>= :: Expr -> Expr -> Bool
> :: Expr -> Expr -> Bool
$c> :: Expr -> Expr -> Bool
<= :: Expr -> Expr -> Bool
$c<= :: Expr -> Expr -> Bool
< :: Expr -> Expr -> Bool
$c< :: Expr -> Expr -> Bool
compare :: Expr -> Expr -> Ordering
$ccompare :: Expr -> Expr -> Ordering
$cp1Ord :: Eq Expr
Ord, Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> Ident
(Int -> Expr -> ShowS)
-> (Expr -> Ident) -> ([Expr] -> ShowS) -> Show Expr
forall a.
(Int -> a -> ShowS) -> (a -> Ident) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> Ident
$cshow :: Expr -> Ident
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show, Typeable Expr
Constr
DataType
Typeable Expr =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr -> c Expr)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Expr)
-> (Expr -> Constr)
-> (Expr -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Expr))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Expr))
-> ((forall b. Data b => b -> b) -> Expr -> Expr)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Expr -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Expr -> r)
-> (forall u. (forall d. Data d => d -> u) -> Expr -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Expr -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Expr -> m Expr)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expr -> m Expr)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expr -> m Expr)
-> Data Expr
Expr -> Constr
Expr -> DataType
(forall b. Data b => b -> b) -> Expr -> Expr
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr -> c Expr
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Expr
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Expr -> u
forall u. (forall d. Data d => d -> u) -> Expr -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Expr -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Expr -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Expr -> m Expr
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expr -> m Expr
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Expr
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr -> c Expr
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Expr)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Expr)
$cExprFunCall :: Constr
$cExprBinary :: Constr
$cExprUnary :: Constr
$cExprCond :: Constr
$cExprConcat :: Constr
$cExprCase :: Constr
$cExprSliceOff :: Constr
$cExprSlice :: Constr
$cExprIndex :: Constr
$cExprString :: Constr
$cExprVar :: Constr
$cExprLit :: Constr
$tExpr :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Expr -> m Expr
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expr -> m Expr
gmapMp :: (forall d. Data d => d -> m d) -> Expr -> m Expr
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expr -> m Expr
gmapM :: (forall d. Data d => d -> m d) -> Expr -> m Expr
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Expr -> m Expr
gmapQi :: Int -> (forall d. Data d => d -> u) -> Expr -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Expr -> u
gmapQ :: (forall d. Data d => d -> u) -> Expr -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Expr -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Expr -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Expr -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Expr -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Expr -> r
gmapT :: (forall b. Data b => b -> b) -> Expr -> Expr
$cgmapT :: (forall b. Data b => b -> b) -> Expr -> Expr
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Expr)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Expr)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Expr)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Expr)
dataTypeOf :: Expr -> DataType
$cdataTypeOf :: Expr -> DataType
toConstr :: Expr -> Constr
$ctoConstr :: Expr -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Expr
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Expr
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr -> c Expr
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr -> c Expr
$cp1Data :: Typeable Expr
Data, Typeable)
data ExprLit
= ExprNum Integer
| ExprBit Bit
| ExprBitVector [Bit]
deriving (ExprLit -> ExprLit -> Bool
(ExprLit -> ExprLit -> Bool)
-> (ExprLit -> ExprLit -> Bool) -> Eq ExprLit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExprLit -> ExprLit -> Bool
$c/= :: ExprLit -> ExprLit -> Bool
== :: ExprLit -> ExprLit -> Bool
$c== :: ExprLit -> ExprLit -> Bool
Eq, Eq ExprLit
Eq ExprLit =>
(ExprLit -> ExprLit -> Ordering)
-> (ExprLit -> ExprLit -> Bool)
-> (ExprLit -> ExprLit -> Bool)
-> (ExprLit -> ExprLit -> Bool)
-> (ExprLit -> ExprLit -> Bool)
-> (ExprLit -> ExprLit -> ExprLit)
-> (ExprLit -> ExprLit -> ExprLit)
-> Ord ExprLit
ExprLit -> ExprLit -> Bool
ExprLit -> ExprLit -> Ordering
ExprLit -> ExprLit -> ExprLit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExprLit -> ExprLit -> ExprLit
$cmin :: ExprLit -> ExprLit -> ExprLit
max :: ExprLit -> ExprLit -> ExprLit
$cmax :: ExprLit -> ExprLit -> ExprLit
>= :: ExprLit -> ExprLit -> Bool
$c>= :: ExprLit -> ExprLit -> Bool
> :: ExprLit -> ExprLit -> Bool
$c> :: ExprLit -> ExprLit -> Bool
<= :: ExprLit -> ExprLit -> Bool
$c<= :: ExprLit -> ExprLit -> Bool
< :: ExprLit -> ExprLit -> Bool
$c< :: ExprLit -> ExprLit -> Bool
compare :: ExprLit -> ExprLit -> Ordering
$ccompare :: ExprLit -> ExprLit -> Ordering
$cp1Ord :: Eq ExprLit
Ord, Int -> ExprLit -> ShowS
[ExprLit] -> ShowS
ExprLit -> Ident
(Int -> ExprLit -> ShowS)
-> (ExprLit -> Ident) -> ([ExprLit] -> ShowS) -> Show ExprLit
forall a.
(Int -> a -> ShowS) -> (a -> Ident) -> ([a] -> ShowS) -> Show a
showList :: [ExprLit] -> ShowS
$cshowList :: [ExprLit] -> ShowS
show :: ExprLit -> Ident
$cshow :: ExprLit -> Ident
showsPrec :: Int -> ExprLit -> ShowS
$cshowsPrec :: Int -> ExprLit -> ShowS
Show, Typeable ExprLit
Constr
DataType
Typeable ExprLit =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExprLit -> c ExprLit)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExprLit)
-> (ExprLit -> Constr)
-> (ExprLit -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExprLit))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExprLit))
-> ((forall b. Data b => b -> b) -> ExprLit -> ExprLit)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExprLit -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExprLit -> r)
-> (forall u. (forall d. Data d => d -> u) -> ExprLit -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ExprLit -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExprLit -> m ExprLit)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExprLit -> m ExprLit)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExprLit -> m ExprLit)
-> Data ExprLit
ExprLit -> Constr
ExprLit -> DataType
(forall b. Data b => b -> b) -> ExprLit -> ExprLit
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExprLit -> c ExprLit
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExprLit
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ExprLit -> u
forall u. (forall d. Data d => d -> u) -> ExprLit -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExprLit -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExprLit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExprLit -> m ExprLit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExprLit -> m ExprLit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExprLit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExprLit -> c ExprLit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExprLit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExprLit)
$cExprBitVector :: Constr
$cExprBit :: Constr
$cExprNum :: Constr
$tExprLit :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ExprLit -> m ExprLit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExprLit -> m ExprLit
gmapMp :: (forall d. Data d => d -> m d) -> ExprLit -> m ExprLit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExprLit -> m ExprLit
gmapM :: (forall d. Data d => d -> m d) -> ExprLit -> m ExprLit
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExprLit -> m ExprLit
gmapQi :: Int -> (forall d. Data d => d -> u) -> ExprLit -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ExprLit -> u
gmapQ :: (forall d. Data d => d -> u) -> ExprLit -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ExprLit -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExprLit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExprLit -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExprLit -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExprLit -> r
gmapT :: (forall b. Data b => b -> b) -> ExprLit -> ExprLit
$cgmapT :: (forall b. Data b => b -> b) -> ExprLit -> ExprLit
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExprLit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExprLit)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ExprLit)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExprLit)
dataTypeOf :: ExprLit -> DataType
$cdataTypeOf :: ExprLit -> DataType
toConstr :: ExprLit -> Constr
$ctoConstr :: ExprLit -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExprLit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExprLit
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExprLit -> c ExprLit
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExprLit -> c ExprLit
$cp1Data :: Typeable ExprLit
Data, Typeable)
data Bit
= T | F | U | Z
deriving (Bit -> Bit -> Bool
(Bit -> Bit -> Bool) -> (Bit -> Bit -> Bool) -> Eq Bit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bit -> Bit -> Bool
$c/= :: Bit -> Bit -> Bool
== :: Bit -> Bit -> Bool
$c== :: Bit -> Bit -> Bool
Eq, Eq Bit
Eq Bit =>
(Bit -> Bit -> Ordering)
-> (Bit -> Bit -> Bool)
-> (Bit -> Bit -> Bool)
-> (Bit -> Bit -> Bool)
-> (Bit -> Bit -> Bool)
-> (Bit -> Bit -> Bit)
-> (Bit -> Bit -> Bit)
-> Ord Bit
Bit -> Bit -> Bool
Bit -> Bit -> Ordering
Bit -> Bit -> Bit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Bit -> Bit -> Bit
$cmin :: Bit -> Bit -> Bit
max :: Bit -> Bit -> Bit
$cmax :: Bit -> Bit -> Bit
>= :: Bit -> Bit -> Bool
$c>= :: Bit -> Bit -> Bool
> :: Bit -> Bit -> Bool
$c> :: Bit -> Bit -> Bool
<= :: Bit -> Bit -> Bool
$c<= :: Bit -> Bit -> Bool
< :: Bit -> Bit -> Bool
$c< :: Bit -> Bit -> Bool
compare :: Bit -> Bit -> Ordering
$ccompare :: Bit -> Bit -> Ordering
$cp1Ord :: Eq Bit
Ord, Int -> Bit -> ShowS
[Bit] -> ShowS
Bit -> Ident
(Int -> Bit -> ShowS)
-> (Bit -> Ident) -> ([Bit] -> ShowS) -> Show Bit
forall a.
(Int -> a -> ShowS) -> (a -> Ident) -> ([a] -> ShowS) -> Show a
showList :: [Bit] -> ShowS
$cshowList :: [Bit] -> ShowS
show :: Bit -> Ident
$cshow :: Bit -> Ident
showsPrec :: Int -> Bit -> ShowS
$cshowsPrec :: Int -> Bit -> ShowS
Show, Typeable Bit
Constr
DataType
Typeable Bit =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bit -> c Bit)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bit)
-> (Bit -> Constr)
-> (Bit -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bit))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bit))
-> ((forall b. Data b => b -> b) -> Bit -> Bit)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bit -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bit -> r)
-> (forall u. (forall d. Data d => d -> u) -> Bit -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Bit -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bit -> m Bit)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bit -> m Bit)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bit -> m Bit)
-> Data Bit
Bit -> Constr
Bit -> DataType
(forall b. Data b => b -> b) -> Bit -> Bit
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bit -> c Bit
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bit
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Bit -> u
forall u. (forall d. Data d => d -> u) -> Bit -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bit -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bit -> m Bit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bit -> m Bit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bit -> c Bit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bit)
$cZ :: Constr
$cU :: Constr
$cF :: Constr
$cT :: Constr
$tBit :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Bit -> m Bit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bit -> m Bit
gmapMp :: (forall d. Data d => d -> m d) -> Bit -> m Bit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bit -> m Bit
gmapM :: (forall d. Data d => d -> m d) -> Bit -> m Bit
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bit -> m Bit
gmapQi :: Int -> (forall d. Data d => d -> u) -> Bit -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Bit -> u
gmapQ :: (forall d. Data d => d -> u) -> Bit -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Bit -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bit -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bit -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bit -> r
gmapT :: (forall b. Data b => b -> b) -> Bit -> Bit
$cgmapT :: (forall b. Data b => b -> b) -> Bit -> Bit
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Bit)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Bit)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Bit)
dataTypeOf :: Bit -> DataType
$cdataTypeOf :: Bit -> DataType
toConstr :: Bit -> Constr
$ctoConstr :: Bit -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Bit
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bit -> c Bit
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bit -> c Bit
$cp1Data :: Typeable Bit
Data, Typeable)
data Stmt
= Assign LValue Expr
| If Expr Stmt (Maybe Stmt)
| Case Expr [([Expr], Stmt)] (Maybe Stmt)
| Seq [Stmt]
| FunCallStmt Ident [Expr]
deriving (Stmt -> Stmt -> Bool
(Stmt -> Stmt -> Bool) -> (Stmt -> Stmt -> Bool) -> Eq Stmt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stmt -> Stmt -> Bool
$c/= :: Stmt -> Stmt -> Bool
== :: Stmt -> Stmt -> Bool
$c== :: Stmt -> Stmt -> Bool
Eq, Eq Stmt
Eq Stmt =>
(Stmt -> Stmt -> Ordering)
-> (Stmt -> Stmt -> Bool)
-> (Stmt -> Stmt -> Bool)
-> (Stmt -> Stmt -> Bool)
-> (Stmt -> Stmt -> Bool)
-> (Stmt -> Stmt -> Stmt)
-> (Stmt -> Stmt -> Stmt)
-> Ord Stmt
Stmt -> Stmt -> Bool
Stmt -> Stmt -> Ordering
Stmt -> Stmt -> Stmt
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Stmt -> Stmt -> Stmt
$cmin :: Stmt -> Stmt -> Stmt
max :: Stmt -> Stmt -> Stmt
$cmax :: Stmt -> Stmt -> Stmt
>= :: Stmt -> Stmt -> Bool
$c>= :: Stmt -> Stmt -> Bool
> :: Stmt -> Stmt -> Bool
$c> :: Stmt -> Stmt -> Bool
<= :: Stmt -> Stmt -> Bool
$c<= :: Stmt -> Stmt -> Bool
< :: Stmt -> Stmt -> Bool
$c< :: Stmt -> Stmt -> Bool
compare :: Stmt -> Stmt -> Ordering
$ccompare :: Stmt -> Stmt -> Ordering
$cp1Ord :: Eq Stmt
Ord, Int -> Stmt -> ShowS
[Stmt] -> ShowS
Stmt -> Ident
(Int -> Stmt -> ShowS)
-> (Stmt -> Ident) -> ([Stmt] -> ShowS) -> Show Stmt
forall a.
(Int -> a -> ShowS) -> (a -> Ident) -> ([a] -> ShowS) -> Show a
showList :: [Stmt] -> ShowS
$cshowList :: [Stmt] -> ShowS
show :: Stmt -> Ident
$cshow :: Stmt -> Ident
showsPrec :: Int -> Stmt -> ShowS
$cshowsPrec :: Int -> Stmt -> ShowS
Show, Typeable Stmt
Constr
DataType
Typeable Stmt =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Stmt -> c Stmt)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Stmt)
-> (Stmt -> Constr)
-> (Stmt -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Stmt))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Stmt))
-> ((forall b. Data b => b -> b) -> Stmt -> Stmt)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Stmt -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Stmt -> r)
-> (forall u. (forall d. Data d => d -> u) -> Stmt -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Stmt -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Stmt -> m Stmt)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stmt -> m Stmt)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stmt -> m Stmt)
-> Data Stmt
Stmt -> Constr
Stmt -> DataType
(forall b. Data b => b -> b) -> Stmt -> Stmt
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Stmt -> c Stmt
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Stmt
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Stmt -> u
forall u. (forall d. Data d => d -> u) -> Stmt -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Stmt -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Stmt -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Stmt -> m Stmt
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stmt -> m Stmt
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Stmt
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Stmt -> c Stmt
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Stmt)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Stmt)
$cFunCallStmt :: Constr
$cSeq :: Constr
$cCase :: Constr
$cIf :: Constr
$cAssign :: Constr
$tStmt :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Stmt -> m Stmt
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stmt -> m Stmt
gmapMp :: (forall d. Data d => d -> m d) -> Stmt -> m Stmt
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stmt -> m Stmt
gmapM :: (forall d. Data d => d -> m d) -> Stmt -> m Stmt
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Stmt -> m Stmt
gmapQi :: Int -> (forall d. Data d => d -> u) -> Stmt -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Stmt -> u
gmapQ :: (forall d. Data d => d -> u) -> Stmt -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Stmt -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Stmt -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Stmt -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Stmt -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Stmt -> r
gmapT :: (forall b. Data b => b -> b) -> Stmt -> Stmt
$cgmapT :: (forall b. Data b => b -> b) -> Stmt -> Stmt
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Stmt)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Stmt)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Stmt)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Stmt)
dataTypeOf :: Stmt -> DataType
$cdataTypeOf :: Stmt -> DataType
toConstr :: Stmt -> Constr
$ctoConstr :: Stmt -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Stmt
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Stmt
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Stmt -> c Stmt
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Stmt -> c Stmt
$cp1Data :: Typeable Stmt
Data, Typeable)
type LValue = Expr
data UnaryOp
= UPlus | UMinus | LNeg | Neg | UAnd | UNand | UOr | UNor | UXor | UXnor
deriving (UnaryOp -> UnaryOp -> Bool
(UnaryOp -> UnaryOp -> Bool)
-> (UnaryOp -> UnaryOp -> Bool) -> Eq UnaryOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnaryOp -> UnaryOp -> Bool
$c/= :: UnaryOp -> UnaryOp -> Bool
== :: UnaryOp -> UnaryOp -> Bool
$c== :: UnaryOp -> UnaryOp -> Bool
Eq, Eq UnaryOp
Eq UnaryOp =>
(UnaryOp -> UnaryOp -> Ordering)
-> (UnaryOp -> UnaryOp -> Bool)
-> (UnaryOp -> UnaryOp -> Bool)
-> (UnaryOp -> UnaryOp -> Bool)
-> (UnaryOp -> UnaryOp -> Bool)
-> (UnaryOp -> UnaryOp -> UnaryOp)
-> (UnaryOp -> UnaryOp -> UnaryOp)
-> Ord UnaryOp
UnaryOp -> UnaryOp -> Bool
UnaryOp -> UnaryOp -> Ordering
UnaryOp -> UnaryOp -> UnaryOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UnaryOp -> UnaryOp -> UnaryOp
$cmin :: UnaryOp -> UnaryOp -> UnaryOp
max :: UnaryOp -> UnaryOp -> UnaryOp
$cmax :: UnaryOp -> UnaryOp -> UnaryOp
>= :: UnaryOp -> UnaryOp -> Bool
$c>= :: UnaryOp -> UnaryOp -> Bool
> :: UnaryOp -> UnaryOp -> Bool
$c> :: UnaryOp -> UnaryOp -> Bool
<= :: UnaryOp -> UnaryOp -> Bool
$c<= :: UnaryOp -> UnaryOp -> Bool
< :: UnaryOp -> UnaryOp -> Bool
$c< :: UnaryOp -> UnaryOp -> Bool
compare :: UnaryOp -> UnaryOp -> Ordering
$ccompare :: UnaryOp -> UnaryOp -> Ordering
$cp1Ord :: Eq UnaryOp
Ord, Int -> UnaryOp -> ShowS
[UnaryOp] -> ShowS
UnaryOp -> Ident
(Int -> UnaryOp -> ShowS)
-> (UnaryOp -> Ident) -> ([UnaryOp] -> ShowS) -> Show UnaryOp
forall a.
(Int -> a -> ShowS) -> (a -> Ident) -> ([a] -> ShowS) -> Show a
showList :: [UnaryOp] -> ShowS
$cshowList :: [UnaryOp] -> ShowS
show :: UnaryOp -> Ident
$cshow :: UnaryOp -> Ident
showsPrec :: Int -> UnaryOp -> ShowS
$cshowsPrec :: Int -> UnaryOp -> ShowS
Show, Typeable UnaryOp
Constr
DataType
Typeable UnaryOp =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnaryOp -> c UnaryOp)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnaryOp)
-> (UnaryOp -> Constr)
-> (UnaryOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnaryOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnaryOp))
-> ((forall b. Data b => b -> b) -> UnaryOp -> UnaryOp)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnaryOp -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnaryOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> UnaryOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UnaryOp -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp)
-> Data UnaryOp
UnaryOp -> Constr
UnaryOp -> DataType
(forall b. Data b => b -> b) -> UnaryOp -> UnaryOp
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnaryOp -> c UnaryOp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnaryOp
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UnaryOp -> u
forall u. (forall d. Data d => d -> u) -> UnaryOp -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnaryOp -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnaryOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnaryOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnaryOp -> c UnaryOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnaryOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnaryOp)
$cUXnor :: Constr
$cUXor :: Constr
$cUNor :: Constr
$cUOr :: Constr
$cUNand :: Constr
$cUAnd :: Constr
$cNeg :: Constr
$cLNeg :: Constr
$cUMinus :: Constr
$cUPlus :: Constr
$tUnaryOp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp
gmapMp :: (forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp
gmapM :: (forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp
gmapQi :: Int -> (forall d. Data d => d -> u) -> UnaryOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UnaryOp -> u
gmapQ :: (forall d. Data d => d -> u) -> UnaryOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UnaryOp -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnaryOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnaryOp -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnaryOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnaryOp -> r
gmapT :: (forall b. Data b => b -> b) -> UnaryOp -> UnaryOp
$cgmapT :: (forall b. Data b => b -> b) -> UnaryOp -> UnaryOp
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnaryOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnaryOp)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c UnaryOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnaryOp)
dataTypeOf :: UnaryOp -> DataType
$cdataTypeOf :: UnaryOp -> DataType
toConstr :: UnaryOp -> Constr
$ctoConstr :: UnaryOp -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnaryOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnaryOp
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnaryOp -> c UnaryOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnaryOp -> c UnaryOp
$cp1Data :: Typeable UnaryOp
Data, Typeable)
data BinaryOp
= Pow | Plus | Minus | Times | Divide | Modulo
| Equals | NotEquals
| CEquals | CNotEquals
| LAnd | LOr
| LessThan | LessEqual | GreaterThan | GreaterEqual
| And | Nand | Or | Nor | Xor | Xnor
| ShiftLeft | ShiftRight | RotateLeft | RotateRight
| ShiftLeftArith | ShiftRightArith
deriving (BinaryOp -> BinaryOp -> Bool
(BinaryOp -> BinaryOp -> Bool)
-> (BinaryOp -> BinaryOp -> Bool) -> Eq BinaryOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinaryOp -> BinaryOp -> Bool
$c/= :: BinaryOp -> BinaryOp -> Bool
== :: BinaryOp -> BinaryOp -> Bool
$c== :: BinaryOp -> BinaryOp -> Bool
Eq, Eq BinaryOp
Eq BinaryOp =>
(BinaryOp -> BinaryOp -> Ordering)
-> (BinaryOp -> BinaryOp -> Bool)
-> (BinaryOp -> BinaryOp -> Bool)
-> (BinaryOp -> BinaryOp -> Bool)
-> (BinaryOp -> BinaryOp -> Bool)
-> (BinaryOp -> BinaryOp -> BinaryOp)
-> (BinaryOp -> BinaryOp -> BinaryOp)
-> Ord BinaryOp
BinaryOp -> BinaryOp -> Bool
BinaryOp -> BinaryOp -> Ordering
BinaryOp -> BinaryOp -> BinaryOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BinaryOp -> BinaryOp -> BinaryOp
$cmin :: BinaryOp -> BinaryOp -> BinaryOp
max :: BinaryOp -> BinaryOp -> BinaryOp
$cmax :: BinaryOp -> BinaryOp -> BinaryOp
>= :: BinaryOp -> BinaryOp -> Bool
$c>= :: BinaryOp -> BinaryOp -> Bool
> :: BinaryOp -> BinaryOp -> Bool
$c> :: BinaryOp -> BinaryOp -> Bool
<= :: BinaryOp -> BinaryOp -> Bool
$c<= :: BinaryOp -> BinaryOp -> Bool
< :: BinaryOp -> BinaryOp -> Bool
$c< :: BinaryOp -> BinaryOp -> Bool
compare :: BinaryOp -> BinaryOp -> Ordering
$ccompare :: BinaryOp -> BinaryOp -> Ordering
$cp1Ord :: Eq BinaryOp
Ord, Int -> BinaryOp -> ShowS
[BinaryOp] -> ShowS
BinaryOp -> Ident
(Int -> BinaryOp -> ShowS)
-> (BinaryOp -> Ident) -> ([BinaryOp] -> ShowS) -> Show BinaryOp
forall a.
(Int -> a -> ShowS) -> (a -> Ident) -> ([a] -> ShowS) -> Show a
showList :: [BinaryOp] -> ShowS
$cshowList :: [BinaryOp] -> ShowS
show :: BinaryOp -> Ident
$cshow :: BinaryOp -> Ident
showsPrec :: Int -> BinaryOp -> ShowS
$cshowsPrec :: Int -> BinaryOp -> ShowS
Show, Typeable BinaryOp
Constr
DataType
Typeable BinaryOp =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinaryOp -> c BinaryOp)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinaryOp)
-> (BinaryOp -> Constr)
-> (BinaryOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BinaryOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinaryOp))
-> ((forall b. Data b => b -> b) -> BinaryOp -> BinaryOp)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BinaryOp -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BinaryOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> BinaryOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> BinaryOp -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BinaryOp -> m BinaryOp)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinaryOp -> m BinaryOp)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinaryOp -> m BinaryOp)
-> Data BinaryOp
BinaryOp -> Constr
BinaryOp -> DataType
(forall b. Data b => b -> b) -> BinaryOp -> BinaryOp
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinaryOp -> c BinaryOp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinaryOp
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BinaryOp -> u
forall u. (forall d. Data d => d -> u) -> BinaryOp -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BinaryOp -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BinaryOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BinaryOp -> m BinaryOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinaryOp -> m BinaryOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinaryOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinaryOp -> c BinaryOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BinaryOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinaryOp)
$cShiftRightArith :: Constr
$cShiftLeftArith :: Constr
$cRotateRight :: Constr
$cRotateLeft :: Constr
$cShiftRight :: Constr
$cShiftLeft :: Constr
$cXnor :: Constr
$cXor :: Constr
$cNor :: Constr
$cOr :: Constr
$cNand :: Constr
$cAnd :: Constr
$cGreaterEqual :: Constr
$cGreaterThan :: Constr
$cLessEqual :: Constr
$cLessThan :: Constr
$cLOr :: Constr
$cLAnd :: Constr
$cCNotEquals :: Constr
$cCEquals :: Constr
$cNotEquals :: Constr
$cEquals :: Constr
$cModulo :: Constr
$cDivide :: Constr
$cTimes :: Constr
$cMinus :: Constr
$cPlus :: Constr
$cPow :: Constr
$tBinaryOp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> BinaryOp -> m BinaryOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinaryOp -> m BinaryOp
gmapMp :: (forall d. Data d => d -> m d) -> BinaryOp -> m BinaryOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BinaryOp -> m BinaryOp
gmapM :: (forall d. Data d => d -> m d) -> BinaryOp -> m BinaryOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BinaryOp -> m BinaryOp
gmapQi :: Int -> (forall d. Data d => d -> u) -> BinaryOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BinaryOp -> u
gmapQ :: (forall d. Data d => d -> u) -> BinaryOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BinaryOp -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BinaryOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BinaryOp -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BinaryOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BinaryOp -> r
gmapT :: (forall b. Data b => b -> b) -> BinaryOp -> BinaryOp
$cgmapT :: (forall b. Data b => b -> b) -> BinaryOp -> BinaryOp
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinaryOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinaryOp)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c BinaryOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BinaryOp)
dataTypeOf :: BinaryOp -> DataType
$cdataTypeOf :: BinaryOp -> DataType
toConstr :: BinaryOp -> Constr
$ctoConstr :: BinaryOp -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinaryOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BinaryOp
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinaryOp -> c BinaryOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BinaryOp -> c BinaryOp
$cp1Data :: Typeable BinaryOp
Data, Typeable)
instance Binary Module where
put :: Module -> Put
put (Module x1 :: Ident
x1 x2 :: [(Ident, Maybe Range)]
x2 x3 :: [(Ident, Maybe Range)]
x3 x4 :: [(Ident, Expr)]
x4 x5 :: [Decl]
x5)
= do Ident -> Put
forall t. Binary t => t -> Put
put Ident
x1
[(Ident, Maybe Range)] -> Put
forall t. Binary t => t -> Put
put [(Ident, Maybe Range)]
x2
[(Ident, Maybe Range)] -> Put
forall t. Binary t => t -> Put
put [(Ident, Maybe Range)]
x3
[(Ident, Expr)] -> Put
forall t. Binary t => t -> Put
put [(Ident, Expr)]
x4
[Decl] -> Put
forall t. Binary t => t -> Put
put [Decl]
x5
get :: Get Module
get
= do Ident
x1 <- Get Ident
forall t. Binary t => Get t
get
[(Ident, Maybe Range)]
x2 <- Get [(Ident, Maybe Range)]
forall t. Binary t => Get t
get
[(Ident, Maybe Range)]
x3 <- Get [(Ident, Maybe Range)]
forall t. Binary t => Get t
get
[(Ident, Expr)]
x4 <- Get [(Ident, Expr)]
forall t. Binary t => Get t
get
[Decl]
x5 <- Get [Decl]
forall t. Binary t => Get t
get
Module -> Get Module
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident
-> [(Ident, Maybe Range)]
-> [(Ident, Maybe Range)]
-> [(Ident, Expr)]
-> [Decl]
-> Module
Module Ident
x1 [(Ident, Maybe Range)]
x2 [(Ident, Maybe Range)]
x3 [(Ident, Expr)]
x4 [Decl]
x5)
instance Binary Decl where
put :: Decl -> Put
put x :: Decl
x
= case Decl
x of
NetDecl x1 :: Ident
x1 x2 :: Maybe Range
x2 x3 :: Maybe Expr
x3 -> do Word8 -> Put
putWord8 0
Ident -> Put
forall t. Binary t => t -> Put
put Ident
x1
Maybe Range -> Put
forall t. Binary t => t -> Put
put Maybe Range
x2
Maybe Expr -> Put
forall t. Binary t => t -> Put
put Maybe Expr
x3
NetAssign x1 :: Ident
x1 x2 :: Expr
x2 -> do Word8 -> Put
putWord8 1
Ident -> Put
forall t. Binary t => t -> Put
put Ident
x1
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x2
MemDecl x1 :: Ident
x1 x2 :: Maybe Range
x2 x3 :: Maybe Range
x3 x4 :: Maybe [Expr]
x4 -> do Word8 -> Put
putWord8 2
Ident -> Put
forall t. Binary t => t -> Put
put Ident
x1
Maybe Range -> Put
forall t. Binary t => t -> Put
put Maybe Range
x2
Maybe Range -> Put
forall t. Binary t => t -> Put
put Maybe Range
x3
Maybe [Expr] -> Put
forall t. Binary t => t -> Put
put Maybe [Expr]
x4
MemAssign x1 :: Ident
x1 x2 :: Expr
x2 x3 :: Expr
x3 -> do Word8 -> Put
putWord8 3
Ident -> Put
forall t. Binary t => t -> Put
put Ident
x1
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x2
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x3
InstDecl x1 :: Ident
x1 x2 :: Ident
x2 x3 :: [(Ident, Expr)]
x3 x4 :: [(Ident, Expr)]
x4 x5 :: [(Ident, Expr)]
x5 -> do Word8 -> Put
putWord8 4
Ident -> Put
forall t. Binary t => t -> Put
put Ident
x1
Ident -> Put
forall t. Binary t => t -> Put
put Ident
x2
[(Ident, Expr)] -> Put
forall t. Binary t => t -> Put
put [(Ident, Expr)]
x3
[(Ident, Expr)] -> Put
forall t. Binary t => t -> Put
put [(Ident, Expr)]
x4
[(Ident, Expr)] -> Put
forall t. Binary t => t -> Put
put [(Ident, Expr)]
x5
ProcessDecl x1 :: Event
x1 x2 :: Maybe (Event, Stmt)
x2 x3 :: Stmt
x3 -> do Word8 -> Put
putWord8 5
Event -> Put
forall t. Binary t => t -> Put
put Event
x1
Maybe (Event, Stmt) -> Put
forall t. Binary t => t -> Put
put Maybe (Event, Stmt)
x2
Stmt -> Put
forall t. Binary t => t -> Put
put Stmt
x3
InitProcessDecl x1 :: Stmt
x1 -> do Word8 -> Put
putWord8 6
Stmt -> Put
forall t. Binary t => t -> Put
put Stmt
x1
CommentDecl x1 :: Ident
x1 -> do Word8 -> Put
putWord8 7
Ident -> Put
forall t. Binary t => t -> Put
put Ident
x1
get :: Get Decl
get
= do Word8
i <- Get Word8
getWord8
case Word8
i of
0 -> do Ident
x1 <- Get Ident
forall t. Binary t => Get t
get
Maybe Range
x2 <- Get (Maybe Range)
forall t. Binary t => Get t
get
Maybe Expr
x3 <- Get (Maybe Expr)
forall t. Binary t => Get t
get
Decl -> Get Decl
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident -> Maybe Range -> Maybe Expr -> Decl
NetDecl Ident
x1 Maybe Range
x2 Maybe Expr
x3)
1 -> do Ident
x1 <- Get Ident
forall t. Binary t => Get t
get
Expr
x2 <- Get Expr
forall t. Binary t => Get t
get
Decl -> Get Decl
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident -> Expr -> Decl
NetAssign Ident
x1 Expr
x2)
2 -> do Ident
x1 <- Get Ident
forall t. Binary t => Get t
get
Maybe Range
x2 <- Get (Maybe Range)
forall t. Binary t => Get t
get
Maybe Range
x3 <- Get (Maybe Range)
forall t. Binary t => Get t
get
Maybe [Expr]
x4 <- Get (Maybe [Expr])
forall t. Binary t => Get t
get
Decl -> Get Decl
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident -> Maybe Range -> Maybe Range -> Maybe [Expr] -> Decl
MemDecl Ident
x1 Maybe Range
x2 Maybe Range
x3 Maybe [Expr]
x4)
3 -> do Ident
x1 <- Get Ident
forall t. Binary t => Get t
get
Expr
x2 <- Get Expr
forall t. Binary t => Get t
get
Expr
x3 <- Get Expr
forall t. Binary t => Get t
get
Decl -> Get Decl
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident -> Expr -> Expr -> Decl
MemAssign Ident
x1 Expr
x2 Expr
x3)
4 -> do Ident
x1 <- Get Ident
forall t. Binary t => Get t
get
Ident
x2 <- Get Ident
forall t. Binary t => Get t
get
[(Ident, Expr)]
x3 <- Get [(Ident, Expr)]
forall t. Binary t => Get t
get
[(Ident, Expr)]
x4 <- Get [(Ident, Expr)]
forall t. Binary t => Get t
get
[(Ident, Expr)]
x5 <- Get [(Ident, Expr)]
forall t. Binary t => Get t
get
Decl -> Get Decl
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident
-> Ident
-> [(Ident, Expr)]
-> [(Ident, Expr)]
-> [(Ident, Expr)]
-> Decl
InstDecl Ident
x1 Ident
x2 [(Ident, Expr)]
x3 [(Ident, Expr)]
x4 [(Ident, Expr)]
x5)
5 -> do Event
x1 <- Get Event
forall t. Binary t => Get t
get
Maybe (Event, Stmt)
x2 <- Get (Maybe (Event, Stmt))
forall t. Binary t => Get t
get
Stmt
x3 <- Get Stmt
forall t. Binary t => Get t
get
Decl -> Get Decl
forall (m :: * -> *) a. Monad m => a -> m a
return (Event -> Maybe (Event, Stmt) -> Stmt -> Decl
ProcessDecl Event
x1 Maybe (Event, Stmt)
x2 Stmt
x3)
6 -> do Stmt
x1 <- Get Stmt
forall t. Binary t => Get t
get
Decl -> Get Decl
forall (m :: * -> *) a. Monad m => a -> m a
return (Stmt -> Decl
InitProcessDecl Stmt
x1)
7 -> do Ident
x1 <- Get Ident
forall t. Binary t => Get t
get
Decl -> Get Decl
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident -> Decl
CommentDecl Ident
x1)
_ -> Ident -> Get Decl
forall a. HasCallStack => Ident -> a
error "Corrupted binary data for Decl"
instance Binary Range where
put :: Range -> Put
put (Range x1 :: Expr
x1 x2 :: Expr
x2)
= do Expr -> Put
forall t. Binary t => t -> Put
put Expr
x1
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x2
get :: Get Range
get
= do Expr
x1 <- Get Expr
forall t. Binary t => Get t
get
Expr
x2 <- Get Expr
forall t. Binary t => Get t
get
Range -> Get Range
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Expr -> Range
Range Expr
x1 Expr
x2)
instance Binary Event where
put :: Event -> Put
put (Event x1 :: Expr
x1 x2 :: Edge
x2)
= do Expr -> Put
forall t. Binary t => t -> Put
put Expr
x1
Edge -> Put
forall t. Binary t => t -> Put
put Edge
x2
get :: Get Event
get
= do Expr
x1 <- Get Expr
forall t. Binary t => Get t
get
Edge
x2 <- Get Edge
forall t. Binary t => Get t
get
Event -> Get Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Edge -> Event
Event Expr
x1 Edge
x2)
instance Binary Edge where
put :: Edge -> Put
put x :: Edge
x
= case Edge
x of
PosEdge -> Word8 -> Put
putWord8 0
NegEdge -> Word8 -> Put
putWord8 1
get :: Get Edge
get
= do Word8
i <- Get Word8
getWord8
case Word8
i of
0 -> Edge -> Get Edge
forall (m :: * -> *) a. Monad m => a -> m a
return Edge
PosEdge
1 -> Edge -> Get Edge
forall (m :: * -> *) a. Monad m => a -> m a
return Edge
NegEdge
_ -> Ident -> Get Edge
forall a. HasCallStack => Ident -> a
error "Corrupted binary data for Edge"
instance Binary Expr where
put :: Expr -> Put
put x :: Expr
x
= case Expr
x of
ExprLit x1 :: Maybe Int
x1 x2 :: ExprLit
x2 -> do Word8 -> Put
putWord8 0
Maybe Int -> Put
forall t. Binary t => t -> Put
put Maybe Int
x1
ExprLit -> Put
forall t. Binary t => t -> Put
put ExprLit
x2
ExprVar x1 :: Ident
x1 -> do Word8 -> Put
putWord8 1
Ident -> Put
forall t. Binary t => t -> Put
put Ident
x1
ExprString x1 :: Ident
x1 -> do Word8 -> Put
putWord8 2
Ident -> Put
forall t. Binary t => t -> Put
put Ident
x1
ExprIndex x1 :: Ident
x1 x2 :: Expr
x2 -> do Word8 -> Put
putWord8 3
Ident -> Put
forall t. Binary t => t -> Put
put Ident
x1
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x2
ExprSlice x1 :: Ident
x1 x2 :: Expr
x2 x3 :: Expr
x3 -> do Word8 -> Put
putWord8 4
Ident -> Put
forall t. Binary t => t -> Put
put Ident
x1
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x2
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x3
ExprSliceOff x1 :: Ident
x1 x2 :: Expr
x2 x3 :: Int
x3 -> do Word8 -> Put
putWord8 5
Ident -> Put
forall t. Binary t => t -> Put
put Ident
x1
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x2
Int -> Put
forall t. Binary t => t -> Put
put Int
x3
ExprCase x1 :: Expr
x1 x2 :: [([Expr], Expr)]
x2 x3 :: Maybe Expr
x3 -> do Word8 -> Put
putWord8 6
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x1
[([Expr], Expr)] -> Put
forall t. Binary t => t -> Put
put [([Expr], Expr)]
x2
Maybe Expr -> Put
forall t. Binary t => t -> Put
put Maybe Expr
x3
ExprConcat x1 :: [Expr]
x1 -> do Word8 -> Put
putWord8 7
[Expr] -> Put
forall t. Binary t => t -> Put
put [Expr]
x1
ExprCond x1 :: Expr
x1 x2 :: Expr
x2 x3 :: Expr
x3 -> do Word8 -> Put
putWord8 8
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x1
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x2
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x3
ExprUnary x1 :: UnaryOp
x1 x2 :: Expr
x2 -> do Word8 -> Put
putWord8 9
UnaryOp -> Put
forall t. Binary t => t -> Put
put UnaryOp
x1
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x2
ExprBinary x1 :: BinaryOp
x1 x2 :: Expr
x2 x3 :: Expr
x3 -> do Word8 -> Put
putWord8 10
BinaryOp -> Put
forall t. Binary t => t -> Put
put BinaryOp
x1
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x2
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x3
ExprFunCall x1 :: Ident
x1 x2 :: [Expr]
x2 -> do Word8 -> Put
putWord8 11
Ident -> Put
forall t. Binary t => t -> Put
put Ident
x1
[Expr] -> Put
forall t. Binary t => t -> Put
put [Expr]
x2
get :: Get Expr
get
= do Word8
i <- Get Word8
getWord8
case Word8
i of
0 -> do Maybe Int
x1 <- Get (Maybe Int)
forall t. Binary t => Get t
get
ExprLit
x2 <- Get ExprLit
forall t. Binary t => Get t
get
Expr -> Get Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> ExprLit -> Expr
ExprLit Maybe Int
x1 ExprLit
x2)
1 -> do Ident
x1 <- Get Ident
forall t. Binary t => Get t
get
Expr -> Get Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident -> Expr
ExprVar Ident
x1)
2 -> do Ident
x1 <- Get Ident
forall t. Binary t => Get t
get
Expr -> Get Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident -> Expr
ExprString Ident
x1)
3 -> do Ident
x1 <- Get Ident
forall t. Binary t => Get t
get
Expr
x2 <- Get Expr
forall t. Binary t => Get t
get
Expr -> Get Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident -> Expr -> Expr
ExprIndex Ident
x1 Expr
x2)
4 -> do Ident
x1 <- Get Ident
forall t. Binary t => Get t
get
Expr
x2 <- Get Expr
forall t. Binary t => Get t
get
Expr
x3 <- Get Expr
forall t. Binary t => Get t
get
Expr -> Get Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident -> Expr -> Expr -> Expr
ExprSlice Ident
x1 Expr
x2 Expr
x3)
5 -> do Ident
x1 <- Get Ident
forall t. Binary t => Get t
get
Expr
x2 <- Get Expr
forall t. Binary t => Get t
get
Int
x3 <- Get Int
forall t. Binary t => Get t
get
Expr -> Get Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident -> Expr -> Int -> Expr
ExprSliceOff Ident
x1 Expr
x2 Int
x3)
6 -> do Expr
x1 <- Get Expr
forall t. Binary t => Get t
get
[([Expr], Expr)]
x2 <- Get [([Expr], Expr)]
forall t. Binary t => Get t
get
Maybe Expr
x3 <- Get (Maybe Expr)
forall t. Binary t => Get t
get
Expr -> Get Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> [([Expr], Expr)] -> Maybe Expr -> Expr
ExprCase Expr
x1 [([Expr], Expr)]
x2 Maybe Expr
x3)
7 -> do [Expr]
x1 <- Get [Expr]
forall t. Binary t => Get t
get
Expr -> Get Expr
forall (m :: * -> *) a. Monad m => a -> m a
return ([Expr] -> Expr
ExprConcat [Expr]
x1)
8 -> do Expr
x1 <- Get Expr
forall t. Binary t => Get t
get
Expr
x2 <- Get Expr
forall t. Binary t => Get t
get
Expr
x3 <- Get Expr
forall t. Binary t => Get t
get
Expr -> Get Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Expr -> Expr -> Expr
ExprCond Expr
x1 Expr
x2 Expr
x3)
9 -> do UnaryOp
x1 <- Get UnaryOp
forall t. Binary t => Get t
get
Expr
x2 <- Get Expr
forall t. Binary t => Get t
get
Expr -> Get Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (UnaryOp -> Expr -> Expr
ExprUnary UnaryOp
x1 Expr
x2)
10 -> do BinaryOp
x1 <- Get BinaryOp
forall t. Binary t => Get t
get
Expr
x2 <- Get Expr
forall t. Binary t => Get t
get
Expr
x3 <- Get Expr
forall t. Binary t => Get t
get
Expr -> Get Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (BinaryOp -> Expr -> Expr -> Expr
ExprBinary BinaryOp
x1 Expr
x2 Expr
x3)
11 -> do Ident
x1 <- Get Ident
forall t. Binary t => Get t
get
[Expr]
x2 <- Get [Expr]
forall t. Binary t => Get t
get
Expr -> Get Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident -> [Expr] -> Expr
ExprFunCall Ident
x1 [Expr]
x2)
_ -> Ident -> Get Expr
forall a. HasCallStack => Ident -> a
error "Corrupted binary data for Expr"
instance Binary ExprLit where
put :: ExprLit -> Put
put x :: ExprLit
x
= case ExprLit
x of
ExprNum x1 :: Integer
x1 -> do Word8 -> Put
putWord8 0
Integer -> Put
forall t. Binary t => t -> Put
put Integer
x1
ExprBit x1 :: Bit
x1 -> do Word8 -> Put
putWord8 1
Bit -> Put
forall t. Binary t => t -> Put
put Bit
x1
ExprBitVector x1 :: [Bit]
x1 -> do Word8 -> Put
putWord8 2
[Bit] -> Put
forall t. Binary t => t -> Put
put [Bit]
x1
get :: Get ExprLit
get
= do Word8
i <- Get Word8
getWord8
case Word8
i of
0 -> do Integer
x1 <- Get Integer
forall t. Binary t => Get t
get
ExprLit -> Get ExprLit
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> ExprLit
ExprNum Integer
x1)
1 -> do Bit
x1 <- Get Bit
forall t. Binary t => Get t
get
ExprLit -> Get ExprLit
forall (m :: * -> *) a. Monad m => a -> m a
return (Bit -> ExprLit
ExprBit Bit
x1)
2 -> do [Bit]
x1 <- Get [Bit]
forall t. Binary t => Get t
get
ExprLit -> Get ExprLit
forall (m :: * -> *) a. Monad m => a -> m a
return ([Bit] -> ExprLit
ExprBitVector [Bit]
x1)
_ -> Ident -> Get ExprLit
forall a. HasCallStack => Ident -> a
error "Corrupted binary data for ExprLit"
instance Binary Bit where
put :: Bit -> Put
put x :: Bit
x
= case Bit
x of
T -> Word8 -> Put
putWord8 0
F -> Word8 -> Put
putWord8 1
U -> Word8 -> Put
putWord8 2
Z -> Word8 -> Put
putWord8 3
get :: Get Bit
get
= do Word8
i <- Get Word8
getWord8
case Word8
i of
0 -> Bit -> Get Bit
forall (m :: * -> *) a. Monad m => a -> m a
return Bit
T
1 -> Bit -> Get Bit
forall (m :: * -> *) a. Monad m => a -> m a
return Bit
F
2 -> Bit -> Get Bit
forall (m :: * -> *) a. Monad m => a -> m a
return Bit
U
3 -> Bit -> Get Bit
forall (m :: * -> *) a. Monad m => a -> m a
return Bit
Z
_ -> Ident -> Get Bit
forall a. HasCallStack => Ident -> a
error "Corrupted binary data for Bit"
instance Binary Stmt where
put :: Stmt -> Put
put x :: Stmt
x
= case Stmt
x of
Assign x1 :: Expr
x1 x2 :: Expr
x2 -> do Word8 -> Put
putWord8 0
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x1
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x2
If x1 :: Expr
x1 x2 :: Stmt
x2 x3 :: Maybe Stmt
x3 -> do Word8 -> Put
putWord8 1
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x1
Stmt -> Put
forall t. Binary t => t -> Put
put Stmt
x2
Maybe Stmt -> Put
forall t. Binary t => t -> Put
put Maybe Stmt
x3
Case x1 :: Expr
x1 x2 :: [([Expr], Stmt)]
x2 x3 :: Maybe Stmt
x3 -> do Word8 -> Put
putWord8 2
Expr -> Put
forall t. Binary t => t -> Put
put Expr
x1
[([Expr], Stmt)] -> Put
forall t. Binary t => t -> Put
put [([Expr], Stmt)]
x2
Maybe Stmt -> Put
forall t. Binary t => t -> Put
put Maybe Stmt
x3
Seq x1 :: [Stmt]
x1 -> do Word8 -> Put
putWord8 3
[Stmt] -> Put
forall t. Binary t => t -> Put
put [Stmt]
x1
FunCallStmt x1 :: Ident
x1 x2 :: [Expr]
x2 -> do Word8 -> Put
putWord8 4
Ident -> Put
forall t. Binary t => t -> Put
put Ident
x1
[Expr] -> Put
forall t. Binary t => t -> Put
put [Expr]
x2
get :: Get Stmt
get
= do Word8
i <- Get Word8
getWord8
case Word8
i of
0 -> do Expr
x1 <- Get Expr
forall t. Binary t => Get t
get
Expr
x2 <- Get Expr
forall t. Binary t => Get t
get
Stmt -> Get Stmt
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Expr -> Stmt
Assign Expr
x1 Expr
x2)
1 -> do Expr
x1 <- Get Expr
forall t. Binary t => Get t
get
Stmt
x2 <- Get Stmt
forall t. Binary t => Get t
get
Maybe Stmt
x3 <- Get (Maybe Stmt)
forall t. Binary t => Get t
get
Stmt -> Get Stmt
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Stmt -> Maybe Stmt -> Stmt
If Expr
x1 Stmt
x2 Maybe Stmt
x3)
2 -> do Expr
x1 <- Get Expr
forall t. Binary t => Get t
get
[([Expr], Stmt)]
x2 <- Get [([Expr], Stmt)]
forall t. Binary t => Get t
get
Maybe Stmt
x3 <- Get (Maybe Stmt)
forall t. Binary t => Get t
get
Stmt -> Get Stmt
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> [([Expr], Stmt)] -> Maybe Stmt -> Stmt
Case Expr
x1 [([Expr], Stmt)]
x2 Maybe Stmt
x3)
3 -> do [Stmt]
x1 <- Get [Stmt]
forall t. Binary t => Get t
get
Stmt -> Get Stmt
forall (m :: * -> *) a. Monad m => a -> m a
return ([Stmt] -> Stmt
Seq [Stmt]
x1)
4 -> do Ident
x1 <- Get Ident
forall t. Binary t => Get t
get
[Expr]
x2 <- Get [Expr]
forall t. Binary t => Get t
get
Stmt -> Get Stmt
forall (m :: * -> *) a. Monad m => a -> m a
return (Ident -> [Expr] -> Stmt
FunCallStmt Ident
x1 [Expr]
x2)
_ -> Ident -> Get Stmt
forall a. HasCallStack => Ident -> a
error "Corrupted binary data for Stmt"
instance Binary UnaryOp where
put :: UnaryOp -> Put
put x :: UnaryOp
x
= case UnaryOp
x of
UPlus -> Word8 -> Put
putWord8 0
UMinus -> Word8 -> Put
putWord8 1
LNeg -> Word8 -> Put
putWord8 2
Neg -> Word8 -> Put
putWord8 3
UAnd -> Word8 -> Put
putWord8 4
UNand -> Word8 -> Put
putWord8 5
UOr -> Word8 -> Put
putWord8 6
UNor -> Word8 -> Put
putWord8 7
UXor -> Word8 -> Put
putWord8 8
UXnor -> Word8 -> Put
putWord8 9
get :: Get UnaryOp
get
= do Word8
i <- Get Word8
getWord8
case Word8
i of
0 -> UnaryOp -> Get UnaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return UnaryOp
UPlus
1 -> UnaryOp -> Get UnaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return UnaryOp
UMinus
2 -> UnaryOp -> Get UnaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return UnaryOp
LNeg
3 -> UnaryOp -> Get UnaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return UnaryOp
Neg
4 -> UnaryOp -> Get UnaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return UnaryOp
UAnd
5 -> UnaryOp -> Get UnaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return UnaryOp
UNand
6 -> UnaryOp -> Get UnaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return UnaryOp
UOr
7 -> UnaryOp -> Get UnaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return UnaryOp
UNor
8 -> UnaryOp -> Get UnaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return UnaryOp
UXor
9 -> UnaryOp -> Get UnaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return UnaryOp
UXnor
_ -> Ident -> Get UnaryOp
forall a. HasCallStack => Ident -> a
error "Corrupted binary data for UnaryOp"
instance Binary BinaryOp where
put :: BinaryOp -> Put
put x :: BinaryOp
x
= case BinaryOp
x of
Pow -> Word8 -> Put
putWord8 0
Plus -> Word8 -> Put
putWord8 1
Minus -> Word8 -> Put
putWord8 2
Times -> Word8 -> Put
putWord8 3
Divide -> Word8 -> Put
putWord8 4
Modulo -> Word8 -> Put
putWord8 5
Equals -> Word8 -> Put
putWord8 6
NotEquals -> Word8 -> Put
putWord8 7
CEquals -> Word8 -> Put
putWord8 8
CNotEquals -> Word8 -> Put
putWord8 9
LAnd -> Word8 -> Put
putWord8 10
LOr -> Word8 -> Put
putWord8 11
LessThan -> Word8 -> Put
putWord8 12
LessEqual -> Word8 -> Put
putWord8 13
GreaterThan -> Word8 -> Put
putWord8 14
GreaterEqual -> Word8 -> Put
putWord8 15
And -> Word8 -> Put
putWord8 16
Nand -> Word8 -> Put
putWord8 17
Or -> Word8 -> Put
putWord8 18
Nor -> Word8 -> Put
putWord8 19
Xor -> Word8 -> Put
putWord8 20
Xnor -> Word8 -> Put
putWord8 21
ShiftLeft -> Word8 -> Put
putWord8 22
ShiftRight -> Word8 -> Put
putWord8 23
RotateLeft -> Word8 -> Put
putWord8 24
RotateRight -> Word8 -> Put
putWord8 25
ShiftLeftArith -> Word8 -> Put
putWord8 26
ShiftRightArith -> Word8 -> Put
putWord8 27
get :: Get BinaryOp
get
= do Word8
i <- Get Word8
getWord8
case Word8
i of
0 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
Pow
1 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
Plus
2 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
Minus
3 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
Times
4 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
Divide
5 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
Modulo
6 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
Equals
7 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
NotEquals
8 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
CEquals
9 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
CNotEquals
10 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
LAnd
11 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
LOr
12 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
LessThan
13 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
LessEqual
14 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
GreaterThan
15 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
GreaterEqual
16 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
And
17 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
Nand
18 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
Or
19 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
Nor
20 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
Xor
21 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
Xnor
22 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
ShiftLeft
23 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
ShiftRight
24 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
RotateLeft
25 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
RotateRight
26 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
ShiftLeftArith
27 -> BinaryOp -> Get BinaryOp
forall (m :: * -> *) a. Monad m => a -> m a
return BinaryOp
ShiftRightArith
_ -> Ident -> Get BinaryOp
forall a. HasCallStack => Ident -> a
error "Corrupted binary data for BinaryOp"