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

-- | Michelson instructions in untyped model.

module Morley.Michelson.Untyped.Instr
  ( InstrAbstract (..)
  , ExpandedOp (..)
  , ExpandedInstr
  , flattenExpandedOp
  ) where

import Prelude hiding (EQ, GT, LT, group)

import Data.Aeson.TH (deriveJSON)
import Data.Data (Data(..))
import Fmt (Buildable(build), (+|), (|+))
import Generics.SYB (everywhere, mkT)
import Text.PrettyPrint.Leijen.Text
  (Doc, align, braces, enclose, group, indent, integer, nest, space, text, (<$$>), (<+>))
import Text.PrettyPrint.Leijen.Text qualified as PP

import Morley.Michelson.ErrorPos (ErrorSrcPos)
import Morley.Michelson.Printer.Util
  (RenderDoc(..), buildRenderDoc, doesntNeedParens, needsParens, renderOpsList, spaces)
import Morley.Michelson.Untyped.Annotation
  (Annotation, AnyAnn, FieldAnn, KnownAnnTag, TypeAnn, VarAnn, fullAnnSet, renderAnyAnns,
  singleAnnSet)
import Morley.Michelson.Untyped.Contract (Contract'(..))
import Morley.Michelson.Untyped.Ext (ExtInstrAbstract)
import Morley.Michelson.Untyped.Type (Ty)
import Morley.Michelson.Untyped.Value (Value'(..))
import Morley.Michelson.Untyped.View
import Morley.Util.Aeson

-------------------------------------
-- Types after macroexpander
-------------------------------------

type ExpandedInstr = InstrAbstract ExpandedOp

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

instance NFData ExpandedOp

instance RenderDoc ExpandedOp where
  renderDoc :: RenderContext -> ExpandedOp -> Doc
renderDoc RenderContext
pn (WithSrcEx ErrorSrcPos
_ ExpandedOp
op) = RenderContext -> ExpandedOp -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
pn ExpandedOp
op
  renderDoc RenderContext
pn (PrimEx ExpandedInstr
i) = RenderContext -> ExpandedInstr -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
pn ExpandedInstr
i
  renderDoc RenderContext
_  (SeqEx [ExpandedOp]
i) = Bool -> [ExpandedOp] -> Doc
forall op. RenderDoc op => Bool -> [op] -> Doc
renderOpsList Bool
False [ExpandedOp]
i
  isRenderable :: ExpandedOp -> Bool
isRenderable =
    \case PrimEx ExpandedInstr
i -> ExpandedInstr -> Bool
forall a. RenderDoc a => a -> Bool
isRenderable ExpandedInstr
i
          WithSrcEx ErrorSrcPos
_ ExpandedOp
op -> ExpandedOp -> Bool
forall a. RenderDoc a => a -> Bool
isRenderable ExpandedOp
op
          ExpandedOp
_ -> Bool
True

instance Buildable ExpandedOp where
  build :: ExpandedOp -> Builder
build (WithSrcEx ErrorSrcPos
_ ExpandedOp
op) = ExpandedOp -> Builder
forall p. Buildable p => p -> Builder
build ExpandedOp
op
  build (PrimEx ExpandedInstr
expandedInstr) = Builder
"<PrimEx: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|ExpandedInstr
expandedInstrExpandedInstr -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"
  build (SeqEx [ExpandedOp]
expandedOps)    = Builder
"<SeqEx: "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|[ExpandedOp]
expandedOps[ExpandedOp] -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
">"

-- | Flatten all 'SeqEx' in 'ExpandedOp'. This function is mostly for
-- testing. It returns instructions with the same logic, but they are
-- not strictly equivalent, because they are serialized differently
-- (grouping instructions into sequences affects the way they are
-- PACK'ed).
flattenExpandedOp :: ExpandedOp -> [ExpandedInstr]
flattenExpandedOp :: ExpandedOp -> [ExpandedInstr]
flattenExpandedOp =
  \case
    PrimEx ExpandedInstr
i -> [ExpandedInstr -> ExpandedInstr
flattenInstr ExpandedInstr
i]
    SeqEx [ExpandedOp]
ops -> (ExpandedOp -> [ExpandedInstr]) -> [ExpandedOp] -> [ExpandedInstr]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ExpandedOp -> [ExpandedInstr]
flattenExpandedOp [ExpandedOp]
ops
    WithSrcEx ErrorSrcPos
_ ExpandedOp
op -> ExpandedOp -> [ExpandedInstr]
flattenExpandedOp ExpandedOp
op
  where
    flattenInstr :: ExpandedInstr -> ExpandedInstr
    flattenInstr :: ExpandedInstr -> ExpandedInstr
flattenInstr = (forall b. Data b => b -> b) -> forall b. Data b => b -> b
everywhere (([ExpandedOp] -> [ExpandedOp]) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT [ExpandedOp] -> [ExpandedOp]
flattenOps)

    flattenOps :: [ExpandedOp] -> [ExpandedOp]
    flattenOps :: [ExpandedOp] -> [ExpandedOp]
flattenOps [] = []
    flattenOps (SeqEx [ExpandedOp]
s : [ExpandedOp]
xs) = [ExpandedOp]
s [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. [a] -> [a] -> [a]
++ [ExpandedOp] -> [ExpandedOp]
flattenOps [ExpandedOp]
xs
    flattenOps (x :: ExpandedOp
x@(PrimEx ExpandedInstr
_) : [ExpandedOp]
xs) = ExpandedOp
x ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: [ExpandedOp] -> [ExpandedOp]
flattenOps [ExpandedOp]
xs
    flattenOps (WithSrcEx ErrorSrcPos
_ ExpandedOp
op : [ExpandedOp]
xs) = ExpandedOp
op ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: [ExpandedOp] -> [ExpandedOp]
flattenOps [ExpandedOp]
xs

-------------------------------------
-- Abstract instruction
-------------------------------------

-- | Michelson instruction with abstract parameter @op@.  This
-- parameter is necessary, because at different stages of our pipeline
-- it will be different. Initially it can contain macros and
-- non-flattened instructions, but then it contains only vanilla
-- Michelson instructions.
data InstrAbstract op
  = EXT               (ExtInstrAbstract op)
  | DROPN              Word
  -- ^ "DROP n" instruction.
  -- Note: reference implementation permits int16 here.
  -- Negative numbers are parsed successfully there, but rejected later.
  -- Morley is more permissive, so we use 'Word' here,
  -- i. e. permit more positive numbers. We do not permit negative numbers
  -- at type level.
  -- In practice, probably nobody will ever have numbers greater than ≈1000
  -- here, at least due to gas limits.
  -- Same reasoning applies to other instructions which have a numeric
  -- parameter representing number of elements on stack.
  | DROP
  -- ^ 'DROP' is essentially as special case for 'DROPN', but we need
  -- both because they are packed differently.
  | DUP               VarAnn
  | DUPN              VarAnn Word
  | SWAP
  | DIG               Word
  | DUG               Word
  | PUSH              VarAnn Ty (Value' op)
  | SOME              TypeAnn VarAnn
  | NONE              TypeAnn VarAnn Ty
  | UNIT              TypeAnn VarAnn
  | IF_NONE           [op] [op]
  | PAIR              TypeAnn VarAnn FieldAnn FieldAnn
  | UNPAIR            VarAnn VarAnn FieldAnn FieldAnn
  | PAIRN             VarAnn Word
  | UNPAIRN           Word
  | CAR               VarAnn FieldAnn
  | CDR               VarAnn FieldAnn
  | LEFT              TypeAnn VarAnn FieldAnn FieldAnn Ty
  | RIGHT             TypeAnn VarAnn FieldAnn FieldAnn Ty
  | IF_LEFT           [op] [op]
  | NIL               TypeAnn VarAnn Ty
  | CONS              VarAnn
  | IF_CONS           [op] [op]
  | SIZE              VarAnn
  | EMPTY_SET         TypeAnn VarAnn Ty
  | EMPTY_MAP         TypeAnn VarAnn Ty Ty
  | EMPTY_BIG_MAP     TypeAnn VarAnn Ty Ty
  | MAP               VarAnn [op]
  | ITER              [op]
  | MEM               VarAnn
  | GET               VarAnn
  | GETN              VarAnn Word
  | UPDATE            VarAnn
  | UPDATEN           VarAnn Word
  | GET_AND_UPDATE    VarAnn
  | IF                [op] [op]
  | LOOP              [op]
  | LOOP_LEFT         [op]
  | LAMBDA            VarAnn Ty Ty [op]
  | EXEC              VarAnn
  | APPLY             VarAnn
  | DIP               [op]
  | DIPN              Word [op]
  | FAILWITH
  | CAST              VarAnn Ty
  | RENAME            VarAnn
  | PACK              VarAnn
  | UNPACK            TypeAnn VarAnn Ty
  | CONCAT            VarAnn
  | SLICE             VarAnn
  | ISNAT             VarAnn
  | ADD               VarAnn
  | SUB               VarAnn
  | SUB_MUTEZ         VarAnn
  | MUL               VarAnn
  | EDIV              VarAnn
  | ABS               VarAnn
  | NEG               VarAnn
  | LSL               VarAnn
  | LSR               VarAnn
  | OR                VarAnn
  | AND               VarAnn
  | XOR               VarAnn
  | NOT               VarAnn
  | COMPARE           VarAnn
  | EQ                VarAnn
  | NEQ               VarAnn
  | LT                VarAnn
  | GT                VarAnn
  | LE                VarAnn
  | GE                VarAnn
  | INT               VarAnn
  | VIEW              VarAnn ViewName Ty
  | SELF              VarAnn FieldAnn
  | CONTRACT          VarAnn FieldAnn Ty
  | TRANSFER_TOKENS   VarAnn
  | SET_DELEGATE      VarAnn
  | CREATE_CONTRACT   VarAnn VarAnn (Contract' op)
  | IMPLICIT_ACCOUNT  VarAnn
  | NOW               VarAnn
  | AMOUNT            VarAnn
  | BALANCE           VarAnn
  | VOTING_POWER      VarAnn
  | TOTAL_VOTING_POWER VarAnn
  | CHECK_SIGNATURE   VarAnn
  | SHA256            VarAnn
  | SHA512            VarAnn
  | BLAKE2B           VarAnn
  | SHA3              VarAnn
  | KECCAK            VarAnn
  | HASH_KEY          VarAnn
  | PAIRING_CHECK     VarAnn
  | SOURCE            VarAnn
  | SENDER            VarAnn
  | ADDRESS           VarAnn
  | CHAIN_ID          VarAnn
  | LEVEL             VarAnn
  | SELF_ADDRESS      VarAnn
  | NEVER
  | TICKET            VarAnn
  | READ_TICKET       VarAnn
  | SPLIT_TICKET      VarAnn
  | JOIN_TICKETS      VarAnn
  | OPEN_CHEST        VarAnn
  | SAPLING_EMPTY_STATE VarAnn Natural
  | SAPLING_VERIFY_UPDATE VarAnn
  | MIN_BLOCK_TIME    [AnyAnn]
  | EMIT              VarAnn FieldAnn (Maybe Ty)
  deriving stock (InstrAbstract op -> InstrAbstract op -> Bool
(InstrAbstract op -> InstrAbstract op -> Bool)
-> (InstrAbstract op -> InstrAbstract op -> Bool)
-> Eq (InstrAbstract op)
forall op. Eq op => InstrAbstract op -> InstrAbstract op -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstrAbstract op -> InstrAbstract op -> Bool
$c/= :: forall op. Eq op => InstrAbstract op -> InstrAbstract op -> Bool
== :: InstrAbstract op -> InstrAbstract op -> Bool
$c== :: forall op. Eq op => InstrAbstract op -> InstrAbstract op -> Bool
Eq, (forall a b. (a -> b) -> InstrAbstract a -> InstrAbstract b)
-> (forall a b. a -> InstrAbstract b -> InstrAbstract a)
-> Functor InstrAbstract
forall a b. a -> InstrAbstract b -> InstrAbstract a
forall a b. (a -> b) -> InstrAbstract a -> InstrAbstract b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> InstrAbstract b -> InstrAbstract a
$c<$ :: forall a b. a -> InstrAbstract b -> InstrAbstract a
fmap :: forall a b. (a -> b) -> InstrAbstract a -> InstrAbstract b
$cfmap :: forall a b. (a -> b) -> InstrAbstract a -> InstrAbstract b
Functor, Typeable (InstrAbstract op)
Typeable (InstrAbstract op)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> InstrAbstract op
    -> c (InstrAbstract op))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (InstrAbstract op))
-> (InstrAbstract op -> Constr)
-> (InstrAbstract op -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (InstrAbstract op)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (InstrAbstract op)))
-> ((forall b. Data b => b -> b)
    -> InstrAbstract op -> InstrAbstract op)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> InstrAbstract op -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> InstrAbstract op -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> InstrAbstract op -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> InstrAbstract op -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> InstrAbstract op -> m (InstrAbstract op))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InstrAbstract op -> m (InstrAbstract op))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InstrAbstract op -> m (InstrAbstract op))
-> Data (InstrAbstract op)
InstrAbstract op -> DataType
InstrAbstract op -> Constr
(forall b. Data b => b -> b)
-> InstrAbstract op -> InstrAbstract op
forall {op}. Data op => Typeable (InstrAbstract op)
forall op. Data op => InstrAbstract op -> DataType
forall op. Data op => InstrAbstract op -> Constr
forall op.
Data op =>
(forall b. Data b => b -> b)
-> InstrAbstract op -> InstrAbstract op
forall op u.
Data op =>
Int -> (forall d. Data d => d -> u) -> InstrAbstract op -> u
forall op u.
Data op =>
(forall d. Data d => d -> u) -> InstrAbstract op -> [u]
forall op r r'.
Data op =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InstrAbstract op -> r
forall op r r'.
Data op =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InstrAbstract op -> r
forall op (m :: * -> *).
(Data op, Monad m) =>
(forall d. Data d => d -> m d)
-> InstrAbstract op -> m (InstrAbstract op)
forall op (m :: * -> *).
(Data op, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> InstrAbstract op -> m (InstrAbstract op)
forall op (c :: * -> *).
Data op =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (InstrAbstract op)
forall op (c :: * -> *).
Data op =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InstrAbstract op -> c (InstrAbstract op)
forall op (t :: * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (InstrAbstract op))
forall op (t :: * -> * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (InstrAbstract op))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> InstrAbstract op -> u
forall u. (forall d. Data d => d -> u) -> InstrAbstract op -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InstrAbstract op -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InstrAbstract op -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InstrAbstract op -> m (InstrAbstract op)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InstrAbstract op -> m (InstrAbstract op)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (InstrAbstract op)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InstrAbstract op -> c (InstrAbstract op)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (InstrAbstract op))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (InstrAbstract op))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InstrAbstract op -> m (InstrAbstract op)
$cgmapMo :: forall op (m :: * -> *).
(Data op, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> InstrAbstract op -> m (InstrAbstract op)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InstrAbstract op -> m (InstrAbstract op)
$cgmapMp :: forall op (m :: * -> *).
(Data op, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> InstrAbstract op -> m (InstrAbstract op)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InstrAbstract op -> m (InstrAbstract op)
$cgmapM :: forall op (m :: * -> *).
(Data op, Monad m) =>
(forall d. Data d => d -> m d)
-> InstrAbstract op -> m (InstrAbstract op)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InstrAbstract op -> u
$cgmapQi :: forall op u.
Data op =>
Int -> (forall d. Data d => d -> u) -> InstrAbstract op -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> InstrAbstract op -> [u]
$cgmapQ :: forall op u.
Data op =>
(forall d. Data d => d -> u) -> InstrAbstract op -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InstrAbstract op -> r
$cgmapQr :: forall op r r'.
Data op =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InstrAbstract op -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InstrAbstract op -> r
$cgmapQl :: forall op r r'.
Data op =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InstrAbstract op -> r
gmapT :: (forall b. Data b => b -> b)
-> InstrAbstract op -> InstrAbstract op
$cgmapT :: forall op.
Data op =>
(forall b. Data b => b -> b)
-> InstrAbstract op -> InstrAbstract op
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (InstrAbstract op))
$cdataCast2 :: forall op (t :: * -> * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (InstrAbstract op))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (InstrAbstract op))
$cdataCast1 :: forall op (t :: * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (InstrAbstract op))
dataTypeOf :: InstrAbstract op -> DataType
$cdataTypeOf :: forall op. Data op => InstrAbstract op -> DataType
toConstr :: InstrAbstract op -> Constr
$ctoConstr :: forall op. Data op => InstrAbstract op -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (InstrAbstract op)
$cgunfold :: forall op (c :: * -> *).
Data op =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (InstrAbstract op)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InstrAbstract op -> c (InstrAbstract op)
$cgfoldl :: forall op (c :: * -> *).
Data op =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InstrAbstract op -> c (InstrAbstract op)
Data, (forall x. InstrAbstract op -> Rep (InstrAbstract op) x)
-> (forall x. Rep (InstrAbstract op) x -> InstrAbstract op)
-> Generic (InstrAbstract op)
forall x. Rep (InstrAbstract op) x -> InstrAbstract op
forall x. InstrAbstract op -> Rep (InstrAbstract op) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall op x. Rep (InstrAbstract op) x -> InstrAbstract op
forall op x. InstrAbstract op -> Rep (InstrAbstract op) x
$cto :: forall op x. Rep (InstrAbstract op) x -> InstrAbstract op
$cfrom :: forall op x. InstrAbstract op -> Rep (InstrAbstract op) x
Generic, Int -> InstrAbstract op -> ShowS
[InstrAbstract op] -> ShowS
InstrAbstract op -> String
(Int -> InstrAbstract op -> ShowS)
-> (InstrAbstract op -> String)
-> ([InstrAbstract op] -> ShowS)
-> Show (InstrAbstract op)
forall op. Show op => Int -> InstrAbstract op -> ShowS
forall op. Show op => [InstrAbstract op] -> ShowS
forall op. Show op => InstrAbstract op -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstrAbstract op] -> ShowS
$cshowList :: forall op. Show op => [InstrAbstract op] -> ShowS
show :: InstrAbstract op -> String
$cshow :: forall op. Show op => InstrAbstract op -> String
showsPrec :: Int -> InstrAbstract op -> ShowS
$cshowsPrec :: forall op. Show op => Int -> InstrAbstract op -> ShowS
Show)

