-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

module Morley.Michelson.Macro
  (
  -- * Macros types
    CadrStruct (..)
  , PairStruct (..)
  , UnpairStruct (..)
  , Macro (..)

  -- * Morley Parsed value types
  , ParsedValue

  -- * Morley Parsed instruction types
  , ParsedInstr
  , ParsedOp (..)
  , ParsedSeq (..)
  , ParsedUExtInstr

    -- * For utilities
  , expandContract
  , expandValue

    -- * For parsing
  , mapPairLeaves

    -- * Internals exported for tests
  , expand
  , expandSeq
  , expandMacro
  , expandPapair
  , expandUnpapair
  , expandCadr
  , expandSetCadr
  , expandMapCadr
  ) where

import Data.Aeson.TH (deriveJSON)
import Data.Data (Data(..))
import Data.Default (def)
import Fmt (Buildable(build), blockListF, (+|), (|+))

import Morley.Michelson.ErrorPos
import Morley.Michelson.Printer (RenderDoc(..))
import Morley.Michelson.Untyped
import Morley.Michelson.Untyped.HoistInstr
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
$c== :: PairStruct -> PairStruct -> Bool
== :: PairStruct -> PairStruct -> Bool
$c/= :: PairStruct -> PairStruct -> Bool
/= :: 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
$cshowsPrec :: Int -> PairStruct -> ShowS
showsPrec :: Int -> PairStruct -> ShowS
$cshow :: PairStruct -> String
show :: PairStruct -> String
$cshowList :: [PairStruct] -> ShowS
showList :: [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 -> Constr
PairStruct -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PairStruct -> c PairStruct
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PairStruct -> c PairStruct
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PairStruct
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PairStruct
$ctoConstr :: PairStruct -> Constr
toConstr :: PairStruct -> Constr
$cdataTypeOf :: PairStruct -> DataType
dataTypeOf :: PairStruct -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PairStruct)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PairStruct)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PairStruct)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PairStruct)
$cgmapT :: (forall b. Data b => b -> b) -> PairStruct -> PairStruct
gmapT :: (forall b. Data b => b -> b) -> PairStruct -> PairStruct
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PairStruct -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PairStruct -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PairStruct -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PairStruct -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PairStruct -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PairStruct -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PairStruct -> m PairStruct
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PairStruct -> m 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
$cfrom :: forall x. PairStruct -> Rep PairStruct x
from :: forall x. PairStruct -> Rep PairStruct x
$cto :: forall x. Rep PairStruct x -> PairStruct
to :: forall x. Rep PairStruct x -> PairStruct
Generic)
  deriving anyclass [PairStruct] -> Doc
PairStruct -> Doc
(PairStruct -> Doc)
-> ([PairStruct] -> Doc) -> Buildable PairStruct
forall a. (a -> Doc) -> ([a] -> Doc) -> Buildable a
$cbuild :: PairStruct -> Doc
build :: PairStruct -> Doc
$cbuildList :: [PairStruct] -> Doc
buildList :: [PairStruct] -> Doc
Buildable

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
$c== :: UnpairStruct -> UnpairStruct -> Bool
== :: UnpairStruct -> UnpairStruct -> Bool
$c/= :: UnpairStruct -> UnpairStruct -> Bool
/= :: 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
$cshowsPrec :: Int -> UnpairStruct -> ShowS
showsPrec :: Int -> UnpairStruct -> ShowS
$cshow :: UnpairStruct -> String
show :: UnpairStruct -> String
$cshowList :: [UnpairStruct] -> ShowS
showList :: [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 -> Constr
UnpairStruct -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnpairStruct -> c UnpairStruct
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnpairStruct -> c UnpairStruct
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnpairStruct
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnpairStruct
$ctoConstr :: UnpairStruct -> Constr
toConstr :: UnpairStruct -> Constr
$cdataTypeOf :: UnpairStruct -> DataType
dataTypeOf :: UnpairStruct -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnpairStruct)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnpairStruct)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UnpairStruct)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UnpairStruct)
$cgmapT :: (forall b. Data b => b -> b) -> UnpairStruct -> UnpairStruct
gmapT :: (forall b. Data b => b -> b) -> UnpairStruct -> UnpairStruct
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnpairStruct -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnpairStruct -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UnpairStruct -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UnpairStruct -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UnpairStruct -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UnpairStruct -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnpairStruct -> m 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
$cfrom :: forall x. UnpairStruct -> Rep UnpairStruct x
from :: forall x. UnpairStruct -> Rep UnpairStruct x
$cto :: forall x. Rep UnpairStruct x -> UnpairStruct
to :: forall x. Rep UnpairStruct x -> UnpairStruct
Generic)
  deriving anyclass [UnpairStruct] -> Doc
UnpairStruct -> Doc
(UnpairStruct -> Doc)
-> ([UnpairStruct] -> Doc) -> Buildable UnpairStruct
forall a. (a -> Doc) -> ([a] -> Doc) -> Buildable a
$cbuild :: UnpairStruct -> Doc
build :: UnpairStruct -> Doc
$cbuildList :: [UnpairStruct] -> Doc
buildList :: [UnpairStruct] -> Doc
Buildable

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
$c== :: CadrStruct -> CadrStruct -> Bool
== :: CadrStruct -> CadrStruct -> Bool
$c/= :: CadrStruct -> CadrStruct -> Bool
/= :: 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
$cshowsPrec :: Int -> CadrStruct -> ShowS
showsPrec :: Int -> CadrStruct -> ShowS
$cshow :: CadrStruct -> String
show :: CadrStruct -> String
$cshowList :: [CadrStruct] -> ShowS
showList :: [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 -> Constr
CadrStruct -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CadrStruct -> c CadrStruct
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CadrStruct -> c CadrStruct
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CadrStruct
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CadrStruct
$ctoConstr :: CadrStruct -> Constr
toConstr :: CadrStruct -> Constr
$cdataTypeOf :: CadrStruct -> DataType
dataTypeOf :: CadrStruct -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CadrStruct)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CadrStruct)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CadrStruct)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CadrStruct)
$cgmapT :: (forall b. Data b => b -> b) -> CadrStruct -> CadrStruct
gmapT :: (forall b. Data b => b -> b) -> CadrStruct -> CadrStruct
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CadrStruct -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CadrStruct -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CadrStruct -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CadrStruct -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CadrStruct -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CadrStruct -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CadrStruct -> m 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
$cfrom :: forall x. CadrStruct -> Rep CadrStruct x
from :: forall x. CadrStruct -> Rep CadrStruct x
$cto :: forall x. Rep CadrStruct x -> CadrStruct
to :: forall x. Rep CadrStruct x -> CadrStruct
Generic)
  deriving anyclass [CadrStruct] -> Doc
CadrStruct -> Doc
(CadrStruct -> Doc)
-> ([CadrStruct] -> Doc) -> Buildable CadrStruct
forall a. (a -> Doc) -> ([a] -> Doc) -> Buildable a
$cbuild :: CadrStruct -> Doc
build :: CadrStruct -> Doc
$cbuildList :: [CadrStruct] -> Doc
buildList :: [CadrStruct] -> Doc
Buildable

instance NFData CadrStruct

