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

-- | Michelson instructions in untyped model.

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

import Prelude hiding (EQ, GT, LT)

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, indent, line, nest, space, text, (<$$>), (<+>))
import qualified Text.Show

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

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

type ExpandedInstr = InstrAbstract ExpandedOp

data ExpandedOp
  = PrimEx ExpandedInstr
  | SeqEx [ExpandedOp]
  | WithSrcEx InstrCallStack 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
DataType
Constr
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 d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExpandedOp -> c ExpandedOp
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cWithSrcEx :: Constr
$cSeqEx :: Constr
$cPrimEx :: Constr
$tExpandedOp :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> ExpandedOp -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ExpandedOp -> u
gmapQ :: (forall d. Data d => d -> u) -> ExpandedOp -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ExpandedOp -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable 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 InstrCallStack
_ 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 InstrCallStack
_ 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 InstrCallStack
_ 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 InstrCallStack
_ 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 InstrCallStack
_ 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
  | 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
  | 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
  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, a -> InstrAbstract b -> InstrAbstract a
(a -> b) -> InstrAbstract a -> InstrAbstract b
(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
<$ :: a -> InstrAbstract b -> InstrAbstract a
$c<$ :: forall a b. a -> InstrAbstract b -> InstrAbstract a
fmap :: (a -> b) -> InstrAbstract a -> InstrAbstract b
$cfmap :: forall a b. (a -> b) -> InstrAbstract a -> InstrAbstract b
Functor, Typeable (InstrAbstract op)
DataType
Constr
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 d. Data d => c (t d)) -> Maybe (c (InstrAbstract op))
(forall b. Data b => b -> b)
-> InstrAbstract op -> InstrAbstract op
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InstrAbstract op -> c (InstrAbstract op)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (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))
$cJOIN_TICKETS :: Constr
$cSPLIT_TICKET :: Constr
$cREAD_TICKET :: Constr
$cTICKET :: Constr
$cNEVER :: Constr
$cSELF_ADDRESS :: Constr
$cLEVEL :: Constr
$cCHAIN_ID :: Constr
$cADDRESS :: Constr
$cSENDER :: Constr
$cSOURCE :: Constr
$cPAIRING_CHECK :: Constr
$cHASH_KEY :: Constr
$cKECCAK :: Constr
$cSHA3 :: Constr
$cBLAKE2B :: Constr
$cSHA512 :: Constr
$cSHA256 :: Constr
$cCHECK_SIGNATURE :: Constr
$cTOTAL_VOTING_POWER :: Constr
$cVOTING_POWER :: Constr
$cBALANCE :: Constr
$cAMOUNT :: Constr
$cNOW :: Constr
$cIMPLICIT_ACCOUNT :: Constr
$cCREATE_CONTRACT :: Constr
$cSET_DELEGATE :: Constr
$cTRANSFER_TOKENS :: Constr
$cCONTRACT :: Constr
$cSELF :: Constr
$cINT :: Constr
$cGE :: Constr
$cLE :: Constr
$cGT :: Constr
$cLT :: Constr
$cNEQ :: Constr
$cEQ :: Constr
$cCOMPARE :: Constr
$cNOT :: Constr
$cXOR :: Constr
$cAND :: Constr
$cOR :: Constr
$cLSR :: Constr
$cLSL :: Constr
$cNEG :: Constr
$cABS :: Constr
$cEDIV :: Constr
$cMUL :: Constr
$cSUB :: Constr
$cADD :: Constr
$cISNAT :: Constr
$cSLICE :: Constr
$cCONCAT :: Constr
$cUNPACK :: Constr
$cPACK :: Constr
$cRENAME :: Constr
$cCAST :: Constr
$cFAILWITH :: Constr
$cDIPN :: Constr
$cDIP :: Constr
$cAPPLY :: Constr
$cEXEC :: Constr
$cLAMBDA :: Constr
$cLOOP_LEFT :: Constr
$cLOOP :: Constr
$cIF :: Constr
$cGET_AND_UPDATE :: Constr
$cUPDATEN :: Constr
$cUPDATE :: Constr
$cGETN :: Constr
$cGET :: Constr
$cMEM :: Constr
$cITER :: Constr
$cMAP :: Constr
$cEMPTY_BIG_MAP :: Constr
$cEMPTY_MAP :: Constr
$cEMPTY_SET :: Constr
$cSIZE :: Constr
$cIF_CONS :: Constr
$cCONS :: Constr
$cNIL :: Constr
$cIF_LEFT :: Constr
$cRIGHT :: Constr
$cLEFT :: Constr
$cCDR :: Constr
$cCAR :: Constr
$cUNPAIRN :: Constr
$cPAIRN :: Constr
$cUNPAIR :: Constr
$cPAIR :: Constr
$cIF_NONE :: Constr
$cUNIT :: Constr
$cNONE :: Constr
$cSOME :: Constr
$cPUSH :: Constr
$cDUG :: Constr
$cDIG :: Constr
$cSWAP :: Constr
$cDUPN :: Constr
$cDUP :: Constr
$cDROP :: Constr
$cDROPN :: Constr
$cEXT :: Constr
$tInstrAbstract :: DataType
gmapMo :: (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 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 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 :: 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 d. Data d => d -> u) -> InstrAbstract op -> [u]
$cgmapQ :: forall op u.
Data op =>
(forall d. Data d => d -> u) -> InstrAbstract op -> [u]
gmapQr :: (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 :: (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 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 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 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 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)
$cp1Data :: forall op. Data op => Typeable (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)

instance RenderDoc (InstrAbstract op) => Show (InstrAbstract op) where
  show :: InstrAbstract op -> String
show = Bool -> Doc -> String
printDocS Bool
True (Doc -> String)
-> (InstrAbstract op -> Doc) -> InstrAbstract op -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderContext -> InstrAbstract op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
doesntNeedParens

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. (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. (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. (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. (Show a, IsString b) => a -> b
show Word
n)
    PUSH VarAnn
va Ty
t Value' op
v             ->
      let renderConsecutively :: Doc
renderConsecutively =
            Doc
"PUSH" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va Doc -> Doc -> Doc
<+> Ty -> Doc
renderTy Ty
t Doc -> Doc -> Doc
<+> RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Value' op
v
          renderAligned :: Doc
renderAligned = Doc
"PUSH" 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
<> Int -> Doc -> Doc
nest Int
3 (RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Value' op
v)
      in case Value' op
v of
        Value' op
ValueNil      -> Doc
renderConsecutively
        ValueInt{}    -> Doc
renderConsecutively
        ValueString{} -> Doc
renderConsecutively
        ValueBytes{}  -> Doc
renderConsecutively
        Value' op
ValueUnit     -> Doc
renderConsecutively
        Value' op
ValueTrue     -> Doc
renderConsecutively
        Value' op
ValueFalse    -> Doc
renderConsecutively
        Value' op
ValueNone     -> Doc
renderConsecutively
        Value' op
_             -> Doc
renderAligned
    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. (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. (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. (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. (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. (Show a, IsString b) => a -> b
show Word
n) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> 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
    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
    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
    where
      renderTy :: Ty -> Doc
renderTy = RenderContext -> Ty -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc @Ty RenderContext
needsParens
      renderComp :: Ty -> Doc
renderComp = RenderContext -> Ty -> Doc
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 :: 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 ''ExpandedOp
deriveJSON morleyAesonOptions ''InstrAbstract