instance NFData op => NFData (InstrAbstract op)

instance (RenderDoc op) => RenderDoc (InstrAbstract op) where
  renderDoc :: RenderContext -> InstrAbstract op -> Doc
renderDoc RenderContext
pn = \case
    EXT ExtInstrAbstract op
extInstr            -> RenderContext -> ExtInstrAbstract op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
pn ExtInstrAbstract op
extInstr
    InstrAbstract op
DROP                    -> Doc
"DROP"
    DROPN Word
n                 -> Doc
"DROP" Doc -> Doc -> Doc
<+> Text -> Doc
text (Word -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Word
n)
    DUP VarAnn
va                  -> Doc
"DUP" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    DUPN VarAnn
va Word
n               -> Doc
"DUP" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va Doc -> Doc -> Doc
<+> Text -> Doc
text (Word -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Word
n)
    InstrAbstract op
SWAP                    -> Doc
"SWAP"
    DIG Word
n                   -> Doc
"DIG" Doc -> Doc -> Doc
<+> Text -> Doc
text (Word -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Word
n)
    DUG Word
n                   -> Doc
"DUG" Doc -> Doc -> Doc
<+> Text -> Doc
text (Word -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Word
n)
    PUSH VarAnn
va Ty
t Value' op
v             ->
      Doc -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        Text -> Doc
