module Morley.Michelson.Macro
(
CadrStruct (..)
, PairStruct (..)
, UnpairStruct (..)
, Macro (..)
, ParsedValue
, ParsedInstr
, ParsedOp (..)
, ParsedUExtInstr
, expandContract
, expandValue
, mapPairLeaves
, expand
, expandList
, expandMacro
, expandPapair
, expandUnpapair
, expandCadr
, expandSetCadr
, expandMapCadr
) where
import Data.Aeson.TH (deriveJSON)
import Data.Data (Data(..))
import Fmt (Buildable(build), GenericBuildable(..), (+|), (|+))
import Morley.Michelson.ErrorPos
import Morley.Michelson.Printer (RenderDoc(..))
import Morley.Michelson.Untyped
import Morley.Util.Aeson
data PairStruct
= F FieldAnn
| P PairStruct PairStruct
deriving stock (PairStruct -> PairStruct -> Bool
(PairStruct -> PairStruct -> Bool)
-> (PairStruct -> PairStruct -> Bool) -> Eq PairStruct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PairStruct -> PairStruct -> Bool
$c/= :: PairStruct -> PairStruct -> Bool
== :: PairStruct -> PairStruct -> Bool
$c== :: PairStruct -> PairStruct -> Bool
Eq, Int -> PairStruct -> ShowS
[PairStruct] -> ShowS
PairStruct -> String
(Int -> PairStruct -> ShowS)
-> (PairStruct -> String)
-> ([PairStruct] -> ShowS)
-> Show PairStruct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PairStruct] -> ShowS
$cshowList :: [PairStruct] -> ShowS
show :: PairStruct -> String
$cshow :: PairStruct -> String
showsPrec :: Int -> PairStruct -> ShowS
$cshowsPrec :: Int -> PairStruct -> ShowS
Show, Typeable PairStruct
Typeable PairStruct
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PairStruct -> c PairStruct)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PairStruct)
-> (PairStruct -> Constr)
-> (PairStruct -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PairStruct))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PairStruct))
-> ((forall b. Data b => b -> b) -> PairStruct -> PairStruct)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PairStruct -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PairStruct -> r)
-> (forall u. (forall d. Data d => d -> u) -> PairStruct -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> PairStruct -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PairStruct -> m PairStruct)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PairStruct -> m PairStruct)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PairStruct -> m PairStruct)
-> Data PairStruct
PairStruct -> DataType
PairStruct -> Constr
(forall b. Data b => b -> b) -> PairStruct -> PairStruct
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) -> PairStruct -> u
forall u. (forall d. Data d => d -> u) -> PairStruct -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PairStruct -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PairStruct -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PairStruct -> m PairStruct
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PairStruct -> m PairStruct
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PairStruct
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PairStruct -> c PairStruct
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PairStruct)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PairStruct)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PairStruct -> m PairStruct
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PairStruct -> m PairStruct
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PairStruct -> m PairStruct
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PairStruct -> m PairStruct
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PairStruct -> m PairStruct
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PairStruct -> m PairStruct
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PairStruct -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PairStruct -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PairStruct -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PairStruct -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PairStruct -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PairStruct -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PairStruct -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PairStruct -> r
gmapT :: (forall b. Data b => b -> b) -> PairStruct -> PairStruct
$cgmapT :: (forall b. Data b => b -> b) -> PairStruct -> PairStruct
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PairStruct)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PairStruct)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PairStruct)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PairStruct)
dataTypeOf :: PairStruct -> DataType
$cdataTypeOf :: PairStruct -> DataType
toConstr :: PairStruct -> Constr
$ctoConstr :: PairStruct -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PairStruct
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PairStruct
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PairStruct -> c PairStruct
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PairStruct -> c PairStruct
Data, (forall x. PairStruct -> Rep PairStruct x)
-> (forall x. Rep PairStruct x -> PairStruct) -> Generic PairStruct
forall x. Rep PairStruct x -> PairStruct
forall x. PairStruct -> Rep PairStruct x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PairStruct x -> PairStruct
$cfrom :: forall x. PairStruct -> Rep PairStruct x
Generic)
deriving PairStruct -> Builder
(PairStruct -> Builder) -> Buildable PairStruct
forall p. (p -> Builder) -> Buildable p
build :: PairStruct -> Builder
$cbuild :: PairStruct -> Builder
Buildable via GenericBuildable PairStruct
instance NFData PairStruct
data UnpairStruct
= UF
| UP UnpairStruct UnpairStruct
deriving stock (UnpairStruct -> UnpairStruct -> Bool
(UnpairStruct -> UnpairStruct -> Bool)
-> (UnpairStruct -> UnpairStruct -> Bool) -> Eq UnpairStruct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnpairStruct -> UnpairStruct -> Bool
$c/= :: UnpairStruct -> UnpairStruct -> Bool
== :: UnpairStruct -> UnpairStruct -> Bool
$c== :: UnpairStruct -> UnpairStruct -> Bool
Eq, Int -> UnpairStruct -> ShowS
[UnpairStruct] -> ShowS
UnpairStruct -> String
(Int -> UnpairStruct -> ShowS)
-> (UnpairStruct -> String)
-> ([UnpairStruct] -> ShowS)
-> Show UnpairStruct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnpairStruct] -> ShowS
$cshowList :: [UnpairStruct] -> ShowS
show :: UnpairStruct -> String
$cshow :: UnpairStruct -> String
showsPrec :: Int -> UnpairStruct -> ShowS
$cshowsPrec :: Int -> UnpairStruct -> ShowS
Show, Typeable UnpairStruct
Typeable UnpairStruct
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnpairStruct -> c UnpairStruct)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnpairStruct)
-> (UnpairStruct -> Constr)
-> (UnpairStruct -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnpairStruct))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UnpairStruct))
-> ((forall b. Data b => b -> b) -> UnpairStruct -> UnpairStruct)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnpairStruct -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnpairStruct -> r)
-> (forall u. (forall d. Data d => d -> u) -> UnpairStruct -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> UnpairStruct -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct)
-> Data UnpairStruct
UnpairStruct -> DataType
UnpairStruct -> Constr
(forall b. Data b => b -> b) -> UnpairStruct -> UnpairStruct
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) -> UnpairStruct -> u
forall u. (forall d. Data d => d -> u) -> UnpairStruct -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnpairStruct -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnpairStruct -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnpairStruct
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnpairStruct -> c UnpairStruct
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnpairStruct)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UnpairStruct)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UnpairStruct -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UnpairStruct -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> UnpairStruct -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UnpairStruct -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnpairStruct -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnpairStruct -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnpairStruct -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnpairStruct -> r
gmapT :: (forall b. Data b => b -> b) -> UnpairStruct -> UnpairStruct
$cgmapT :: (forall b. Data b => b -> b) -> UnpairStruct -> UnpairStruct
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UnpairStruct)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UnpairStruct)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnpairStruct)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnpairStruct)
dataTypeOf :: UnpairStruct -> DataType
$cdataTypeOf :: UnpairStruct -> DataType
toConstr :: UnpairStruct -> Constr
$ctoConstr :: UnpairStruct -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnpairStruct
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnpairStruct
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnpairStruct -> c UnpairStruct
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnpairStruct -> c UnpairStruct
Data, (forall x. UnpairStruct -> Rep UnpairStruct x)
-> (forall x. Rep UnpairStruct x -> UnpairStruct)
-> Generic UnpairStruct
forall x. Rep UnpairStruct x -> UnpairStruct
forall x. UnpairStruct -> Rep UnpairStruct x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnpairStruct x -> UnpairStruct
$cfrom :: forall x. UnpairStruct -> Rep UnpairStruct x
Generic)
deriving UnpairStruct -> Builder
(UnpairStruct -> Builder) -> Buildable UnpairStruct
forall p. (p -> Builder) -> Buildable p
build :: UnpairStruct -> Builder
$cbuild :: UnpairStruct -> Builder
Buildable via GenericBuildable UnpairStruct
instance NFData UnpairStruct
data CadrStruct
= A
| D
deriving stock (CadrStruct -> CadrStruct -> Bool
(CadrStruct -> CadrStruct -> Bool)
-> (CadrStruct -> CadrStruct -> Bool) -> Eq CadrStruct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CadrStruct -> CadrStruct -> Bool
$c/= :: CadrStruct -> CadrStruct -> Bool
== :: CadrStruct -> CadrStruct -> Bool
$c== :: CadrStruct -> CadrStruct -> Bool
Eq, Int -> CadrStruct -> ShowS
[CadrStruct] -> ShowS
CadrStruct -> String
(Int -> CadrStruct -> ShowS)
-> (CadrStruct -> String)
-> ([CadrStruct] -> ShowS)
-> Show CadrStruct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CadrStruct] -> ShowS
$cshowList :: [CadrStruct] -> ShowS
show :: CadrStruct -> String
$cshow :: CadrStruct -> String
showsPrec :: Int -> CadrStruct -> ShowS
$cshowsPrec :: Int -> CadrStruct -> ShowS
Show, Typeable CadrStruct
Typeable CadrStruct
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CadrStruct -> c CadrStruct)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CadrStruct)
-> (CadrStruct -> Constr)
-> (CadrStruct -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CadrStruct))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CadrStruct))
-> ((forall b. Data b => b -> b) -> CadrStruct -> CadrStruct)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CadrStruct -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CadrStruct -> r)
-> (forall u. (forall d. Data d => d -> u) -> CadrStruct -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> CadrStruct -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct)
-> Data CadrStruct
CadrStruct -> DataType
CadrStruct -> Constr
(forall b. Data b => b -> b) -> CadrStruct -> CadrStruct
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) -> CadrStruct -> u
forall u. (forall d. Data d => d -> u) -> CadrStruct -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CadrStruct -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CadrStruct -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CadrStruct
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CadrStruct -> c CadrStruct
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CadrStruct)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CadrStruct)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CadrStruct -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CadrStruct -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> CadrStruct -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CadrStruct -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CadrStruct -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CadrStruct -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CadrStruct -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CadrStruct -> r
gmapT :: (forall b. Data b => b -> b) -> CadrStruct -> CadrStruct
$cgmapT :: (forall b. Data b => b -> b) -> CadrStruct -> CadrStruct
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CadrStruct)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CadrStruct)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CadrStruct)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CadrStruct)
dataTypeOf :: CadrStruct -> DataType
$cdataTypeOf :: CadrStruct -> DataType
toConstr :: CadrStruct -> Constr
$ctoConstr :: CadrStruct -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CadrStruct
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CadrStruct
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CadrStruct -> c CadrStruct
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CadrStruct -> c CadrStruct
Data, (forall x. CadrStruct -> Rep CadrStruct x)
-> (forall x. Rep CadrStruct x -> CadrStruct) -> Generic CadrStruct
forall x. Rep CadrStruct x -> CadrStruct
forall x. CadrStruct -> Rep CadrStruct x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CadrStruct x -> CadrStruct
$cfrom :: forall x. CadrStruct -> Rep CadrStruct x
Generic)
deriving CadrStruct -> Builder
(CadrStruct -> Builder) -> Buildable CadrStruct
forall p. (p -> Builder) -> Buildable p
build :: CadrStruct -> Builder
$cbuild :: CadrStruct -> Builder
Buildable via GenericBuildable CadrStruct
instance NFData CadrStruct
data ParsedOp
= Prim ParsedInstr SrcPos
| Mac Macro SrcPos
| Seq [ParsedOp] SrcPos
deriving stock (ParsedOp -> ParsedOp -> Bool
(ParsedOp -> ParsedOp -> Bool)
-> (ParsedOp -> ParsedOp -> Bool) -> Eq ParsedOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParsedOp -> ParsedOp -> Bool
$c/= :: ParsedOp -> ParsedOp -> Bool
== :: ParsedOp -> ParsedOp -> Bool
$c== :: ParsedOp -> ParsedOp -> Bool
Eq, Int -> ParsedOp -> ShowS
[ParsedOp] -> ShowS
ParsedOp -> String
(Int -> ParsedOp -> ShowS)
-> (ParsedOp -> String) -> ([ParsedOp] -> ShowS) -> Show ParsedOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParsedOp] -> ShowS
$cshowList :: [ParsedOp] -> ShowS
show :: ParsedOp -> String
$cshow :: ParsedOp -> String
showsPrec :: Int -> ParsedOp -> ShowS
$cshowsPrec :: Int -> ParsedOp -> ShowS
Show, Typeable ParsedOp
Typeable ParsedOp
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsedOp -> c ParsedOp)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParsedOp)
-> (ParsedOp -> Constr)
-> (ParsedOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParsedOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ParsedOp))
-> ((forall b. Data b => b -> b) -> ParsedOp -> ParsedOp)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedOp -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> ParsedOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ParsedOp -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp)
-> Data ParsedOp
ParsedOp -> DataType
ParsedOp -> Constr
(forall b. Data b => b -> b) -> ParsedOp -> ParsedOp
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) -> ParsedOp -> u
forall u. (forall d. Data d => d -> u) -> ParsedOp -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedOp -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParsedOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsedOp -> c ParsedOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParsedOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ParsedOp)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParsedOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParsedOp -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ParsedOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ParsedOp -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedOp -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedOp -> r
gmapT :: (forall b. Data b => b -> b) -> ParsedOp -> ParsedOp
$cgmapT :: (forall b. Data b => b -> b) -> ParsedOp -> ParsedOp
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ParsedOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ParsedOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParsedOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParsedOp)
dataTypeOf :: ParsedOp -> DataType
$cdataTypeOf :: ParsedOp -> DataType
toConstr :: ParsedOp -> Constr
$ctoConstr :: ParsedOp -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParsedOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParsedOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsedOp -> c ParsedOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsedOp -> c ParsedOp
Data, (forall x. ParsedOp -> Rep ParsedOp x)
-> (forall x. Rep ParsedOp x -> ParsedOp) -> Generic ParsedOp
forall x. Rep ParsedOp x -> ParsedOp
forall x. ParsedOp -> Rep ParsedOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParsedOp x -> ParsedOp
$cfrom :: forall x. ParsedOp -> Rep ParsedOp x
Generic)
instance RenderDoc ParsedOp where
renderDoc :: RenderContext -> ParsedOp -> Doc
renderDoc RenderContext
pn ParsedOp
parsedOp = RenderContext -> ExpandedOp -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
pn (ExpandedOp -> Doc) -> ExpandedOp -> Doc
forall a b. (a -> b) -> a -> b
$ ParsedOp -> ExpandedOp
expand ParsedOp
parsedOp
instance Buildable ParsedOp where
build :: ParsedOp -> Builder
build = \case
Prim ParsedInstr
parseInstr SrcPos
_ -> Builder
"<Prim: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|ParsedInstr
parseInstrParsedInstr -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
Mac Macro
macro SrcPos
_ -> Builder
"<Mac: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|Macro
macroMacro -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
Seq [ParsedOp]
parsedOps SrcPos
_ -> Builder
"<Seq: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
instance NFData ParsedOp
type ParsedUExtInstr = ExtInstrAbstract ParsedOp
type ParsedInstr = InstrAbstract ParsedOp
type ParsedValue = Value' ParsedOp
data Macro
= CMP ParsedInstr VarAnn
| IFX ParsedInstr [ParsedOp] [ParsedOp]
| IFCMP ParsedInstr VarAnn [ParsedOp] [ParsedOp]
| FAIL
| PAPAIR PairStruct TypeAnn VarAnn
| UNPAPAIR UnpairStruct
| CADR [CadrStruct] VarAnn FieldAnn
| CARN VarAnn Word
| CDRN VarAnn Word
| SET_CADR [CadrStruct] VarAnn FieldAnn
| MAP_CADR [CadrStruct] VarAnn FieldAnn [ParsedOp]
| DIIP Word [ParsedOp]
| DUUP Word VarAnn
| ASSERT
| ASSERTX ParsedInstr
| ASSERT_CMP ParsedInstr
| ASSERT_NONE
| ASSERT_SOME
| ASSERT_LEFT
| ASSERT_RIGHT
| IF_SOME [ParsedOp] [ParsedOp]
| IF_RIGHT [ParsedOp] [ParsedOp]
deriving stock (Macro -> Macro -> Bool
(Macro -> Macro -> Bool) -> (Macro -> Macro -> Bool) -> Eq Macro
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Macro -> Macro -> Bool
$c/= :: Macro -> Macro -> Bool
== :: Macro -> Macro -> Bool
$c== :: Macro -> Macro -> Bool
Eq, Int -> Macro -> ShowS
[Macro] -> ShowS
Macro -> String
(Int -> Macro -> ShowS)
-> (Macro -> String) -> ([Macro] -> ShowS) -> Show Macro
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Macro] -> ShowS
$cshowList :: [Macro] -> ShowS
show :: Macro -> String
$cshow :: Macro -> String
showsPrec :: Int -> Macro -> ShowS
$cshowsPrec :: Int -> Macro -> ShowS
Show, Typeable Macro
Typeable Macro
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Macro -> c Macro)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Macro)
-> (Macro -> Constr)
-> (Macro -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Macro))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Macro))
-> ((forall b. Data b => b -> b) -> Macro -> Macro)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Macro -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Macro -> r)
-> (forall u. (forall d. Data d => d -> u) -> Macro -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Macro -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Macro -> m Macro)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Macro -> m Macro)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Macro -> m Macro)
-> Data Macro
Macro -> DataType
Macro -> Constr
(forall b. Data b => b -> b) -> Macro -> Macro
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) -> Macro -> u
forall u. (forall d. Data d => d -> u) -> Macro -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Macro -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Macro -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Macro -> m Macro
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Macro -> m Macro
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Macro
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Macro -> c Macro
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Macro)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Macro)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Macro -> m Macro
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Macro -> m Macro
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Macro -> m Macro
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Macro -> m Macro
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Macro -> m Macro
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Macro -> m Macro
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Macro -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Macro -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Macro -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Macro -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Macro -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Macro -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Macro -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Macro -> r
gmapT :: (forall b. Data b => b -> b) -> Macro -> Macro
$cgmapT :: (forall b. Data b => b -> b) -> Macro -> Macro
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Macro)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Macro)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Macro)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Macro)
dataTypeOf :: Macro -> DataType
$cdataTypeOf :: Macro -> DataType
toConstr :: Macro -> Constr
$ctoConstr :: Macro -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Macro
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Macro
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Macro -> c Macro
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Macro -> c Macro
Data, (forall x. Macro -> Rep Macro x)
-> (forall x. Rep Macro x -> Macro) -> Generic Macro
forall x. Rep Macro x -> Macro
forall x. Macro -> Rep Macro x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Macro x -> Macro
$cfrom :: forall x. Macro -> Rep Macro x
Generic)
instance Buildable Macro where
build :: Macro -> Builder
build = \case
CMP ParsedInstr
parsedInstr VarAnn
carAnn -> Builder
"<CMP: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|ParsedInstr
parsedInstrParsedInstr -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|VarAnn
carAnnVarAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
IFX ParsedInstr
parsedInstr [ParsedOp]
parsedOps1 [ParsedOp]
parsedOps2 -> Builder
"<IFX: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|ParsedInstr
parsedInstrParsedInstr -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps1[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps2[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
IFCMP ParsedInstr
parsedInstr VarAnn
varAnn [ParsedOp]
parsedOps1 [ParsedOp]
parsedOps2 -> Builder
"<IFCMP: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|ParsedInstr
parsedInstrParsedInstr -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|VarAnn
varAnnVarAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps1[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps2[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
Macro
FAIL -> Builder
"FAIL"
PAPAIR PairStruct
pairStruct TypeAnn
typeAnn VarAnn
varAnn -> Builder
"<PAPAIR: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|PairStruct
pairStructPairStruct -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|TypeAnn
typeAnnTypeAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|VarAnn
varAnnVarAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
UNPAPAIR UnpairStruct
pairStruct -> Builder
"<UNPAPAIR: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|UnpairStruct
pairStructUnpairStruct -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
CADR [CadrStruct]
cadrStructs VarAnn
varAnn FieldAnn
fieldAnn -> Builder
"<CADR: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[CadrStruct]
cadrStructs[CadrStruct] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|VarAnn
varAnnVarAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|FieldAnn
fieldAnnFieldAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
CARN VarAnn
varAnn Word
idx -> Builder
"<CAR: #"Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|Word
idxWord -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
","Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|VarAnn
varAnnVarAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
CDRN VarAnn
varAnn Word
idx -> Builder
"<CDR: #"Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|Word
idxWord -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
","Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|VarAnn
varAnnVarAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
SET_CADR [CadrStruct]
cadrStructs VarAnn
varAnn FieldAnn
fieldAnn -> Builder
"<SET_CADR: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[CadrStruct]
cadrStructs[CadrStruct] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|VarAnn
varAnnVarAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|FieldAnn
fieldAnnFieldAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
MAP_CADR [CadrStruct]
cadrStructs VarAnn
varAnn FieldAnn
fieldAnn [ParsedOp]
parsedOps -> Builder
"<MAP_CADR: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[CadrStruct]
cadrStructs[CadrStruct] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|VarAnn
varAnnVarAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|FieldAnn
fieldAnnFieldAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
DIIP Word
integer [ParsedOp]
parsedOps -> Builder
"<DIIP: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|Word
integerWord -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
DUUP Word
integer VarAnn
varAnn -> Builder
"<DUUP: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|Word
integerWord -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|VarAnn
varAnnVarAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
Macro
ASSERT -> Builder
"ASSERT"
ASSERTX ParsedInstr
parsedInstr -> Builder
"<ASSERTX: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|ParsedInstr
parsedInstrParsedInstr -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
ASSERT_CMP ParsedInstr
parsedInstr -> Builder
"<ASSERT_CMP: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|ParsedInstr
parsedInstrParsedInstr -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
Macro
ASSERT_NONE -> Builder
"ASSERT_NONE"
Macro
ASSERT_SOME -> Builder
"ASSERT_SOME"
Macro
ASSERT_LEFT -> Builder
"ASSERT_LEFT"
Macro
ASSERT_RIGHT -> Builder
"ASSERT_RIGHT"
IF_SOME [ParsedOp]
parsedOps1 [ParsedOp]
parsedOps2 -> Builder
"<IF_SOME: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps1[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps2[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
IF_RIGHT [ParsedOp]
parsedOps1 [ParsedOp]
parsedOps2 -> Builder
"<IF_RIGHT: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps1[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps2[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
instance NFData Macro
expandList :: [ParsedOp] -> [ExpandedOp]
expandList :: [ParsedOp] -> [ExpandedOp]
expandList = (ParsedOp -> ExpandedOp) -> [ParsedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedOp -> ExpandedOp
expand
expandView :: View' ParsedOp -> View
expandView :: View' ParsedOp -> View
expandView View' ParsedOp
v = View' ParsedOp
v{ viewCode :: [ExpandedOp]
viewCode = [ParsedOp] -> [ExpandedOp]
expandList (View' ParsedOp -> [ParsedOp]
forall op. View' op -> [op]
viewCode View' ParsedOp
v) }
expandContract :: Contract' ParsedOp -> Contract
expandContract :: Contract' ParsedOp -> Contract
expandContract Contract' ParsedOp
contract =
Contract' ParsedOp
contract
{ contractCode :: [ExpandedOp]
contractCode = [ParsedOp] -> [ExpandedOp]
expandList (Contract' ParsedOp -> [ParsedOp]
forall op. Contract' op -> [op]
contractCode Contract' ParsedOp
contract)
, contractViews :: [View]
contractViews = View' ParsedOp -> View
expandView (View' ParsedOp -> View) -> [View' ParsedOp] -> [View]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Contract' ParsedOp -> [View' ParsedOp]
forall op. Contract' op -> [View' op]
contractViews Contract' ParsedOp
contract
}
expandValue :: ParsedValue -> Value
expandValue :: ParsedValue -> Value
expandValue = \case
ValuePair ParsedValue
l ParsedValue
r -> Value -> Value -> Value
forall op. Value' op -> Value' op -> Value' op
ValuePair (ParsedValue -> Value
expandValue ParsedValue
l) (ParsedValue -> Value
expandValue ParsedValue
r)
ValueLeft ParsedValue
x -> Value -> Value
forall op. Value' op -> Value' op
ValueLeft (ParsedValue -> Value
expandValue ParsedValue
x)
ValueRight ParsedValue
x -> Value -> Value
forall op. Value' op -> Value' op
ValueRight (ParsedValue -> Value
expandValue ParsedValue
x)
ValueSome ParsedValue
x -> Value -> Value
forall op. Value' op -> Value' op
ValueSome (ParsedValue -> Value
expandValue ParsedValue
x)
ParsedValue
ValueNil -> Value
forall op. Value' op
ValueNil
ValueSeq NonEmpty $ ParsedValue
valueList -> (NonEmpty $ Value) -> Value
forall op. (NonEmpty $ Value' op) -> Value' op
ValueSeq ((ParsedValue -> Value)
-> (NonEmpty $ ParsedValue) -> NonEmpty $ Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ParsedValue -> Value
expandValue NonEmpty $ ParsedValue
valueList)
ValueMap NonEmpty $ Elt ParsedOp
eltList -> (NonEmpty $ Elt ExpandedOp) -> Value
forall op. (NonEmpty $ Elt op) -> Value' op
ValueMap ((Elt ParsedOp -> Elt ExpandedOp)
-> (NonEmpty $ Elt ParsedOp) -> NonEmpty $ Elt ExpandedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Elt ParsedOp -> Elt ExpandedOp
expandElt NonEmpty $ Elt ParsedOp
eltList)
ValueLambda NonEmpty ParsedOp
opList ->
Value
-> (NonEmpty ExpandedOp -> Value)
-> Maybe (NonEmpty ExpandedOp)
-> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
forall op. Value' op
ValueNil NonEmpty ExpandedOp -> Value
forall op. NonEmpty op -> Value' op
ValueLambda (Maybe (NonEmpty ExpandedOp) -> Value)
-> Maybe (NonEmpty ExpandedOp) -> Value
forall a b. (a -> b) -> a -> b
$
[ExpandedOp] -> Maybe (NonEmpty ExpandedOp)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([ParsedOp] -> [ExpandedOp]
expandList ([ParsedOp] -> [ExpandedOp]) -> [ParsedOp] -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ NonEmpty ParsedOp -> [Element (NonEmpty ParsedOp)]
forall t. Container t => t -> [Element t]
toList NonEmpty ParsedOp
opList)
ParsedValue
x -> (ParsedOp -> ExpandedOp) -> ParsedValue -> Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedOp -> ExpandedOp
expand ParsedValue
x
expandElt :: Elt ParsedOp -> Elt ExpandedOp
expandElt :: Elt ParsedOp -> Elt ExpandedOp
expandElt (Elt ParsedValue
l ParsedValue
r) = Value -> Value -> Elt ExpandedOp
forall op. Value' op -> Value' op -> Elt op
Elt (ParsedValue -> Value
expandValue ParsedValue
l) (ParsedValue -> Value
expandValue ParsedValue
r)
expand :: ParsedOp -> ExpandedOp
expand :: ParsedOp -> ExpandedOp
expand = let ics :: SrcPos -> ErrorSrcPos
ics SrcPos
pos = SrcPos -> ErrorSrcPos
ErrorSrcPos SrcPos
pos in \case
(Mac (PAPAIR (P (F FieldAnn
a) (F FieldAnn
b)) TypeAnn
t VarAnn
v) SrcPos
pos) ->
ErrorSrcPos -> ExpandedOp -> ExpandedOp
WithSrcEx (SrcPos -> ErrorSrcPos
ics SrcPos
pos) (ExpandedOp -> ExpandedOp) -> ExpandedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ ExpandedInstr -> ExpandedOp
PrimEx (TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
t VarAnn
v FieldAnn
a FieldAnn
b)
(Mac (DIIP Word
n [ParsedOp]
ops) SrcPos
pos) ->
ErrorSrcPos -> ExpandedOp -> ExpandedOp
WithSrcEx (SrcPos -> ErrorSrcPos
ics SrcPos
pos) (ExpandedOp -> ExpandedOp) -> ExpandedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ ExpandedInstr -> ExpandedOp
PrimEx (Word -> [ExpandedOp] -> ExpandedInstr
forall op. Word -> [op] -> InstrAbstract op
DIPN Word
n (ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp) -> [ParsedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedOp]
ops))
(Mac (DUUP Word
n VarAnn
v) SrcPos
pos) ->
ErrorSrcPos -> ExpandedOp -> ExpandedOp
WithSrcEx (SrcPos -> ErrorSrcPos
ics SrcPos
pos) (ExpandedOp -> ExpandedOp) -> ExpandedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ VarAnn -> Word -> ExpandedInstr
forall op. VarAnn -> Word -> InstrAbstract op
DUPN VarAnn
v Word
n
(Mac Macro
m SrcPos
pos) -> ErrorSrcPos -> ExpandedOp -> ExpandedOp
WithSrcEx (SrcPos -> ErrorSrcPos
ics SrcPos
pos) (ExpandedOp -> ExpandedOp) -> ExpandedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> ExpandedOp
SeqEx ([ExpandedOp] -> ExpandedOp) -> [ExpandedOp] -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro (SrcPos -> ErrorSrcPos
ics SrcPos
pos) Macro
m
(Prim ParsedInstr
i SrcPos
pos) -> ErrorSrcPos -> ExpandedOp -> ExpandedOp
WithSrcEx (SrcPos -> ErrorSrcPos
ics SrcPos
pos) (ExpandedOp -> ExpandedOp) -> ExpandedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp) -> ParsedInstr -> ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsedInstr
i
(Seq [ParsedOp]
s SrcPos
pos) -> ErrorSrcPos -> ExpandedOp -> ExpandedOp
WithSrcEx (SrcPos -> ErrorSrcPos
ics SrcPos
pos) (ExpandedOp -> ExpandedOp) -> ExpandedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> ExpandedOp
SeqEx ([ExpandedOp] -> ExpandedOp) -> [ExpandedOp] -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp) -> [ParsedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedOp]
s
expandMacro :: ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro :: ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro p :: ErrorSrcPos
p@ErrorSrcPos{unErrorSrcPos :: ErrorSrcPos -> SrcPos
unErrorSrcPos=SrcPos
macroPos} = \case
CMP ParsedInstr
i VarAnn
v -> [ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
COMPARE VarAnn
v), ParsedInstr -> ExpandedOp
xo ParsedInstr
i]
IFX ParsedInstr
i [ParsedOp]
bt [ParsedOp]
bf -> [ParsedInstr -> ExpandedOp
xo ParsedInstr
i, ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF ([ParsedOp] -> [ExpandedOp]
xp [ParsedOp]
bt) ([ParsedOp] -> [ExpandedOp]
xp [ParsedOp]
bf)]
IFCMP ParsedInstr
i VarAnn
v [ParsedOp]
bt [ParsedOp]
bf -> ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
COMPARE VarAnn
v, ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp) -> ParsedInstr -> ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsedInstr
i, [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF ([ParsedOp] -> [ExpandedOp]
xp [ParsedOp]
bt) ([ParsedOp] -> [ExpandedOp]
xp [ParsedOp]
bf)]
IF_SOME [ParsedOp]
bt [ParsedOp]
bf -> [ExpandedInstr -> ExpandedOp
PrimEx ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_NONE ([ParsedOp] -> [ExpandedOp]
xp [ParsedOp]
bf) ([ParsedOp] -> [ExpandedOp]
xp [ParsedOp]
bt))]
IF_RIGHT [ParsedOp]
bt [ParsedOp]
bf -> [ExpandedInstr -> ExpandedOp
PrimEx ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_LEFT ([ParsedOp] -> [ExpandedOp]
xp [ParsedOp]
bf) ([ParsedOp] -> [ExpandedOp]
xp [ParsedOp]
bt))]
Macro
FAIL -> ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeAnn -> VarAnn -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> InstrAbstract op
UNIT TypeAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn, ExpandedInstr
forall op. InstrAbstract op
FAILWITH]
Macro
ASSERT -> ExpandedInstr -> [ExpandedOp]
oprimEx (ExpandedInstr -> [ExpandedOp]) -> ExpandedInstr -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF [] (ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
p Macro
FAIL)
ASSERTX ParsedInstr
i -> [ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp) -> ParsedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Macro -> ParsedOp
mac (Macro -> ParsedOp) -> Macro -> ParsedOp
forall a b. (a -> b) -> a -> b
$ ParsedInstr -> [ParsedOp] -> [ParsedOp] -> Macro
IFX ParsedInstr
i [] [Macro -> ParsedOp
mac Macro
FAIL]]
ASSERT_CMP ParsedInstr
i -> [ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp) -> ParsedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Macro -> ParsedOp
mac (Macro -> ParsedOp) -> Macro -> ParsedOp
forall a b. (a -> b) -> a -> b
$ ParsedInstr -> VarAnn -> [ParsedOp] -> [ParsedOp] -> Macro
IFCMP ParsedInstr
i VarAnn
forall {k} (a :: k). Annotation a
noAnn [] [Macro -> ParsedOp
mac Macro
FAIL]]
Macro
ASSERT_NONE -> ExpandedInstr -> [ExpandedOp]
oprimEx (ExpandedInstr -> [ExpandedOp]) -> ExpandedInstr -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_NONE [] (ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
p Macro
FAIL)
Macro
ASSERT_SOME -> ExpandedInstr -> [ExpandedOp]
oprimEx (ExpandedInstr -> [ExpandedOp]) -> ExpandedInstr -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_NONE (ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
p Macro
FAIL) []
Macro
ASSERT_LEFT -> ExpandedInstr -> [ExpandedOp]
oprimEx (ExpandedInstr -> [ExpandedOp]) -> ExpandedInstr -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_LEFT [] (ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
p Macro
FAIL)
Macro
ASSERT_RIGHT -> ExpandedInstr -> [ExpandedOp]
oprimEx (ExpandedInstr -> [ExpandedOp]) -> ExpandedInstr -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_LEFT (ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
p Macro
FAIL) []
PAPAIR PairStruct
ps TypeAnn
t VarAnn
v -> ErrorSrcPos -> PairStruct -> TypeAnn -> VarAnn -> [ExpandedOp]
expandPapair ErrorSrcPos
p PairStruct
ps TypeAnn
t VarAnn
v
UNPAPAIR UnpairStruct
ps -> ErrorSrcPos -> UnpairStruct -> [ExpandedOp]
expandUnpapair ErrorSrcPos
p UnpairStruct
ps
CADR [CadrStruct]
c VarAnn
v FieldAnn
f -> ErrorSrcPos -> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp]
expandCadr ErrorSrcPos
p [CadrStruct]
c VarAnn
v FieldAnn
f
CARN VarAnn
v Word
idx -> [ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> Word -> ExpandedInstr
forall op. VarAnn -> Word -> InstrAbstract op
GETN VarAnn
v (Word
2 Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
idx Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1))]
CDRN VarAnn
v Word
idx -> [ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> Word -> ExpandedInstr
forall op. VarAnn -> Word -> InstrAbstract op
GETN VarAnn
v (Word
2 Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
idx))]
SET_CADR [CadrStruct]
c VarAnn
v FieldAnn
f -> ErrorSrcPos -> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp]
expandSetCadr ErrorSrcPos
p [CadrStruct]
c VarAnn
v FieldAnn
f
MAP_CADR [CadrStruct]
c VarAnn
v FieldAnn
f [ParsedOp]
ops -> ErrorSrcPos
-> [CadrStruct] -> VarAnn -> FieldAnn -> [ParsedOp] -> [ExpandedOp]
expandMapCadr ErrorSrcPos
p [CadrStruct]
c VarAnn
v FieldAnn
f [ParsedOp]
ops
DIIP {} -> Text -> [ExpandedOp]
forall a. HasCallStack => Text -> a
error Text
"expandMacro DIIP is unreachable"
DUUP {} -> Text -> [ExpandedOp]
forall a. HasCallStack => Text -> a
error Text
"expandMacro DUUP is unreachable"
where
mac :: Macro -> ParsedOp
mac = (Macro -> SrcPos -> ParsedOp) -> SrcPos -> Macro -> ParsedOp
forall a b c. (a -> b -> c) -> b -> a -> c
flip Macro -> SrcPos -> ParsedOp
Mac SrcPos
macroPos
oprimEx :: ExpandedInstr -> [ExpandedOp]
oprimEx = ExpandedOp -> [ExpandedOp]
forall x. One x => OneItem x -> x
one (ExpandedOp -> [ExpandedOp])
-> (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> [ExpandedOp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpandedInstr -> ExpandedOp
PrimEx
xo :: ParsedInstr -> ExpandedOp
xo = ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp)
-> (ParsedInstr -> ExpandedInstr) -> ParsedInstr -> ExpandedOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParsedOp -> ExpandedOp) -> ParsedInstr -> ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedOp -> ExpandedOp
expand
xp :: [ParsedOp] -> [ExpandedOp]
xp = (ParsedOp -> ExpandedOp) -> [ParsedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedOp -> ExpandedOp
expand
expandPapair :: ErrorSrcPos -> PairStruct -> TypeAnn -> VarAnn -> [ExpandedOp]
expandPapair :: ErrorSrcPos -> PairStruct -> TypeAnn -> VarAnn -> [ExpandedOp]
expandPapair ErrorSrcPos
ics PairStruct
ps TypeAnn
t VarAnn
v = case PairStruct
ps of
P (F FieldAnn
a) (F FieldAnn
b) -> [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
t VarAnn
v FieldAnn
a FieldAnn
b]
P (F FieldAnn
a) PairStruct
r -> ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP ([ExpandedOp] -> ExpandedInstr) -> [ExpandedOp] -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
ics (PairStruct -> TypeAnn -> VarAnn -> Macro
PAPAIR PairStruct
r TypeAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn)
, TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
t VarAnn
v FieldAnn
a FieldAnn
forall {k} (a :: k). Annotation a
noAnn]
P PairStruct
l (F FieldAnn
b) -> ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
ics (PairStruct -> TypeAnn -> VarAnn -> Macro
PAPAIR PairStruct
l TypeAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn) [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. [a] -> [a] -> [a]
++
[ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
t VarAnn
v FieldAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
b]
P PairStruct
l PairStruct
r -> ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
ics (PairStruct -> TypeAnn -> VarAnn -> Macro
PAPAIR PairStruct
l TypeAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn) [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. [a] -> [a] -> [a]
++
[ ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP ([ExpandedOp] -> ExpandedInstr) -> [ExpandedOp] -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
ics (PairStruct -> TypeAnn -> VarAnn -> Macro
PAPAIR PairStruct
r TypeAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn)
, ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
t VarAnn
v FieldAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
forall {k} (a :: k). Annotation a
noAnn]
F FieldAnn
_ -> []
expandUnpapair :: ErrorSrcPos -> UnpairStruct -> [ExpandedOp]
expandUnpapair :: ErrorSrcPos -> UnpairStruct -> [ExpandedOp]
expandUnpapair ErrorSrcPos
ics = \case
UP UnpairStruct
UF UnpairStruct
UF ->
[ ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
UNPAIR VarAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
forall {k} (a :: k). Annotation a
noAnn) ]
UP UnpairStruct
UF UnpairStruct
r ->
ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
UNPAIR VarAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
forall {k} (a :: k). Annotation a
noAnn
, [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP (ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
ics (UnpairStruct -> Macro
UNPAPAIR UnpairStruct
r))
]
UP UnpairStruct
l UnpairStruct
UF ->
ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
UNPAIR VarAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
forall {k} (a :: k). Annotation a
noAnn)
ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
ics (UnpairStruct -> Macro
UNPAPAIR UnpairStruct
l)
UP UnpairStruct
l UnpairStruct
r ->
[ ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
UNPAIR VarAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
forall {k} (a :: k). Annotation a
noAnn)
, ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP ([ExpandedOp] -> ExpandedInstr) -> [ExpandedOp] -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
ics (Macro -> [ExpandedOp]) -> Macro -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ UnpairStruct -> Macro
UNPAPAIR UnpairStruct
r
] [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. [a] -> [a] -> [a]
++
ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
ics (UnpairStruct -> Macro
UNPAPAIR UnpairStruct
l)
UnpairStruct
UF -> []
expandCadr :: ErrorSrcPos -> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp]
expandCadr :: ErrorSrcPos -> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp]
expandCadr ErrorSrcPos
ics [CadrStruct]
cs VarAnn
v FieldAnn
f = case [CadrStruct]
cs of
[] -> []
[CadrStruct
A] -> [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
v FieldAnn
f]
[CadrStruct
D] -> [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
v FieldAnn
f]
CadrStruct
A:[CadrStruct]
css -> ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
forall {k} (a :: k). Annotation a
noAnn) ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
ics ([CadrStruct] -> VarAnn -> FieldAnn -> Macro
CADR [CadrStruct]
css VarAnn
v FieldAnn
f)
CadrStruct
D:[CadrStruct]
css -> ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
forall {k} (a :: k). Annotation a
noAnn) ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
ics ([CadrStruct] -> VarAnn -> FieldAnn -> Macro
CADR [CadrStruct]
css VarAnn
v FieldAnn
f)
carNoAnn :: InstrAbstract op
carNoAnn :: forall op. InstrAbstract op
carNoAnn = VarAnn -> FieldAnn -> InstrAbstract op
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR [annQ|%%|] FieldAnn
forall {k} (a :: k). Annotation a
noAnn
cdrNoAnn :: InstrAbstract op
cdrNoAnn :: forall op. InstrAbstract op
cdrNoAnn = VarAnn -> FieldAnn -> InstrAbstract op
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR [annQ|%%|] FieldAnn
forall {k} (a :: k). Annotation a
noAnn
pairNoAnn :: VarAnn -> InstrAbstract op
pairNoAnn :: forall op. VarAnn -> InstrAbstract op
pairNoAnn VarAnn
v = TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
v [annQ|@|] [annQ|@|]
expandSetCadr :: ErrorSrcPos -> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp]
expandSetCadr :: ErrorSrcPos -> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp]
expandSetCadr ErrorSrcPos
ics [CadrStruct]
cs VarAnn
v FieldAnn
f = ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case [CadrStruct]
cs of
[] -> []
[CadrStruct
A] -> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall {k} (a :: k). Annotation a
noAnn, VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
f, ExpandedInstr
forall op. InstrAbstract op
DROP,
ExpandedInstr
forall op. InstrAbstract op
cdrNoAnn, ExpandedInstr
forall op. InstrAbstract op
SWAP, TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
v FieldAnn
f [annQ|@|]]
[CadrStruct
D] -> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall {k} (a :: k). Annotation a
noAnn, VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
f, ExpandedInstr
forall op. InstrAbstract op
DROP,
ExpandedInstr
forall op. InstrAbstract op
carNoAnn, TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
v [annQ|@|] FieldAnn
f]
CadrStruct
A:[CadrStruct]
css -> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall {k} (a :: k). Annotation a
noAnn, [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP (ExpandedInstr -> ExpandedOp
PrimEx ExpandedInstr
forall op. InstrAbstract op
carNoAnn ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
ics ([CadrStruct] -> VarAnn -> FieldAnn -> Macro
SET_CADR [CadrStruct]
css VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
f)), ExpandedInstr
forall op. InstrAbstract op
cdrNoAnn, ExpandedInstr
forall op. InstrAbstract op
SWAP, VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
pairNoAnn VarAnn
v]
CadrStruct
D:[CadrStruct]
css -> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall {k} (a :: k). Annotation a
noAnn, [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP (ExpandedInstr -> ExpandedOp
PrimEx ExpandedInstr
forall op. InstrAbstract op
cdrNoAnn ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
ics ([CadrStruct] -> VarAnn -> FieldAnn -> Macro
SET_CADR [CadrStruct]
css VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
f)), ExpandedInstr
forall op. InstrAbstract op
carNoAnn, VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
pairNoAnn VarAnn
v]
expandMapCadr :: ErrorSrcPos -> [CadrStruct] -> VarAnn -> FieldAnn -> [ParsedOp] -> [ExpandedOp]
expandMapCadr :: ErrorSrcPos
-> [CadrStruct] -> VarAnn -> FieldAnn -> [ParsedOp] -> [ExpandedOp]
expandMapCadr ErrorSrcPos
ics [CadrStruct]
cs VarAnn
v FieldAnn
f [ParsedOp]
ops = case [CadrStruct]
cs of
[] -> []
[CadrStruct
A] -> ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall {k} (a :: k). Annotation a
noAnn, ExpandedInstr
forall op. InstrAbstract op
cdrNoAnn, [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
f, [ExpandedOp] -> ExpandedOp
SeqEx (ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp) -> [ParsedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedOp]
ops)], ExpandedInstr
forall op. InstrAbstract op
SWAP, TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
v FieldAnn
f [annQ|@|]]
[CadrStruct
D] -> [[ExpandedOp]] -> [ExpandedOp]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall {k} (a :: k). Annotation a
noAnn, VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
f], [[ExpandedOp] -> ExpandedOp
SeqEx (ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp) -> [ParsedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedOp]
ops)], ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExpandedInstr
forall op. InstrAbstract op
SWAP, ExpandedInstr
forall op. InstrAbstract op
carNoAnn, TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
v [annQ|@|] FieldAnn
f]]
CadrStruct
A:[CadrStruct]
css -> ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall {k} (a :: k). Annotation a
noAnn, [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP (ExpandedInstr -> ExpandedOp
PrimEx ExpandedInstr
forall op. InstrAbstract op
carNoAnn ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
ics ([CadrStruct] -> VarAnn -> FieldAnn -> [ParsedOp] -> Macro
MAP_CADR [CadrStruct]
css VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
f [ParsedOp]
ops)), ExpandedInstr
forall op. InstrAbstract op
cdrNoAnn, ExpandedInstr
forall op. InstrAbstract op
SWAP, VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
pairNoAnn VarAnn
v]
CadrStruct
D:[CadrStruct]
css -> ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall {k} (a :: k). Annotation a
noAnn, [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP (ExpandedInstr -> ExpandedOp
PrimEx ExpandedInstr
forall op. InstrAbstract op
cdrNoAnn ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
ics ([CadrStruct] -> VarAnn -> FieldAnn -> [ParsedOp] -> Macro
MAP_CADR [CadrStruct]
css VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
f [ParsedOp]
ops)), ExpandedInstr
forall op. InstrAbstract op
carNoAnn, VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
pairNoAnn VarAnn
v]
mapPairLeaves :: [FieldAnn] -> PairStruct -> PairStruct
mapPairLeaves :: [FieldAnn] -> PairStruct -> PairStruct
mapPairLeaves [FieldAnn]
fs PairStruct
p = State [FieldAnn] PairStruct -> [FieldAnn] -> PairStruct
forall s a. State s a -> s -> a
evalState (PairStruct -> State [FieldAnn] PairStruct
pairLeavesST PairStruct
p) [FieldAnn]
fs
pairLeavesST :: PairStruct -> State [FieldAnn] PairStruct
pairLeavesST :: PairStruct -> State [FieldAnn] PairStruct
pairLeavesST = \case
(P PairStruct
l PairStruct
r) -> do
PairStruct
l' <- PairStruct -> State [FieldAnn] PairStruct
pairLeavesST PairStruct
l
PairStruct
r' <- PairStruct -> State [FieldAnn] PairStruct
pairLeavesST PairStruct
r
return $ PairStruct -> PairStruct -> PairStruct
P PairStruct
l' PairStruct
r'
(F FieldAnn
_) -> do
FieldAnn
f <- ([FieldAnn] -> (FieldAnn, [FieldAnn]))
-> StateT [FieldAnn] Identity FieldAnn
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state [FieldAnn] -> (FieldAnn, [FieldAnn])
forall {k} {a :: k}.
[Annotation a] -> (Annotation a, [Annotation a])
getLeaf
return $ FieldAnn -> PairStruct
F FieldAnn
f
where
getLeaf :: [Annotation a] -> (Annotation a, [Annotation a])
getLeaf (Annotation a
a:[Annotation a]
as) = (Annotation a
a, [Annotation a]
as)
getLeaf [Annotation a]
_ = (Annotation a
forall {k} (a :: k). Annotation a
noAnn, [])
deriveJSON morleyAesonOptions ''PairStruct
deriveJSON morleyAesonOptions ''UnpairStruct
deriveJSON morleyAesonOptions ''CadrStruct
$(mconcat
[ deriveJSON morleyAesonOptions ''Macro
, deriveJSON morleyAesonOptions ''ParsedOp
])