-- | Unexpanded instructions produced directly by the @ops@ parser, which
-- contains primitive Michelson Instructions, inline-able macros and sequences
data ParsedOp
  = Prim ParsedInstr SrcPos -- ^ Primitive Michelson instruction
  | Mac Macro        SrcPos -- ^ Built-in Michelson macro defined by the specification
  | Seq [ParsedOp]   SrcPos -- ^ A sequence of instructions
  deriving stock (ParsedOp -> ParsedOp -> Bool
(ParsedOp -> ParsedOp -> Bool)
-> (ParsedOp -> ParsedOp -> Bool) -> Eq ParsedOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParsedOp -> ParsedOp -> Bool
== :: ParsedOp -> ParsedOp -> Bool
$c/= :: ParsedOp -> ParsedOp -> Bool
/= :: 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
$cshowsPrec :: Int -> ParsedOp -> ShowS
showsPrec :: Int -> ParsedOp -> ShowS
$cshow :: ParsedOp -> String
show :: ParsedOp -> String
$cshowList :: [ParsedOp] -> ShowS
showList :: [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 -> Constr
ParsedOp -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsedOp -> c ParsedOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsedOp -> c ParsedOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParsedOp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParsedOp
$ctoConstr :: ParsedOp -> Constr
toConstr :: ParsedOp -> Constr
$cdataTypeOf :: ParsedOp -> DataType
dataTypeOf :: ParsedOp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParsedOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParsedOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ParsedOp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ParsedOp)
$cgmapT :: (forall b. Data b => b -> b) -> ParsedOp -> ParsedOp
gmapT :: (forall b. Data b => b -> b) -> ParsedOp -> ParsedOp
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedOp -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedOp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ParsedOp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ParsedOp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParsedOp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParsedOp -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedOp -> m 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
$cfrom :: forall x. ParsedOp -> Rep ParsedOp x
from :: forall x. ParsedOp -> Rep ParsedOp x
$cto :: forall x. Rep ParsedOp x -> ParsedOp
to :: forall x. Rep ParsedOp x -> ParsedOp
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 -> Doc
build = \case
    Prim ParsedInstr
parseInstr SrcPos
_ -> Doc
"<Prim: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParsedInstr
parseInstr ParsedInstr -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"
    Mac Macro
macro SrcPos
_       -> Doc
"<Mac: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Macro
macro Macro -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"
    Seq [ParsedOp]
parsedOps SrcPos
_   -> Doc
"<Seq: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| [ParsedOp]
parsedOps [ParsedOp] -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"

instance NFData ParsedOp

-------------------------------------
-- Types produced by parser
-------------------------------------

data ParsedSeq op
  = PSSingleMacro SrcPos Macro
  | PSSequence [op]
  deriving stock (ParsedSeq op -> ParsedSeq op -> Bool
(ParsedSeq op -> ParsedSeq op -> Bool)
-> (ParsedSeq op -> ParsedSeq op -> Bool) -> Eq (ParsedSeq op)
forall op. Eq op => ParsedSeq op -> ParsedSeq op -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall op. Eq op => ParsedSeq op -> ParsedSeq op -> Bool
== :: ParsedSeq op -> ParsedSeq op -> Bool
$c/= :: forall op. Eq op => ParsedSeq op -> ParsedSeq op -> Bool
/= :: ParsedSeq op -> ParsedSeq op -> Bool
Eq, Int -> ParsedSeq op -> ShowS
[ParsedSeq op] -> ShowS
ParsedSeq op -> String
(Int -> ParsedSeq op -> ShowS)
-> (ParsedSeq op -> String)
-> ([ParsedSeq op] -> ShowS)
-> Show (ParsedSeq op)
forall op. Show op => Int -> ParsedSeq op -> ShowS
forall op. Show op => [ParsedSeq op] -> ShowS
forall op. Show op => ParsedSeq op -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall op. Show op => Int -> ParsedSeq op -> ShowS
showsPrec :: Int -> ParsedSeq op -> ShowS
$cshow :: forall op. Show op => ParsedSeq op -> String
show :: ParsedSeq op -> String
$cshowList :: forall op. Show op => [ParsedSeq op] -> ShowS
showList :: [ParsedSeq op] -> ShowS
Show, Typeable (ParsedSeq op)
Typeable (ParsedSeq op)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ParsedSeq op -> c (ParsedSeq op))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (ParsedSeq op))
-> (ParsedSeq op -> Constr)
-> (ParsedSeq op -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (ParsedSeq op)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (ParsedSeq op)))
-> ((forall b. Data b => b -> b) -> ParsedSeq op -> ParsedSeq op)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ParsedSeq op -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ParsedSeq op -> r)
-> (forall u. (forall d. Data d => d -> u) -> ParsedSeq op -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ParsedSeq op -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ParsedSeq op -> m (ParsedSeq op))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ParsedSeq op -> m (ParsedSeq op))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ParsedSeq op -> m (ParsedSeq op))
-> Data (ParsedSeq op)
ParsedSeq op -> Constr
ParsedSeq op -> DataType
(forall b. Data b => b -> b) -> ParsedSeq op -> ParsedSeq op
forall {op}. Data op => Typeable (ParsedSeq op)
forall op. Data op => ParsedSeq op -> Constr
forall op. Data op => ParsedSeq op -> DataType
forall op.
Data op =>
(forall b. Data b => b -> b) -> ParsedSeq op -> ParsedSeq op
forall op u.
Data op =>
Int -> (forall d. Data d => d -> u) -> ParsedSeq op -> u
forall op u.
Data op =>
(forall d. Data d => d -> u) -> ParsedSeq op -> [u]
forall op r r'.
Data op =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedSeq op -> r
forall op r r'.
Data op =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedSeq op -> r
forall op (m :: * -> *).
(Data op, Monad m) =>
(forall d. Data d => d -> m d) -> ParsedSeq op -> m (ParsedSeq op)
forall op (m :: * -> *).
(Data op, MonadPlus m) =>
(forall d. Data d => d -> m d) -> ParsedSeq op -> m (ParsedSeq op)
forall op (c :: * -> *).
Data op =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ParsedSeq op)
forall op (c :: * -> *).
Data op =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsedSeq op -> c (ParsedSeq op)
forall op (t :: * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ParsedSeq op))
forall op (t :: * -> * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ParsedSeq op))
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) -> ParsedSeq op -> u
forall u. (forall d. Data d => d -> u) -> ParsedSeq op -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedSeq op -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedSeq op -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParsedSeq op -> m (ParsedSeq op)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedSeq op -> m (ParsedSeq op)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ParsedSeq op)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsedSeq op -> c (ParsedSeq op)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ParsedSeq op))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ParsedSeq op))
$cgfoldl :: forall op (c :: * -> *).
Data op =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsedSeq op -> c (ParsedSeq op)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsedSeq op -> c (ParsedSeq op)
$cgunfold :: forall op (c :: * -> *).
Data op =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ParsedSeq op)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ParsedSeq op)
$ctoConstr :: forall op. Data op => ParsedSeq op -> Constr
toConstr :: ParsedSeq op -> Constr
$cdataTypeOf :: forall op. Data op => ParsedSeq op -> DataType
dataTypeOf :: ParsedSeq op -> DataType
$cdataCast1 :: forall op (t :: * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ParsedSeq op))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ParsedSeq op))
$cdataCast2 :: forall op (t :: * -> * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ParsedSeq op))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ParsedSeq op))
$cgmapT :: forall op.
Data op =>
(forall b. Data b => b -> b) -> ParsedSeq op -> ParsedSeq op
gmapT :: (forall b. Data b => b -> b) -> ParsedSeq op -> ParsedSeq op
$cgmapQl :: forall op r r'.
Data op =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedSeq op -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedSeq op -> r
$cgmapQr :: forall op r r'.
Data op =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedSeq op -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedSeq op -> r
$cgmapQ :: forall op u.
Data op =>
(forall d. Data d => d -> u) -> ParsedSeq op -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ParsedSeq op -> [u]
$cgmapQi :: forall op u.
Data op =>
Int -> (forall d. Data d => d -> u) -> ParsedSeq op -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParsedSeq op -> u
$cgmapM :: forall op (m :: * -> *).
(Data op, Monad m) =>
(forall d. Data d => d -> m d) -> ParsedSeq op -> m (ParsedSeq op)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParsedSeq op -> m (ParsedSeq op)
$cgmapMp :: forall op (m :: * -> *).
(Data op, MonadPlus m) =>
(forall d. Data d => d -> m d) -> ParsedSeq op -> m (ParsedSeq op)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedSeq op -> m (ParsedSeq op)
$cgmapMo :: forall op (m :: * -> *).
(Data op, MonadPlus m) =>
(forall d. Data d => d -> m d) -> ParsedSeq op -> m (ParsedSeq op)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedSeq op -> m (ParsedSeq op)
Data, (forall x. ParsedSeq op -> Rep (ParsedSeq op) x)
-> (forall x. Rep (ParsedSeq op) x -> ParsedSeq op)
-> Generic (ParsedSeq op)
forall x. Rep (ParsedSeq op) x -> ParsedSeq op
forall x. ParsedSeq op -> Rep (ParsedSeq op) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall op x. Rep (ParsedSeq op) x -> ParsedSeq op
forall op x. ParsedSeq op -> Rep (ParsedSeq op) x
$cfrom :: forall op x. ParsedSeq op -> Rep (ParsedSeq op) x
from :: forall x. ParsedSeq op -> Rep (ParsedSeq op) x
$cto :: forall op x. Rep (ParsedSeq op) x -> ParsedSeq op
to :: forall x. Rep (ParsedSeq op) x -> ParsedSeq op
Generic, (forall a b. (a -> b) -> ParsedSeq a -> ParsedSeq b)
-> (forall a b. a -> ParsedSeq b -> ParsedSeq a)
-> Functor ParsedSeq
forall a b. a -> ParsedSeq b -> ParsedSeq a
forall a b. (a -> b) -> ParsedSeq a -> ParsedSeq b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ParsedSeq a -> ParsedSeq b
fmap :: forall a b. (a -> b) -> ParsedSeq a -> ParsedSeq b
$c<$ :: forall a b. a -> ParsedSeq b -> ParsedSeq a
<$ :: forall a b. a -> ParsedSeq b -> ParsedSeq a
Functor, (forall m. Monoid m => ParsedSeq m -> m)
-> (forall m a. Monoid m => (a -> m) -> ParsedSeq a -> m)
-> (forall m a. Monoid m => (a -> m) -> ParsedSeq a -> m)
-> (forall a b. (a -> b -> b) -> b -> ParsedSeq a -> b)
-> (forall a b. (a -> b -> b) -> b -> ParsedSeq a -> b)
-> (forall b a. (b -> a -> b) -> b -> ParsedSeq a -> b)
-> (forall b a. (b -> a -> b) -> b -> ParsedSeq a -> b)
-> (forall a. (a -> a -> a) -> ParsedSeq a -> a)
-> (forall a. (a -> a -> a) -> ParsedSeq a -> a)
-> (forall a. ParsedSeq a -> [a])
-> (forall a. ParsedSeq a -> Bool)
-> (forall a. ParsedSeq a -> Int)
-> (forall a. Eq a => a -> ParsedSeq a -> Bool)
-> (forall a. Ord a => ParsedSeq a -> a)
-> (forall a. Ord a => ParsedSeq a -> a)
-> (forall a. Num a => ParsedSeq a -> a)
-> (forall a. Num a => ParsedSeq a -> a)
-> Foldable ParsedSeq
forall a. Eq a => a -> ParsedSeq a -> Bool
forall a. Num a => ParsedSeq a -> a
forall a. Ord a => ParsedSeq a -> a
forall m. Monoid m => ParsedSeq m -> m
forall a. ParsedSeq a -> Bool
forall a. ParsedSeq a -> Int
forall a. ParsedSeq a -> [a]
forall a. (a -> a -> a) -> ParsedSeq a -> a
forall m a. Monoid m => (a -> m) -> ParsedSeq a -> m
forall b a. (b -> a -> b) -> b -> ParsedSeq a -> b
forall a b. (a -> b -> b) -> b -> ParsedSeq a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => ParsedSeq m -> m
fold :: forall m. Monoid m => ParsedSeq m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ParsedSeq a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ParsedSeq a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ParsedSeq a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ParsedSeq a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ParsedSeq a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ParsedSeq a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ParsedSeq a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ParsedSeq a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ParsedSeq a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ParsedSeq a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ParsedSeq a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ParsedSeq a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ParsedSeq a -> a
foldr1 :: forall a. (a -> a -> a) -> ParsedSeq a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ParsedSeq a -> a
foldl1 :: forall a. (a -> a -> a) -> ParsedSeq a -> a
$ctoList :: forall a. ParsedSeq a -> [a]
toList :: forall a. ParsedSeq a -> [a]
$cnull :: forall a. ParsedSeq a -> Bool
null :: forall a. ParsedSeq a -> Bool
$clength :: forall a. ParsedSeq a -> Int
length :: forall a. ParsedSeq a -> Int
$celem :: forall a. Eq a => a -> ParsedSeq a -> Bool
elem :: forall a. Eq a => a -> ParsedSeq a -> Bool
$cmaximum :: forall a. Ord a => ParsedSeq a -> a
maximum :: forall a. Ord a => ParsedSeq a -> a
$cminimum :: forall a. Ord a => ParsedSeq a -> a
minimum :: forall a. Ord a => ParsedSeq a -> a
$csum :: forall a. Num a => ParsedSeq a -> a
sum :: forall a. Num a => ParsedSeq a -> a
$cproduct :: forall a. Num a => ParsedSeq a -> a
product :: forall a. Num a => ParsedSeq a -> a
Foldable)
  deriving anyclass ParsedSeq op -> ()