text Text
"PUSH" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
        Doc -> Doc -> Doc
PP.<$> Ty -> Doc
renderTy Ty
t
        Doc -> Doc -> Doc
PP.<$> RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Value' op
v
    SOME TypeAnn
ta VarAnn
va              -> Doc
"SOME" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [] [VarAnn
va]
    NONE TypeAnn
ta VarAnn
va Ty
t            -> Doc
"NONE" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [] [VarAnn
va] Doc -> Doc -> Doc
<+> Ty -> Doc
renderTy Ty
t
    UNIT TypeAnn
ta VarAnn
va              -> Doc
"UNIT" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [] [VarAnn
va]
    IF_NONE [op]
x [op]
y             -> Doc
"IF_NONE" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest Int
9 ([op] -> Doc
renderOps [op]
x) Doc -> Doc -> Doc
<$$> Int -> Doc
spaces Int
8 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
9 ([op] -> Doc
renderOps [op]
y)
    PAIR TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2      -> Doc
"PAIR" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [FieldAnn
fa1, FieldAnn
fa2] [VarAnn
va]
    UNPAIR VarAnn
va1 VarAnn
va2 FieldAnn
fa1 FieldAnn
fa2  -> Doc
"UNPAIR" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [] [FieldAnn
fa1, FieldAnn
fa2] [VarAnn
va1, VarAnn
va2]
    PAIRN VarAnn
