-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

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

  -- * Morley Parsed value types
  , ParsedValue

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

    -- * For utilities
  , expandContract
  , expandValue

    -- * For parsing
  , mapPairLeaves
  , mapUnpairLeaves

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

import Data.Aeson.TH (deriveJSON)
import Data.Data (Data(..))
import qualified Data.Text as T
import Fmt (Buildable(build), genericF, (+|), (+||), (|+), (||+))
import qualified Text.PrettyPrint.Leijen.Text as PP (empty)

import Michelson.ErrorPos
import Michelson.Printer (RenderDoc(..))
import Michelson.Untyped
import Util.Aeson
import Util.Generic
import Util.Positive

-- | A programmer-defined macro
data LetMacro = LetMacro
  { LetMacro -> Text
lmName :: T.Text
  , LetMacro -> StackFn
lmSig :: StackFn
  , LetMacro -> [ParsedOp]
lmExpr :: [ParsedOp]
  } deriving stock (LetMacro -> LetMacro -> Bool
(LetMacro -> LetMacro -> Bool)
-> (LetMacro -> LetMacro -> Bool) -> Eq LetMacro
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LetMacro -> LetMacro -> Bool
$c/= :: LetMacro -> LetMacro -> Bool
== :: LetMacro -> LetMacro -> Bool
$c== :: LetMacro -> LetMacro -> Bool
Eq, Int -> LetMacro -> ShowS
[LetMacro] -> ShowS
LetMacro -> String
(Int -> LetMacro -> ShowS)
-> (LetMacro -> String) -> ([LetMacro] -> ShowS) -> Show LetMacro
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LetMacro] -> ShowS
$cshowList :: [LetMacro] -> ShowS
show :: LetMacro -> String
$cshow :: LetMacro -> String
showsPrec :: Int -> LetMacro -> ShowS
$cshowsPrec :: Int -> LetMacro -> ShowS
Show, Typeable LetMacro
DataType
Constr
Typeable LetMacro =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> LetMacro -> c LetMacro)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LetMacro)
-> (LetMacro -> Constr)
-> (LetMacro -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LetMacro))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LetMacro))
-> ((forall b. Data b => b -> b) -> LetMacro -> LetMacro)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LetMacro -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LetMacro -> r)
-> (forall u. (forall d. Data d => d -> u) -> LetMacro -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> LetMacro -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> LetMacro -> m LetMacro)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LetMacro -> m LetMacro)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LetMacro -> m LetMacro)
-> Data LetMacro
LetMacro -> DataType
LetMacro -> Constr
(forall b. Data b => b -> b) -> LetMacro -> LetMacro
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetMacro -> c LetMacro
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LetMacro
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) -> LetMacro -> u
forall u. (forall d. Data d => d -> u) -> LetMacro -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LetMacro -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LetMacro -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LetMacro -> m LetMacro
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LetMacro -> m LetMacro
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LetMacro
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetMacro -> c LetMacro
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LetMacro)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LetMacro)
$cLetMacro :: Constr
$tLetMacro :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> LetMacro -> m LetMacro
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LetMacro -> m LetMacro
gmapMp :: (forall d. Data d => d -> m d) -> LetMacro -> m LetMacro
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LetMacro -> m LetMacro
gmapM :: (forall d. Data d => d -> m d) -> LetMacro -> m LetMacro
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LetMacro -> m LetMacro
gmapQi :: Int -> (forall d. Data d => d -> u) -> LetMacro -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LetMacro -> u
gmapQ :: (forall d. Data d => d -> u) -> LetMacro -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LetMacro -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LetMacro -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LetMacro -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LetMacro -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LetMacro -> r
gmapT :: (forall b. Data b => b -> b) -> LetMacro -> LetMacro
$cgmapT :: (forall b. Data b => b -> b) -> LetMacro -> LetMacro
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LetMacro)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LetMacro)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LetMacro)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LetMacro)
dataTypeOf :: LetMacro -> DataType
$cdataTypeOf :: LetMacro -> DataType
toConstr :: LetMacro -> Constr
$ctoConstr :: LetMacro -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LetMacro
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LetMacro
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetMacro -> c LetMacro
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetMacro -> c LetMacro
$cp1Data :: Typeable LetMacro
Data, (forall x. LetMacro -> Rep LetMacro x)
-> (forall x. Rep LetMacro x -> LetMacro) -> Generic LetMacro
forall x. Rep LetMacro x -> LetMacro
forall x. LetMacro -> Rep LetMacro x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LetMacro x -> LetMacro
$cfrom :: forall x. LetMacro -> Rep LetMacro x
Generic)

instance Buildable LetMacro where
  build :: LetMacro -> Builder
build = LetMacro -> Builder
forall a. (Generic a, GBuildable (Rep a)) => a -> Builder
genericF

instance NFData LetMacro

data PairStruct
  = F FieldAnn
  | P PairStruct PairStruct
  deriving stock (PairStruct -> PairStruct -> Bool
(PairStruct -> PairStruct -> Bool)
-> (PairStruct -> PairStruct -> Bool) -> Eq PairStruct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PairStruct -> PairStruct -> Bool
$c/= :: PairStruct -> PairStruct -> Bool
== :: PairStruct -> PairStruct -> Bool
$c== :: PairStruct -> PairStruct -> Bool
Eq, Int -> PairStruct -> ShowS
[PairStruct] -> ShowS
PairStruct -> String
(Int -> PairStruct -> ShowS)
-> (PairStruct -> String)
-> ([PairStruct] -> ShowS)
-> Show PairStruct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PairStruct] -> ShowS
$cshowList :: [PairStruct] -> ShowS
show :: PairStruct -> String
$cshow :: PairStruct -> String
showsPrec :: Int -> PairStruct -> ShowS
$cshowsPrec :: Int -> PairStruct -> ShowS
Show, Typeable PairStruct
DataType
Constr
Typeable PairStruct =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> PairStruct -> c PairStruct)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PairStruct)
-> (PairStruct -> Constr)
-> (PairStruct -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PairStruct))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PairStruct))
-> ((forall b. Data b => b -> b) -> PairStruct -> PairStruct)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PairStruct -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PairStruct -> r)
-> (forall u. (forall d. Data d => d -> u) -> PairStruct -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PairStruct -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PairStruct -> m PairStruct)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PairStruct -> m PairStruct)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PairStruct -> m PairStruct)
-> Data PairStruct
PairStruct -> DataType
PairStruct -> Constr
(forall b. Data b => b -> b) -> PairStruct -> PairStruct
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PairStruct -> c PairStruct
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cP :: Constr
$cF :: Constr
$tPairStruct :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> PairStruct -> m PairStruct
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PairStruct -> m PairStruct
gmapMp :: (forall d. Data d => d -> m d) -> PairStruct -> m PairStruct
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PairStruct -> m PairStruct
gmapM :: (forall d. Data d => d -> m d) -> PairStruct -> m PairStruct
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PairStruct -> m PairStruct
gmapQi :: Int -> (forall d. Data d => d -> u) -> PairStruct -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PairStruct -> u
gmapQ :: (forall d. Data d => d -> u) -> PairStruct -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PairStruct -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PairStruct -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PairStruct -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PairStruct -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PairStruct -> r
gmapT :: (forall b. Data b => b -> b) -> PairStruct -> PairStruct
$cgmapT :: (forall b. Data b => b -> b) -> PairStruct -> PairStruct
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PairStruct)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PairStruct)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PairStruct)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PairStruct)
dataTypeOf :: PairStruct -> DataType
$cdataTypeOf :: PairStruct -> DataType
toConstr :: PairStruct -> Constr
$ctoConstr :: PairStruct -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PairStruct
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PairStruct
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PairStruct -> c PairStruct
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PairStruct -> c PairStruct
$cp1Data :: Typeable PairStruct
Data, (forall x. PairStruct -> Rep PairStruct x)
-> (forall x. Rep PairStruct x -> PairStruct) -> Generic PairStruct
forall x. Rep PairStruct x -> PairStruct
forall x. PairStruct -> Rep PairStruct x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PairStruct x -> PairStruct
$cfrom :: forall x. PairStruct -> Rep PairStruct x
Generic)

instance NFData PairStruct

instance Buildable PairStruct where
  build :: PairStruct -> Builder
build = PairStruct -> Builder
forall a. (Generic a, GBuildable (Rep a)) => a -> Builder
genericF

data UnpairStruct
  = UF (VarAnn, FieldAnn)
  | UP UnpairStruct UnpairStruct
  deriving stock (UnpairStruct -> UnpairStruct -> Bool
(UnpairStruct -> UnpairStruct -> Bool)
-> (UnpairStruct -> UnpairStruct -> Bool) -> Eq UnpairStruct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnpairStruct -> UnpairStruct -> Bool
$c/= :: UnpairStruct -> UnpairStruct -> Bool
== :: UnpairStruct -> UnpairStruct -> Bool
$c== :: UnpairStruct -> UnpairStruct -> Bool
Eq, Int -> UnpairStruct -> ShowS
[UnpairStruct] -> ShowS
UnpairStruct -> String
(Int -> UnpairStruct -> ShowS)
-> (UnpairStruct -> String)
-> ([UnpairStruct] -> ShowS)
-> Show UnpairStruct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnpairStruct] -> ShowS
$cshowList :: [UnpairStruct] -> ShowS
show :: UnpairStruct -> String
$cshow :: UnpairStruct -> String
showsPrec :: Int -> UnpairStruct -> ShowS
$cshowsPrec :: Int -> UnpairStruct -> ShowS
Show, Typeable UnpairStruct
DataType
Constr
Typeable UnpairStruct =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> UnpairStruct -> c UnpairStruct)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UnpairStruct)
-> (UnpairStruct -> Constr)
-> (UnpairStruct -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UnpairStruct))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c UnpairStruct))
-> ((forall b. Data b => b -> b) -> UnpairStruct -> UnpairStruct)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> UnpairStruct -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> UnpairStruct -> r)
-> (forall u. (forall d. Data d => d -> u) -> UnpairStruct -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> UnpairStruct -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct)
-> Data UnpairStruct
UnpairStruct -> DataType
UnpairStruct -> Constr
(forall b. Data b => b -> b) -> UnpairStruct -> UnpairStruct
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnpairStruct -> c UnpairStruct
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cUP :: Constr
$cUF :: Constr
$tUnpairStruct :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct
gmapMp :: (forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct
gmapM :: (forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnpairStruct -> m UnpairStruct
gmapQi :: Int -> (forall d. Data d => d -> u) -> UnpairStruct -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UnpairStruct -> u
gmapQ :: (forall d. Data d => d -> u) -> UnpairStruct -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UnpairStruct -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnpairStruct -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UnpairStruct -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnpairStruct -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UnpairStruct -> r
gmapT :: (forall b. Data b => b -> b) -> UnpairStruct -> UnpairStruct
$cgmapT :: (forall b. Data b => b -> b) -> UnpairStruct -> UnpairStruct
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UnpairStruct)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c UnpairStruct)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c UnpairStruct)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnpairStruct)
dataTypeOf :: UnpairStruct -> DataType
$cdataTypeOf :: UnpairStruct -> DataType
toConstr :: UnpairStruct -> Constr
$ctoConstr :: UnpairStruct -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnpairStruct
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnpairStruct
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnpairStruct -> c UnpairStruct
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnpairStruct -> c UnpairStruct
$cp1Data :: Typeable UnpairStruct
Data, (forall x. UnpairStruct -> Rep UnpairStruct x)
-> (forall x. Rep UnpairStruct x -> UnpairStruct)
-> Generic UnpairStruct
forall x. Rep UnpairStruct x -> UnpairStruct
forall x. UnpairStruct -> Rep UnpairStruct x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnpairStruct x -> UnpairStruct
$cfrom :: forall x. UnpairStruct -> Rep UnpairStruct x
Generic)