(ParsedSeq op -> ()) -> NFData (ParsedSeq op)
forall op. NFData op => ParsedSeq op -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall op. NFData op => ParsedSeq op -> ()
rnf :: ParsedSeq op -> ()
NFData

type ParsedUExtInstr = ExtInstrAbstract ParsedSeq ParsedOp

type ParsedInstr = InstrAbstract ParsedSeq ParsedOp

type ParsedValue = Value' ParsedSeq ParsedOp

-- | Built-in Michelson Macros defined by the specification
data Macro
  = CMP ParsedInstr
  | IFX ParsedInstr (ParsedSeq ParsedOp) (ParsedSeq ParsedOp)
  | IFCMP ParsedInstr (ParsedSeq ParsedOp) (ParsedSeq 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 (ParsedSeq ParsedOp)
  | DIIP Word (ParsedSeq ParsedOp)
  | DUUP Word VarAnn
  | ASSERT
  | ASSERTX ParsedInstr
  | ASSERT_CMP ParsedInstr
  | ASSERT_NONE
  | ASSERT_SOME
  | ASSERT_LEFT
  | ASSERT_RIGHT
  | IF_SOME (ParsedSeq ParsedOp) (ParsedSeq ParsedOp)
  | IF_RIGHT (ParsedSeq ParsedOp) (ParsedSeq ParsedOp)
  deriving stock (Macro -> Macro -> Bool
(Macro -> Macro -> Bool) -> (Macro -> Macro -> Bool) -> Eq Macro
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Macro -> Macro -> Bool
== :: Macro -> Macro -> Bool
$c/= :: Macro -> Macro -> Bool
/= :: 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
$cshowsPrec :: Int -> Macro -> ShowS
showsPrec :: Int -> Macro -> ShowS
$cshow :: Macro -> String
show :: Macro -> String
$cshowList :: [Macro] -> ShowS
showList :: [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 -> Constr
Macro -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Macro -> c Macro
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Macro -> c Macro
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Macro
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Macro
$ctoConstr :: Macro -> Constr
toConstr :: Macro -> Constr
$cdataTypeOf :: Macro -> DataType
dataTypeOf :: Macro -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Macro)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Macro)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Macro)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Macro)
$cgmapT :: (forall b. Data b => b -> b) -> Macro -> Macro
gmapT :: (forall b. Data b => b -> b) -> Macro -> Macro
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Macro -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Macro -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Macro -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Macro -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Macro -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Macro -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Macro -> m Macro
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Macro -> m 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
$cfrom :: forall x. Macro -> Rep Macro x
from :: forall x. Macro -> Rep Macro x
$cto :: forall x. Rep Macro x -> Macro
to :: forall x. Rep Macro x -> Macro
Generic)