va Word
n              -> Doc
"PAIR" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [] [] [VarAnn
va] Doc -> Doc -> Doc
<+> Text -> Doc
text (Word -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Word
n)
    UNPAIRN Word
n               -> Doc
"UNPAIR" Doc -> Doc -> Doc
<+> Text -> Doc
text (Word -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Word
n)
    CAR VarAnn
va FieldAnn
fa               -> Doc
"CAR" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [] [FieldAnn
fa] [VarAnn
va]
    CDR VarAnn
va FieldAnn
fa               -> Doc
"CDR" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [] [FieldAnn
fa] [VarAnn
va]
    LEFT TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2 Ty
t    -> Doc
"LEFT" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [FieldAnn
fa1, FieldAnn
fa2] [VarAnn
va] Doc -> Doc -> Doc
<+> Ty -> Doc
renderTy Ty
t
    RIGHT TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2 Ty
t   -> Doc
"RIGHT" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [FieldAnn
fa1, FieldAnn
fa2] [VarAnn
va] Doc -> Doc -> Doc
<+> Ty -> Doc
renderTy Ty
t
    IF_LEFT [op]
x [op]
y             -> Doc
"IF_LEFT" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest Int
9 ([op] -> Doc
renderOps [op]
x) Doc -> Doc -> Doc
<$$> Int -> Doc
spaces Int
8 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
9 ([op] -> Doc
renderOps [op]
y)
    NIL TypeAnn