instance NFData UnpairStruct

instance Buildable UnpairStruct where
  build :: UnpairStruct -> Builder
build = UnpairStruct -> Builder
forall a. (Generic a, GBuildable (Rep a)) => a -> Builder
genericF

data CadrStruct
  = A
  | D
  deriving stock (CadrStruct -> CadrStruct -> Bool
(CadrStruct -> CadrStruct -> Bool)
-> (CadrStruct -> CadrStruct -> Bool) -> Eq CadrStruct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CadrStruct -> CadrStruct -> Bool
$c/= :: CadrStruct -> CadrStruct -> Bool
== :: CadrStruct -> CadrStruct -> Bool
$c== :: CadrStruct -> CadrStruct -> Bool
Eq, Int -> CadrStruct -> ShowS
[CadrStruct] -> ShowS
CadrStruct -> String
(Int -> CadrStruct -> ShowS)
-> (CadrStruct -> String)
-> ([CadrStruct] -> ShowS)
-> Show CadrStruct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CadrStruct] -> ShowS
$cshowList :: [CadrStruct] -> ShowS
show :: CadrStruct -> String
$cshow :: CadrStruct -> String
showsPrec :: Int -> CadrStruct -> ShowS
$cshowsPrec :: Int -> CadrStruct -> ShowS
Show, Typeable CadrStruct
DataType
Constr
Typeable CadrStruct =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CadrStruct -> c CadrStruct)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CadrStruct)
-> (CadrStruct -> Constr)
-> (CadrStruct -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CadrStruct))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CadrStruct))
-> ((forall b. Data b => b -> b) -> CadrStruct -> CadrStruct)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CadrStruct -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CadrStruct -> r)
-> (forall u. (forall d. Data d => d -> u) -> CadrStruct -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CadrStruct -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct)
-> Data CadrStruct
CadrStruct -> DataType
CadrStruct -> Constr
(forall b. Data b => b -> b) -> CadrStruct -> CadrStruct
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CadrStruct -> c CadrStruct
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cD :: Constr
$cA :: Constr
$tCadrStruct :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct
gmapMp :: (forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct
gmapM :: (forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CadrStruct -> m CadrStruct
gmapQi :: Int -> (forall d. Data d => d -> u) -> CadrStruct -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CadrStruct -> u
gmapQ :: (forall d. Data d => d -> u) -> CadrStruct -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CadrStruct -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CadrStruct -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CadrStruct -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CadrStruct -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CadrStruct -> r
gmapT :: (forall b. Data b => b -> b) -> CadrStruct -> CadrStruct
$cgmapT :: (forall b. Data b => b -> b) -> CadrStruct -> CadrStruct
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CadrStruct)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CadrStruct)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CadrStruct)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CadrStruct)
dataTypeOf :: CadrStruct -> DataType
$cdataTypeOf :: CadrStruct -> DataType
toConstr :: CadrStruct -> Constr
$ctoConstr :: CadrStruct -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CadrStruct
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CadrStruct
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CadrStruct -> c CadrStruct
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CadrStruct -> c CadrStruct
$cp1Data :: Typeable CadrStruct
Data, (forall x. CadrStruct -> Rep CadrStruct x)
-> (forall x. Rep CadrStruct x -> CadrStruct) -> Generic CadrStruct
forall x. Rep CadrStruct x -> CadrStruct
forall x. CadrStruct -> Rep CadrStruct x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CadrStruct x -> CadrStruct
$cfrom :: forall x. CadrStruct -> Rep CadrStruct x
Generic)

instance NFData CadrStruct

instance Buildable CadrStruct where
  build :: CadrStruct -> Builder
build = CadrStruct -> Builder
forall a. (Generic a, GBuildable (Rep a)) => a -> Builder
genericF

-- | 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
  | LMac LetMacro    SrcPos -- ^ User-defined macro with instructions to be inlined
  | 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
/= :: ParsedOp -> ParsedOp -> Bool
$c/= :: ParsedOp -> ParsedOp -> Bool
== :: ParsedOp -> ParsedOp -> Bool
$c== :: ParsedOp -> ParsedOp -> Bool
Eq, Int -> ParsedOp -> ShowS
[ParsedOp] -> ShowS
ParsedOp -> String
(Int -> ParsedOp -> ShowS)
-> (ParsedOp -> String) -> ([ParsedOp] -> ShowS) -> Show ParsedOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParsedOp] -> ShowS
$cshowList :: [ParsedOp] -> ShowS
show :: ParsedOp -> String
$cshow :: ParsedOp -> String
showsPrec :: Int -> ParsedOp -> ShowS
$cshowsPrec :: Int -> ParsedOp -> ShowS
Show, Typeable ParsedOp
DataType
Constr
Typeable ParsedOp =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ParsedOp -> c ParsedOp)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ParsedOp)
-> (ParsedOp -> Constr)
-> (ParsedOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ParsedOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ParsedOp))
-> ((forall b. Data b => b -> b) -> ParsedOp -> ParsedOp)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ParsedOp -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ParsedOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> ParsedOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ParsedOp -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp)
-> Data ParsedOp
ParsedOp -> DataType
ParsedOp -> Constr
(forall b. Data b => b -> b) -> ParsedOp -> ParsedOp
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsedOp -> c ParsedOp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cSeq :: Constr
$cLMac :: Constr
$cMac :: Constr
$cPrim :: Constr
$tParsedOp :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp
gmapMp :: (forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp
gmapM :: (forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParsedOp -> m ParsedOp
gmapQi :: Int -> (forall d. Data d => d -> u) -> ParsedOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParsedOp -> u
gmapQ :: (forall d. Data d => d -> u) -> ParsedOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ParsedOp -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedOp -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedOp -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParsedOp -> r
gmapT :: (forall b. Data b => b -> b) -> ParsedOp -> ParsedOp
$cgmapT :: (forall b. Data b => b -> b) -> ParsedOp -> ParsedOp
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ParsedOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ParsedOp)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ParsedOp)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParsedOp)
dataTypeOf :: ParsedOp -> DataType
$cdataTypeOf :: ParsedOp -> DataType
toConstr :: ParsedOp -> Constr
$ctoConstr :: ParsedOp -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParsedOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParsedOp
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsedOp -> c ParsedOp
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsedOp -> c ParsedOp
$cp1Data :: Typeable ParsedOp
Data, (forall x. ParsedOp -> Rep ParsedOp x)
-> (forall x. Rep ParsedOp x -> ParsedOp) -> Generic ParsedOp
forall x. Rep ParsedOp x -> ParsedOp
forall x. ParsedOp -> Rep ParsedOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParsedOp x -> ParsedOp
$cfrom :: forall x. ParsedOp -> Rep ParsedOp x
Generic)

-- dummy value
instance RenderDoc ParsedOp where
  renderDoc :: RenderContext -> ParsedOp -> Doc
renderDoc _ _ = Doc
PP.empty

instance Buildable ParsedOp where
  build :: ParsedOp -> Builder
build = \case
    Prim parseInstr :: ParsedInstr
parseInstr _ -> "<Prim: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|ParsedInstr
parseInstrParsedInstr -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    Mac macro :: Macro
macro _       -> "<Mac: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|Macro
macroMacro -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    LMac letMacro :: LetMacro
letMacro _   -> "<LMac: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|LetMacro
letMacroLetMacro -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    Seq parsedOps :: [ParsedOp]
parsedOps _   -> "<Seq: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"

instance NFData ParsedOp

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

type ParsedUExtInstr = ExtInstrAbstract ParsedOp

type ParsedInstr = InstrAbstract ParsedOp

type ParsedValue = Value' ParsedOp