instance Buildable op => Buildable (ParsedSeq op) where
  build :: ParsedSeq op -> Doc
build = \case
    PSSingleMacro SrcPos
_ Macro
mac -> Macro -> Doc
forall a. Buildable a => a -> Doc
build Macro
mac
    PSSequence [op]
xs -> [op] -> Doc
forall a (f :: * -> *). (Buildable a, Foldable f) => f a -> Doc
blockListF [op]
xs

instance Buildable Macro where
  build :: Macro -> Doc
build = \case
    CMP ParsedInstr
parsedInstr -> Doc
"<CMP: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParsedInstr
parsedInstr ParsedInstr -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"
    IFX ParsedInstr
parsedInstr ParsedSeq ParsedOp
parsedOps1 ParsedSeq ParsedOp
parsedOps2 -> Doc
"<IFX: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParsedInstr
parsedInstr ParsedInstr -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParsedSeq ParsedOp
parsedOps1 ParsedSeq ParsedOp -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParsedSeq ParsedOp
parsedOps2 ParsedSeq ParsedOp -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"
    IFCMP ParsedInstr
parsedInstr ParsedSeq ParsedOp
parsedOps1 ParsedSeq ParsedOp
parsedOps2 -> Doc
"<IFCMP: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParsedInstr
parsedInstr ParsedInstr -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParsedSeq ParsedOp
parsedOps1 ParsedSeq ParsedOp -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParsedSeq ParsedOp
parsedOps2 ParsedSeq ParsedOp -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"
    Macro
FAIL -> Doc
"FAIL"
    PAPAIR PairStruct
pairStruct TypeAnn
typeAnn VarAnn
varAnn -> Doc
"<PAPAIR: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| PairStruct
pairStruct PairStruct -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| TypeAnn
typeAnn TypeAnn -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| VarAnn
varAnn VarAnn -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"
    UNPAPAIR UnpairStruct
pairStruct -> Doc
"<UNPAPAIR: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| UnpairStruct
pairStruct UnpairStruct -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"
    CADR [CadrStruct]
cadrStructs VarAnn
varAnn FieldAnn
fieldAnn -> Doc
"<CADR: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| [CadrStruct]
cadrStructs [CadrStruct] -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| VarAnn
varAnn VarAnn -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| FieldAnn
fieldAnn FieldAnn -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"
    CARN VarAnn
varAnn Word
idx -> Doc
"<CAR: #" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Word
idx Word -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"," Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| VarAnn
varAnn VarAnn -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"
    CDRN VarAnn
varAnn Word
idx -> Doc
"<CDR: #" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Word
idx Word -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"," Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| VarAnn
varAnn VarAnn -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"
    SET_CADR [CadrStruct]
cadrStructs VarAnn
varAnn FieldAnn
fieldAnn -> Doc
"<SET_CADR: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| [CadrStruct]
cadrStructs [CadrStruct] -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| VarAnn
varAnn VarAnn -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| FieldAnn
fieldAnn FieldAnn -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"
    MAP_CADR [CadrStruct]
cadrStructs VarAnn
varAnn FieldAnn
fieldAnn ParsedSeq ParsedOp
parsedOps -> Doc
"<MAP_CADR: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| [CadrStruct]
cadrStructs [CadrStruct] -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| VarAnn
varAnn VarAnn -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| FieldAnn
fieldAnn FieldAnn -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParsedSeq ParsedOp
parsedOps ParsedSeq ParsedOp -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"
    DIIP Word
integer ParsedSeq ParsedOp
parsedOps -> Doc
"<DIIP: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Word
integer Word -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParsedSeq ParsedOp
parsedOps ParsedSeq ParsedOp -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"
    DUUP Word
integer VarAnn
varAnn -> Doc
"<DUUP: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Word
integer Word -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| VarAnn
varAnn VarAnn -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"
    Macro
ASSERT -> Doc
"ASSERT"
    ASSERTX ParsedInstr
parsedInstr -> Doc
"<ASSERTX: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParsedInstr
parsedInstr ParsedInstr -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"
    ASSERT_CMP ParsedInstr
parsedInstr -> Doc
"<ASSERT_CMP: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParsedInstr
parsedInstr ParsedInstr -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"
    Macro
ASSERT_NONE  -> Doc
"ASSERT_NONE"
    Macro
ASSERT_SOME  -> Doc
"ASSERT_SOME"
    Macro
ASSERT_LEFT  -> Doc
"ASSERT_LEFT"
    Macro
ASSERT_RIGHT -> Doc
"ASSERT_RIGHT"
    IF_SOME ParsedSeq ParsedOp
parsedOps1 ParsedSeq ParsedOp
parsedOps2 -> Doc
"<IF_SOME: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParsedSeq ParsedOp
parsedOps1 ParsedSeq ParsedOp -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParsedSeq ParsedOp
parsedOps2 ParsedSeq ParsedOp -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"
    IF_RIGHT ParsedSeq ParsedOp
parsedOps1 ParsedSeq ParsedOp
parsedOps2 -> Doc
"<IF_RIGHT: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParsedSeq ParsedOp
parsedOps1 ParsedSeq ParsedOp -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
", " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParsedSeq ParsedOp
parsedOps2 ParsedSeq ParsedOp -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
">"

instance NFData Macro

-- | Expand all macros in parsed contract.
expandContract :: Contract' ParsedOp -> Contract
expandContract :: Contract' ParsedOp -> Contract
expandContract = (ParsedOp -> ExpandedOp) -> Contract' ParsedOp -> Contract
forall a b. (a -> b) -> Contract' a -> Contract' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedOp -> ExpandedOp
expand

-- | Expand all macros in parsed value.
expandValue :: ParsedValue -> Value
expandValue :: ParsedValue -> Value
expandValue = (ParsedSeq ExpandedOp -> [ExpandedOp])
-> Value' ParsedSeq ExpandedOp -> Value
forall {k} (n :: (k -> *) -> k -> *) (f :: k -> *) (a :: k)
       (g :: k -> *).