ta VarAnn
va Ty
t             -> Doc
"NIL" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [] [VarAnn
va] Doc -> Doc -> Doc
<+> Ty -> Doc
renderTy Ty
t
    CONS VarAnn
va                 -> Doc
"CONS" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    IF_CONS [op]
x [op]
y             -> Doc
"IF_CONS" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest Int
9 ([op] -> Doc
renderOps [op]
x) Doc -> Doc -> Doc
<$$> Int -> Doc
spaces Int
8 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
9 ([op] -> Doc
renderOps [op]
y)
    SIZE VarAnn
va                 -> Doc
"SIZE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    EMPTY_SET TypeAnn
ta VarAnn
va Ty
t       -> Doc
"EMPTY_SET" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [] [VarAnn
va] Doc -> Doc -> Doc
<+> Ty -> Doc
renderComp Ty
t
    EMPTY_MAP TypeAnn
ta VarAnn
va Ty
c Ty
t     -> Doc
"EMPTY_MAP" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [] [VarAnn
va] Doc -> Doc -> Doc
<+> Ty -> Doc
renderComp Ty
c Doc -> Doc -> Doc
<+> Ty -> Doc
renderTy Ty
t
    EMPTY_BIG_MAP TypeAnn
ta VarAnn
va Ty
c Ty
t -> Doc
"EMPTY_BIG_MAP" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [] [VarAnn
va] Doc -> Doc -> Doc
<+> Ty -> Doc
renderComp Ty
c Doc -> Doc -> Doc
<+> Ty -> Doc
renderTy Ty
t
    MAP VarAnn