-- | Built-in Michelson Macros defined by the specification
data Macro
  = CASE (NonEmpty [ParsedOp])
  | TAG Natural (NonEmpty Type)
  | ACCESS Natural Positive
  | SET Natural Positive
  | CONSTRUCT (NonEmpty [ParsedOp])
  | VIEW [ParsedOp]
  | VOID [ParsedOp]
  | CMP ParsedInstr VarAnn
  | IFX ParsedInstr [ParsedOp] [ParsedOp]
  | IFCMP ParsedInstr VarAnn [ParsedOp] [ParsedOp]
  | FAIL
  | PAPAIR PairStruct TypeAnn VarAnn
  | UNPAIR UnpairStruct
  | CADR [CadrStruct] VarAnn FieldAnn
  | SET_CADR [CadrStruct] VarAnn FieldAnn
  | MAP_CADR [CadrStruct] VarAnn FieldAnn [ParsedOp]
  | DIIP Word [ParsedOp]
  | DUUP Word VarAnn
  | ASSERT
  | ASSERTX ParsedInstr
  | ASSERT_CMP ParsedInstr
  | ASSERT_NONE
  | ASSERT_SOME
  | ASSERT_LEFT
  | ASSERT_RIGHT
  | IF_SOME [ParsedOp] [ParsedOp]
  | IF_RIGHT [ParsedOp] [ParsedOp]
  deriving stock (Macro -> Macro -> Bool
(Macro -> Macro -> Bool) -> (Macro -> Macro -> Bool) -> Eq Macro
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Macro -> Macro -> Bool
$c/= :: Macro -> Macro -> Bool
== :: Macro -> Macro -> Bool
$c== :: Macro -> Macro -> Bool
Eq, Int -> Macro -> ShowS
[Macro] -> ShowS
Macro -> String
(Int -> Macro -> ShowS)
-> (Macro -> String) -> ([Macro] -> ShowS) -> Show Macro
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Macro] -> ShowS
$cshowList :: [Macro] -> ShowS
show :: Macro -> String
$cshow :: Macro -> String
showsPrec :: Int -> Macro -> ShowS
$cshowsPrec :: Int -> Macro -> ShowS
Show, Typeable Macro
DataType
Constr
Typeable Macro =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Macro -> c Macro)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Macro)
-> (Macro -> Constr)
-> (Macro -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Macro))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Macro))
-> ((forall b. Data b => b -> b) -> Macro -> Macro)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Macro -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Macro -> r)
-> (forall u. (forall d. Data d => d -> u) -> Macro -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Macro -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Macro -> m Macro)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Macro -> m Macro)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Macro -> m Macro)
-> Data Macro
Macro -> DataType
Macro -> Constr
(forall b. Data b => b -> b) -> Macro -> Macro
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Macro -> c Macro
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cIF_RIGHT :: Constr
$cIF_SOME :: Constr
$cASSERT_RIGHT :: Constr
$cASSERT_LEFT :: Constr
$cASSERT_SOME :: Constr
$cASSERT_NONE :: Constr
$cASSERT_CMP :: Constr
$cASSERTX :: Constr
$cASSERT :: Constr
$cDUUP :: Constr
$cDIIP :: Constr
$cMAP_CADR :: Constr
$cSET_CADR :: Constr
$cCADR :: Constr
$cUNPAIR :: Constr
$cPAPAIR :: Constr
$cFAIL :: Constr
$cIFCMP :: Constr
$cIFX :: Constr
$cCMP :: Constr
$cVOID :: Constr
$cVIEW :: Constr
$cCONSTRUCT :: Constr
$cSET :: Constr
$cACCESS :: Constr
$cTAG :: Constr
$cCASE :: Constr
$tMacro :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Macro -> m Macro
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Macro -> m Macro
gmapMp :: (forall d. Data d => d -> m d) -> Macro -> m Macro
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Macro -> m Macro
gmapM :: (forall d. Data d => d -> m d) -> Macro -> m Macro
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Macro -> m Macro
gmapQi :: Int -> (forall d. Data d => d -> u) -> Macro -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Macro -> u
gmapQ :: (forall d. Data d => d -> u) -> Macro -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Macro -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Macro -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Macro -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Macro -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Macro -> r
gmapT :: (forall b. Data b => b -> b) -> Macro -> Macro
$cgmapT :: (forall b. Data b => b -> b) -> Macro -> Macro
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Macro)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Macro)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Macro)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Macro)
dataTypeOf :: Macro -> DataType
$cdataTypeOf :: Macro -> DataType
toConstr :: Macro -> Constr
$ctoConstr :: Macro -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Macro
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Macro
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Macro -> c Macro
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Macro -> c Macro
$cp1Data :: Typeable Macro
Data, (forall x. Macro -> Rep Macro x)
-> (forall x. Rep Macro x -> Macro) -> Generic Macro
forall x. Rep Macro x -> Macro
forall x. Macro -> Rep Macro x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Macro x -> Macro
$cfrom :: forall x. Macro -> Rep Macro x
Generic)

instance Buildable Macro where
  build :: Macro -> Builder
build = \case
    TAG idx :: Natural
idx ty :: NonEmpty Type
ty -> "<TAG: #"Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+||Natural
idxNatural -> Builder -> Builder
forall a b. (Show a, FromBuilder b) => a -> Builder -> b
||+" from "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|NonEmpty Type -> [Element (NonEmpty Type)]
forall t. Container t => t -> [Element t]
toList NonEmpty Type
ty[Type] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+""
    CASE parsedInstrs :: NonEmpty [ParsedOp]
parsedInstrs -> "<CASE: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|NonEmpty [ParsedOp] -> [Element (NonEmpty [ParsedOp])]
forall t. Container t => t -> [Element t]
toList NonEmpty [ParsedOp]
parsedInstrs[[ParsedOp]] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    ACCESS idx :: Natural
idx size :: Positive
size -> "<ACCESS: #"Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+||Natural
idxNatural -> Builder -> Builder
forall a b. (Show a, FromBuilder b) => a -> Builder -> b
||+"/"Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|Positive
sizePositive -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+""
    SET idx :: Natural
idx size :: Positive
size -> "<SET: #"Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+||Natural
idxNatural -> Builder -> Builder
forall a b. (Show a, FromBuilder b) => a -> Builder -> b
||+"/"Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|Positive
sizePositive -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+""
    CONSTRUCT parsedInstrs :: NonEmpty [ParsedOp]