HoistInstr n =>
(f a -> g a) -> n f a -> n g a
forall (f :: * -> *) a (g :: * -> *).
(f a -> g a) -> Value' f a -> Value' g a
hoistInstr ParsedSeq ExpandedOp -> [ExpandedOp]
expandSeq (Value' ParsedSeq ExpandedOp -> Value)
-> (ParsedValue -> Value' ParsedSeq ExpandedOp)
-> ParsedValue
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParsedOp -> ExpandedOp)
-> ParsedValue -> Value' ParsedSeq ExpandedOp
forall a b. (a -> b) -> Value' ParsedSeq a -> Value' ParsedSeq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedOp -> ExpandedOp
expand

expandSeq :: ParsedSeq ExpandedOp -> [ExpandedOp]
expandSeq :: ParsedSeq ExpandedOp -> [ExpandedOp]
expandSeq = \case
  PSSingleMacro SrcPos
pos Macro
macro -> ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro (SrcPos -> ErrorSrcPos
ErrorSrcPos SrcPos
pos) Macro
macro
  PSSequence [ExpandedOp]
xs -> [ExpandedOp]
xs

expand :: ParsedOp -> ExpandedOp
expand :: ParsedOp -> ExpandedOp
expand = let ics :: SrcPos -> ErrorSrcPos
ics SrcPos
pos = SrcPos -> ErrorSrcPos
ErrorSrcPos SrcPos
pos in \case
  (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
$ (ExpandedInstr -> ExpandedOp)
-> ([ExpandedOp] -> ExpandedOp)
-> Either ExpandedInstr [ExpandedOp]
-> ExpandedOp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ExpandedInstr -> ExpandedOp
PrimEx [ExpandedOp] -> ExpandedOp
SeqEx (Either ExpandedInstr [ExpandedOp] -> ExpandedOp)
-> Either ExpandedInstr [ExpandedOp] -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ ErrorSrcPos -> Macro -> Either ExpandedInstr [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
$ (ParsedSeq ExpandedOp -> [ExpandedOp])
-> InstrAbstract ParsedSeq ExpandedOp -> ExpandedInstr
forall {k} (n :: (k -> *) -> k -> *) (f :: k -> *) (a :: k)
       (g :: k -> *).
HoistInstr n =>
(f a -> g a) -> n f a -> n g a
forall (f :: * -> *) a (g :: * -> *).
(f a -> g a) -> InstrAbstract f a -> InstrAbstract g a
hoistInstr ParsedSeq ExpandedOp -> [ExpandedOp]
expandSeq (InstrAbstract ParsedSeq ExpandedOp -> ExpandedInstr)
-> InstrAbstract ParsedSeq ExpandedOp -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp)
-> ParsedInstr -> InstrAbstract ParsedSeq ExpandedOp
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 -> Either ExpandedInstr [ExpandedOp]
expandMacro' :: ErrorSrcPos -> Macro -> Either ExpandedInstr [ExpandedOp]
expandMacro' p :: ErrorSrcPos
p@ErrorSrcPos{unErrorSrcPos :: ErrorSrcPos -> SrcPos
unErrorSrcPos=SrcPos
macroPos} = \case
  -- special cases
  -- DIIP is now always represented as a single instruction.
  DIIP Word
n ParsedSeq ParsedOp
ops -> ExpandedInstr -> Either ExpandedInstr [ExpandedOp]
forall a b. a -> Either a b
Left (ExpandedInstr -> Either ExpandedInstr [ExpandedOp])
-> ExpandedInstr -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ Word -> [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. Word -> f op -> InstrAbstract f op
DIPN Word
n ([ExpandedOp] -> ExpandedInstr) -> [ExpandedOp] -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ ParsedSeq ExpandedOp -> [ExpandedOp]
expandSeq (ParsedSeq ExpandedOp -> [ExpandedOp])
-> ParsedSeq ExpandedOp -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp)
-> ParsedSeq ParsedOp -> ParsedSeq ExpandedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsedSeq ParsedOp
ops
  -- Similarly to above, DUUP is now always represented as a single instruction.
  DUUP Word
n VarAnn
v -> ExpandedInstr -> Either ExpandedInstr [ExpandedOp]
forall a b. a -> Either a b
Left (ExpandedInstr -> Either ExpandedInstr [ExpandedOp])
-> ExpandedInstr -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ VarAnn -> Word -> ExpandedInstr
forall (f :: * -> *) op. VarAnn -> Word -> InstrAbstract f op
DUPN VarAnn
v Word
n

  -- regular cases
  CMP ParsedInstr
i              -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> ExpandedInstr
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
COMPARE VarAnn
forall a. Default a => a
def), ParsedInstr -> ExpandedOp
xo ParsedInstr
i]
  IFX ParsedInstr
i ParsedSeq ParsedOp
bt ParsedSeq ParsedOp
bf        -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ParsedInstr -> ExpandedOp
xo ParsedInstr
i, ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. f op -> f op -> InstrAbstract f op
IF (ParsedSeq ParsedOp -> [ExpandedOp]
xp ParsedSeq ParsedOp
bt) (ParsedSeq ParsedOp -> [ExpandedOp]
xp ParsedSeq ParsedOp
bf)]
  IFCMP ParsedInstr
i ParsedSeq ParsedOp
bt ParsedSeq ParsedOp
bf      -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarAnn -> ExpandedInstr
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
COMPARE VarAnn
forall a. Default a => a
def, ParsedInstr -> ExpandedInstr
ex ParsedInstr
i, [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. f op -> f op -> InstrAbstract f op
IF (ParsedSeq ParsedOp -> [ExpandedOp]
xp ParsedSeq ParsedOp
bt) (ParsedSeq ParsedOp -> [ExpandedOp]
xp ParsedSeq ParsedOp
bf)]
  IF_SOME ParsedSeq ParsedOp
bt ParsedSeq ParsedOp
bf      -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedInstr -> ExpandedOp
PrimEx ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. f op -> f op -> InstrAbstract f op
IF_NONE (ParsedSeq ParsedOp -> [ExpandedOp]
xp ParsedSeq ParsedOp
bf) (ParsedSeq ParsedOp -> [ExpandedOp]
xp ParsedSeq ParsedOp
bt))]
  IF_RIGHT ParsedSeq ParsedOp
bt ParsedSeq ParsedOp
bf     -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedInstr -> ExpandedOp
PrimEx ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. f op -> f op -> InstrAbstract f op
IF_LEFT (ParsedSeq ParsedOp -> [ExpandedOp]
xp ParsedSeq ParsedOp
bf) (ParsedSeq ParsedOp -> [ExpandedOp]
xp ParsedSeq ParsedOp
bt))]
  Macro
FAIL               -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeAnn -> VarAnn -> ExpandedInstr
forall (f :: * -> *) op. TypeAnn -> VarAnn -> InstrAbstract f op
UNIT TypeAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn, ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
FAILWITH]
  Macro
ASSERT             -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ ExpandedInstr -> [ExpandedOp]
oprimEx (ExpandedInstr -> [ExpandedOp]) -> ExpandedInstr -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. f op -> f op -> InstrAbstract f op
IF [] [ExpandedOp]
fail'
  ASSERTX ParsedInstr
i          -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [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 -> ParsedSeq ParsedOp -> ParsedSeq ParsedOp -> Macro
IFX ParsedInstr
i ([ParsedOp] -> ParsedSeq ParsedOp
forall op. [op] -> ParsedSeq op
PSSequence []) ([ParsedOp] -> ParsedSeq ParsedOp
forall op. [op] -> ParsedSeq op
PSSequence [Macro -> ParsedOp
mac Macro
FAIL])]
  ASSERT_CMP ParsedInstr