va [op]
s                -> Doc
"MAP" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va Doc -> Doc -> Doc
<$$> Int -> Doc
spaces Int
4 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
5 ([op] -> Doc
renderOps [op]
s)
    ITER [op]
s                  -> Doc
"ITER" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest Int
6 ([op] -> Doc
renderOps [op]
s)
    MEM VarAnn
va                  -> Doc
"MEM" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    GET VarAnn
va                  -> Doc
"GET" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    GETN VarAnn
va Word
n               -> Doc
"GET" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va Doc -> Doc -> Doc
<+> Text -> Doc
text (Word -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Word
n)
    UPDATE VarAnn
va               -> Doc
"UPDATE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    UPDATEN VarAnn
va Word
n            -> Doc
"UPDATE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va Doc -> Doc -> Doc
<+> Text -> Doc
text (Word -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Word
n)
    GET_AND_UPDATE VarAnn
va       -> Doc
"GET_AND_UPDATE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    IF [op]
x [op]
y                  -> Doc
"IF" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest Int
4 ([op] -> Doc
renderOps [op]
x) Doc -> Doc -> Doc
<$$> Int -> Doc
spaces Int
3 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
4 ([op] -> Doc
renderOps [op]
y)
    LOOP [op]
s                  -> Doc
"LOOP" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest Int
6 ([op] -> Doc
renderOps [op]
s)
    LOOP_LEFT [op]
s             -> Doc
"LOOP_LEFT" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest Int
11 ([op] -> Doc
renderOps [op]
s)
    LAMBDA VarAnn
va Ty
t Ty
r [op]
s         -> Doc
"LAMBDA" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va Doc -> Doc -> Doc
<$$> (Int -> Doc
spaces Int
2 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Ty -> Doc
renderTy Ty
t) Doc -> Doc -> Doc
<$$> (Int -> Doc
spaces Int
2 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Ty -> Doc
renderTy Ty
r) Doc -> Doc -> Doc
<$$> Int -> Doc
spaces Int
2 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
3 ([op] -> Doc
renderOps [op]
s)
    EXEC VarAnn
va                 -> Doc
"EXEC" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    APPLY VarAnn
va                -> Doc
"APPLY" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    DIP [op]
s                   -> Doc
"DIP" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest Int
5 ([op] -> Doc
renderOps [op]
s)
    DIPN Word
n [op]
s                -> Doc
"DIP" Doc -> Doc -> Doc
<+> Text -> Doc
text (Word -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Word
n) Doc -> Doc -> Doc
PP.<$> Int -> Doc -> Doc
indent Int
4 ([op] -> Doc
renderOps [op]
s)
    InstrAbstract op