parsedInstrs -> "<CONSTRUCT: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|NonEmpty [ParsedOp] -> [Element (NonEmpty [ParsedOp])]
forall t. Container t => t -> [Element t]
toList NonEmpty [ParsedOp]
parsedInstrs[[ParsedOp]] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    VIEW code :: [ParsedOp]
code -> "<VIEW: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
code[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    VOID code :: [ParsedOp]
code -> "<VOID: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
code[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    CMP parsedInstr :: ParsedInstr
parsedInstr carAnn :: VarAnn
carAnn -> "<CMP: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|ParsedInstr
parsedInstrParsedInstr -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|VarAnn
carAnnVarAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    IFX parsedInstr :: ParsedInstr
parsedInstr parsedOps1 :: [ParsedOp]
parsedOps1 parsedOps2 :: [ParsedOp]
parsedOps2 -> "<IFX: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|ParsedInstr
parsedInstrParsedInstr -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps1[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps2[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    IFCMP parsedInstr :: ParsedInstr
parsedInstr varAnn :: VarAnn
varAnn parsedOps1 :: [ParsedOp]
parsedOps1 parsedOps2 :: [ParsedOp]
parsedOps2 -> "<IFCMP: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|ParsedInstr
parsedInstrParsedInstr -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|VarAnn
varAnnVarAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps1[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps2[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    FAIL -> "FAIL"
    PAPAIR pairStruct :: PairStruct
pairStruct typeAnn :: TypeAnn
typeAnn varAnn :: VarAnn
varAnn -> "<PAPAIR: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|PairStruct
pairStructPairStruct -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|TypeAnn
typeAnnTypeAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|VarAnn
varAnnVarAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    UNPAIR pairStruct :: UnpairStruct
pairStruct -> "<UNPAIR: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|UnpairStruct
pairStructUnpairStruct -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    CADR cadrStructs :: [CadrStruct]
cadrStructs varAnn :: VarAnn
varAnn fieldAnn :: FieldAnn
fieldAnn -> "<CADR: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[CadrStruct]
cadrStructs[CadrStruct] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|VarAnn
varAnnVarAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|FieldAnn
fieldAnnFieldAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    SET_CADR cadrStructs :: [CadrStruct]
cadrStructs varAnn :: VarAnn
varAnn fieldAnn :: FieldAnn
fieldAnn -> "<SET_CADR: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[CadrStruct]
cadrStructs[CadrStruct] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|VarAnn
varAnnVarAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|FieldAnn
fieldAnnFieldAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    MAP_CADR cadrStructs :: [CadrStruct]
cadrStructs varAnn :: VarAnn
varAnn fieldAnn :: FieldAnn
fieldAnn parsedOps :: [ParsedOp]
parsedOps -> "<MAP_CADR: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[CadrStruct]
cadrStructs[CadrStruct] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|VarAnn
varAnnVarAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|FieldAnn
fieldAnnFieldAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    DIIP integer :: Word
integer parsedOps :: [ParsedOp]
parsedOps -> "<DIIP: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|Word
integerWord -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    DUUP integer :: Word
integer varAnn :: VarAnn
varAnn -> "<DUUP: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|Word
integerWord -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|VarAnn
varAnnVarAnn -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    ASSERT -> "ASSERT"
    ASSERTX parsedInstr :: ParsedInstr
parsedInstr -> "<ASSERTX: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|ParsedInstr
parsedInstrParsedInstr -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    ASSERT_CMP parsedInstr :: ParsedInstr
parsedInstr -> "<ASSERT_CMP: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|ParsedInstr
parsedInstrParsedInstr -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    ASSERT_NONE  -> "ASSERT_NONE"
    ASSERT_SOME  -> "ASSERT_SOME"
    ASSERT_LEFT  -> "ASSERT_LEFT"
    ASSERT_RIGHT -> "ASSERT_RIGHT"
    IF_SOME parsedOps1 :: [ParsedOp]
parsedOps1 parsedOps2 :: [ParsedOp]
parsedOps2 -> "<IF_SOME: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps1[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps2[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"
    IF_RIGHT parsedOps1 :: [ParsedOp]
parsedOps1 parsedOps2 :: [ParsedOp]
parsedOps2 -> "<IF_RIGHT: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps1[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+", "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ParsedOp]
parsedOps2[ParsedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+">"

instance NFData Macro

expandList :: [ParsedOp] -> [ExpandedOp]
expandList :: [ParsedOp] -> [ExpandedOp]
expandList = (ParsedOp -> ExpandedOp) -> [ParsedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LetCallStack -> ParsedOp -> ExpandedOp
expand [])

-- | Expand all macros in parsed contract.
expandContract :: Contract' ParsedOp -> Contract
expandContract :: Contract' ParsedOp -> Contract
expandContract contract :: Contract' ParsedOp
contract =
  Contract' ParsedOp
contract { contractCode :: [ExpandedOp]
contractCode = [ParsedOp] -> [ExpandedOp]
expandList (Contract' ParsedOp -> [ParsedOp]
forall op. Contract' op -> [op]
contractCode Contract' ParsedOp
contract) }

-- Probably, some SYB can be used here
expandValue :: ParsedValue -> Value
expandValue :: ParsedValue -> Value
expandValue = \case
  ValuePair l :: ParsedValue
l r :: ParsedValue
r -> Value -> Value -> Value
forall op. Value' op -> Value' op -> Value' op
ValuePair (ParsedValue -> Value
expandValue ParsedValue
l) (ParsedValue -> Value
expandValue ParsedValue
r)
  ValueLeft x :: ParsedValue
x -> Value -> Value
forall op. Value' op -> Value' op
ValueLeft (ParsedValue -> Value
expandValue ParsedValue
x)
  ValueRight x :: ParsedValue
x -> Value -> Value
forall op. Value' op -> Value' op
ValueRight (ParsedValue -> Value
expandValue ParsedValue
x)
  ValueSome x :: ParsedValue
x -> Value -> Value
forall op. Value' op -> Value' op
ValueSome (ParsedValue -> Value
expandValue ParsedValue
x)
  ValueNil -> Value
forall op. Value' op
ValueNil
  ValueSeq valueList :: NonEmpty $ ParsedValue
valueList -> (NonEmpty $ Value) -> Value
forall op. (NonEmpty $ Value' op) -> Value' op
ValueSeq ((ParsedValue -> Value)
-> (NonEmpty $ ParsedValue) -> NonEmpty $ Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ParsedValue -> Value
expandValue NonEmpty $ ParsedValue
valueList)
  ValueMap eltList :: NonEmpty $ Elt ParsedOp
eltList -> (NonEmpty $ Elt ExpandedOp) -> Value
forall op. (NonEmpty $ Elt op) -> Value' op
ValueMap ((Elt ParsedOp -> Elt ExpandedOp)
-> (NonEmpty $ Elt ParsedOp) -> NonEmpty $ Elt ExpandedOp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Elt ParsedOp -> Elt ExpandedOp
expandElt NonEmpty $ Elt ParsedOp
eltList)
  ValueLambda opList :: NonEmpty ParsedOp
opList ->
    Value
-> (NonEmpty ExpandedOp -> Value)
-> Maybe (NonEmpty ExpandedOp)
-> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
forall op. Value' op
ValueNil NonEmpty ExpandedOp -> Value
forall op. NonEmpty op -> Value' op
ValueLambda (Maybe (NonEmpty ExpandedOp) -> Value)
-> Maybe (NonEmpty ExpandedOp) -> Value
forall a b. (a -> b) -> a -> b
$
    [ExpandedOp] -> Maybe (NonEmpty ExpandedOp)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([ParsedOp] -> [ExpandedOp]
expandList ([ParsedOp] -> [ExpandedOp]) -> [ParsedOp] -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ NonEmpty ParsedOp -> [Element (NonEmpty ParsedOp)]
forall t. Container t => t -> [Element t]
toList NonEmpty ParsedOp
opList)
  x :: ParsedValue
x -> (ParsedOp -> ExpandedOp) -> ParsedValue -> Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LetCallStack -> ParsedOp -> ExpandedOp
expand []) ParsedValue
x

expandElt :: Elt ParsedOp -> Elt ExpandedOp
expandElt :: Elt ParsedOp -> Elt ExpandedOp
expandElt (Elt l :: ParsedValue
l r :: ParsedValue
r) = Value -> Value -> Elt ExpandedOp
forall op. Value' op -> Value' op -> Elt op
Elt (ParsedValue -> Value
expandValue ParsedValue
l) (ParsedValue -> Value
expandValue ParsedValue
r)

expand :: LetCallStack -> ParsedOp -> ExpandedOp
expand :: LetCallStack -> ParsedOp -> ExpandedOp
expand cs :: LetCallStack
cs = let ics :: SrcPos -> InstrCallStack
ics pos :: SrcPos
pos = LetCallStack -> SrcPos -> InstrCallStack
InstrCallStack LetCallStack
cs SrcPos
pos in \case
  -- 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.
  (Mac (PAPAIR (P (F a :: FieldAnn
a) (F b :: FieldAnn
b)) t :: TypeAnn
t v :: VarAnn
v) pos :: SrcPos
pos) ->
    InstrCallStack -> ExpandedOp -> ExpandedOp
WithSrcEx (SrcPos -> InstrCallStack
ics SrcPos
pos) (ExpandedOp -> ExpandedOp) -> ExpandedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ ExpandedInstr -> ExpandedOp
PrimEx (TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
t VarAnn
v FieldAnn
a FieldAnn
b)
  -- DIIP is now always represented as a single instruction.
  -- `expandMacro` always returns a list which we wrap into `SeqEx`, so we
  -- can't use it.
  -- As the above comment says, we need to do something better eventually
  -- (e. g. to avoid `error` usage inside `expandMacro`).
  (Mac (DIIP n :: Word
n ops :: [ParsedOp]
ops) pos :: SrcPos
pos) ->
    InstrCallStack -> ExpandedOp -> ExpandedOp
WithSrcEx (SrcPos -> InstrCallStack
ics SrcPos
pos) (ExpandedOp -> ExpandedOp) -> ExpandedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ ExpandedInstr -> ExpandedOp
PrimEx (Word -> [ExpandedOp] -> ExpandedInstr
forall op. Word -> [op] -> InstrAbstract op
DIPN Word
n (LetCallStack -> ParsedOp -> ExpandedOp
expand LetCallStack
cs (ParsedOp -> ExpandedOp) -> [ParsedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedOp]
ops))
  (Mac m :: Macro
m pos :: SrcPos
pos) -> InstrCallStack -> ExpandedOp -> ExpandedOp
WithSrcEx (SrcPos -> InstrCallStack
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
$ InstrCallStack -> Macro -> [ExpandedOp]
expandMacro (SrcPos -> InstrCallStack
ics SrcPos
pos) Macro
m
  (Prim i :: ParsedInstr
i pos :: SrcPos
pos) -> InstrCallStack -> ExpandedOp -> ExpandedOp
WithSrcEx (SrcPos -> InstrCallStack
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
$ LetCallStack -> ParsedOp -> ExpandedOp
expand LetCallStack
cs (ParsedOp -> ExpandedOp) -> ParsedInstr -> ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsedInstr
i
  (Seq s :: [ParsedOp]
s pos :: SrcPos
pos) -> InstrCallStack -> ExpandedOp -> ExpandedOp
WithSrcEx (SrcPos -> InstrCallStack
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
$ LetCallStack -> ParsedOp -> ExpandedOp
expand LetCallStack
cs (ParsedOp -> ExpandedOp) -> [ParsedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedOp]
s
  (LMac l :: LetMacro
l pos :: SrcPos
pos) -> LetMacro -> ExpandedOp
expandLetMac LetMacro
l
    where
      expandLetMac :: LetMacro -> ExpandedOp
      expandLetMac :: LetMacro -> ExpandedOp
expandLetMac LetMacro {..} =
        let newCS :: LetCallStack
newCS = Text -> LetName
LetName Text
lmName LetName -> LetCallStack -> LetCallStack
forall a. a -> [a] -> [a]
: LetCallStack
cs in
        let ics' :: InstrCallStack
ics' = LetCallStack -> SrcPos -> InstrCallStack
InstrCallStack LetCallStack
newCS SrcPos
pos in
        InstrCallStack -> ExpandedOp -> ExpandedOp
WithSrcEx InstrCallStack
ics' (ExpandedOp -> ExpandedOp) -> ExpandedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp)
-> ([ExpandedOp] -> ExpandedInstr) -> [ExpandedOp] -> ExpandedOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtInstrAbstract ExpandedOp -> ExpandedInstr
forall op. ExtInstrAbstract op -> InstrAbstract op
EXT (ExtInstrAbstract ExpandedOp -> ExpandedInstr)
-> ([ExpandedOp] -> ExtInstrAbstract ExpandedOp)
-> [ExpandedOp]
-> ExpandedInstr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StackFn -> [ExpandedOp] -> ExtInstrAbstract ExpandedOp
forall op. Text -> StackFn -> [op] -> ExtInstrAbstract op
FN Text
lmName StackFn
lmSig ([ExpandedOp] -> ExpandedOp) -> [ExpandedOp] -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ LetCallStack -> ParsedOp -> ExpandedOp
expand LetCallStack
newCS (ParsedOp -> ExpandedOp) -> [ParsedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedOp]
lmExpr

expandMacro :: InstrCallStack -> Macro -> [ExpandedOp]
expandMacro :: InstrCallStack -> Macro -> [ExpandedOp]
expandMacro p :: InstrCallStack
p@InstrCallStack{icsCallStack :: InstrCallStack -> LetCallStack
icsCallStack=LetCallStack
cs,icsSrcPos :: InstrCallStack -> SrcPos
icsSrcPos=SrcPos
macroPos} = \case
  VIEW a :: [ParsedOp]
a             -> InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
p (UnpairStruct -> Macro
UNPAIR (UnpairStruct -> Macro) -> UnpairStruct -> Macro
forall a b. (a -> b) -> a -> b
$ UnpairStruct -> UnpairStruct -> UnpairStruct
UP ((VarAnn, FieldAnn) -> UnpairStruct
UF (VarAnn
forall k (a :: k). Annotation a
noAnn, FieldAnn
forall k (a :: k). Annotation a
noAnn)) ((VarAnn, FieldAnn) -> UnpairStruct
UF (VarAnn
forall k (a :: k). Annotation a
noAnn, FieldAnn
forall k (a :: k). Annotation a
noAnn))) [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. [a] -> [a] -> [a]
++
                        [ ExpandedInstr -> ExpandedOp
PrimEx ([ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP ([ExpandedOp] -> ExpandedInstr) -> [ExpandedOp] -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
p (Macro -> [ExpandedOp]) -> Macro -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ Word -> VarAnn -> Macro
DUUP 2 VarAnn
forall k (a :: k). Annotation a
noAnn) ] [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. [a] -> [a] -> [a]
++
                        [ ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
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]
++
                        (LetCallStack -> ParsedOp -> ExpandedOp
expand LetCallStack
cs (ParsedOp -> ExpandedOp) -> [ParsedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedOp]
a) [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. [a] -> [a] -> [a]
++
                        [ ExpandedInstr -> ExpandedOp
PrimEx ([ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
AMOUNT VarAnn
forall k (a :: k). Annotation a
noAnn])
                        , ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
TRANSFER_TOKENS VarAnn
forall k (a :: k). Annotation a
noAnn
                        , ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> Type -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Type -> InstrAbstract op
NIL TypeAnn
forall k (a :: k). Annotation a
noAnn VarAnn
forall k (a :: k). Annotation a
noAnn (T -> TypeAnn -> Type
Type T
TOperation TypeAnn
forall k (a :: k). Annotation a
noAnn)
                        , ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ ExpandedInstr
forall op. InstrAbstract op
SWAP
                        , ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
CONS VarAnn
forall k (a :: k). Annotation a
noAnn
                        , ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
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
                        ]
  VOID a :: [ParsedOp]
a             -> InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
p (UnpairStruct -> Macro
UNPAIR (UnpairStruct -> UnpairStruct -> UnpairStruct
UP ((VarAnn, FieldAnn) -> UnpairStruct
UF (VarAnn
forall k (a :: k). Annotation a
noAnn, FieldAnn
forall k (a :: k). Annotation a
noAnn)) ((VarAnn, FieldAnn) -> UnpairStruct
UF (VarAnn
forall k (a :: k). Annotation a
noAnn, FieldAnn
forall k (a :: k). Annotation a
noAnn)))) [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. [a] -> [a] -> [a]
++
                        [ ExpandedInstr -> ExpandedOp
PrimEx ExpandedInstr
forall op. InstrAbstract op
SWAP
                        , ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP ([ExpandedOp] -> ExpandedInstr) -> [ExpandedOp] -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ LetCallStack -> ParsedOp -> ExpandedOp
expand LetCallStack
cs (ParsedOp -> ExpandedOp) -> [ParsedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedOp]
a
                        , ExpandedInstr -> ExpandedOp
PrimEx ExpandedInstr
forall op. InstrAbstract op
SWAP
                        , ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
EXEC VarAnn
forall k (a :: k). Annotation a
noAnn
                        , ExpandedInstr -> ExpandedOp
PrimEx ExpandedInstr
forall op. InstrAbstract op
FAILWITH
                        ]
  CASE ops :: NonEmpty [ParsedOp]
ops           -> NonEmpty [ExpandedOp] -> [ExpandedOp]
expandCase ((ParsedOp -> ExpandedOp) -> [ParsedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (LetCallStack -> ParsedOp -> ExpandedOp
expand LetCallStack
cs) ([ParsedOp] -> [ExpandedOp])
-> NonEmpty [ParsedOp] -> NonEmpty [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty [ParsedOp]
ops)
  TAG idx :: Natural
idx uty :: NonEmpty Type
uty        -> Natural -> NonEmpty Type -> [ExpandedOp]
expandTag Natural
idx NonEmpty Type
uty
  ACCESS idx :: Natural
idx size :: Positive
size    -> Natural -> Positive -> [ExpandedOp]
expandAccess Natural
idx Positive
size
  SET idx :: Natural
idx size :: Positive
size       -> Natural -> Positive -> [ExpandedOp]
expandSet Natural
idx Positive
size
  CONSTRUCT ops :: NonEmpty [ParsedOp]
ops      -> NonEmpty [ExpandedOp] -> [ExpandedOp]
expandConstruct ((ParsedOp -> ExpandedOp) -> [ParsedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (LetCallStack -> ParsedOp -> ExpandedOp
expand LetCallStack
cs) ([ParsedOp] -> [ExpandedOp])
-> NonEmpty [ParsedOp] -> NonEmpty [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty [ParsedOp]
ops)
  CMP i :: ParsedInstr
i v :: VarAnn
v            -> [ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
COMPARE VarAnn
v), ParsedInstr -> ExpandedOp
xo ParsedInstr
i]
  IFX i :: ParsedInstr
i bt :: [ParsedOp]
bt bf :: [ParsedOp]
bf        -> [ParsedInstr -> ExpandedOp
xo ParsedInstr
i, ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF ([ParsedOp] -> [ExpandedOp]
xp [ParsedOp]
bt) ([ParsedOp] -> [ExpandedOp]
xp [ParsedOp]
bf)]
  IFCMP i :: ParsedInstr
i v :: VarAnn
v bt :: [ParsedOp]
bt bf :: [ParsedOp]
bf    -> ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
COMPARE VarAnn
v, LetCallStack -> ParsedOp -> ExpandedOp
expand LetCallStack
cs (ParsedOp -> ExpandedOp) -> ParsedInstr -> ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsedInstr
i, [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF ([ParsedOp] -> [ExpandedOp]
xp [ParsedOp]
bt) ([ParsedOp] -> [ExpandedOp]
xp [ParsedOp]
bf)]
  IF_SOME bt :: [ParsedOp]
bt bf :: [ParsedOp]
bf      -> [ExpandedInstr -> ExpandedOp
PrimEx ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_NONE ([ParsedOp] -> [ExpandedOp]
xp [ParsedOp]
bf) ([ParsedOp] -> [ExpandedOp]
xp [ParsedOp]
bt))]
  IF_RIGHT bt :: [ParsedOp]
bt bf :: [ParsedOp]
bf     -> [ExpandedInstr -> ExpandedOp
PrimEx ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_LEFT ([ParsedOp] -> [ExpandedOp]
xp [ParsedOp]
bf) ([ParsedOp] -> [ExpandedOp]
xp [ParsedOp]
bt))]
  FAIL               -> ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeAnn -> VarAnn -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> InstrAbstract op
UNIT TypeAnn
forall k (a :: k). Annotation a
noAnn VarAnn
forall k (a :: k). Annotation a
noAnn, ExpandedInstr
forall op. InstrAbstract op
FAILWITH]
  ASSERT             -> ExpandedInstr -> [ExpandedOp]
oprimEx (ExpandedInstr -> [ExpandedOp]) -> ExpandedInstr -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF [] (InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
p Macro
FAIL)
  ASSERTX i :: ParsedInstr
i          -> [LetCallStack -> ParsedOp -> ExpandedOp
expand LetCallStack
cs (ParsedOp -> ExpandedOp) -> ParsedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Macro -> ParsedOp
mac (Macro -> ParsedOp) -> Macro -> ParsedOp
forall a b. (a -> b) -> a -> b
$ ParsedInstr -> [ParsedOp] -> [ParsedOp] -> Macro
IFX ParsedInstr
i [] [Macro -> ParsedOp
mac Macro
FAIL]]
  ASSERT_CMP i :: ParsedInstr
i       -> [LetCallStack -> ParsedOp -> ExpandedOp
expand LetCallStack
cs (ParsedOp -> ExpandedOp) -> ParsedOp -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Macro -> ParsedOp
mac (Macro -> ParsedOp) -> Macro -> ParsedOp
forall a b. (a -> b) -> a -> b
$ ParsedInstr -> VarAnn -> [ParsedOp] -> [ParsedOp] -> Macro
IFCMP ParsedInstr
i VarAnn
forall k (a :: k). Annotation a
noAnn [] [Macro -> ParsedOp
mac Macro
FAIL]]
  ASSERT_NONE        -> ExpandedInstr -> [ExpandedOp]
oprimEx (ExpandedInstr -> [ExpandedOp]) -> ExpandedInstr -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_NONE [] (InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
p Macro
FAIL)
  ASSERT_SOME        -> ExpandedInstr -> [ExpandedOp]
oprimEx (ExpandedInstr -> [ExpandedOp]) -> ExpandedInstr -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_NONE (InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
p Macro
FAIL) []
  ASSERT_LEFT        -> ExpandedInstr -> [ExpandedOp]
oprimEx (ExpandedInstr -> [ExpandedOp]) -> ExpandedInstr -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_LEFT [] (InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
p Macro
FAIL)
  ASSERT_RIGHT       -> ExpandedInstr -> [ExpandedOp]
oprimEx (ExpandedInstr -> [ExpandedOp]) -> ExpandedInstr -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_LEFT (InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
p Macro
FAIL) []
  PAPAIR ps :: PairStruct
ps t :: TypeAnn
t v :: VarAnn
v      -> InstrCallStack -> PairStruct -> TypeAnn -> VarAnn -> [ExpandedOp]
expandPapair InstrCallStack
p PairStruct
ps TypeAnn
t VarAnn
v
  UNPAIR ps :: UnpairStruct
ps          -> InstrCallStack -> UnpairStruct -> [ExpandedOp]
expandUnpapair InstrCallStack
p UnpairStruct
ps
  CADR c :: [CadrStruct]
c v :: VarAnn
v f :: FieldAnn
f         -> InstrCallStack
-> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp]
expandCadr InstrCallStack
p [CadrStruct]
c VarAnn
v FieldAnn
f
  SET_CADR c :: [CadrStruct]
c v :: VarAnn
v f :: FieldAnn
f     -> InstrCallStack
-> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp]
expandSetCadr InstrCallStack
p [CadrStruct]
c VarAnn
v FieldAnn
f
  MAP_CADR c :: [CadrStruct]
c v :: VarAnn
v f :: FieldAnn
f ops :: [ParsedOp]
ops -> InstrCallStack
-> [CadrStruct] -> VarAnn -> FieldAnn -> [ParsedOp] -> [ExpandedOp]
expandMapCadr InstrCallStack
p [CadrStruct]
c VarAnn
v FieldAnn
f [ParsedOp]
ops
  -- We handle DIIP outside.
  DIIP {}             -> Text -> [ExpandedOp]
forall a. HasCallStack => Text -> a
error "expandMacro DIIP is unreachable"
  DUUP 1 v :: VarAnn
v           -> ExpandedInstr -> [ExpandedOp]
oprimEx (ExpandedInstr -> [ExpandedOp]) -> ExpandedInstr -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
v -- this case should be impossible in practice
  DUUP 2 v :: VarAnn
v           -> ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
v], ExpandedInstr
forall op. InstrAbstract op
SWAP]
  DUUP n :: Word
n v :: VarAnn
v           -> ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word -> [ExpandedOp] -> ExpandedInstr
forall op. Word -> [op] -> InstrAbstract op
DIPN (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1) [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
v], Word -> ExpandedInstr
forall op. Word -> InstrAbstract op
DIG Word
n]
  where
    mac :: Macro -> ParsedOp
mac = (Macro -> SrcPos -> ParsedOp) -> SrcPos -> Macro -> ParsedOp
forall a b c. (a -> b -> c) -> b -> a -> c
flip Macro -> SrcPos -> ParsedOp
Mac SrcPos
macroPos
    oprimEx :: ExpandedInstr -> [ExpandedOp]
oprimEx = ExpandedOp -> [ExpandedOp]
forall x. One x => OneItem x -> x
one (ExpandedOp -> [ExpandedOp])
-> (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> [ExpandedOp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpandedInstr -> ExpandedOp
PrimEx
    xo :: ParsedInstr -> ExpandedOp
xo = ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp)
-> (ParsedInstr -> ExpandedInstr) -> ParsedInstr -> ExpandedOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParsedOp -> ExpandedOp) -> ParsedInstr -> ExpandedInstr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LetCallStack -> ParsedOp -> ExpandedOp
expand LetCallStack
cs)
    xp :: [ParsedOp] -> [ExpandedOp]
xp = (ParsedOp -> ExpandedOp) -> [ParsedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LetCallStack -> ParsedOp -> ExpandedOp
expand LetCallStack
cs)

-- the correctness of type-annotation expansion is currently untested, as these
-- expansions are not explicitly documented in the Michelson Specification
expandPapair :: InstrCallStack -> PairStruct -> TypeAnn -> VarAnn -> [ExpandedOp]
expandPapair :: InstrCallStack -> PairStruct -> TypeAnn -> VarAnn -> [ExpandedOp]
expandPapair ics :: InstrCallStack
ics ps :: PairStruct
ps t :: TypeAnn
t v :: VarAnn
v = case PairStruct
ps of
  P (F a :: FieldAnn
a) (F b :: FieldAnn
b) -> [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
t VarAnn
v FieldAnn
a FieldAnn
b]
  P (F a :: FieldAnn
a) r :: PairStruct
r     -> ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP ([ExpandedOp] -> ExpandedInstr) -> [ExpandedOp] -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
ics (PairStruct -> TypeAnn -> VarAnn -> Macro
PAPAIR PairStruct
r TypeAnn
forall k (a :: k). Annotation a
noAnn VarAnn
forall k (a :: k). Annotation a
noAnn)
                              , TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
t VarAnn
v FieldAnn
a FieldAnn
forall k (a :: k). Annotation a
noAnn]
  P l :: PairStruct
l     (F b :: FieldAnn
b) -> InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
ics (PairStruct -> TypeAnn -> VarAnn -> Macro
PAPAIR PairStruct
l TypeAnn
forall k (a :: k). Annotation a
noAnn VarAnn
forall k (a :: k). Annotation a
noAnn) [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. [a] -> [a] -> [a]
++
                   [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
t VarAnn
v FieldAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
b]
  P l :: PairStruct
l     r :: PairStruct
r     -> InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
ics (PairStruct -> TypeAnn -> VarAnn -> Macro
PAPAIR PairStruct
l TypeAnn
forall k (a :: k). Annotation a
noAnn VarAnn
forall k (a :: k). Annotation a
noAnn) [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. [a] -> [a] -> [a]
++
                   [ ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP ([ExpandedOp] -> ExpandedInstr) -> [ExpandedOp] -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
ics (PairStruct -> TypeAnn -> VarAnn -> Macro
PAPAIR PairStruct
r TypeAnn
forall k (a :: k). Annotation a
noAnn VarAnn
forall k (a :: k). Annotation a
noAnn)
                   , ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
t VarAnn
v FieldAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
forall k (a :: k). Annotation a
noAnn]
  F _           -> [] -- Do nothing in this case.
  -- It's impossible from the structure of PairStruct and considered cases above,
  -- but if it accidentally happened let's just do nothing.

expandUnpapair :: InstrCallStack -> UnpairStruct -> [ExpandedOp]
expandUnpapair :: InstrCallStack -> UnpairStruct -> [ExpandedOp]
expandUnpapair ics :: InstrCallStack
ics = \case
  UP (UF (v :: VarAnn
v,f :: FieldAnn
f)) (UF (w :: VarAnn
w,g :: FieldAnn
g)) ->
    ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall k (a :: k). Annotation a
noAnn
               , VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
v FieldAnn
f
               , [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
w FieldAnn
g]
               ]
  UP (UF (v :: VarAnn
v, f :: FieldAnn
f)) r :: UnpairStruct
r ->
    ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall k (a :: k). Annotation a
noAnn
               , VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
v FieldAnn
f
               , [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP (ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
forall k (a :: k). Annotation a
noAnn) ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
ics (UnpairStruct -> Macro
UNPAIR UnpairStruct
r))
               ]
  UP l :: UnpairStruct
l (UF (v :: VarAnn
v, f :: FieldAnn
f)) ->
    (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ExpandedInstr -> ExpandedOp
PrimEx [ VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall k (a :: k). Annotation a
noAnn
               , [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
v FieldAnn
f]
               , VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
forall k (a :: k). Annotation a
noAnn
               ] [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. [a] -> [a] -> [a]
++
               InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
ics (UnpairStruct -> Macro
UNPAIR UnpairStruct
l)
  UP l :: UnpairStruct
l r :: UnpairStruct
r ->
    InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
ics Macro
unpairOne [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. [a] -> [a] -> [a]
++
    [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP ([ExpandedOp] -> ExpandedInstr) -> [ExpandedOp] -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
ics (Macro -> [ExpandedOp]) -> Macro -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ UnpairStruct -> Macro
UNPAIR UnpairStruct
r] [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. [a] -> [a] -> [a]
++
    InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
ics (UnpairStruct -> Macro
UNPAIR UnpairStruct
l)
  UF _  -> [] -- Do nothing in this case.
  -- It's impossible from the structure of UnpairStruct and considered cases above,
  -- but if it accidentally happened let's just do nothing.
  where
    unpairOne :: Macro
unpairOne = UnpairStruct -> Macro
UNPAIR (UnpairStruct -> UnpairStruct -> UnpairStruct
UP UnpairStruct
fn UnpairStruct
fn)
    fn :: UnpairStruct
fn = (VarAnn, FieldAnn) -> UnpairStruct
UF (VarAnn
forall k (a :: k). Annotation a
noAnn, FieldAnn
forall k (a :: k). Annotation a
noAnn)

expandCadr :: InstrCallStack -> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp]
expandCadr :: InstrCallStack
-> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp]
expandCadr ics :: InstrCallStack
ics cs :: [CadrStruct]
cs v :: VarAnn
v f :: FieldAnn
f = case [CadrStruct]
cs of
  []    -> []
  [A]  -> [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
v FieldAnn
f]
  [D]  -> [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
v FieldAnn
f]
  A:css :: [CadrStruct]
css -> ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
forall k (a :: k). Annotation a
noAnn) ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
ics ([CadrStruct] -> VarAnn -> FieldAnn -> Macro
CADR [CadrStruct]
css VarAnn
v FieldAnn
f)
  D:css :: [CadrStruct]
css -> ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
forall k (a :: k). Annotation a
noAnn) ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
ics ([CadrStruct] -> VarAnn -> FieldAnn -> Macro
CADR [CadrStruct]
css VarAnn
v FieldAnn
f)

carNoAnn :: InstrAbstract op
carNoAnn :: InstrAbstract op
carNoAnn = VarAnn -> FieldAnn -> InstrAbstract op
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
forall k (a :: k). Annotation a
noAnn

cdrNoAnn :: InstrAbstract op
cdrNoAnn :: InstrAbstract op
cdrNoAnn = VarAnn -> FieldAnn -> InstrAbstract op
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
forall k (a :: k). Annotation a
noAnn

pairNoAnn :: VarAnn -> InstrAbstract op
pairNoAnn :: VarAnn -> InstrAbstract op
pairNoAnn v :: VarAnn
v = TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
forall k (a :: k). Annotation a
noAnn VarAnn
v FieldAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
forall k (a :: k). Annotation a
noAnn

expandSetCadr :: InstrCallStack -> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp]
expandSetCadr :: InstrCallStack
-> [CadrStruct] -> VarAnn -> FieldAnn -> [ExpandedOp]
expandSetCadr ics :: InstrCallStack
ics cs :: [CadrStruct]
cs v :: VarAnn
v f :: 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
  []    -> []
  [A]   -> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall k (a :: k). Annotation a
noAnn, VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
f, ExpandedInstr
forall op. InstrAbstract op
DROP,
           -- ↑ These operations just check that the left element of pair has %f
           VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR (Text -> VarAnn
forall k (a :: k). HasCallStack => Text -> Annotation a
ann "%%") FieldAnn
forall k (a :: k). Annotation a
noAnn, ExpandedInstr
forall op. InstrAbstract op
SWAP, TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
forall k (a :: k). Annotation a
noAnn VarAnn
v FieldAnn
f (Text -> FieldAnn
forall k (a :: k). HasCallStack => Text -> Annotation a
ann "@")]
  [D]   -> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall k (a :: k). Annotation a
noAnn, VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
f, ExpandedInstr
forall op. InstrAbstract op
DROP,
           -- ↑ These operations just check that the right element of pair has %f
           VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR (Text -> VarAnn
forall k (a :: k). HasCallStack => Text -> Annotation a
ann "%%") FieldAnn
forall k (a :: k). Annotation a
noAnn, TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
forall k (a :: k). Annotation a
noAnn VarAnn
v (Text -> FieldAnn
forall k (a :: k). HasCallStack => Text -> Annotation a
ann "@") FieldAnn
f]
  A:css :: [CadrStruct]
css -> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall k (a :: k). Annotation a
noAnn, [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP (ExpandedInstr -> ExpandedOp
PrimEx ExpandedInstr
forall op. InstrAbstract op
carNoAnn ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
ics ([CadrStruct] -> VarAnn -> FieldAnn -> Macro
SET_CADR [CadrStruct]
css VarAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
f)), ExpandedInstr
forall op. InstrAbstract op
cdrNoAnn, ExpandedInstr
forall op. InstrAbstract op
SWAP, VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
pairNoAnn VarAnn
v]
  D:css :: [CadrStruct]
css -> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall k (a :: k). Annotation a
noAnn, [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP (ExpandedInstr -> ExpandedOp
PrimEx ExpandedInstr
forall op. InstrAbstract op
cdrNoAnn ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
ics ([CadrStruct] -> VarAnn -> FieldAnn -> Macro
SET_CADR [CadrStruct]
css VarAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
f)), ExpandedInstr
forall op. InstrAbstract op
carNoAnn, VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
pairNoAnn VarAnn
v]

expandMapCadr :: InstrCallStack -> [CadrStruct] -> VarAnn -> FieldAnn -> [ParsedOp] -> [ExpandedOp]
expandMapCadr :: InstrCallStack
-> [CadrStruct] -> VarAnn -> FieldAnn -> [ParsedOp] -> [ExpandedOp]
expandMapCadr ics :: InstrCallStack
ics@InstrCallStack{icsCallStack :: InstrCallStack -> LetCallStack
icsCallStack=LetCallStack
cls} cs :: [CadrStruct]
cs v :: VarAnn
v f :: FieldAnn
f ops :: [ParsedOp]
ops = case [CadrStruct]
cs of
  []    -> []
  [A]   -> ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall k (a :: k). Annotation a
noAnn, ExpandedInstr
forall op. InstrAbstract op
cdrNoAnn, [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
f, [ExpandedOp] -> ExpandedOp
SeqEx (LetCallStack -> ParsedOp -> ExpandedOp
expand LetCallStack
cls (ParsedOp -> ExpandedOp) -> [ParsedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedOp]
ops)], ExpandedInstr
forall op. InstrAbstract op
SWAP, VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
pairNoAnn VarAnn
v]
  [D]   -> [[ExpandedOp]] -> [ExpandedOp]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall k (a :: k). Annotation a
noAnn, VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
f], [[ExpandedOp] -> ExpandedOp
SeqEx (LetCallStack -> ParsedOp -> ExpandedOp
expand LetCallStack
cls (ParsedOp -> ExpandedOp) -> [ParsedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedOp]
ops)], ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExpandedInstr
forall op. InstrAbstract op
SWAP, ExpandedInstr
forall op. InstrAbstract op
carNoAnn, VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
pairNoAnn VarAnn
v]]
  A:css :: [CadrStruct]
css -> ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall k (a :: k). Annotation a
noAnn, [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP (ExpandedInstr -> ExpandedOp
PrimEx ExpandedInstr
forall op. InstrAbstract op
carNoAnn ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
ics ([CadrStruct] -> VarAnn -> FieldAnn -> [ParsedOp] -> Macro
MAP_CADR [CadrStruct]
css VarAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
f [ParsedOp]
ops)), ExpandedInstr
forall op. InstrAbstract op
cdrNoAnn, ExpandedInstr
forall op. InstrAbstract op
SWAP, VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
pairNoAnn VarAnn
v]
  D:css :: [CadrStruct]
css -> ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall k (a :: k). Annotation a
noAnn, [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP (ExpandedInstr -> ExpandedOp
PrimEx ExpandedInstr
forall op. InstrAbstract op
cdrNoAnn ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: InstrCallStack -> Macro -> [ExpandedOp]
expandMacro InstrCallStack
ics ([CadrStruct] -> VarAnn -> FieldAnn -> [ParsedOp] -> Macro
MAP_CADR [CadrStruct]
css VarAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
f [ParsedOp]
ops)), ExpandedInstr
forall op. InstrAbstract op
carNoAnn, VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
pairNoAnn VarAnn
v]

expandCase :: NonEmpty [ExpandedOp] -> [ExpandedOp]
expandCase :: NonEmpty [ExpandedOp] -> [ExpandedOp]
expandCase = (Natural -> [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp])
-> NonEmpty [ExpandedOp] -> [ExpandedOp]
forall a. (Natural -> a -> a -> a) -> NonEmpty a -> a
mkGenericTree (\_ l :: [ExpandedOp]
l r :: [ExpandedOp]
r -> 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 (ExpandedInstr -> [ExpandedOp]) -> ExpandedInstr -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
IF_LEFT [ExpandedOp]
l [ExpandedOp]
r)

expandTag :: Natural -> NonEmpty Type -> [ExpandedOp]
expandTag :: Natural -> NonEmpty Type -> [ExpandedOp]
expandTag idx :: Natural
idx unionTy :: NonEmpty Type
unionTy =
  [ExpandedOp] -> [ExpandedOp]
forall a. [a] -> [a]
reverse ([ExpandedOp] -> [ExpandedOp])
-> (([ExpandedOp], Type) -> [ExpandedOp])
-> ([ExpandedOp], Type)
-> [ExpandedOp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ExpandedOp], Type) -> [ExpandedOp]
forall a b. (a, b) -> a
fst (([ExpandedOp], Type) -> [ExpandedOp])
-> ([ExpandedOp], Type) -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ (Natural
 -> ([ExpandedOp], Type)
 -> ([ExpandedOp], Type)
 -> ([ExpandedOp], Type))