i       -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$
    -- reference has weirdly inconsistent nesting between this and IFCMP
    [ParsedOp -> ExpandedOp
expand (Macro -> SrcPos -> ParsedOp
Mac (ParsedInstr -> Macro
CMP ParsedInstr
i) SrcPos
macroPos), ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. f op -> f op -> InstrAbstract f op
IF [] [ExpandedOp]
fail']
  Macro
ASSERT_NONE        -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ ExpandedInstr -> [ExpandedOp]
oprimEx (ExpandedInstr -> [ExpandedOp]) -> ExpandedInstr -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. f op -> f op -> InstrAbstract f op
IF_NONE [] [ExpandedOp]
fail'
  Macro
ASSERT_SOME        -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ ExpandedInstr -> [ExpandedOp]
oprimEx (ExpandedInstr -> [ExpandedOp]) -> ExpandedInstr -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. f op -> f op -> InstrAbstract f op
IF_NONE [ExpandedOp]
fail' []
  Macro
ASSERT_LEFT        -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ ExpandedInstr -> [ExpandedOp]
oprimEx (ExpandedInstr -> [ExpandedOp]) -> ExpandedInstr -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. f op -> f op -> InstrAbstract f op
IF_LEFT [] [ExpandedOp]
fail'
  Macro
ASSERT_RIGHT       -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ ExpandedInstr -> [ExpandedOp]
oprimEx (ExpandedInstr -> [ExpandedOp]) -> ExpandedInstr -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. f op -> f op -> InstrAbstract f op
IF_LEFT [ExpandedOp]
fail' []
  PAPAIR PairStruct
ps TypeAnn
t VarAnn
v      -> ErrorSrcPos
-> PairStruct
-> TypeAnn
-> VarAnn
-> Either ExpandedInstr [ExpandedOp]
expandPapair ErrorSrcPos
p PairStruct
ps TypeAnn
t VarAnn
v
  UNPAPAIR UnpairStruct
ps        -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ ErrorSrcPos -> UnpairStruct -> [ExpandedOp]
expandUnpapair ErrorSrcPos
p UnpairStruct
ps
  CADR [CadrStruct]
c VarAnn
v FieldAnn
f         -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ ErrorSrcPos -> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp]
expandCadr ErrorSrcPos
p [CadrStruct]
c VarAnn
v FieldAnn
f
  CARN VarAnn
v Word
idx         -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> Word -> ExpandedInstr
forall (f :: * -> *) op. VarAnn -> Word -> InstrAbstract f 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         -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> Word -> ExpandedInstr
forall (f :: * -> *) op. VarAnn -> Word -> InstrAbstract f 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     -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ ErrorSrcPos -> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp]
expandSetCadr ErrorSrcPos
p [CadrStruct]
c VarAnn
v FieldAnn
f
  MAP_CADR [CadrStruct]
c VarAnn
v FieldAnn
f ParsedSeq ParsedOp
ops -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ ErrorSrcPos
-> [CadrStruct]
-> VarAnn
-> FieldAnn
-> ParsedSeq ParsedOp
-> [ExpandedOp]
expandMapCadr ErrorSrcPos
p [CadrStruct]
c VarAnn
v FieldAnn
f ParsedSeq ParsedOp
ops

  where
    fail' :: [ExpandedOp]
fail' = OneItem [ExpandedOp] -> [ExpandedOp]
ExpandedOp -> [ExpandedOp]
forall x. One x => OneItem x -> x
one (ExpandedOp -> [ExpandedOp])
-> (ParsedOp -> ExpandedOp) -> ParsedOp -> [ExpandedOp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedOp -> ExpandedOp
expand (ParsedOp -> [ExpandedOp]) -> ParsedOp -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ Macro -> ParsedOp
mac Macro
FAIL
    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 = OneItem [ExpandedOp] -> [ExpandedOp]
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
. ParsedInstr -> ExpandedInstr
ex
    ex :: ParsedInstr -> ExpandedInstr
ex = (ParsedSeq ExpandedOp -> [ExpandedOp])
-> InstrAbstract ParsedSeq ExpandedOp -> ExpandedInstr
forall {k} (n :: (k -> *) -> k -> *) (f :: k -> *) (a :: k)
       (g :: k -> *).
HoistInstr n =>
(f a -> g a) -> n f a -> n g a
forall (f :: * -> *) a (g :: * -> *).
(f a -> g a) -> InstrAbstract f a -> InstrAbstract g a
hoistInstr ParsedSeq ExpandedOp -> [ExpandedOp]
expandSeq (InstrAbstract ParsedSeq ExpandedOp -> ExpandedInstr)
-> (ParsedInstr -> InstrAbstract ParsedSeq ExpandedOp)
-> ParsedInstr
-> ExpandedInstr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParsedOp -> ExpandedOp)
-> ParsedInstr -> InstrAbstract ParsedSeq ExpandedOp
forall a b.
(a -> b) -> InstrAbstract ParsedSeq a -> InstrAbstract ParsedSeq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedOp -> ExpandedOp
expand
    xp :: ParsedSeq ParsedOp -> [ExpandedOp]
xp = ParsedSeq ExpandedOp -> [ExpandedOp]
expandSeq (ParsedSeq ExpandedOp -> [ExpandedOp])
-> (ParsedSeq ParsedOp -> ParsedSeq ExpandedOp)
-> ParsedSeq ParsedOp
-> [ExpandedOp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParsedOp -> ExpandedOp)
-> ParsedSeq ParsedOp -> ParsedSeq ExpandedOp
forall a b. (a -> b) -> ParsedSeq a -> ParsedSeq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedOp -> ExpandedOp
expand

expandMacro :: ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro :: ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro = (ExpandedInstr -> [ExpandedOp])
-> ([ExpandedOp] -> [ExpandedOp])
-> Either ExpandedInstr [ExpandedOp]
-> [ExpandedOp]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ExpandedOp -> [ExpandedOp]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExpandedOp -> [ExpandedOp])
-> (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> [ExpandedOp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpandedInstr -> ExpandedOp
PrimEx) [ExpandedOp] -> [ExpandedOp]
forall a. a -> a
id (Either ExpandedInstr [ExpandedOp] -> [ExpandedOp])
-> (ErrorSrcPos -> Macro -> Either ExpandedInstr [ExpandedOp])
-> ErrorSrcPos
-> Macro
-> [ExpandedOp]
forall a b c. SuperComposition a b c => a -> b -> c
... ErrorSrcPos -> Macro -> Either ExpandedInstr [ExpandedOp]
expandMacro'

-- | The macro expansion rules below were taken from: https://tezos.gitlab.io/active/michelson.html#syntactic-conveniences
--
-- The correctness of type-annotation expansion is currently untested, as these
-- expansions are not explicitly documented in the Michelson Specification.
expandPapair
  :: ErrorSrcPos
  -> PairStruct
  -> TypeAnn
  -> VarAnn
  -> Either ExpandedInstr [ExpandedOp]
expandPapair :: ErrorSrcPos
-> PairStruct
-> TypeAnn
-> VarAnn
-> Either ExpandedInstr [ExpandedOp]
expandPapair ics :: ErrorSrcPos
ics@(ErrorSrcPos SrcPos
pos) PairStruct
ps TypeAnn
t VarAnn
v = case PairStruct
ps of
  -- We handle this case specially, because it's essentially just PAIR.
  -- It's needed because we have a hack in parser: we parse PAIR as PAPAIR.
  -- We need to do something better eventually.
  P (F FieldAnn
a) (F FieldAnn
b) -> ExpandedInstr -> Either ExpandedInstr [ExpandedOp]
forall a b. a -> Either a b
Left (ExpandedInstr -> Either ExpandedInstr [ExpandedOp])
-> ExpandedInstr -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall (f :: * -> *) op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract f op
PAIR TypeAnn
t VarAnn
v FieldAnn
a FieldAnn
b

  -- > PA(\right)R / S => DIP ((\right)R) ; PAIR / S
  -- docs lie a bit, reference actually does something weird, which we try to match
  -- to the best of our ability
  P (F FieldAnn
a) PairStruct
r -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$
    (Element [ExpandedOp] -> [ExpandedOp])
-> [ExpandedOp] -> [ExpandedOp]
forall c b. Container c => (Element c -> [b]) -> c -> [b]
concatMap Element [ExpandedOp] -> [ExpandedOp]
ExpandedOp -> [ExpandedOp]
papairDips (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))
    [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. Semigroup a => a -> a -> a
<> [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall (f :: * -> *) op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract f op
PAIR TypeAnn
t VarAnn
v FieldAnn
a FieldAnn
forall {k} (a :: k). Annotation a
noAnn]

  -- > P(\left)IR / S => (\left)R ; PAIR / S
  P PairStruct
l (F FieldAnn
b) -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right [ ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp) -> ParsedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Macro -> SrcPos -> ParsedOp
Mac (PairStruct -> TypeAnn -> VarAnn -> Macro
PAPAIR PairStruct
l TypeAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn) SrcPos
pos, ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall (f :: * -> *) op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract f op
PAIR TypeAnn
t VarAnn
v FieldAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
b ]

  -- > P(\left)(\right)R =>  (\left)R ; DIP ((\right)R) ; PAIR / S
  -- docs lie a bit, reference actually does something weird, which we try to match
  -- to the best of our ability
  P PairStruct