FAILWITH                -> Doc
"FAILWITH"
    CAST VarAnn
va Ty
t               -> Doc
"CAST" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va Doc -> Doc -> Doc
<+> Ty -> Doc
renderTy Ty
t
    RENAME VarAnn
va               -> Doc
"RENAME" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    PACK VarAnn
va                 -> Doc
"PACK" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    UNPACK TypeAnn
ta VarAnn
va Ty
t          -> Doc
"UNPACK" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [] [VarAnn
va] Doc -> Doc -> Doc
<+> Ty -> Doc
renderTy Ty
t
    CONCAT VarAnn
va               -> Doc
"CONCAT" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SLICE VarAnn
va                -> Doc
"SLICE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    ISNAT VarAnn
va                -> Doc
"ISNAT" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    ADD VarAnn
va                  -> Doc
"ADD" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SUB VarAnn
va                  -> Doc
"SUB" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SUB_MUTEZ VarAnn
va            -> Doc
"SUB_MUTEZ" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    MUL VarAnn
va                  -> Doc
"MUL" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    EDIV VarAnn
va                 -> Doc
"EDIV" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    ABS VarAnn
va                  -> Doc
"ABS" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    NEG VarAnn
va                  -> Doc
"NEG" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    LSL VarAnn
va                  -> Doc
"LSL" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    LSR VarAnn
va                  -> Doc
"LSR" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    OR  VarAnn
va                  -> Doc
"OR" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    AND VarAnn
va                  -> Doc
"AND" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    XOR VarAnn
va                  -> Doc
"XOR" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    NOT VarAnn
va                  -> Doc
"NOT" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    COMPARE VarAnn
va              -> Doc
"COMPARE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    EQ VarAnn
va                   -> Doc
"EQ" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    NEQ VarAnn
va                  -> Doc
"NEQ" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    LT VarAnn
va                   -> Doc
"LT" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    GT VarAnn
va                   -> Doc
"GT" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    LE VarAnn
va                   -> Doc
"LE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    GE VarAnn
va                   -> Doc
"GE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    INT VarAnn
va                  -> Doc
"INT" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    VIEW VarAnn
va ViewName
name Ty
ty         -> Doc
"VIEW" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va Doc -> Doc -> Doc
<+> ViewName -> Doc
renderViewName ViewName
name Doc -> Doc -> Doc
<+> Ty -> Doc
renderTy Ty
ty
    SELF VarAnn
va FieldAnn
fa              -> Doc
"SELF" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [] [FieldAnn
fa] [VarAnn
va]
    CONTRACT VarAnn
va FieldAnn
fa Ty
t        -> Doc
"CONTRACT" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [] [FieldAnn
fa] [VarAnn
va] Doc -> Doc -> Doc
<+> Ty -> Doc
renderTy Ty
t
    TRANSFER_TOKENS VarAnn
va      -> Doc
"TRANSFER_TOKENS" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SET_DELEGATE VarAnn
va         -> Doc
"SET_DELEGATE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    CREATE_CONTRACT VarAnn
va1 VarAnn
va2 Contract' op
contract -> let
      body :: Doc