-> NonEmpty ([ExpandedOp], Type) -> ([ExpandedOp], Type)
forall a. (Natural -> a -> a -> a) -> NonEmpty a -> a
mkGenericTree Natural
-> ([ExpandedOp], Type)
-> ([ExpandedOp], Type)
-> ([ExpandedOp], Type)
merge (([], ) (Type -> ([ExpandedOp], Type))
-> NonEmpty Type -> NonEmpty ([ExpandedOp], Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Type
unionTy)
  where
    merge :: Natural
-> ([ExpandedOp], Type)
-> ([ExpandedOp], Type)
-> ([ExpandedOp], Type)
merge i :: Natural
i (li :: [ExpandedOp]
li, lt :: Type
lt) (ri :: [ExpandedOp]
ri, rt :: Type
rt) =
      let ty :: Type
ty = T -> TypeAnn -> Type
Type (FieldAnn -> FieldAnn -> Type -> Type -> T
TOr FieldAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
forall k (a :: k). Annotation a
noAnn Type
lt Type
rt) TypeAnn
forall k (a :: k). Annotation a
noAnn
      in if Natural
idx Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
i
          then (ExpandedInstr -> ExpandedOp
PrimEx (TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Type -> ExpandedInstr
forall op.
TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Type -> InstrAbstract op
LEFT TypeAnn
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 Type
rt) ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: [ExpandedOp]
li, Type
ty)
          else (ExpandedInstr -> ExpandedOp
PrimEx (TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> Type -> ExpandedInstr
forall op.
TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Type -> InstrAbstract op
RIGHT TypeAnn
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 Type
lt) ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: [ExpandedOp]
ri, Type
ty)

expandAccess :: Natural -> Positive -> [ExpandedOp]
expandAccess :: Natural -> Positive -> [ExpandedOp]
expandAccess idx :: Natural
idx size :: Positive
size =
  (Natural -> [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp])
-> NonEmpty [ExpandedOp] -> [ExpandedOp]
forall a. (Natural -> a -> a -> a) -> NonEmpty a -> a
mkGenericTree Natural -> [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
merge (Positive -> [ExpandedOp] -> NonEmpty [ExpandedOp]
forall a. Positive -> a -> NonEmpty a
replicateNE Positive
size [])
  where
    merge :: Natural -> [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
merge i :: Natural
i li :: [ExpandedOp]
li ri :: [ExpandedOp]
ri =
      if Natural
idx Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
i
        then ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
forall k (a :: k). Annotation a
noAnn) ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: [ExpandedOp]
li
        else ExpandedInstr -> ExpandedOp
PrimEx (VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
forall k (a :: k). Annotation a
noAnn FieldAnn
forall k (a :: k). Annotation a
noAnn) ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: [ExpandedOp]
ri

expandSet :: Natural -> Positive -> [ExpandedOp]
expandSet :: Natural -> Positive -> [ExpandedOp]
expandSet idx :: Natural
idx size :: Positive
size =
  ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  Endo [ExpandedInstr] -> [ExpandedInstr] -> [ExpandedInstr]
forall a. Endo a -> a -> a
appEndo ((Natural
 -> Endo [ExpandedInstr]
 -> Endo [ExpandedInstr]
 -> Endo [ExpandedInstr])
-> NonEmpty (Endo [ExpandedInstr]) -> Endo [ExpandedInstr]
forall a. (Natural -> a -> a -> a) -> NonEmpty a -> a
mkGenericTree Natural
-> Endo [ExpandedInstr]
-> Endo [ExpandedInstr]
-> Endo [ExpandedInstr]
merge (Positive -> Endo [ExpandedInstr] -> NonEmpty (Endo [ExpandedInstr])
forall a. Positive -> a -> NonEmpty a
replicateNE Positive
size Endo [ExpandedInstr]
base)) []
  where
    base :: Endo [ExpandedInstr]
base = ExpandedInstr -> Endo [ExpandedInstr]
forall a. a -> Endo [a]
pre (ExpandedInstr -> Endo [ExpandedInstr])
-> ExpandedInstr -> Endo [ExpandedInstr]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP [ExpandedInstr -> ExpandedOp
PrimEx ExpandedInstr
forall op. InstrAbstract op
DROP]
    merge :: Natural
-> Endo [ExpandedInstr]
-> Endo [ExpandedInstr]
-> Endo [ExpandedInstr]
merge i :: Natural
i li :: Endo [ExpandedInstr]
li ri :: Endo [ExpandedInstr]
ri = [Endo [ExpandedInstr]] -> Endo [ExpandedInstr]
forall a. Monoid a => [a] -> a
mconcat ([Endo [ExpandedInstr]] -> Endo [ExpandedInstr])
-> [Endo [ExpandedInstr]] -> Endo [ExpandedInstr]
forall a b. (a -> b) -> a -> b
$
      if Natural
idx Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
i
        then [ ExpandedInstr -> Endo [ExpandedInstr]
forall a. a -> Endo [a]
pre (ExpandedInstr -> Endo [ExpandedInstr])
-> ExpandedInstr -> Endo [ExpandedInstr]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP
                 ((ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ExpandedInstr -> ExpandedOp
PrimEx [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall k (a :: k). Annotation a
n, [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
forall k (a :: k). Annotation a
n FieldAnn
forall k (a :: k). Annotation a
n], VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
forall k (a :: k). Annotation a
n FieldAnn
forall k (a :: k). Annotation a
n])
             , Endo [ExpandedInstr]
li
             , ExpandedInstr -> Endo [ExpandedInstr]
forall a. a -> Endo [a]
pre (ExpandedInstr -> Endo [ExpandedInstr])
-> ExpandedInstr -> Endo [ExpandedInstr]
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
forall k (a :: k). Annotation a
n VarAnn
forall k (a :: k). Annotation a
n FieldAnn
forall k (a :: k). Annotation a
n FieldAnn
forall k (a :: k). Annotation a
n
             ]
        else [ ExpandedInstr -> Endo [ExpandedInstr]
forall a. a -> Endo [a]
pre (ExpandedInstr -> Endo [ExpandedInstr])
-> ExpandedInstr -> Endo [ExpandedInstr]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP
                 ((ExpandedInstr -> ExpandedOp) -> [ExpandedInstr] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ExpandedInstr -> ExpandedOp
PrimEx [VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
DUP VarAnn
forall k (a :: k). Annotation a
n, [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP [ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CAR VarAnn
forall k (a :: k). Annotation a
n FieldAnn
forall k (a :: k). Annotation a
n], VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
CDR VarAnn
forall k (a :: k). Annotation a
n FieldAnn
forall k (a :: k). Annotation a
n])
             , Endo [ExpandedInstr]
ri
             , ExpandedInstr -> Endo [ExpandedInstr]
forall a. a -> Endo [a]
pre (ExpandedInstr -> Endo [ExpandedInstr])
-> ExpandedInstr -> Endo [ExpandedInstr]
forall a b. (a -> b) -> a -> b
$ ExpandedInstr
forall op. InstrAbstract op
SWAP
             , ExpandedInstr -> Endo [ExpandedInstr]
forall a. a -> Endo [a]
pre (ExpandedInstr -> Endo [ExpandedInstr])
-> ExpandedInstr -> Endo [ExpandedInstr]
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
forall k (a :: k). Annotation a
n VarAnn
forall k (a :: k). Annotation a
n FieldAnn
forall k (a :: k). Annotation a
n FieldAnn
forall k (a :: k). Annotation a
n
             ]
    pre :: a -> Endo [a]
pre e :: a
e = ([a] -> [a]) -> Endo [a]
forall a. (a -> a) -> Endo a
Endo (a
e a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)
    n :: Annotation a
n = Annotation a
forall k (a :: k). Annotation a
noAnn

expandConstruct :: NonEmpty [ExpandedOp] -> [ExpandedOp]
expandConstruct :: NonEmpty [ExpandedOp] -> [ExpandedOp]
expandConstruct ctors :: NonEmpty [ExpandedOp]
ctors =
  Endo [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. Endo a -> a -> a
appEndo ((Natural
 -> Endo [ExpandedOp] -> Endo [ExpandedOp] -> Endo [ExpandedOp])
-> NonEmpty (Endo [ExpandedOp]) -> Endo [ExpandedOp]
forall a. (Natural -> a -> a -> a) -> NonEmpty a -> a
mkGenericTree Natural
-> Endo [ExpandedOp] -> Endo [ExpandedOp] -> Endo [ExpandedOp]
forall p.
p -> Endo [ExpandedOp] -> Endo [ExpandedOp] -> Endo [ExpandedOp]
merge (NonEmpty (Endo [ExpandedOp]) -> Endo [ExpandedOp])
-> NonEmpty (Endo [ExpandedOp]) -> Endo [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ ([ExpandedOp] -> Endo [ExpandedOp])
-> NonEmpty [ExpandedOp] -> NonEmpty (Endo [ExpandedOp])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map [ExpandedOp] -> Endo [ExpandedOp]
forall a. [a] -> Endo [a]
toBase NonEmpty [ExpandedOp]
ctors) []
  where
    toBase :: [a] -> Endo [a]
toBase ops :: [a]
ops = ([a] -> [a]) -> Endo [a]
forall a. (a -> a) -> Endo a
Endo ([a]
ops [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++)
    merge :: p -> Endo [ExpandedOp] -> Endo [ExpandedOp] -> Endo [ExpandedOp]
merge _ li :: Endo [ExpandedOp]
li ri :: Endo [ExpandedOp]
ri =
      [Endo [ExpandedOp]] -> Endo [ExpandedOp]
forall a. Monoid a => [a] -> a
mconcat
        [ Endo [ExpandedOp]
li
        , ExpandedOp -> Endo [ExpandedOp]
forall a. a -> Endo [a]
pre (ExpandedOp -> Endo [ExpandedOp])
-> (ExpandedInstr -> ExpandedOp)
-> ExpandedInstr
-> Endo [ExpandedOp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> Endo [ExpandedOp])
-> ExpandedInstr -> Endo [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
DIP (Endo [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. Endo a -> a -> a
appEndo Endo [ExpandedOp]
ri [])
        , ExpandedOp -> Endo [ExpandedOp]
forall a. a -> Endo [a]
pre (ExpandedOp -> Endo [ExpandedOp])
-> (ExpandedInstr -> ExpandedOp)
-> ExpandedInstr
-> Endo [ExpandedOp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpandedInstr -> ExpandedOp
PrimEx (ExpandedInstr -> Endo [ExpandedOp])
-> ExpandedInstr -> Endo [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
PAIR TypeAnn
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
        ]
    pre :: a -> Endo [a]
pre e :: a
e = ([a] -> [a]) -> Endo [a]
forall a. (a -> a) -> Endo a
Endo (a
e a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)

mapPairLeaves :: [FieldAnn] -> PairStruct -> PairStruct
mapPairLeaves :: [FieldAnn] -> PairStruct -> PairStruct
mapPairLeaves fs :: [FieldAnn]
fs p :: 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 l :: PairStruct
l r :: 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 _) -> do
    FieldAnn
f <- ([FieldAnn] -> (FieldAnn, [FieldAnn]))
-> StateT [FieldAnn] Identity FieldAnn
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state [FieldAnn] -> (FieldAnn, [FieldAnn])
forall k (a :: k). [Annotation a] -> (Annotation a, [Annotation a])
getLeaf
    return $ FieldAnn -> PairStruct
F FieldAnn
f
    where
      getLeaf :: [Annotation a] -> (Annotation a, [Annotation a])
getLeaf (a :: Annotation a
a:as :: [Annotation a]
as) = (Annotation a
a, [Annotation a]
as)
      getLeaf _      = (Annotation a
forall k (a :: k). Annotation a
noAnn, [])

mapUnpairLeaves :: [(VarAnn, FieldAnn)] -> UnpairStruct -> UnpairStruct
mapUnpairLeaves :: [(VarAnn, FieldAnn)] -> UnpairStruct -> UnpairStruct
mapUnpairLeaves fs :: [(VarAnn, FieldAnn)]
fs p :: UnpairStruct
p = State [(VarAnn, FieldAnn)] UnpairStruct
-> [(VarAnn, FieldAnn)] -> UnpairStruct
forall s a. State s a -> s -> a
evalState (UnpairStruct -> State [(VarAnn, FieldAnn)] UnpairStruct
unpairLeavesST UnpairStruct
p) [(VarAnn, FieldAnn)]
fs

unpairLeavesST :: UnpairStruct -> State [(VarAnn, FieldAnn)] UnpairStruct
unpairLeavesST :: UnpairStruct -> State [(VarAnn, FieldAnn)] UnpairStruct
unpairLeavesST = \case
  (UP l :: UnpairStruct
l r :: UnpairStruct
r) -> do
    UnpairStruct
l' <- UnpairStruct -> State [(VarAnn, FieldAnn)] UnpairStruct
unpairLeavesST UnpairStruct
l
    UnpairStruct
r' <- UnpairStruct -> State [(VarAnn, FieldAnn)] UnpairStruct
unpairLeavesST UnpairStruct
r
    return $ UnpairStruct -> UnpairStruct -> UnpairStruct
UP UnpairStruct
l' UnpairStruct
r'
  (UF _) -> do
    (VarAnn, FieldAnn)
f <- ([(VarAnn, FieldAnn)]
 -> ((VarAnn, FieldAnn), [(VarAnn, FieldAnn)]))
-> StateT [(VarAnn, FieldAnn)] Identity (VarAnn, FieldAnn)
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state [(VarAnn, FieldAnn)] -> ((VarAnn, FieldAnn), [(VarAnn, FieldAnn)])
forall k k (a :: k) (a :: k).
[(Annotation a, Annotation a)]
-> ((Annotation a, Annotation a), [(Annotation a, Annotation a)])
getLeaf
    return $ (VarAnn, FieldAnn) -> UnpairStruct
UF (VarAnn, FieldAnn)
f
    where
      getLeaf :: [(Annotation a, Annotation a)]
-> ((Annotation a, Annotation a), [(Annotation a, Annotation a)])
getLeaf (a :: (Annotation a, Annotation a)
a:as :: [(Annotation a, Annotation a)]
as) = ((Annotation a, Annotation a)
a, [(Annotation a, Annotation a)]
as)
      getLeaf _      = ((Annotation a
forall k (a :: k). Annotation a
noAnn, Annotation a
forall k (a :: k). Annotation a
noAnn), [])

deriveJSON morleyAesonOptions ''ParsedOp
deriveJSON morleyAesonOptions ''LetMacro
deriveJSON morleyAesonOptions ''PairStruct
deriveJSON morleyAesonOptions ''UnpairStruct
deriveJSON morleyAesonOptions ''CadrStruct
deriveJSON morleyAesonOptions ''Macro