l PairStruct
r -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right ([ExpandedOp] -> Either ExpandedInstr [ExpandedOp])
-> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. (a -> b) -> a -> b
$
    (ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp) -> ParsedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Macro -> SrcPos -> ParsedOp
Mac (PairStruct -> TypeAnn -> VarAnn -> Macro
PAPAIR PairStruct
l TypeAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
forall {k} (a :: k). Annotation a
noAnn) SrcPos
pos)
    ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: (Element [ExpandedOp] -> [ExpandedOp])
-> [ExpandedOp] -> [ExpandedOp]
forall c b. Container c => (Element c -> [b]) -> c -> [b]
concatMap Element [ExpandedOp] -> [ExpandedOp]
ExpandedOp -> [ExpandedOp]
papairDips (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))
    [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. Semigroup a => a -> a -> a
<> [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall (f :: * -> *) op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract f op
PAIR TypeAnn
t VarAnn
v FieldAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
forall {k} (a :: k). Annotation a
noAnn]

  -- It's impossible from the structure of PairStruct and considered cases above,
  -- but if it accidentally happened let's just do nothing.
  F FieldAnn
_           -> [ExpandedOp] -> Either ExpandedInstr [ExpandedOp]
forall a b. b -> Either a b
Right []

-- | Mimic the weirdness that is the reference implementation
papairDips :: ExpandedOp -> [ExpandedOp]
papairDips :: ExpandedOp -> [ExpandedOp]
papairDips = \case
  PrimEx (DIP [ExpandedOp]
xs) -> [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Word -> [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. Word -> f op -> InstrAbstract f op
DIPN Word
2 [ExpandedOp]
xs]
  PrimEx (DIPN Word
n [ExpandedOp]
xs) -> [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Word -> [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. Word -> f op -> InstrAbstract f op
DIPN (Word -> Word
forall a. Enum a => a -> a
succ Word
n) [ExpandedOp]
xs]
  SeqEx [ExpandedOp]
xs -> (Element [ExpandedOp] -> [ExpandedOp])
-> [ExpandedOp] -> [ExpandedOp]
forall c b. Container c => (Element c -> [b]) -> c -> [b]
concatMap Element [ExpandedOp] -> [ExpandedOp]
ExpandedOp -> [ExpandedOp]
papairDips [ExpandedOp]
xs
  PrimEx ExpandedInstr
x -> [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. f op -> InstrAbstract f op
DIP [ExpandedInstr -> ExpandedOp
PrimEx ExpandedInstr
x]]
  WithSrcEx ErrorSrcPos
s ExpandedOp
x -> ErrorSrcPos -> ExpandedOp -> ExpandedOp
WithSrcEx ErrorSrcPos
s (ExpandedOp -> ExpandedOp) -> [ExpandedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExpandedOp -> [ExpandedOp]
papairDips ExpandedOp
x

-- | The macro expansion rules below were taken from: https://tezos.gitlab.io/active/michelson.html#syntactic-conveniences
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 (f :: * -> *) op.
VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract f 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) ]

  -- > UNPA(\right)R / S => UNPAIR ; DIP (UN(\right)R) / S
  -- docs lie a bit, reference actually does something weird, which we try to match
  -- to the best of our ability
  UP UnpairStruct
UF UnpairStruct
r ->
    ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall (f :: * -> *) op.
VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract f 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]
: (Element [ExpandedOp] -> [ExpandedOp])
-> [ExpandedOp] -> [ExpandedOp]
forall c b. Container c => (Element c -> [b]) -> c -> [b]
concatMap Element [ExpandedOp] -> [ExpandedOp]
ExpandedOp -> [ExpandedOp]
papairDips (ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
ics (UnpairStruct -> Macro
UNPAPAIR UnpairStruct
r))

  -- > UNP(\left)IR / S => UNPAIR ; UN(\left)R / S
  UP UnpairStruct
l UnpairStruct
UF ->
    ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall (f :: * -> *) op.
VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract f 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)

  -- > UNP(\left)(\right)R => UNPAIR ; DIP (UN(\right)R) ; UN(\left)R / S
  -- docs lie a bit, reference actually does something weird, which we try to match
  -- to the best of our ability
  UP UnpairStruct
l UnpairStruct
r ->
    ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall (f :: * -> *) op.
VarAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract f 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]
: (Element [ExpandedOp] -> [ExpandedOp])
-> [ExpandedOp] -> [ExpandedOp]
forall c b. Container c => (Element c -> [b]) -> c -> [b]
concatMap Element [ExpandedOp] -> [ExpandedOp]
ExpandedOp -> [ExpandedOp]
papairDips (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. Semigroup a => a -> a -> a
<> ErrorSrcPos -> Macro -> [ExpandedOp]
expandMacro ErrorSrcPos
ics (UnpairStruct -> Macro
UNPAPAIR UnpairStruct
l)

  -- It's impossible from the structure of UnpairStruct and considered cases above,
  -- but if it accidentally happened let's just do nothing.
  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 (f :: * -> *) op. VarAnn -> FieldAnn -> InstrAbstract f 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 (f :: * -> *) op. VarAnn -> FieldAnn -> InstrAbstract f op
CDR VarAnn
v FieldAnn
f]
  CadrStruct
A:[CadrStruct]
css -> ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> FieldAnn -> ExpandedInstr
forall (f :: * -> *) op. VarAnn -> FieldAnn -> InstrAbstract f 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 (f :: * -> *) op. VarAnn -> FieldAnn -> InstrAbstract f 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 f op
carNoAnn :: forall (f :: * -> *) op. InstrAbstract f op
carNoAnn = VarAnn -> FieldAnn -> InstrAbstract f op
forall (f :: * -> *) op. VarAnn -> FieldAnn -> InstrAbstract f op
CAR [annQ|%%|] FieldAnn
forall {k} (a :: k). Annotation a
noAnn