body = Doc -> Doc -> Doc -> Doc
enclose Doc
space Doc
space (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
align (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ (RenderContext -> Contract' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
doesntNeedParens Contract' op
contract)
      in Doc
"CREATE_CONTRACT" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [] [] [VarAnn
va1, VarAnn
va2] Doc -> Doc -> Doc
<$$> (Int -> Doc -> Doc
indent Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
braces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
body)
    IMPLICIT_ACCOUNT VarAnn
va      -> Doc
"IMPLICIT_ACCOUNT" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    NOW VarAnn
va                   -> Doc
"NOW" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    AMOUNT VarAnn
va                -> Doc
"AMOUNT" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    BALANCE VarAnn
va               -> Doc
"BALANCE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    VOTING_POWER VarAnn
va          -> Doc
"VOTING_POWER" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    TOTAL_VOTING_POWER VarAnn
va    -> Doc
"TOTAL_VOTING_POWER" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    CHECK_SIGNATURE VarAnn
va       -> Doc
"CHECK_SIGNATURE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SHA256 VarAnn
va                -> Doc
"SHA256" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SHA512 VarAnn
va                -> Doc
"SHA512" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    BLAKE2B VarAnn
va               -> Doc
"BLAKE2B" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SHA3 VarAnn
va                  -> Doc
"SHA3" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    KECCAK VarAnn
va                -> Doc
"KECCAK" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    HASH_KEY VarAnn
va              -> Doc
"HASH_KEY" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    PAIRING_CHECK VarAnn
va         -> Doc
"PAIRING_CHECK" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SOURCE VarAnn
va                -> Doc
"SOURCE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SENDER VarAnn
va                -> Doc
"SENDER" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    ADDRESS VarAnn
va               -> Doc
"ADDRESS" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    CHAIN_ID VarAnn
va              -> Doc
"CHAIN_ID" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    LEVEL VarAnn
va                 -> Doc
"LEVEL" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SELF_ADDRESS VarAnn
va          -> Doc
"SELF_ADDRESS" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    InstrAbstract op
NEVER                    -> Doc
"NEVER"
    TICKET VarAnn
va                -> Doc
"TICKET" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    READ_TICKET VarAnn
va           -> Doc
"READ_TICKET" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SPLIT_TICKET VarAnn
va          -> Doc
"SPLIT_TICKET" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    JOIN_TICKETS VarAnn
va          -> Doc
"JOIN_TICKETS" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    OPEN_CHEST VarAnn
va            -> Doc
"OPEN_CHEST" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    EMIT VarAnn
va FieldAnn
fa Maybe Ty
ty            -> Doc
"EMIT" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [] [FieldAnn
fa] [VarAnn
va] Doc -> Doc -> Doc
<+> Doc -> (Ty -> Doc) -> Maybe Ty -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
forall a. Monoid a => a
mempty Ty -> Doc
renderTy Maybe Ty
ty
    SAPLING_EMPTY_STATE VarAnn
va Natural
n -> Doc
"SAPLING_EMPTY_STATE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va Doc -> Doc -> Doc
<+> (Integer -> Doc
integer (Integer -> Doc) -> Integer -> Doc
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n)
    SAPLING_VERIFY_UPDATE VarAnn
va -> Doc
"SAPLING_VERIFY_UPDATE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    MIN_BLOCK_TIME [AnyAnn]
anns      -> Doc
"MIN_BLOCK_TIME" Doc -> Doc -> Doc
<+> [AnyAnn] -> Doc
renderAnyAnns [AnyAnn]
anns
    where
      renderTy :: Ty -> Doc
renderTy = forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc @Ty RenderContext
needsParens
      renderComp :: Ty -> Doc
renderComp = forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc @Ty RenderContext
needsParens
      renderOps :: [op] -> Doc
renderOps = Bool -> [op] -> Doc
forall op. RenderDoc op => Bool -> [op] -> Doc
renderOpsList Bool
False

      renderAnnot :: KnownAnnTag tag => Annotation tag -> Doc
      renderAnnot :: forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot = RenderContext -> AnnotationSet -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
doesntNeedParens (AnnotationSet -> Doc)
-> (Annotation tag -> AnnotationSet) -> Annotation tag -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation tag -> AnnotationSet
forall tag. KnownAnnTag tag => Annotation tag -> AnnotationSet
singleAnnSet

      renderAnnots :: [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
      renderAnnots :: [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn]
ts [FieldAnn]
fs [VarAnn]
vs = RenderContext -> AnnotationSet -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
doesntNeedParens (AnnotationSet -> Doc) -> AnnotationSet -> Doc
forall a b. (a -> b) -> a -> b
$ [TypeAnn] -> [FieldAnn] -> [VarAnn] -> AnnotationSet
fullAnnSet [TypeAnn]
ts [FieldAnn]
fs [VarAnn]
vs

  isRenderable :: InstrAbstract op -> Bool
isRenderable = \case
    EXT ExtInstrAbstract op
extInstr -> ExtInstrAbstract op -> Bool
forall a. RenderDoc a => a -> Bool
isRenderable ExtInstrAbstract op
extInstr
    InstrAbstract op
_ -> Bool
True

instance (RenderDoc op, Buildable op) => Buildable (InstrAbstract op) where
  build :: InstrAbstract op -> Builder
build = \case
    EXT ExtInstrAbstract op
ext -> ExtInstrAbstract op -> Builder
forall p. Buildable p => p -> Builder
build ExtInstrAbstract op
ext
    InstrAbstract op
mi -> InstrAbstract op -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDoc InstrAbstract op
mi

----------------------------------------------------------------------------
-- JSON serialization
----------------------------------------------------------------------------

deriveJSON morleyAesonOptions ''InstrAbstract
deriveJSON morleyAesonOptions ''ExpandedOp