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

-- | Michelson instructions in untyped model.

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

  -- * Contract's address
  , OperationHash (..)
  ) 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 (Type)
import Michelson.Untyped.Value (Value'(..))
import Tezos.Address (OperationHash(..))
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 pn :: RenderContext
pn (WithSrcEx _ op :: ExpandedOp
op) = RenderContext -> ExpandedOp -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
pn ExpandedOp
op
  renderDoc pn :: RenderContext
pn (PrimEx i :: ExpandedInstr
i) = RenderContext -> ExpandedInstr -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
pn ExpandedInstr
i
  renderDoc _  (SeqEx i :: [ExpandedOp]
i) = Bool -> [ExpandedOp] -> Doc
forall op. RenderDoc op => Bool -> [op] -> Doc
renderOpsList Bool
False [ExpandedOp]
i
  isRenderable :: ExpandedOp -> Bool
isRenderable =
    \case PrimEx i :: ExpandedInstr
i -> ExpandedInstr -> Bool
forall a. RenderDoc a => a -> Bool
isRenderable ExpandedInstr
i
          WithSrcEx _ op :: ExpandedOp
op -> ExpandedOp -> Bool
forall a. RenderDoc a => a -> Bool
isRenderable ExpandedOp
op
          _ -> Bool
True

instance Buildable ExpandedOp where
  build :: ExpandedOp -> Builder
build (WithSrcEx _ op :: ExpandedOp
op) = ExpandedOp -> Builder
forall p. Buildable p => p -> Builder
build ExpandedOp
op
  build (PrimEx expandedInstr :: ExpandedInstr
expandedInstr) = "<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
|+">"
  build (SeqEx expandedOps :: [ExpandedOp]
expandedOps)    = "<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
|+">"

-- | 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 i :: ExpandedInstr
i -> [ExpandedInstr -> ExpandedInstr
flattenInstr ExpandedInstr
i]
    SeqEx ops :: [ExpandedOp]
ops -> (ExpandedOp -> [ExpandedInstr]) -> [ExpandedOp] -> [ExpandedInstr]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ExpandedOp -> [ExpandedInstr]
flattenExpandedOp [ExpandedOp]
ops
    WithSrcEx _ op :: 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 s :: [ExpandedOp]
s : xs :: [ExpandedOp]
xs) = [ExpandedOp]
s [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. [a] -> [a] -> [a]
++ [ExpandedOp] -> [ExpandedOp]
flattenOps [ExpandedOp]
xs
    flattenOps (x :: ExpandedOp
x@(PrimEx _) : xs :: [ExpandedOp]
xs) = ExpandedOp
x ExpandedOp -> [ExpandedOp] -> [ExpandedOp]
forall a. a -> [a] -> [a]
: [ExpandedOp] -> [ExpandedOp]
flattenOps [ExpandedOp]
xs
    flattenOps (WithSrcEx _ op :: ExpandedOp
op : xs :: [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
  | SWAP
  | DIG               Word
  | DUG               Word
  | PUSH              VarAnn Type (Value' op)
  | SOME              TypeAnn VarAnn
  | NONE              TypeAnn VarAnn Type
  | UNIT              TypeAnn VarAnn
  | IF_NONE           [op] [op]
  | PAIR              TypeAnn VarAnn FieldAnn FieldAnn
  | CAR               VarAnn FieldAnn
  | CDR               VarAnn FieldAnn
  | LEFT              TypeAnn VarAnn FieldAnn FieldAnn Type
  | RIGHT             TypeAnn VarAnn FieldAnn FieldAnn Type
  | IF_LEFT           [op] [op]
  | NIL               TypeAnn VarAnn Type
  | CONS              VarAnn
  | IF_CONS           [op] [op]
  | SIZE              VarAnn
  | EMPTY_SET         TypeAnn VarAnn Type
  | EMPTY_MAP         TypeAnn VarAnn Type Type
  | EMPTY_BIG_MAP     TypeAnn VarAnn Type Type
  | MAP               VarAnn [op]
  | ITER              [op]
  | MEM               VarAnn
  | GET               VarAnn
  | UPDATE            VarAnn
  | IF                [op] [op]
  | LOOP              [op]
  | LOOP_LEFT         [op]
  | LAMBDA            VarAnn Type Type [op]
  | EXEC              VarAnn
  | APPLY             VarAnn
  | DIP               [op]
  | DIPN              Word [op]
  | FAILWITH
  | CAST              VarAnn Type
  | RENAME            VarAnn
  | PACK              VarAnn
  | UNPACK            TypeAnn VarAnn Type
  | 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 Type
  | TRANSFER_TOKENS   VarAnn
  | SET_DELEGATE      VarAnn
  | CREATE_CONTRACT   VarAnn VarAnn (Contract' op)
  | IMPLICIT_ACCOUNT  VarAnn
  | NOW               VarAnn
  | AMOUNT            VarAnn
  | BALANCE           VarAnn
  | CHECK_SIGNATURE   VarAnn
  | SHA256            VarAnn
  | SHA512            VarAnn
  | BLAKE2B           VarAnn
  | SHA3              VarAnn
  | KECCAK            VarAnn
  | HASH_KEY          VarAnn
  | SOURCE            VarAnn
  | SENDER            VarAnn
  | ADDRESS           VarAnn
  | CHAIN_ID          VarAnn
  | LEVEL             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))
$cLEVEL :: Constr
$cCHAIN_ID :: Constr
$cADDRESS :: Constr
$cSENDER :: Constr
$cSOURCE :: Constr
$cHASH_KEY :: Constr
$cKECCAK :: Constr
$cSHA3 :: Constr
$cBLAKE2B :: Constr
$cSHA512 :: Constr
$cSHA256 :: Constr
$cCHECK_SIGNATURE :: 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
$cUPDATE :: 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
$cPAIR :: Constr
$cIF_NONE :: Constr
$cUNIT :: Constr
$cNONE :: Constr
$cSOME :: Constr
$cPUSH :: Constr
$cDUG :: Constr
$cDIG :: Constr
$cSWAP :: 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 pn :: RenderContext
pn = \case
    EXT extInstr :: ExtInstrAbstract op
extInstr            -> RenderContext -> ExtInstrAbstract op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
pn ExtInstrAbstract op
extInstr
    DROP                    -> "DROP"
    DROPN n :: Word
n                 -> "DROP" Doc -> Doc -> Doc
<+> Text -> Doc
text (Word -> Text
forall b a. (Show a, IsString b) => a -> b
show Word
n)
    DUP va :: VarAnn
va                  -> "DUP" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SWAP                    -> "SWAP"
    DIG n :: Word
n                   -> "DIG" Doc -> Doc -> Doc
<+> Text -> Doc
text (Word -> Text
forall b a. (Show a, IsString b) => a -> b
show Word
n)
    DUG n :: Word
n                   -> "DUG" Doc -> Doc -> Doc
<+> Text -> Doc
text (Word -> Text
forall b a. (Show a, IsString b) => a -> b
show Word
n)
    PUSH va :: VarAnn
va t :: Type
t v :: Value' op
v             ->
      let renderConsecutively :: Doc
renderConsecutively =
            "PUSH" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va Doc -> Doc -> Doc
<+> Type -> Doc
renderTy Type
t Doc -> Doc -> Doc
<+> RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Value' op
v
          renderAligned :: Doc
renderAligned = "PUSH" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va Doc -> Doc -> Doc
<$$> (Int -> Doc
spaces 2 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Type -> Doc
renderTy Type
t)
                                Doc -> Doc -> Doc
<$$> Int -> Doc
spaces 2 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest 3 (RenderContext -> Value' op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Value' op
v)
      in case Value' op
v of
        ValueNil      -> Doc
renderConsecutively
        ValueInt{}    -> Doc
renderConsecutively
        ValueString{} -> Doc
renderConsecutively
        ValueBytes{}  -> Doc
renderConsecutively
        ValueUnit     -> Doc
renderConsecutively
        ValueTrue     -> Doc
renderConsecutively
        ValueFalse    -> Doc
renderConsecutively
        ValueNone     -> Doc
renderConsecutively
        _             -> Doc
renderAligned
    SOME ta :: TypeAnn
ta va :: VarAnn
va              -> "SOME" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [] [VarAnn
va]
    NONE ta :: TypeAnn
ta va :: VarAnn
va t :: Type
t            -> "NONE" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [] [VarAnn
va] Doc -> Doc -> Doc
<+> Type -> Doc
renderTy Type
t
    UNIT ta :: TypeAnn
ta va :: VarAnn
va              -> "UNIT" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [] [VarAnn
va]
    IF_NONE x :: [op]
x y :: [op]
y             -> "IF_NONE" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest 9 ([op] -> Doc
renderOps [op]
x) Doc -> Doc -> Doc
<$$> Int -> Doc
spaces 8 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest 9 ([op] -> Doc
renderOps [op]
y)
    PAIR ta :: TypeAnn
ta va :: VarAnn
va fa1 :: FieldAnn
fa1 fa2 :: FieldAnn
fa2      -> "PAIR" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [FieldAnn
fa1, FieldAnn
fa2] [VarAnn
va]
    CAR va :: VarAnn
va fa :: FieldAnn
fa               -> "CAR" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [] [FieldAnn
fa] [VarAnn
va]
    CDR va :: VarAnn
va fa :: FieldAnn
fa               -> "CDR" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [] [FieldAnn
fa] [VarAnn
va]
    LEFT ta :: TypeAnn
ta va :: VarAnn
va fa1 :: FieldAnn
fa1 fa2 :: FieldAnn
fa2 t :: Type
t    -> "LEFT" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [FieldAnn
fa1, FieldAnn
fa2] [VarAnn
va] Doc -> Doc -> Doc
<+> Type -> Doc
renderTy Type
t
    RIGHT ta :: TypeAnn
ta va :: VarAnn
va fa1 :: FieldAnn
fa1 fa2 :: FieldAnn
fa2 t :: Type
t   -> "RIGHT" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [FieldAnn
fa1, FieldAnn
fa2] [VarAnn
va] Doc -> Doc -> Doc
<+> Type -> Doc
renderTy Type
t
    IF_LEFT x :: [op]
x y :: [op]
y             -> "IF_LEFT" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest 9 ([op] -> Doc
renderOps [op]
x) Doc -> Doc -> Doc
<$$> Int -> Doc
spaces 8 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest 9 ([op] -> Doc
renderOps [op]
y)
    NIL ta :: TypeAnn
ta va :: VarAnn
va t :: Type
t             -> "NIL" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [] [VarAnn
va] Doc -> Doc -> Doc
<+> Type -> Doc
renderTy Type
t
    CONS va :: VarAnn
va                 -> "CONS" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    IF_CONS x :: [op]
x y :: [op]
y             -> "IF_CONS" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest 9 ([op] -> Doc
renderOps [op]
x) Doc -> Doc -> Doc
<$$> Int -> Doc
spaces 8 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest 9 ([op] -> Doc
renderOps [op]
y)
    SIZE va :: VarAnn
va                 -> "SIZE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    EMPTY_SET ta :: TypeAnn
ta va :: VarAnn
va t :: Type
t       -> "EMPTY_SET" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [] [VarAnn
va] Doc -> Doc -> Doc
<+> Type -> Doc
renderComp Type
t
    EMPTY_MAP ta :: TypeAnn
ta va :: VarAnn
va c :: Type
c t :: Type
t     -> "EMPTY_MAP" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [] [VarAnn
va] Doc -> Doc -> Doc
<+> Type -> Doc
renderComp Type
c Doc -> Doc -> Doc
<+> Type -> Doc
renderTy Type
t
    EMPTY_BIG_MAP ta :: TypeAnn
ta va :: VarAnn
va c :: Type
c t :: Type
t -> "EMPTY_BIG_MAP" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [] [VarAnn
va] Doc -> Doc -> Doc
<+> Type -> Doc
renderComp Type
c Doc -> Doc -> Doc
<+> Type -> Doc
renderTy Type
t
    MAP va :: VarAnn
va s :: [op]
s                -> "MAP" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va Doc -> Doc -> Doc
<$$> Int -> Doc
spaces 4 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest 5 ([op] -> Doc
renderOps [op]
s)
    ITER s :: [op]
s                  -> "ITER" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest 6 ([op] -> Doc
renderOps [op]
s)
    MEM va :: VarAnn
va                  -> "MEM" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    GET va :: VarAnn
va                  -> "GET" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    UPDATE va :: VarAnn
va               -> "UPDATE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    IF x :: [op]
x y :: [op]
y                  -> "IF" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest 4 ([op] -> Doc
renderOps [op]
x) Doc -> Doc -> Doc
<$$> Int -> Doc
spaces 3 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest 4 ([op] -> Doc
renderOps [op]
y)
    LOOP s :: [op]
s                  -> "LOOP" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest 6 ([op] -> Doc
renderOps [op]
s)
    LOOP_LEFT s :: [op]
s             -> "LOOP_LEFT" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest 11 ([op] -> Doc
renderOps [op]
s)
    LAMBDA va :: VarAnn
va t :: Type
t r :: Type
r s :: [op]
s         -> "LAMBDA" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va Doc -> Doc -> Doc
<$$> (Int -> Doc
spaces 2 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Type -> Doc
renderTy Type
t) Doc -> Doc -> Doc
<$$> (Int -> Doc
spaces 2 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Type -> Doc
renderTy Type
r) Doc -> Doc -> Doc
<$$> Int -> Doc
spaces 2 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest 3 ([op] -> Doc
renderOps [op]
s)
    EXEC va :: VarAnn
va                 -> "EXEC" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    APPLY va :: VarAnn
va                -> "APPLY" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    DIP s :: [op]
s                   -> "DIP" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest 5 ([op] -> Doc
renderOps [op]
s)
    DIPN n :: Word
n s :: [op]
s                -> "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 4 ([op] -> Doc
renderOps [op]
s)
    FAILWITH                -> "FAILWITH"
    CAST va :: VarAnn
va t :: Type
t               -> "CAST" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va Doc -> Doc -> Doc
<+> Type -> Doc
renderTy Type
t
    RENAME va :: VarAnn
va               -> "RENAME" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    PACK va :: VarAnn
va                 -> "PACK" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    UNPACK ta :: TypeAnn
ta va :: VarAnn
va t :: Type
t          -> "UNPACK" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [TypeAnn
ta] [] [VarAnn
va] Doc -> Doc -> Doc
<+> Type -> Doc
renderTy Type
t
    CONCAT va :: VarAnn
va               -> "CONCAT" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SLICE va :: VarAnn
va                -> "SLICE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    ISNAT va :: VarAnn
va                -> "ISNAT" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    ADD va :: VarAnn
va                  -> "ADD" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SUB va :: VarAnn
va                  -> "SUB" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    MUL va :: VarAnn
va                  -> "MUL" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    EDIV va :: VarAnn
va                 -> "EDIV" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    ABS va :: VarAnn
va                  -> "ABS" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    NEG va :: VarAnn
va                  -> "NEG" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    LSL va :: VarAnn
va                  -> "LSL" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    LSR va :: VarAnn
va                  -> "LSR" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    OR  va :: VarAnn
va                  -> "OR" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    AND va :: VarAnn
va                  -> "AND" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    XOR va :: VarAnn
va                  -> "XOR" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    NOT va :: VarAnn
va                  -> "NOT" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    COMPARE va :: VarAnn
va              -> "COMPARE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    EQ va :: VarAnn
va                   -> "EQ" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    NEQ va :: VarAnn
va                  -> "NEQ" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    LT va :: VarAnn
va                   -> "LT" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    GT va :: VarAnn
va                   -> "GT" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    LE va :: VarAnn
va                   -> "LE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    GE va :: VarAnn
va                   -> "GE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    INT va :: VarAnn
va                  -> "INT" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SELF va :: VarAnn
va fa :: FieldAnn
fa              -> "SELF" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [] [FieldAnn
fa] [VarAnn
va]
    CONTRACT va :: VarAnn
va fa :: FieldAnn
fa t :: Type
t        -> "CONTRACT" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [] [FieldAnn
fa] [VarAnn
va] Doc -> Doc -> Doc
<+> Type -> Doc
renderTy Type
t
    TRANSFER_TOKENS va :: VarAnn
va      -> "TRANSFER_TOKENS" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SET_DELEGATE va :: VarAnn
va         -> "SET_DELEGATE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    CREATE_CONTRACT va1 :: VarAnn
va1 va2 :: VarAnn
va2 contract :: 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 "CREATE_CONTRACT" Doc -> Doc -> Doc
<+> [TypeAnn] -> [FieldAnn] -> [VarAnn] -> Doc
renderAnnots [] [] [VarAnn
va1, VarAnn
va2] Doc -> Doc -> Doc
<$$> (Int -> Doc -> Doc
indent 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 va :: VarAnn
va     -> "IMPLICIT_ACCOUNT" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    NOW va :: VarAnn
va                  -> "NOW" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    AMOUNT va :: VarAnn
va               -> "AMOUNT" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    BALANCE va :: VarAnn
va              -> "BALANCE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    CHECK_SIGNATURE va :: VarAnn
va      -> "CHECK_SIGNATURE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SHA256 va :: VarAnn
va               -> "SHA256" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SHA512 va :: VarAnn
va               -> "SHA512" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    BLAKE2B va :: VarAnn
va              -> "BLAKE2B" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SHA3 va :: VarAnn
va                 -> "SHA3" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    KECCAK va :: VarAnn
va               -> "KECCAK" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    HASH_KEY va :: VarAnn
va             -> "HASH_KEY" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SOURCE va :: VarAnn
va               -> "SOURCE" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    SENDER va :: VarAnn
va               -> "SENDER" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    ADDRESS va :: VarAnn
va              -> "ADDRESS" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    CHAIN_ID va :: VarAnn
va             -> "CHAIN_ID" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    LEVEL va :: VarAnn
va                -> "LEVEL" Doc -> Doc -> Doc
<+> VarAnn -> Doc
forall tag. KnownAnnTag tag => Annotation tag -> Doc
renderAnnot VarAnn
va
    where
      renderTy :: Type -> Doc
renderTy = RenderContext -> Type -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc @Type RenderContext
needsParens
      renderComp :: Type -> Doc
renderComp = RenderContext -> Type -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc @Type 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 ts :: [TypeAnn]
ts fs :: [FieldAnn]
fs vs :: [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 extInstr :: ExtInstrAbstract op
extInstr -> ExtInstrAbstract op -> Bool
forall a. RenderDoc a => a -> Bool
isRenderable ExtInstrAbstract op
extInstr
    _ -> Bool
True

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

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

deriveJSON morleyAesonOptions ''ExpandedOp
deriveJSON morleyAesonOptions ''InstrAbstract