cdrNoAnn :: InstrAbstract f op
cdrNoAnn :: forall (f :: * -> *) op. InstrAbstract f op
cdrNoAnn = VarAnn -> FieldAnn -> InstrAbstract f op
forall (f :: * -> *) op. VarAnn -> FieldAnn -> InstrAbstract f op
CDR [annQ|%%|] FieldAnn
forall {k} (a :: k). Annotation a
noAnn

pairNoAnn :: VarAnn -> InstrAbstract f op
pairNoAnn :: forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
pairNoAnn VarAnn
v = TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract f op
forall (f :: * -> *) op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract f 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 SrcPos
ps) [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]   -> [ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
cdrNoAnn, ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
SWAP, TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall (f :: * -> *) op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract f op
PAIR TypeAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
v FieldAnn
f [annQ|@|]]
  [CadrStruct
D]   -> [ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
carNoAnn, TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall (f :: * -> *) op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract f op
PAIR TypeAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
v [annQ|@|] FieldAnn
f]
  CadrStruct
A:[CadrStruct]
css -> [VarAnn -> ExpandedInstr
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
DUP VarAnn
forall {k} (a :: k). Annotation a
noAnn, [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. f op -> InstrAbstract f op
DIP [ExpandedInstr -> ExpandedOp
PrimEx ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
carNoAnn, ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp) -> ParsedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Macro -> SrcPos -> ParsedOp
Mac ([CadrStruct] -> VarAnn -> FieldAnn -> Macro
SET_CADR [CadrStruct]
css VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
f) SrcPos
ps], ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
cdrNoAnn, ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
SWAP, VarAnn -> ExpandedInstr
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
pairNoAnn VarAnn
v]
  CadrStruct
D:[CadrStruct]
css -> [VarAnn -> ExpandedInstr
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
DUP VarAnn
forall {k} (a :: k). Annotation a
noAnn, [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. f op -> InstrAbstract f op
DIP [ExpandedInstr -> ExpandedOp
PrimEx ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
cdrNoAnn, ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp) -> ParsedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Macro -> SrcPos -> ParsedOp
Mac ([CadrStruct] -> VarAnn -> FieldAnn -> Macro
SET_CADR [CadrStruct]
css VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
f) SrcPos
ps], ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
carNoAnn, VarAnn -> ExpandedInstr
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
pairNoAnn VarAnn
v]

expandMapCadr :: ErrorSrcPos -> [CadrStruct] -> VarAnn -> FieldAnn -> ParsedSeq ParsedOp -> [ExpandedOp]
expandMapCadr :: ErrorSrcPos
-> [CadrStruct]
-> VarAnn
-> FieldAnn
-> ParsedSeq ParsedOp
-> [ExpandedOp]
expandMapCadr (ErrorSrcPos SrcPos
pos) [CadrStruct]
cs VarAnn
v FieldAnn
f ParsedSeq ParsedOp
ops = case [CadrStruct]
cs of
  []    -> []
  -- > MAP_CAR code  =>  DUP ; CDR ; DIP { CAR ; code } ; SWAP ; PAIR
  [CadrStruct
A]   -> ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [ VarAnn -> ExpandedInstr
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
DUP VarAnn
forall {k} (a :: k). Annotation a
noAnn
    , ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
cdrNoAnn
    , [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. f op -> InstrAbstract f op
DIP [ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> FieldAnn -> ExpandedInstr
forall (f :: * -> *) op. VarAnn -> FieldAnn -> InstrAbstract f op
CAR VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
f), [ExpandedOp] -> ExpandedOp
SeqEx ([ExpandedOp] -> ExpandedOp) -> [ExpandedOp] -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ ParsedSeq ExpandedOp -> [ExpandedOp]
expandSeq (ParsedSeq ExpandedOp -> [ExpandedOp])
-> ParsedSeq ExpandedOp -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp)
-> ParsedSeq ParsedOp -> ParsedSeq ExpandedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsedSeq ParsedOp
ops]
    , ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
SWAP
    , TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall (f :: * -> *) op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract f op
PAIR TypeAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
v FieldAnn
f [annQ|@|]]
  -- > MAP_CDR code  =>  DUP ; CDR ; code ; SWAP ; CAR ; PAIR
  [CadrStruct
D]   -> (ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarAnn -> ExpandedInstr
forall (f :: * -> *) op. VarAnn -> InstrAbstract f op
DUP VarAnn
forall {k} (a :: k). Annotation a
noAnn, VarAnn -> FieldAnn -> ExpandedInstr
forall (f :: * -> *) op. VarAnn -> FieldAnn -> InstrAbstract f op
CDR VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
f]) [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. Semigroup a => a -> a -> a
<>
    ([ExpandedOp] -> ExpandedOp
SeqEx (ParsedSeq ExpandedOp -> [ExpandedOp]
expandSeq (ParsedSeq ExpandedOp -> [ExpandedOp])
-> ParsedSeq ExpandedOp -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp)
-> ParsedSeq ParsedOp -> ParsedSeq ExpandedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsedSeq ParsedOp
ops) ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: (ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
SWAP, ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
carNoAnn, TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall (f :: * -> *) op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract f op
PAIR TypeAnn
forall {k} (a :: k). Annotation a
noAnn VarAnn
v [annQ|@|] FieldAnn
f]))
  -- > MAP_CA(\rest=[AD]+)R code / S   =>
  --     { DUP ; DIP { CAR ; MAP_C(\rest)R code } ; CDR ; SWAP ; PAIR } / S
  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 (f :: * -> *) op. VarAnn -> InstrAbstract f op
DUP VarAnn
forall {k} (a :: k). Annotation a
noAnn, [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. f op -> InstrAbstract f op
DIP [ExpandedInstr -> ExpandedOp
PrimEx ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
carNoAnn, ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp) -> ParsedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Macro -> SrcPos -> ParsedOp
Mac ([CadrStruct] -> VarAnn -> FieldAnn -> ParsedSeq ParsedOp -> Macro
MAP_CADR [CadrStruct]
css VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
f ParsedSeq ParsedOp
ops) SrcPos
pos], ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
cdrNoAnn, ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
SWAP, VarAnn -> ExpandedInstr
forall (f :: * -> *) op. VarAnn -> InstrAbstract f 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 (f :: * -> *) op. VarAnn -> InstrAbstract f op
DUP VarAnn
forall {k} (a :: k). Annotation a
noAnn, [ExpandedOp] -> ExpandedInstr
forall (f :: * -> *) op. f op -> InstrAbstract f op
DIP [ExpandedInstr -> ExpandedOp
PrimEx ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
cdrNoAnn, ParsedOp -> ExpandedOp
expand (ParsedOp -> ExpandedOp) -> ParsedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Macro -> SrcPos -> ParsedOp
Mac ([CadrStruct] -> VarAnn -> FieldAnn -> ParsedSeq ParsedOp -> Macro
MAP_CADR [CadrStruct]
css VarAnn
forall {k} (a :: k). Annotation a
noAnn FieldAnn
f ParsedSeq ParsedOp
ops) SrcPos
pos], ExpandedInstr
forall (f :: * -> *) op. InstrAbstract f op
carNoAnn, VarAnn -> ExpandedInstr
forall (f :: * -> *) op. VarAnn -> InstrAbstract f 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 a.
([FieldAnn] -> (a, [FieldAnn])) -> StateT [FieldAnn] Identity a
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
  , deriveJSON morleyAesonOptions ''ParsedSeq
  ])