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

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Michelson.Typed.Convert
  ( convertContractCode
  , convertContract
  , instrToOps
  , untypeValue

  -- Helper for generating documentation
  , sampleValueFromUntype
  ) where

import Data.Constraint (Dict(..))
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Singletons (Sing, demote)
import Fmt (Buildable(..), pretty)

import Michelson.Text
import Michelson.Typed.Aliases
import Michelson.Typed.Annotation (Notes(..))
import Michelson.Typed.Entrypoints
import Michelson.Typed.Extract (fromUType, mkUType, toUType)
import Michelson.Typed.Instr as Instr
import Michelson.Typed.Scope
import Michelson.Typed.Sing (SingT(..), withSomeSingT)
import Michelson.Typed.T (T(..))
import Michelson.Typed.Value
import qualified Michelson.Untyped as U
import Tezos.Core
  (mformatChainId, parseChainId, timestampFromSeconds, unMutez, unsafeMkMutez)
import Tezos.Crypto
import Util.Peano
import Util.Typeable

convertContractCode
  :: forall param store . (SingI param, SingI store)
  => ContractCode param store -> U.Contract
convertContractCode :: ContractCode param store -> Contract
convertContractCode contract :: ContractCode param store
contract =
  $WContract :: forall op.
ParameterType -> Storage -> [op] -> EntriesOrder -> Contract' op
U.Contract
    { contractParameter :: ParameterType
contractParameter = Storage -> RootAnn -> ParameterType
U.ParameterType (SingI param => Storage
forall (t :: T). SingI t => Storage
untypeDemoteT @param) RootAnn
forall k (a :: k). Annotation a
U.noAnn
    , contractStorage :: Storage
contractStorage = SingI store => Storage
forall (t :: T). SingI t => Storage
untypeDemoteT @store
    , contractCode :: [ExpandedOp]
contractCode = ContractCode param store -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps ContractCode param store
contract
    , entriesOrder :: EntriesOrder
entriesOrder = EntriesOrder
U.canonicalEntriesOrder
    }

convertContract
  :: forall param store . (SingI param, SingI store)
  => Contract param store -> U.Contract
convertContract :: Contract param store -> Contract
convertContract fc :: Contract param store
fc =
  let c :: Contract
c = ContractCode param store -> Contract
forall (param :: T) (store :: T).
(SingI param, SingI store) =>
ContractCode param store -> Contract
convertContractCode (Contract param store -> ContractCode param store
forall (cp :: T) (st :: T). Contract cp st -> ContractCode cp st
cCode Contract param store
fc)
  in Contract
c { contractParameter :: ParameterType
U.contractParameter = Storage -> RootAnn -> ParameterType
U.ParameterType (Notes param -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType (ParamNotes param -> Notes param
forall (t :: T). ParamNotes t -> Notes t
pnNotes (ParamNotes param -> Notes param)
-> ParamNotes param -> Notes param
forall a b. (a -> b) -> a -> b
$ Contract param store -> ParamNotes param
forall (cp :: T) (st :: T). Contract cp st -> ParamNotes cp
cParamNotes Contract param store
fc))
         (ParamNotes param -> RootAnn
forall (t :: T). ParamNotes t -> RootAnn
pnRootAnn (Contract param store -> ParamNotes param
forall (cp :: T) (st :: T). Contract cp st -> ParamNotes cp
cParamNotes Contract param store
fc))
       , contractStorage :: Storage
U.contractStorage = Notes store -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType (Contract param store -> Notes store
forall (cp :: T) (st :: T). Contract cp st -> Notes st
cStoreNotes Contract param store
fc)
       , entriesOrder :: EntriesOrder
U.entriesOrder = Contract param store -> EntriesOrder
forall (cp :: T) (st :: T). Contract cp st -> EntriesOrder
cEntriesOrder Contract param store
fc
       }

-- | Convert a typed 'Val' to an untyped 'Value'.
--
-- For full isomorphism type of the given 'Val' should not contain
-- 'TOperation' - a compile error will be raised otherwise.
-- You can analyse its presence with 'checkOpPresence' function.
untypeValue ::
     forall t . (SingI t, HasNoOp t)
  => Value' Instr t
  -> U.Value
untypeValue :: Value' Instr t -> Value
untypeValue val :: Value' Instr t
val = case (Value' Instr t
val, SingI t => Sing t
forall k (a :: k). SingI a => Sing a
sing @t) of
  (VInt i :: Integer
i, _) -> Integer -> Value
forall op. Integer -> Value' op
U.ValueInt Integer
i
  (VNat i :: Natural
i, _) -> Integer -> Value
forall op. Integer -> Value' op
U.ValueInt (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
i
  (VString s :: MText
s, _) -> MText -> Value
forall op. MText -> Value' op
U.ValueString MText
s
  (VBytes b :: ByteString
b, _) -> InternalByteString -> Value
forall op. InternalByteString -> Value' op
U.ValueBytes (InternalByteString -> Value) -> InternalByteString -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> InternalByteString
U.InternalByteString ByteString
b
  (VMutez m :: Mutez
m, _) -> Integer -> Value
forall op. Integer -> Value' op
U.ValueInt (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ Mutez -> Word64
unMutez Mutez
m
  (VBool True, _) -> Value
forall op. Value' op
U.ValueTrue
  (VBool False, _) -> Value
forall op. Value' op
U.ValueFalse
  (VKeyHash h :: KeyHash
h, _) -> MText -> Value
forall op. MText -> Value' op
U.ValueString (MText -> Value) -> MText -> Value
forall a b. (a -> b) -> a -> b
$ KeyHash -> MText
mformatKeyHash KeyHash
h
  (VTimestamp t :: Timestamp
t, _) -> MText -> Value
forall op. MText -> Value' op
U.ValueString (MText -> Value) -> MText -> Value
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> MText
Text -> MText
mkMTextUnsafe (Text -> MText) -> Text -> MText
forall a b. (a -> b) -> a -> b
$ Timestamp -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Timestamp
t
  (VAddress a :: EpAddress
a, _) -> MText -> Value
forall op. MText -> Value' op
U.ValueString (MText -> Value) -> MText -> Value
forall a b. (a -> b) -> a -> b
$ EpAddress -> MText
mformatEpAddress EpAddress
a

  (VKey b :: PublicKey
b, _) ->
    MText -> Value
forall op. MText -> Value' op
U.ValueString (MText -> Value) -> MText -> Value
forall a b. (a -> b) -> a -> b
$ PublicKey -> MText
mformatPublicKey PublicKey
b
  (VUnit, _) ->
    Value
forall op. Value' op
U.ValueUnit
  (VSignature b :: Signature
b, _) ->
    MText -> Value
forall op. MText -> Value' op
U.ValueString (MText -> Value) -> MText -> Value
forall a b. (a -> b) -> a -> b
$ Signature -> MText
mformatSignature Signature
b
  (VChainId b :: ChainId
b, _) ->
    MText -> Value
forall op. MText -> Value' op
U.ValueString (MText -> Value) -> MText -> Value
forall a b. (a -> b) -> a -> b
$ ChainId -> MText
mformatChainId ChainId
b
  (VOption (Just x :: Value' Instr t
x), STOption _) ->
    Value -> Value
forall op. Value' op -> Value' op
U.ValueSome (Value' Instr t -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue Value' Instr t
x)
  (VOption Nothing, STOption _) ->
    Value
forall op. Value' op
U.ValueNone
  (VList l :: [Value' Instr t]
l, STList _) ->
    (NonEmpty Value -> Value) -> [Value] -> Value
forall a op. (NonEmpty a -> Value' op) -> [a] -> Value' op
vList NonEmpty Value -> Value
forall op. (NonEmpty $ Value' op) -> Value' op
U.ValueSeq ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (Value' Instr t -> Value) -> [Value' Instr t] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Value' Instr t -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue [Value' Instr t]
l
  (VSet s :: Set (Value' Instr t)
s, STSet (st :: SingT st)) ->
    case Sing t -> OpPresence t
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing t
SingT t
st of
      OpAbsent -> (NonEmpty Value -> Value) -> [Value] -> Value
forall a op. (NonEmpty a -> Value' op) -> [a] -> Value' op
vList NonEmpty Value -> Value
forall op. (NonEmpty $ Value' op) -> Value' op
U.ValueSeq ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (Value' Instr t -> Value) -> [Value' Instr t] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((SingI t, HasNoOp t) => Value' Instr t -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue @st) ([Value' Instr t] -> [Value]) -> [Value' Instr t] -> [Value]
forall a b. (a -> b) -> a -> b
$ Set (Value' Instr t) -> [Element (Set (Value' Instr t))]
forall t. Container t => t -> [Element t]
toList Set (Value' Instr t)
s
  (VContract addr :: Address
addr sepc :: SomeEntrypointCallT arg
sepc, _) ->
    MText -> Value
forall op. MText -> Value' op
U.ValueString (MText -> Value) -> (EpAddress -> MText) -> EpAddress -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpAddress -> MText
mformatEpAddress (EpAddress -> Value) -> EpAddress -> Value
forall a b. (a -> b) -> a -> b
$ Address -> EpName -> EpAddress
EpAddress Address
addr (SomeEntrypointCallT arg -> EpName
forall (arg :: T). SomeEntrypointCallT arg -> EpName
sepcName SomeEntrypointCallT arg
sepc)

  (VPair (l :: Value' Instr l
l, r :: Value' Instr r
r), STPair lt _) ->
    case Sing l -> OpPresence l
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing l
Sing a
lt of
      OpAbsent -> Value -> Value -> Value
forall op. Value' op -> Value' op -> Value' op
U.ValuePair (Value' Instr l -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue Value' Instr l
l) (Value' Instr r -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue Value' Instr r
r)

  (VOr (Left x :: Value' Instr l
x), STOr lt _) ->
    case Sing l -> OpPresence l
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing l
Sing a
lt of
      OpAbsent -> Value -> Value
forall op. Value' op -> Value' op
U.ValueLeft (Value' Instr l -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue Value' Instr l
x)

  (VOr (Right x :: Value' Instr r
x), STOr lt _) ->
    case Sing l -> OpPresence l
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing l
Sing a
lt of
      OpAbsent -> Value -> Value
forall op. Value' op -> Value' op
U.ValueRight (Value' Instr r -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue Value' Instr r
x)

  (VLam (RemFail Instr '[inp] '[out] -> Instr '[inp] '[out]
forall k (instr :: k -> k -> *) (i :: k) (o :: k).
RemFail instr i o -> instr i o
rfAnyInstr -> Instr '[inp] '[out]
ops :: Instr '[inp] '[out]), _) ->
    (NonEmpty ExpandedOp -> Value) -> [ExpandedOp] -> Value
forall a op. (NonEmpty a -> Value' op) -> [a] -> Value' op
vList NonEmpty ExpandedOp -> Value
forall op. NonEmpty op -> Value' op
U.ValueLambda ([ExpandedOp] -> Value) -> [ExpandedOp] -> Value
forall a b. (a -> b) -> a -> b
$ Instr '[inp] '[out] -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr '[inp] '[out]
ops

  (VMap m :: Map (Value' Instr k) (Value' Instr v)
m, STMap kt vt) ->
    case (Sing k -> OpPresence k
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing k
Sing a
kt, Sing v -> OpPresence v
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing v
Sing b
vt) of
      (OpAbsent, OpAbsent) ->
        (NonEmpty (Elt ExpandedOp) -> Value) -> [Elt ExpandedOp] -> Value
forall a op. (NonEmpty a -> Value' op) -> [a] -> Value' op
vList NonEmpty (Elt ExpandedOp) -> Value
forall op. (NonEmpty $ Elt op) -> Value' op
U.ValueMap ([Elt ExpandedOp] -> Value) -> [Elt ExpandedOp] -> Value
forall a b. (a -> b) -> a -> b
$ Map (Value' Instr k) (Value' Instr v)
-> [(Value' Instr k, Value' Instr v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Value' Instr k) (Value' Instr v)
m [(Value' Instr k, Value' Instr v)]
-> ((Value' Instr k, Value' Instr v) -> Elt ExpandedOp)
-> [Elt ExpandedOp]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(k :: Value' Instr k
k, v :: Value' Instr v
v) ->
        Value -> Value -> Elt ExpandedOp
forall op. Value' op -> Value' op -> Elt op
U.Elt (Value' Instr k -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue Value' Instr k
k) (Value' Instr v -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue Value' Instr v
v)

  (VBigMap m :: Map (Value' Instr k) (Value' Instr v)
m, STBigMap kt vt) ->
    case (Sing k -> OpPresence k
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing k
Sing a
kt, Sing v -> OpPresence v
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing v
Sing b
vt) of
      (OpAbsent, OpAbsent) ->
        (NonEmpty (Elt ExpandedOp) -> Value) -> [Elt ExpandedOp] -> Value
forall a op. (NonEmpty a -> Value' op) -> [a] -> Value' op
vList NonEmpty (Elt ExpandedOp) -> Value
forall op. (NonEmpty $ Elt op) -> Value' op
U.ValueMap ([Elt ExpandedOp] -> Value) -> [Elt ExpandedOp] -> Value
forall a b. (a -> b) -> a -> b
$ Map (Value' Instr k) (Value' Instr v)
-> [(Value' Instr k, Value' Instr v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Value' Instr k) (Value' Instr v)
m [(Value' Instr k, Value' Instr v)]
-> ((Value' Instr k, Value' Instr v) -> Elt ExpandedOp)
-> [Elt ExpandedOp]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(k :: Value' Instr k
k, v :: Value' Instr v
v) ->
        Value -> Value -> Elt ExpandedOp
forall op. Value' op -> Value' op -> Elt op
U.Elt (Value' Instr k -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue Value' Instr k
k) (Value' Instr v -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue Value' Instr v
v)
  where
    vList :: (NonEmpty a -> Value' op) -> [a] -> Value' op
vList ctor :: NonEmpty a -> Value' op
ctor = Value' op
-> (NonEmpty a -> Value' op) -> Maybe (NonEmpty a) -> Value' op
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value' op
forall op. Value' op
U.ValueNil NonEmpty a -> Value' op
ctor (Maybe (NonEmpty a) -> Value' op)
-> ([a] -> Maybe (NonEmpty a)) -> [a] -> Value' op
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty

untypeDemoteT :: forall (t :: T). SingI t => U.Type
untypeDemoteT :: Storage
untypeDemoteT = T -> Storage
toUType (T -> Storage) -> T -> Storage
forall a b. (a -> b) -> a -> b
$ (SingKind T, SingI t) => Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
demote @t

instrToOps :: HasCallStack => Instr inp out -> [U.ExpandedOp]
instrToOps :: Instr inp out -> [ExpandedOp]
instrToOps = \case
  Nop -> []
  Seq i1 :: Instr inp b
i1 i2 :: Instr b out
i2 -> Instr inp b -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp b
i1 [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. Semigroup a => a -> a -> a
<> Instr b out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr b out
i2
  Nested sq :: Instr inp out
sq -> OneItem [ExpandedOp] -> [ExpandedOp]
forall x. One x => OneItem x -> x
one (OneItem [ExpandedOp] -> [ExpandedOp])
-> OneItem [ExpandedOp] -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ [ExpandedOp] -> OneItem [ExpandedOp]
[ExpandedOp] -> ExpandedOp
U.SeqEx ([ExpandedOp] -> OneItem [ExpandedOp])
-> [ExpandedOp] -> OneItem [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
sq
  DocGroup _ sq :: Instr inp out
sq -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
sq
  Ext (ExtInstr inp
ext :: ExtInstr inp) -> (ExpandedInstr -> ExpandedOp
U.PrimEx (ExpandedInstr -> ExpandedOp)
-> (ExtInstrAbstract ExpandedOp -> ExpandedInstr)
-> ExtInstrAbstract ExpandedOp
-> ExpandedOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtInstrAbstract ExpandedOp -> ExpandedInstr
forall op. ExtInstrAbstract op -> InstrAbstract op
U.EXT) (ExtInstrAbstract ExpandedOp -> ExpandedOp)
-> [ExtInstrAbstract ExpandedOp] -> [ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExtInstr inp -> [ExtInstrAbstract ExpandedOp]
forall (s :: [T]). ExtInstr s -> [ExtInstrAbstract ExpandedOp]
extInstrToOps ExtInstr inp
ext
  FrameInstr _ i :: Instr a b
i -> Instr a b -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr a b
i
  -- TODO [#283] After representation of locations is polished,
  -- this place should be updated to pass it from typed to untyped ASTs.
  WithLoc _ i :: Instr inp out
i -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
i
  InstrWithNotes n :: PackedNotes out
n i :: Instr inp out
i -> case Instr inp out
i of
    Nop -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
i
    Seq _ _ -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
i
    Nested _ -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
i
    DocGroup _ _ -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
i
    Ext _ -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
i
    WithLoc _ i0 :: Instr inp out
i0 -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps (PackedNotes out -> Instr inp out -> Instr inp out
forall (b :: [T]) (a :: [T]).
PackedNotes b -> Instr a b -> Instr a b
InstrWithNotes PackedNotes out
n Instr inp out
i0)
    InstrWithNotes _ _ -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
i
    InstrWithVarNotes _ _ -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
i
    -- For inner instruction, filter out values that we don't want to apply
    -- annotations to and delegate it's conversion to this function itself.
    -- If none of the above, convert a single instruction and copy annotations
    -- to it.
    _ -> [ExpandedInstr -> ExpandedOp
U.PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Instr inp out -> PackedNotes out -> ExpandedInstr
forall (inp' :: [T]) (out' :: [T]).
HasCallStack =>
Instr inp' out' -> PackedNotes out' -> ExpandedInstr
handleInstrAnnotate Instr inp out
i PackedNotes out
n]
  InstrWithVarNotes n :: NonEmpty VarAnn
n i :: Instr inp out
i -> case Instr inp out
i of
    Nop -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
i
    Seq _ _ -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
i
    Nested _ -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
i
    DocGroup _ _ -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
i
    Ext _ -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
i
    WithLoc _ i0 :: Instr inp out
i0 -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps (NonEmpty VarAnn -> Instr inp out -> Instr inp out
forall (a :: [T]) (b :: [T]).
NonEmpty VarAnn -> Instr a b -> Instr a b
InstrWithVarNotes NonEmpty VarAnn
n Instr inp out
i0)
    InstrWithNotes _ _ -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
i
    InstrWithVarNotes _ _ -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
i
    _ -> [ExpandedInstr -> ExpandedOp
U.PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Instr inp out -> NonEmpty VarAnn -> ExpandedInstr
forall (inp' :: [T]) (out' :: [T]).
HasCallStack =>
Instr inp' out' -> NonEmpty VarAnn -> ExpandedInstr
handleInstrVarNotes Instr inp out
i NonEmpty VarAnn
n]
  i :: Instr inp out
i -> [ExpandedInstr -> ExpandedOp
U.PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Instr inp out -> ExpandedInstr
forall (inp :: [T]) (out :: [T]). Instr inp out -> ExpandedInstr
handleInstr Instr inp out
i]
  where
    handleInstrAnnotate
      :: forall inp' out' . HasCallStack
      => Instr inp' out' -> PackedNotes out' -> U.ExpandedInstr
    handleInstrAnnotate :: Instr inp' out' -> PackedNotes out' -> ExpandedInstr
handleInstrAnnotate ins' :: Instr inp' out'
ins' (PackedNotes notes' :: Notes a
notes') = let
      x :: ExpandedInstr
x = Instr inp' out' -> ExpandedInstr
forall (inp :: [T]) (out :: [T]). Instr inp out -> ExpandedInstr
handleInstr Instr inp' out'
ins' in ExpandedInstr -> Notes a -> ExpandedInstr
forall (t :: T).
(SingI t, HasCallStack) =>
ExpandedInstr -> Notes t -> ExpandedInstr
addInstrNote ExpandedInstr
x Notes a
notes'
      where
        addInstrNote
          :: forall t. (SingI t, HasCallStack)
          => U.ExpandedInstr -> Notes t -> U.ExpandedInstr
        addInstrNote :: ExpandedInstr -> Notes t -> ExpandedInstr
addInstrNote ins :: ExpandedInstr
ins nte :: Notes t
nte = case (SingI t => Sing t
forall k (a :: k). SingI a => Sing a
sing @t, ExpandedInstr
ins, Notes t
nte) of
            (_, U.PUSH va :: VarAnn
va _ v :: Value
v, _) -> VarAnn -> Storage -> Value -> ExpandedInstr
forall op. VarAnn -> Storage -> Value' op -> InstrAbstract op
U.PUSH VarAnn
va (Notes t -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType Notes t
nte) Value
v
            (_, U.SOME _ va :: VarAnn
va, NTOption ta :: TypeAnn
ta _) -> TypeAnn -> VarAnn -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> InstrAbstract op
U.SOME TypeAnn
ta VarAnn
va
            (STOption _, U.NONE _ va :: VarAnn
va _, NTOption ta :: TypeAnn
ta nt :: Notes t
nt) -> TypeAnn -> VarAnn -> Storage -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Storage -> InstrAbstract op
U.NONE TypeAnn
ta VarAnn
va (Notes t -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType Notes t
nt)
            (_, U.UNIT _ va :: VarAnn
va, NTUnit ta :: TypeAnn
ta) -> TypeAnn -> VarAnn -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> InstrAbstract op
U.UNIT TypeAnn
ta VarAnn
va
            (_, U.PAIR ta :: TypeAnn
ta va :: VarAnn
va f1 :: FieldAnn
f1 f2 :: FieldAnn
f2, _) -> TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
U.PAIR TypeAnn
ta VarAnn
va FieldAnn
f1 FieldAnn
f2
            (_, U.CAR va :: VarAnn
va f1 :: FieldAnn
f1, _) -> VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
U.CAR VarAnn
va FieldAnn
f1
            (_, U.CDR va :: VarAnn
va f1 :: FieldAnn
f1, _) -> VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
U.CDR VarAnn
va FieldAnn
f1
            (STOr _ _, U.LEFT _ va :: VarAnn
va _ _ _, NTOr ta :: TypeAnn
ta f1 :: FieldAnn
f1 f2 :: FieldAnn
f2 _ n2 :: Notes q
n2) ->
              TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Storage -> ExpandedInstr
forall op.
TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Storage -> InstrAbstract op
U.LEFT TypeAnn
ta VarAnn
va FieldAnn
f1 FieldAnn
f2 (Notes q -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType Notes q
n2)
            (STOr _ _, U.RIGHT _ va :: VarAnn
va _ _ _, NTOr ta :: TypeAnn
ta f1 :: FieldAnn
f1 f2 :: FieldAnn
f2 n1 :: Notes p
n1 _) ->
              TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Storage -> ExpandedInstr
forall op.
TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Storage -> InstrAbstract op
U.RIGHT TypeAnn
ta VarAnn
va FieldAnn
f1 FieldAnn
f2 (Notes p -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType Notes p
n1)
            (STList _, U.NIL _ va :: VarAnn
va _, NTList ta :: TypeAnn
ta n :: Notes t
n) -> TypeAnn -> VarAnn -> Storage -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Storage -> InstrAbstract op
U.NIL TypeAnn
ta VarAnn
va (Notes t -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType Notes t
n)
            (STSet _, U.EMPTY_SET _ va :: VarAnn
va _, NTSet ta1 :: TypeAnn
ta1 n :: Notes t
n) ->
              TypeAnn -> VarAnn -> Storage -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Storage -> InstrAbstract op
U.EMPTY_SET TypeAnn
ta1 VarAnn
va (Notes t -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType Notes t
n)
            (STMap _ _, U.EMPTY_MAP _ va :: VarAnn
va _ _, NTMap ta1 :: TypeAnn
ta1 k :: Notes k
k n :: Notes v
n) ->
              TypeAnn -> VarAnn -> Storage -> Storage -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> Storage -> Storage -> InstrAbstract op
U.EMPTY_MAP TypeAnn
ta1 VarAnn
va (Notes k -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType Notes k
k) (Notes v -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType Notes v
n)
            (STBigMap _ _, U.EMPTY_BIG_MAP _ va :: VarAnn
va _ _, NTBigMap ta1 :: TypeAnn
ta1 k :: Notes k
k n :: Notes v
n) ->
              TypeAnn -> VarAnn -> Storage -> Storage -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> Storage -> Storage -> InstrAbstract op
U.EMPTY_BIG_MAP TypeAnn
ta1 VarAnn
va (Notes k -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType Notes k
k) (Notes v -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType Notes v
n)
            (STLambda _ _, U.LAMBDA va :: VarAnn
va _ _ ops :: [ExpandedOp]
ops, NTLambda _ n1 :: Notes p
n1 n2 :: Notes q
n2) ->
              VarAnn -> Storage -> Storage -> [ExpandedOp] -> ExpandedInstr
forall op. VarAnn -> Storage -> Storage -> [op] -> InstrAbstract op
U.LAMBDA VarAnn
va (Notes p -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType Notes p
n1) (Notes q -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType Notes q
n2) [ExpandedOp]
ops
            (_, U.CAST va :: VarAnn
va _, n :: Notes t
n) -> VarAnn -> Storage -> ExpandedInstr
forall op. VarAnn -> Storage -> InstrAbstract op
U.CAST VarAnn
va (Notes t -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType Notes t
n)
            (STOption _, U.UNPACK _ va :: VarAnn
va _, NTOption ta :: TypeAnn
ta nt :: Notes t
nt) -> TypeAnn -> VarAnn -> Storage -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Storage -> InstrAbstract op
U.UNPACK TypeAnn
ta VarAnn
va (Notes t -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType Notes t
nt)
            (STOption (STContract _), U.CONTRACT va :: VarAnn
va fa :: FieldAnn
fa _, NTOption _ (NTContract _ nt :: Notes t
nt)) ->
              VarAnn -> FieldAnn -> Storage -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> Storage -> InstrAbstract op
U.CONTRACT VarAnn
va FieldAnn
fa (Notes t -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType Notes t
nt)
            (_, U.CONTRACT va :: VarAnn
va fa :: FieldAnn
fa t :: Storage
t, NTOption _ _) -> VarAnn -> FieldAnn -> Storage -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> Storage -> InstrAbstract op
U.CONTRACT VarAnn
va FieldAnn
fa Storage
t
            (_, a :: ExpandedInstr
a@(U.APPLY {}), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.CHAIN_ID {}), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.EXT _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(ExpandedInstr
U.DROP), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.DROPN _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.DUP _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(ExpandedInstr
U.SWAP), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.DIG {}), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.DUG {}), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.IF_NONE _ _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.CONS _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.IF_LEFT _ _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.IF_CONS _ _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.SIZE _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.MAP _ _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.ITER _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.MEM _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.GET _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.UPDATE _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.IF _ _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.LOOP _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.LOOP_LEFT _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.EXEC _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.DIP _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.DIPN {}), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(ExpandedInstr
U.FAILWITH), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.RENAME _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.PACK _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.CONCAT _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.SLICE _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.ISNAT _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.ADD _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.SUB _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.MUL _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.EDIV _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.ABS _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.NEG _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.LSL _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.LSR _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.OR _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.AND _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.XOR _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.NOT _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.COMPARE _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.EQ _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.NEQ _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.LT _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.GT _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.LE _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.GE _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.INT _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.SELF _ _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.TRANSFER_TOKENS _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.SET_DELEGATE _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.CREATE_CONTRACT {}), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.IMPLICIT_ACCOUNT _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.NOW _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.AMOUNT _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.BALANCE _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.CHECK_SIGNATURE _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.SHA256 _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.SHA512 _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.BLAKE2B _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.HASH_KEY _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.SOURCE _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.SENDER _), _) -> ExpandedInstr
a
            (_, a :: ExpandedInstr
a@(U.ADDRESS _), _) -> ExpandedInstr
a
            (_, b :: ExpandedInstr
b, c :: Notes t
c) -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error (Text -> ExpandedInstr) -> Text -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ "addInstrNote: Unexpected instruction/annotation combination: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ExpandedInstr, Notes t) -> Text
forall b a. (Show a, IsString b) => a -> b
show (ExpandedInstr
b, Notes t
c)

    handleInstrVarNotes :: forall inp' out' . HasCallStack
      => Instr inp' out' -> NonEmpty U.VarAnn -> U.ExpandedInstr
    handleInstrVarNotes :: Instr inp' out' -> NonEmpty VarAnn -> ExpandedInstr
handleInstrVarNotes ins' :: Instr inp' out'
ins' varAnns :: NonEmpty VarAnn
varAnns =
      let x :: ExpandedInstr
x = Instr inp' out' -> ExpandedInstr
forall (inp :: [T]) (out :: [T]). Instr inp out -> ExpandedInstr
handleInstr Instr inp' out'
ins' in HasCallStack => ExpandedInstr -> NonEmpty VarAnn -> ExpandedInstr
ExpandedInstr -> NonEmpty VarAnn -> ExpandedInstr
addVarNotes ExpandedInstr
x NonEmpty VarAnn
varAnns
      where
        addVarNotes
          :: HasCallStack
          => U.ExpandedInstr -> NonEmpty U.VarAnn -> U.ExpandedInstr
        addVarNotes :: ExpandedInstr -> NonEmpty VarAnn -> ExpandedInstr
addVarNotes ins :: ExpandedInstr
ins varNotes :: NonEmpty VarAnn
varNotes = case NonEmpty VarAnn
varNotes of
          va1 :: VarAnn
va1 :| [va2 :: VarAnn
va2] -> case ExpandedInstr
ins of
            U.CREATE_CONTRACT _ _ c :: Contract
c -> VarAnn -> VarAnn -> Contract -> ExpandedInstr
forall op. VarAnn -> VarAnn -> Contract' op -> InstrAbstract op
U.CREATE_CONTRACT VarAnn
va1 VarAnn
va2 Contract
c
            _ -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error (Text -> ExpandedInstr) -> Text -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$
              "addVarNotes: Cannot add two var annotations to instr: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExpandedInstr -> Text
forall b a. (Show a, IsString b) => a -> b
show ExpandedInstr
ins
          va :: VarAnn
va :| [] -> case ExpandedInstr
ins of
            U.DUP _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.DUP VarAnn
va
            U.PUSH _ t :: Storage
t v :: Value
v -> VarAnn -> Storage -> Value -> ExpandedInstr
forall op. VarAnn -> Storage -> Value' op -> InstrAbstract op
U.PUSH VarAnn
va Storage
t Value
v
            U.SOME ta :: TypeAnn
ta _ -> TypeAnn -> VarAnn -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> InstrAbstract op
U.SOME TypeAnn
ta VarAnn
va
            U.NONE ta :: TypeAnn
ta _ t :: Storage
t -> TypeAnn -> VarAnn -> Storage -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Storage -> InstrAbstract op
U.NONE TypeAnn
ta VarAnn
va Storage
t
            U.UNIT ta :: TypeAnn
ta _ -> TypeAnn -> VarAnn -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> InstrAbstract op
U.UNIT TypeAnn
ta VarAnn
va
            U.PAIR ta :: TypeAnn
ta _ fa1 :: FieldAnn
fa1 fa2 :: FieldAnn
fa2 -> TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
U.PAIR TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2
            U.CAR _ fa :: FieldAnn
fa -> VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
U.CAR VarAnn
va FieldAnn
fa
            U.CDR _ fa :: FieldAnn
fa -> VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
U.CDR VarAnn
va FieldAnn
fa
            U.LEFT ta :: TypeAnn
ta _ fa1 :: FieldAnn
fa1 fa2 :: FieldAnn
fa2 t :: Storage
t -> TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Storage -> ExpandedInstr
forall op.
TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Storage -> InstrAbstract op
U.LEFT TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2 Storage
t
            U.RIGHT ta :: TypeAnn
ta _ fa1 :: FieldAnn
fa1 fa2 :: FieldAnn
fa2 t :: Storage
t -> TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Storage -> ExpandedInstr
forall op.
TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Storage -> InstrAbstract op
U.RIGHT TypeAnn
ta VarAnn
va FieldAnn
fa1 FieldAnn
fa2 Storage
t
            U.NIL ta :: TypeAnn
ta _ t :: Storage
t -> TypeAnn -> VarAnn -> Storage -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Storage -> InstrAbstract op
U.NIL TypeAnn
ta VarAnn
va Storage
t
            U.CONS _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CONS VarAnn
va
            U.SIZE _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SIZE VarAnn
va
            U.EMPTY_SET ta :: TypeAnn
ta _ c :: Storage
c -> TypeAnn -> VarAnn -> Storage -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Storage -> InstrAbstract op
U.EMPTY_SET TypeAnn
ta VarAnn
va Storage
c
            U.EMPTY_MAP ta :: TypeAnn
ta _ c :: Storage
c t :: Storage
t -> TypeAnn -> VarAnn -> Storage -> Storage -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> Storage -> Storage -> InstrAbstract op
U.EMPTY_MAP TypeAnn
ta VarAnn
va Storage
c Storage
t
            U.EMPTY_BIG_MAP ta :: TypeAnn
ta _ c :: Storage
c t :: Storage
t -> TypeAnn -> VarAnn -> Storage -> Storage -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> Storage -> Storage -> InstrAbstract op
U.EMPTY_BIG_MAP TypeAnn
ta VarAnn
va Storage
c Storage
t
            U.MAP _ ops :: [ExpandedOp]
ops -> VarAnn -> [ExpandedOp] -> ExpandedInstr
forall op. VarAnn -> [op] -> InstrAbstract op
U.MAP VarAnn
va [ExpandedOp]
ops
            U.MEM _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.MEM VarAnn
va
            U.GET _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.GET VarAnn
va
            U.UPDATE _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.UPDATE VarAnn
va
            U.LAMBDA _ t1 :: Storage
t1 t2 :: Storage
t2 ops :: [ExpandedOp]
ops -> VarAnn -> Storage -> Storage -> [ExpandedOp] -> ExpandedInstr
forall op. VarAnn -> Storage -> Storage -> [op] -> InstrAbstract op
U.LAMBDA VarAnn
va Storage
t1 Storage
t2 [ExpandedOp]
ops
            U.EXEC _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.EXEC VarAnn
va
            U.APPLY _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.APPLY VarAnn
va
            U.CAST _ t :: Storage
t -> VarAnn -> Storage -> ExpandedInstr
forall op. VarAnn -> Storage -> InstrAbstract op
U.CAST VarAnn
va Storage
t
            U.RENAME _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.RENAME VarAnn
va
            U.PACK _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.PACK VarAnn
va
            U.UNPACK ta :: TypeAnn
ta _ t :: Storage
t -> TypeAnn -> VarAnn -> Storage -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Storage -> InstrAbstract op
U.UNPACK TypeAnn
ta VarAnn
va Storage
t
            U.CONCAT _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CONCAT VarAnn
va
            U.SLICE _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SLICE VarAnn
va
            U.ISNAT _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.ISNAT VarAnn
va
            U.ADD _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.ADD VarAnn
va
            U.SUB _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.MUL VarAnn
va
            U.MUL _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.MUL VarAnn
va
            U.EDIV _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.EDIV VarAnn
va
            U.ABS _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.ABS VarAnn
va
            U.NEG _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.NEG VarAnn
va
            U.LSL _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.LSL VarAnn
va
            U.LSR _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.LSR VarAnn
va
            U.OR _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.OR VarAnn
va
            U.AND _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.AND VarAnn
va
            U.XOR _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.XOR VarAnn
va
            U.NOT _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.NOT VarAnn
va
            U.COMPARE _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.COMPARE VarAnn
va
            U.EQ _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.EQ VarAnn
va
            U.NEQ _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.NEQ VarAnn
va
            U.LT _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.GT VarAnn
va
            U.GT _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.GT VarAnn
va
            U.LE _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.GE VarAnn
va
            U.INT _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.INT VarAnn
va
            U.SELF _ fa :: FieldAnn
fa -> VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
U.SELF VarAnn
va FieldAnn
fa
            U.CONTRACT _ fa :: FieldAnn
fa t :: Storage
t -> VarAnn -> FieldAnn -> Storage -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> Storage -> InstrAbstract op
U.CONTRACT VarAnn
va FieldAnn
fa Storage
t
            U.TRANSFER_TOKENS _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.TRANSFER_TOKENS VarAnn
va
            U.SET_DELEGATE _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SET_DELEGATE VarAnn
va
            U.CREATE_CONTRACT _ _ c :: Contract
c -> VarAnn -> VarAnn -> Contract -> ExpandedInstr
forall op. VarAnn -> VarAnn -> Contract' op -> InstrAbstract op
U.CREATE_CONTRACT VarAnn
va VarAnn
forall k (a :: k). Annotation a
U.noAnn Contract
c
            U.IMPLICIT_ACCOUNT _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.IMPLICIT_ACCOUNT VarAnn
va
            U.NOW _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.NOW VarAnn
va
            U.AMOUNT _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.AMOUNT VarAnn
va
            U.BALANCE _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.BALANCE VarAnn
va
            U.CHECK_SIGNATURE _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CHECK_SIGNATURE VarAnn
va
            U.SHA256 _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SHA512 VarAnn
va
            U.BLAKE2B _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.BLAKE2B VarAnn
va
            U.HASH_KEY _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.HASH_KEY VarAnn
va
            U.SOURCE _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SOURCE VarAnn
va
            U.SENDER _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SENDER VarAnn
va
            U.ADDRESS _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.ADDRESS VarAnn
va
            U.CHAIN_ID _ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CHAIN_ID VarAnn
va
            _ -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error (Text -> ExpandedInstr) -> Text -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$
              "addVarNotes: Cannot add single var annotation to instr: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ExpandedInstr -> Text
forall b a. (Show a, IsString b) => a -> b
show ExpandedInstr
ins)
          _ -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error (Text -> ExpandedInstr) -> Text -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$
            "addVarNotes: Trying to add more than two var annotations to instr: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ExpandedInstr -> Text
forall b a. (Show a, IsString b) => a -> b
show ExpandedInstr
ins)

    handleInstr :: Instr inp out -> U.ExpandedInstr
    handleInstr :: Instr inp out -> ExpandedInstr
handleInstr = \case
      (WithLoc _ _) -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error "impossible"
      (InstrWithNotes _ _) -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error "impossible"
      (InstrWithVarNotes _ _) -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error "impossible"
      (FrameInstr _ _) -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error "impossible"
      (Seq _ _) -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error "impossible"
      Nop -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error "impossible"
      (Ext _) -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error "impossible"
      (Nested _) -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error "impossible"
      DocGroup{} -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error "impossible"
      DROP -> ExpandedInstr
forall op. InstrAbstract op
U.DROP
      (DROPN s :: Sing n
s) -> Word -> ExpandedInstr
forall op. Word -> InstrAbstract op
U.DROPN (Natural -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word) -> Natural -> Word
forall a b. (a -> b) -> a -> b
$ Sing n -> Natural
forall (n :: Peano). KnownPeano n => Sing n -> Natural
peanoValSing Sing n
s)
      DUP -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.DUP VarAnn
forall k (a :: k). Annotation a
U.noAnn
      SWAP -> ExpandedInstr
forall op. InstrAbstract op
U.SWAP
      (DIG s :: Sing n
s) -> Word -> ExpandedInstr
forall op. Word -> InstrAbstract op
U.DIG (Natural -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word) -> Natural -> Word
forall a b. (a -> b) -> a -> b
$ Sing n -> Natural
forall (n :: Peano). KnownPeano n => Sing n -> Natural
peanoValSing Sing n
s)
      (DUG s :: Sing n
s) -> Word -> ExpandedInstr
forall op. Word -> InstrAbstract op
U.DUG (Natural -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word) -> Natural -> Word
forall a b. (a -> b) -> a -> b
$ Sing n -> Natural
forall (n :: Peano). KnownPeano n => Sing n -> Natural
peanoValSing Sing n
s)
      i :: Instr inp out
i@(PUSH val :: Value' Instr t
val) | _ :: Instr inp1 (t ': s) <- Instr inp out
i ->
        let value :: Value
value = Value' Instr t -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue Value' Instr t
val
        in VarAnn -> Storage -> Value -> ExpandedInstr
forall op. VarAnn -> Storage -> Value' op -> InstrAbstract op
U.PUSH VarAnn
forall k (a :: k). Annotation a
U.noAnn (SingI t => Storage
forall (t :: T). SingI t => Storage
untypeDemoteT @t) Value
value
      i :: Instr inp out
i@Instr inp out
NONE | _ :: Instr inp1 ('TOption a ': inp1) <- Instr inp out
i ->
        TypeAnn -> VarAnn -> Storage -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Storage -> InstrAbstract op
U.NONE TypeAnn
forall k (a :: k). Annotation a
U.noAnn VarAnn
forall k (a :: k). Annotation a
U.noAnn (SingI a => Storage
forall (t :: T). SingI t => Storage
untypeDemoteT @a)
      SOME -> TypeAnn -> VarAnn -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> InstrAbstract op
U.SOME TypeAnn
forall k (a :: k). Annotation a
U.noAnn VarAnn
forall k (a :: k). Annotation a
U.noAnn
      UNIT -> TypeAnn -> VarAnn -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> InstrAbstract op
U.UNIT TypeAnn
forall k (a :: k). Annotation a
U.noAnn VarAnn
forall k (a :: k). Annotation a
U.noAnn
      (IF_NONE i1 :: Instr s out
i1 i2 :: Instr (a : s) out
i2) -> [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
U.IF_NONE (Instr s out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr s out
i1) (Instr (a : s) out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr (a : s) out
i2)
      AnnPAIR tn :: TypeAnn
tn fn1 :: FieldAnn
fn1 fn2 :: FieldAnn
fn2 -> TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> FieldAnn -> FieldAnn -> InstrAbstract op
U.PAIR TypeAnn
tn VarAnn
forall k (a :: k). Annotation a
U.noAnn FieldAnn
fn1 FieldAnn
fn2
      (AnnCAR fn :: FieldAnn
fn) -> VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
U.CAR VarAnn
forall k (a :: k). Annotation a
U.noAnn FieldAnn
fn
      (AnnCDR fn :: FieldAnn
fn) -> VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
U.CDR VarAnn
forall k (a :: k). Annotation a
U.noAnn FieldAnn
fn
      i :: Instr inp out
i@Instr inp out
LEFT | _ :: Instr (a ': s) ('TOr a b ': s) <- Instr inp out
i ->
        TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Storage -> ExpandedInstr
forall op.
TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Storage -> InstrAbstract op
U.LEFT TypeAnn
forall k (a :: k). Annotation a
U.noAnn VarAnn
forall k (a :: k). Annotation a
U.noAnn FieldAnn
forall k (a :: k). Annotation a
U.noAnn FieldAnn
forall k (a :: k). Annotation a
U.noAnn (SingI b => Storage
forall (t :: T). SingI t => Storage
untypeDemoteT @b)
      i :: Instr inp out
i@Instr inp out
RIGHT | _ :: Instr (b ': s) ('TOr a b ': s) <- Instr inp out
i ->
        TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Storage -> ExpandedInstr
forall op.
TypeAnn
-> VarAnn -> FieldAnn -> FieldAnn -> Storage -> InstrAbstract op
U.RIGHT TypeAnn
forall k (a :: k). Annotation a
U.noAnn VarAnn
forall k (a :: k). Annotation a
U.noAnn FieldAnn
forall k (a :: k). Annotation a
U.noAnn FieldAnn
forall k (a :: k). Annotation a
U.noAnn (SingI a => Storage
forall (t :: T). SingI t => Storage
untypeDemoteT @a)
      (IF_LEFT i1 :: Instr (a : s) out
i1 i2 :: Instr (b : s) out
i2) -> [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
U.IF_LEFT (Instr (a : s) out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr (a : s) out
i1) (Instr (b : s) out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr (b : s) out
i2)
      i :: Instr inp out
i@Instr inp out
NIL | _ :: Instr s ('TList p ': s) <- Instr inp out
i ->
        TypeAnn -> VarAnn -> Storage -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Storage -> InstrAbstract op
U.NIL TypeAnn
forall k (a :: k). Annotation a
U.noAnn VarAnn
forall k (a :: k). Annotation a
U.noAnn (SingI p => Storage
forall (t :: T). SingI t => Storage
untypeDemoteT @p)
      CONS -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CONS VarAnn
forall k (a :: k). Annotation a
U.noAnn
      (IF_CONS i1 :: Instr (a : 'TList a : s) out
i1 i2 :: Instr s out
i2) -> [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
U.IF_CONS (Instr (a : 'TList a : s) out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr (a : 'TList a : s) out
i1) (Instr s out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr s out
i2)
      SIZE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SIZE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      i :: Instr inp out
i@Instr inp out
EMPTY_SET | _ :: Instr s ('TSet e ': s) <- Instr inp out
i ->
        TypeAnn -> VarAnn -> Storage -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Storage -> InstrAbstract op
U.EMPTY_SET TypeAnn
forall k (a :: k). Annotation a
U.noAnn VarAnn
forall k (a :: k). Annotation a
U.noAnn (T -> TypeAnn -> Storage
U.Type (Storage -> T
U.unwrapT (Storage -> T) -> Storage -> T
forall a b. (a -> b) -> a -> b
$ SingI e => Storage
forall (t :: T). SingI t => Storage
untypeDemoteT @e) TypeAnn
forall k (a :: k). Annotation a
U.noAnn)
      i :: Instr inp out
i@Instr inp out
EMPTY_MAP | _ :: Instr s ('TMap a b ': s) <- Instr inp out
i ->
        TypeAnn -> VarAnn -> Storage -> Storage -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> Storage -> Storage -> InstrAbstract op
U.EMPTY_MAP TypeAnn
forall k (a :: k). Annotation a
U.noAnn VarAnn
forall k (a :: k). Annotation a
U.noAnn (T -> TypeAnn -> Storage
U.Type (Storage -> T
U.unwrapT (Storage -> T) -> Storage -> T
forall a b. (a -> b) -> a -> b
$ SingI a => Storage
forall (t :: T). SingI t => Storage
untypeDemoteT @a) TypeAnn
forall k (a :: k). Annotation a
U.noAnn)
          (SingI b => Storage
forall (t :: T). SingI t => Storage
untypeDemoteT @b)
      i :: Instr inp out
i@Instr inp out
EMPTY_BIG_MAP | _ :: Instr s ('TBigMap a b ': s) <- Instr inp out
i ->
        TypeAnn -> VarAnn -> Storage -> Storage -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> Storage -> Storage -> InstrAbstract op
U.EMPTY_BIG_MAP TypeAnn
forall k (a :: k). Annotation a
U.noAnn VarAnn
forall k (a :: k). Annotation a
U.noAnn (T -> TypeAnn -> Storage
U.Type (Storage -> T
U.unwrapT (Storage -> T) -> Storage -> T
forall a b. (a -> b) -> a -> b
$ SingI a => Storage
forall (t :: T). SingI t => Storage
untypeDemoteT @a) TypeAnn
forall k (a :: k). Annotation a
U.noAnn)
          (SingI b => Storage
forall (t :: T). SingI t => Storage
untypeDemoteT @b)
      (MAP op :: Instr (MapOpInp c : s) (b : s)
op) -> VarAnn -> [ExpandedOp] -> ExpandedInstr
forall op. VarAnn -> [op] -> InstrAbstract op
U.MAP VarAnn
forall k (a :: k). Annotation a
U.noAnn ([ExpandedOp] -> ExpandedInstr) -> [ExpandedOp] -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ Instr (MapOpInp c : s) (b : s) -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr (MapOpInp c : s) (b : s)
op
      (ITER op :: Instr (IterOpEl c : out) out
op) -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
U.ITER ([ExpandedOp] -> ExpandedInstr) -> [ExpandedOp] -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ Instr (IterOpEl c : out) out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr (IterOpEl c : out) out
op
      MEM -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.MEM VarAnn
forall k (a :: k). Annotation a
U.noAnn
      GET -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.GET VarAnn
forall k (a :: k). Annotation a
U.noAnn
      UPDATE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.UPDATE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      (IF op1 :: Instr s out
op1 op2 :: Instr s out
op2) -> [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
U.IF (Instr s out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr s out
op1) (Instr s out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr s out
op2)
      (LOOP op :: Instr out ('TBool : out)
op) -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
U.LOOP (Instr out ('TBool : out) -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr out ('TBool : out)
op)
      (LOOP_LEFT op :: Instr (a : s) ('TOr a b : s)
op) -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
U.LOOP_LEFT (Instr (a : s) ('TOr a b : s) -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr (a : s) ('TOr a b : s)
op)
      i :: Instr inp out
i@(LAMBDA {}) | LAMBDA (VLam l) :: Instr s ('TLambda i o ': s) <- Instr inp out
i ->
        VarAnn -> Storage -> Storage -> [ExpandedOp] -> ExpandedInstr
forall op. VarAnn -> Storage -> Storage -> [op] -> InstrAbstract op
U.LAMBDA VarAnn
forall k (a :: k). Annotation a
U.noAnn (SingI i => Storage
forall (t :: T). SingI t => Storage
untypeDemoteT @i) (SingI o => Storage
forall (t :: T). SingI t => Storage
untypeDemoteT @o) (Instr '[inp] '[out] -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps (Instr '[inp] '[out] -> [ExpandedOp])
-> Instr '[inp] '[out] -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ RemFail Instr '[inp] '[out] -> Instr '[inp] '[out]
forall k (instr :: k -> k -> *) (i :: k) (o :: k).
RemFail instr i o -> instr i o
rfAnyInstr RemFail Instr '[inp] '[out]
l)
      EXEC -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.EXEC VarAnn
forall k (a :: k). Annotation a
U.noAnn
      APPLY -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.APPLY VarAnn
forall k (a :: k). Annotation a
U.noAnn
      (DIP op :: Instr a c
op) -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
U.DIP (Instr a c -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr a c
op)
      (DIPN s :: Sing n
s op :: Instr s s'
op) ->
        Word -> [ExpandedOp] -> ExpandedInstr
forall op. Word -> [op] -> InstrAbstract op
U.DIPN (Natural -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word) -> Natural -> Word
forall a b. (a -> b) -> a -> b
$ Sing n -> Natural
forall (n :: Peano). KnownPeano n => Sing n -> Natural
peanoValSing Sing n
s) (Instr s s' -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr s s'
op)
      FAILWITH -> ExpandedInstr
forall op. InstrAbstract op
U.FAILWITH
      i :: Instr inp out
i@Instr inp out
CAST | _ :: Instr (a ': s) (a ': s) <- Instr inp out
i ->
        VarAnn -> Storage -> ExpandedInstr
forall op. VarAnn -> Storage -> InstrAbstract op
U.CAST VarAnn
forall k (a :: k). Annotation a
U.noAnn (SingI a => Storage
forall (t :: T). SingI t => Storage
untypeDemoteT @a)
      RENAME -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.RENAME VarAnn
forall k (a :: k). Annotation a
U.noAnn
      PACK -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.PACK VarAnn
forall k (a :: k). Annotation a
U.noAnn
      i :: Instr inp out
i@Instr inp out
UNPACK
        | _ :: Instr ('TBytes ': s) ('TOption a ': s) <- Instr inp out
i ->
            TypeAnn -> VarAnn -> Storage -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Storage -> InstrAbstract op
U.UNPACK TypeAnn
forall k (a :: k). Annotation a
U.noAnn VarAnn
forall k (a :: k). Annotation a
U.noAnn (SingI a => Storage
forall (t :: T). SingI t => Storage
untypeDemoteT @a)
      CONCAT -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CONCAT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      CONCAT' -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CONCAT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      SLICE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SLICE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      ISNAT -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.ISNAT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      ADD -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.ADD VarAnn
forall k (a :: k). Annotation a
U.noAnn
      SUB -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SUB VarAnn
forall k (a :: k). Annotation a
U.noAnn
      MUL -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.MUL VarAnn
forall k (a :: k). Annotation a
U.noAnn
      EDIV -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.EDIV VarAnn
forall k (a :: k). Annotation a
U.noAnn
      ABS -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.ABS VarAnn
forall k (a :: k). Annotation a
U.noAnn
      NEG -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.NEG VarAnn
forall k (a :: k). Annotation a
U.noAnn
      LSL -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.LSL VarAnn
forall k (a :: k). Annotation a
U.noAnn
      LSR -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.LSR VarAnn
forall k (a :: k). Annotation a
U.noAnn
      OR -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.OR VarAnn
forall k (a :: k). Annotation a
U.noAnn
      AND -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.AND VarAnn
forall k (a :: k). Annotation a
U.noAnn
      XOR -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.XOR VarAnn
forall k (a :: k). Annotation a
U.noAnn
      NOT -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.NOT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      COMPARE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.COMPARE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr.EQ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.EQ VarAnn
forall k (a :: k). Annotation a
U.noAnn
      NEQ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.NEQ VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr.LT -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.LT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr.GT -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.GT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      LE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.LE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      GE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.GE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      INT -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.INT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      SELF sepc :: SomeEntrypointCallT arg
sepc ->
        VarAnn -> FieldAnn -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> InstrAbstract op
U.SELF VarAnn
forall k (a :: k). Annotation a
U.noAnn (EpName -> FieldAnn
epNameToRefAnn (EpName -> FieldAnn) -> EpName -> FieldAnn
forall a b. (a -> b) -> a -> b
$ SomeEntrypointCallT arg -> EpName
forall (arg :: T). SomeEntrypointCallT arg -> EpName
sepcName SomeEntrypointCallT arg
sepc)
      i :: Instr inp out
i@(CONTRACT nt :: Notes p
nt epName :: EpName
epName)
        | _ :: Instr ('TAddress ': s) ('TOption ('TContract p) ': s) <- Instr inp out
i ->
            let fa :: FieldAnn
fa = EpName -> FieldAnn
epNameToRefAnn EpName
epName
            in VarAnn -> FieldAnn -> Storage -> ExpandedInstr
forall op. VarAnn -> FieldAnn -> Storage -> InstrAbstract op
U.CONTRACT VarAnn
forall k (a :: k). Annotation a
U.noAnn FieldAnn
fa (Notes p -> Storage
forall (x :: T). SingI x => Notes x -> Storage
mkUType Notes p
nt)
      TRANSFER_TOKENS -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.TRANSFER_TOKENS VarAnn
forall k (a :: k). Annotation a
U.noAnn
      SET_DELEGATE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SET_DELEGATE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      i :: Instr inp out
i@(CREATE_CONTRACT contract :: Contract p g
contract)
        | _ :: Instr
            (  'TOption ('TKeyHash)
            ': 'TMutez
            ': g
            ': s)
            ('TOperation ': 'TAddress ': s) <- Instr inp out
i ->
          VarAnn -> VarAnn -> Contract -> ExpandedInstr
forall op. VarAnn -> VarAnn -> Contract' op -> InstrAbstract op
U.CREATE_CONTRACT VarAnn
forall k (a :: k). Annotation a
U.noAnn VarAnn
forall k (a :: k). Annotation a
U.noAnn (Contract p g -> Contract
forall (param :: T) (store :: T).
(SingI param, SingI store) =>
Contract param store -> Contract
convertContract Contract p g
contract)
      IMPLICIT_ACCOUNT -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.IMPLICIT_ACCOUNT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      NOW -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.NOW VarAnn
forall k (a :: k). Annotation a
U.noAnn
      AMOUNT -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.AMOUNT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      BALANCE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.BALANCE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      CHECK_SIGNATURE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CHECK_SIGNATURE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      SHA256 -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SHA256 VarAnn
forall k (a :: k). Annotation a
U.noAnn
      SHA512 -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SHA512 VarAnn
forall k (a :: k). Annotation a
U.noAnn
      BLAKE2B -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.BLAKE2B VarAnn
forall k (a :: k). Annotation a
U.noAnn
      HASH_KEY -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.HASH_KEY VarAnn
forall k (a :: k). Annotation a
U.noAnn
      SOURCE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SOURCE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      SENDER -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SENDER VarAnn
forall k (a :: k). Annotation a
U.noAnn
      ADDRESS -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.ADDRESS VarAnn
forall k (a :: k). Annotation a
U.noAnn
      CHAIN_ID -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CHAIN_ID VarAnn
forall k (a :: k). Annotation a
U.noAnn

untypeStackRef :: StackRef s -> U.StackRef
untypeStackRef :: StackRef s -> StackRef
untypeStackRef (StackRef n :: Sing idx
n) = Natural -> StackRef
U.StackRef (SingNat idx -> Natural
forall (n :: Peano) (proxy :: Peano -> *).
KnownPeano n =>
proxy n -> Natural
peanoVal Sing idx
SingNat idx
n)

untypePrintComment :: PrintComment s -> U.PrintComment
untypePrintComment :: PrintComment s -> PrintComment
untypePrintComment (PrintComment pc :: [Either Text (StackRef s)]
pc) = [Either Text StackRef] -> PrintComment
U.PrintComment ([Either Text StackRef] -> PrintComment)
-> [Either Text StackRef] -> PrintComment
forall a b. (a -> b) -> a -> b
$ (Either Text (StackRef s) -> Either Text StackRef)
-> [Either Text (StackRef s)] -> [Either Text StackRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((StackRef s -> StackRef)
-> Either Text (StackRef s) -> Either Text StackRef
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second StackRef s -> StackRef
forall (s :: [T]). StackRef s -> StackRef
untypeStackRef) [Either Text (StackRef s)]
pc

extInstrToOps :: ExtInstr s -> [U.ExtInstrAbstract U.ExpandedOp]
extInstrToOps :: ExtInstr s -> [ExtInstrAbstract ExpandedOp]
extInstrToOps = \case
  PRINT pc :: PrintComment s
pc -> OneItem [ExtInstrAbstract ExpandedOp]
-> [ExtInstrAbstract ExpandedOp]
forall x. One x => OneItem x -> x
one (OneItem [ExtInstrAbstract ExpandedOp]
 -> [ExtInstrAbstract ExpandedOp])
-> OneItem [ExtInstrAbstract ExpandedOp]
-> [ExtInstrAbstract ExpandedOp]
forall a b. (a -> b) -> a -> b
$ PrintComment -> ExtInstrAbstract ExpandedOp
forall op. PrintComment -> ExtInstrAbstract op
U.UPRINT (PrintComment s -> PrintComment
forall (s :: [T]). PrintComment s -> PrintComment
untypePrintComment PrintComment s
pc)
  TEST_ASSERT (TestAssert nm :: Text
nm pc :: PrintComment s
pc i :: Instr s ('TBool : out)
i) ->
    OneItem [ExtInstrAbstract ExpandedOp]
-> [ExtInstrAbstract ExpandedOp]
forall x. One x => OneItem x -> x
one (OneItem [ExtInstrAbstract ExpandedOp]
 -> [ExtInstrAbstract ExpandedOp])
-> OneItem [ExtInstrAbstract ExpandedOp]
-> [ExtInstrAbstract ExpandedOp]
forall a b. (a -> b) -> a -> b
$ TestAssert ExpandedOp -> OneItem [ExtInstrAbstract ExpandedOp]
forall op. TestAssert op -> ExtInstrAbstract op
U.UTEST_ASSERT (TestAssert ExpandedOp -> OneItem [ExtInstrAbstract ExpandedOp])
-> TestAssert ExpandedOp -> OneItem [ExtInstrAbstract ExpandedOp]
forall a b. (a -> b) -> a -> b
$
    Text -> PrintComment -> [ExpandedOp] -> TestAssert ExpandedOp
forall op. Text -> PrintComment -> [op] -> TestAssert op
U.TestAssert Text
nm (PrintComment s -> PrintComment
forall (s :: [T]). PrintComment s -> PrintComment
untypePrintComment PrintComment s
pc) (Instr s ('TBool : out) -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr s ('TBool : out)
i)
  DOC_ITEM{} -> []
  COMMENT_ITEM tp :: CommentType
tp ->
    case CommentType
tp of
      FunctionStarts name :: Text
name -> OneItem [ExtInstrAbstract ExpandedOp]
-> [ExtInstrAbstract ExpandedOp]
forall x. One x => OneItem x -> x
one (OneItem [ExtInstrAbstract ExpandedOp]
 -> [ExtInstrAbstract ExpandedOp])
-> OneItem [ExtInstrAbstract ExpandedOp]
-> [ExtInstrAbstract ExpandedOp]
forall a b. (a -> b) -> a -> b
$ Text -> OneItem [ExtInstrAbstract ExpandedOp]
forall op. Text -> ExtInstrAbstract op
U.UCOMMENT (Text -> OneItem [ExtInstrAbstract ExpandedOp])
-> Text -> OneItem [ExtInstrAbstract ExpandedOp]
forall a b. (a -> b) -> a -> b
$ "Function starts: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
      FunctionEnds name :: Text
name -> OneItem [ExtInstrAbstract ExpandedOp]
-> [ExtInstrAbstract ExpandedOp]
forall x. One x => OneItem x -> x
one (OneItem [ExtInstrAbstract ExpandedOp]
 -> [ExtInstrAbstract ExpandedOp])
-> OneItem [ExtInstrAbstract ExpandedOp]
-> [ExtInstrAbstract ExpandedOp]
forall a b. (a -> b) -> a -> b
$ Text -> OneItem [ExtInstrAbstract ExpandedOp]
forall op. Text -> ExtInstrAbstract op
U.UCOMMENT (Text -> OneItem [ExtInstrAbstract ExpandedOp])
-> Text -> OneItem [ExtInstrAbstract ExpandedOp]
forall a b. (a -> b) -> a -> b
$ "Function ends: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
      StatementStarts name :: Text
name -> OneItem [ExtInstrAbstract ExpandedOp]
-> [ExtInstrAbstract ExpandedOp]
forall x. One x => OneItem x -> x
one (OneItem [ExtInstrAbstract ExpandedOp]
 -> [ExtInstrAbstract ExpandedOp])
-> OneItem [ExtInstrAbstract ExpandedOp]
-> [ExtInstrAbstract ExpandedOp]
forall a b. (a -> b) -> a -> b
$ Text -> OneItem [ExtInstrAbstract ExpandedOp]
forall op. Text -> ExtInstrAbstract op
U.UCOMMENT (Text -> OneItem [ExtInstrAbstract ExpandedOp])
-> Text -> OneItem [ExtInstrAbstract ExpandedOp]
forall a b. (a -> b) -> a -> b
$ "Statement starts: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
      StatementEnds name :: Text
name -> OneItem [ExtInstrAbstract ExpandedOp]
-> [ExtInstrAbstract ExpandedOp]
forall x. One x => OneItem x -> x
one (OneItem [ExtInstrAbstract ExpandedOp]
 -> [ExtInstrAbstract ExpandedOp])
-> OneItem [ExtInstrAbstract ExpandedOp]
-> [ExtInstrAbstract ExpandedOp]
forall a b. (a -> b) -> a -> b
$ Text -> OneItem [ExtInstrAbstract ExpandedOp]
forall op. Text -> ExtInstrAbstract op
U.UCOMMENT (Text -> OneItem [ExtInstrAbstract ExpandedOp])
-> Text -> OneItem [ExtInstrAbstract ExpandedOp]
forall a b. (a -> b) -> a -> b
$ "Statement ends: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
      JustComment com :: Text
com -> OneItem [ExtInstrAbstract ExpandedOp]
-> [ExtInstrAbstract ExpandedOp]
forall x. One x => OneItem x -> x
one (OneItem [ExtInstrAbstract ExpandedOp]
 -> [ExtInstrAbstract ExpandedOp])
-> OneItem [ExtInstrAbstract ExpandedOp]
-> [ExtInstrAbstract ExpandedOp]
forall a b. (a -> b) -> a -> b
$ Text -> ExtInstrAbstract ExpandedOp
forall op. Text -> ExtInstrAbstract op
U.UCOMMENT Text
com

-- It's an orphan instance, but it's better than checking all cases manually.
-- We can also move this convertion to the place where `Instr` is defined,
-- but then there will be a very large module (as we'll have to move a lot of
-- stuff as well).
instance Eq (Instr inp out) where
  i1 :: Instr inp out
i1 == :: Instr inp out -> Instr inp out -> Bool
== i2 :: Instr inp out
i2 = Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
i1 [ExpandedOp] -> [ExpandedOp] -> Bool
forall a. Eq a => a -> a -> Bool
== Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr inp out
i2

instance Typeable s => Eq (TestAssert s) where
  TestAssert   name1 :: Text
name1 pattern1 :: PrintComment s
pattern1 instr1 :: Instr s ('TBool : out)
instr1
    == :: TestAssert s -> TestAssert s -> Bool
==
    TestAssert name2 :: Text
name2 pattern2 :: PrintComment s
pattern2 instr2 :: Instr s ('TBool : out)
instr2
    = [Bool] -> Bool
forall t. (Container t, Element t ~ Bool) => t -> Bool
and
    [ Text
name1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name2
    , PrintComment s
pattern1 PrintComment s -> PrintComment s -> Bool
forall k (a1 :: k) (a2 :: k) (t :: k -> *).
(Typeable a1, Typeable a2, Eq (t a1)) =>
t a1 -> t a2 -> Bool
`eqParam1` PrintComment s
pattern2
    , Instr s ('TBool : out)
instr1 Instr s ('TBool : out) -> Instr s ('TBool : out) -> Bool
forall k1 k2 (a1 :: k1) (a2 :: k1) (b1 :: k2) (b2 :: k2)
       (t :: k1 -> k2 -> *).
(Typeable a1, Typeable a2, Typeable b1, Typeable b2,
 Eq (t a1 b2)) =>
t a1 b1 -> t a2 b2 -> Bool
`eqParam2` Instr s ('TBool : out)
instr2
    ]

instance (SingI t, HasNoOp t) => Buildable (Value' Instr t) where
  build :: Value' Instr t -> Builder
build = Value -> Builder
forall p. Buildable p => p -> Builder
build (Value -> Builder)
-> (Value' Instr t -> Value) -> Value' Instr t -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value' Instr t -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue

-- | Get 'sampleTypedValue' from untyped value.
--
-- Throw error if @U.Type@ contains @TOperation@.
sampleValueFromUntype :: HasCallStack => U.Type -> U.Value' U.ExpandedOp
sampleValueFromUntype :: Storage -> Value
sampleValueFromUntype ty :: Storage
ty = T -> (forall (a :: T). KnownT a => Sing a -> Value) -> Value
forall r. T -> (forall (a :: T). KnownT a => Sing a -> r) -> r
withSomeSingT (Storage -> T
fromUType Storage
ty) ((forall (a :: T). KnownT a => Sing a -> Value) -> Value)
-> (forall (a :: T). KnownT a => Sing a -> Value) -> Value
forall a b. (a -> b) -> a -> b
$ \(_ :: Sing t) ->
  case CheckScope (ParameterScope a) =>
Either BadTypeForScope (Dict (ParameterScope a))
forall (c :: Constraint).
CheckScope c =>
Either BadTypeForScope (Dict c)
checkScope @(ParameterScope t) of
    Left bt :: BadTypeForScope
bt -> Text -> Value
forall a. HasCallStack => Text -> a
error (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ "Scope error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BadTypeForScope -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty BadTypeForScope
bt
    Right Dict -> Value' Instr a -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue (Value' Instr a -> Value) -> Value' Instr a -> Value
forall a b. (a -> b) -> a -> b
$ (HasCallStack, ParameterScope a) => Value' Instr a
forall (t :: T). (HasCallStack, ParameterScope t) => Value t
sampleTypedValue @t

-- | Sample values used for generating examples of entrypoint parameter in documentation.
sampleTypedValue :: forall t. (HasCallStack, ParameterScope t) => Value t
sampleTypedValue :: Value t
sampleTypedValue = case SingI t => Sing t
forall k (a :: k). SingI a => Sing a
sing @t of
    STInt              -> Integer -> Value' Instr 'TInt
forall (instr :: [T] -> [T] -> *). Integer -> Value' instr 'TInt
VInt -1
    STNat              -> Natural -> Value' Instr 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat 0
    STString           -> MText -> Value' Instr 'TString
forall (instr :: [T] -> [T] -> *). MText -> Value' instr 'TString
VString [mt|hello|]
    STMutez            -> Mutez -> Value' Instr 'TMutez
forall (instr :: [T] -> [T] -> *). Mutez -> Value' instr 'TMutez
VMutez (HasCallStack => Word64 -> Mutez
Word64 -> Mutez
unsafeMkMutez 100)
    STBool             -> Bool -> Value' Instr 'TBool
forall (instr :: [T] -> [T] -> *). Bool -> Value' instr 'TBool
VBool Bool
True
    STKey              -> PublicKey -> Value' Instr 'TKey
forall (instr :: [T] -> [T] -> *). PublicKey -> Value' instr 'TKey
VKey PublicKey
samplePublicKey
    STKeyHash          -> KeyHash -> Value t
forall (instr :: [T] -> [T] -> *).
KeyHash -> Value' instr 'TKeyHash
VKeyHash (KeyHash -> Value t) -> KeyHash -> Value t
forall a b. (a -> b) -> a -> b
$ PublicKey -> KeyHash
hashKey PublicKey
samplePublicKey
    STTimestamp        -> Timestamp -> Value t
forall (instr :: [T] -> [T] -> *).
Timestamp -> Value' instr 'TTimestamp
VTimestamp (Timestamp -> Value t) -> Timestamp -> Value t
forall a b. (a -> b) -> a -> b
$ Integer -> Timestamp
timestampFromSeconds 1564142952
    STBytes            -> ByteString -> Value' Instr 'TBytes
forall (instr :: [T] -> [T] -> *).
ByteString -> Value' instr 'TBytes
VBytes "\10"
    STAddress          -> EpAddress -> Value t
forall (instr :: [T] -> [T] -> *).
EpAddress -> Value' instr 'TAddress
VAddress (EpAddress -> Value t) -> EpAddress -> Value t
forall a b. (a -> b) -> a -> b
$ EpAddress
sampleAddress
    STUnit             -> Value t
forall (instr :: [T] -> [T] -> *). Value' instr 'TUnit
VUnit
    STSignature        -> Signature -> Value t
forall (instr :: [T] -> [T] -> *).
Signature -> Value' instr 'TSignature
VSignature (Signature -> Value t) -> Signature -> Value t
forall a b. (a -> b) -> a -> b
$ Signature
sampleSignature
    STChainId          -> ChainId -> Value' Instr 'TChainId
forall (instr :: [T] -> [T] -> *).
ChainId -> Value' instr 'TChainId
VChainId ChainId
sampleChainId
    STOption (_ :: Sing t2) -> Maybe (Value' Instr a) -> Value t
forall (t :: T) (instr :: [T] -> [T] -> *).
KnownT t =>
Maybe (Value' instr t) -> Value' instr ('TOption t)
VOption (Maybe (Value' Instr a) -> Value t)
-> Maybe (Value' Instr a) -> Value t
forall a b. (a -> b) -> a -> b
$ Value' Instr a -> Maybe (Value' Instr a)
forall a. a -> Maybe a
Just (Value' Instr a -> Maybe (Value' Instr a))
-> Value' Instr a -> Maybe (Value' Instr a)
forall a b. (a -> b) -> a -> b
$ (HasCallStack, ParameterScope a) => Value' Instr a
forall (t :: T). (HasCallStack, ParameterScope t) => Value t
sampleTypedValue @t2
    STList (_ :: Sing t2) -> [Value' Instr a] -> Value' Instr ('TList a)
forall (t :: T) (instr :: [T] -> [T] -> *).
KnownT t =>
[Value' instr t] -> Value' instr ('TList t)
VList [(HasCallStack, ParameterScope a) => Value' Instr a
forall (t :: T). (HasCallStack, ParameterScope t) => Value t
sampleTypedValue @t2]
    STSet (s2 :: Sing t2) ->
      case ( Sing a -> Comparability a
forall (t :: T). Sing t -> Comparability t
checkComparability Sing a
s2
           , Sing a -> NestedBigMapsPresence a
forall (ty :: T). Sing ty -> NestedBigMapsPresence ty
checkNestedBigMapsPresence Sing a
s2
           ) of
        (CanBeCompared, NestedBigMapsAbsent) ->
          Set (Value' Instr a) -> Value t
forall (t :: T) (instr :: [T] -> [T] -> *).
(KnownT t, Comparable t) =>
Set (Value' instr t) -> Value' instr ('TSet t)
VSet (Set (Value' Instr a) -> Value t)
-> Set (Value' Instr a) -> Value t
forall a b. (a -> b) -> a -> b
$ [Value' Instr a] -> Set (Value' Instr a)
forall a. Ord a => [a] -> Set a
Set.fromList [(HasCallStack, ParameterScope a) => Value' Instr a
forall (t :: T). (HasCallStack, ParameterScope t) => Value t
sampleTypedValue @t2]
        _ -> Text -> Value t
forall a. HasCallStack => Text -> a
error (Text -> Value t) -> Text -> Value t
forall a b. (a -> b) -> a -> b
$ "Error generating sample value: scope error"
    STContract _ ->
      Address -> SomeEntrypointCallT a -> Value' Instr ('TContract a)
forall (arg :: T) (instr :: [T] -> [T] -> *).
Address -> SomeEntrypointCallT arg -> Value' instr ('TContract arg)
VContract (EpAddress -> Address
eaAddress EpAddress
sampleAddress) (SomeEntrypointCallT a -> Value t)
-> SomeEntrypointCallT a -> Value t
forall a b. (a -> b) -> a -> b
$ EntrypointCallT a a -> SomeEntrypointCallT a
forall (arg :: T) (param :: T).
ParameterScope param =>
EntrypointCallT param arg -> SomeEntrypointCallT arg
SomeEpc EntrypointCallT a a
forall (param :: T).
ParameterScope param =>
EntrypointCallT param param
epcCallRootUnsafe
    STPair (s2 :: Sing t2) (s3 :: Sing t3) ->
      case ( Sing a -> OpPresence a
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing a
s2
           , Sing a -> NestedBigMapsPresence a
forall (ty :: T). Sing ty -> NestedBigMapsPresence ty
checkNestedBigMapsPresence Sing a
s2
           , Sing b -> OpPresence b
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing b
s3
           , Sing b -> NestedBigMapsPresence b
forall (ty :: T). Sing ty -> NestedBigMapsPresence ty
checkNestedBigMapsPresence Sing b
s3
           ) of
        (OpAbsent, NestedBigMapsAbsent, OpAbsent, NestedBigMapsAbsent) ->
          (Value' Instr a, Value' Instr b) -> Value' Instr ('TPair a b)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair ((HasCallStack, ParameterScope a) => Value' Instr a
forall (t :: T). (HasCallStack, ParameterScope t) => Value t
sampleTypedValue @t2, (HasCallStack, ParameterScope b) => Value' Instr b
forall (t :: T). (HasCallStack, ParameterScope t) => Value t
sampleTypedValue @t3)
    STOr (s2 :: Sing t2) _ ->
      case (Sing a -> NestedBigMapsPresence a
forall (ty :: T). Sing ty -> NestedBigMapsPresence ty
checkNestedBigMapsPresence Sing a
s2, Sing a -> OpPresence a
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing a
s2) of
        (NestedBigMapsAbsent, OpAbsent) ->
          Either (Value' Instr a) (Value' Instr b) -> Value t
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(KnownT l, KnownT r) =>
Either (Value' instr l) (Value' instr r) -> Value' instr ('TOr l r)
VOr (Either (Value' Instr a) (Value' Instr b) -> Value t)
-> Either (Value' Instr a) (Value' Instr b) -> Value t
forall a b. (a -> b) -> a -> b
$ Value' Instr a -> Either (Value' Instr a) (Value' Instr b)
forall a b. a -> Either a b
Left (Value' Instr a -> Either (Value' Instr a) (Value' Instr b))
-> Value' Instr a -> Either (Value' Instr a) (Value' Instr b)
forall a b. (a -> b) -> a -> b
$ (HasCallStack, ParameterScope a) => Value' Instr a
forall (t :: T). (HasCallStack, ParameterScope t) => Value t
sampleTypedValue @t2
    STMap (s2 :: Sing t2) (s3 :: Sing t3) ->
      case ( Sing a -> NestedBigMapsPresence a
forall (ty :: T). Sing ty -> NestedBigMapsPresence ty
checkNestedBigMapsPresence Sing a
s2
           , Sing a -> Comparability a
forall (t :: T). Sing t -> Comparability t
checkComparability Sing a
s2
           , Sing a -> OpPresence a
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing a
s2
           , Sing b -> NestedBigMapsPresence b
forall (ty :: T). Sing ty -> NestedBigMapsPresence ty
checkNestedBigMapsPresence Sing b
s3
           ) of
        (NestedBigMapsAbsent, CanBeCompared, OpAbsent, NestedBigMapsAbsent) ->
            Map (Value' Instr a) (Value' Instr b) -> Value t
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
(KnownT k, KnownT v, Comparable k) =>
Map (Value' instr k) (Value' instr v) -> Value' instr ('TMap k v)
VMap (Map (Value' Instr a) (Value' Instr b) -> Value t)
-> Map (Value' Instr a) (Value' Instr b) -> Value t
forall a b. (a -> b) -> a -> b
$ [(Value' Instr a, Value' Instr b)]
-> Map (Value' Instr a) (Value' Instr b)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((HasCallStack, ParameterScope a) => Value' Instr a
forall (t :: T). (HasCallStack, ParameterScope t) => Value t
sampleTypedValue @t2, (HasCallStack, ParameterScope b) => Value' Instr b
forall (t :: T). (HasCallStack, ParameterScope t) => Value t
sampleTypedValue @t3)]
        _ -> Text -> Value t
forall a. HasCallStack => Text -> a
error (Text -> Value t) -> Text -> Value t
forall a b. (a -> b) -> a -> b
$ "Error generating sample value: scope error"
    STBigMap (s2 :: Sing t2) (s3 :: Sing t3) ->
      case ( Sing a -> NestedBigMapsPresence a
forall (ty :: T). Sing ty -> NestedBigMapsPresence ty
checkNestedBigMapsPresence Sing a
s2
           , Sing a -> Comparability a
forall (t :: T). Sing t -> Comparability t
checkComparability Sing a
s2
           , Sing a -> OpPresence a
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing a
s2
           , Sing b -> NestedBigMapsPresence b
forall (ty :: T). Sing ty -> NestedBigMapsPresence ty
checkNestedBigMapsPresence Sing b
s3
           ) of
        (NestedBigMapsAbsent, CanBeCompared, OpAbsent, NestedBigMapsAbsent) ->
            Map (Value' Instr a) (Value' Instr b) -> Value t
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
(KnownT k, KnownT v, Comparable k) =>
Map (Value' instr k) (Value' instr v)
-> Value' instr ('TBigMap k v)
VBigMap (Map (Value' Instr a) (Value' Instr b) -> Value t)
-> Map (Value' Instr a) (Value' Instr b) -> Value t
forall a b. (a -> b) -> a -> b
$ [(Value' Instr a, Value' Instr b)]
-> Map (Value' Instr a) (Value' Instr b)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((HasCallStack, ParameterScope a) => Value' Instr a
forall (t :: T). (HasCallStack, ParameterScope t) => Value t
sampleTypedValue @t2, (HasCallStack, ParameterScope b) => Value' Instr b
forall (t :: T). (HasCallStack, ParameterScope t) => Value t
sampleTypedValue @t3)]
        _ -> Text -> Value t
forall a. HasCallStack => Text -> a
error (Text -> Value t) -> Text -> Value t
forall a b. (a -> b) -> a -> b
$ "Error generating sample value: scope error"
    STLambda (_ :: Sing t2) (s3 :: Sing t3) ->
      case ( Sing b -> NestedBigMapsPresence b
forall (ty :: T). Sing ty -> NestedBigMapsPresence ty
checkNestedBigMapsPresence Sing b
s3
           , Sing b -> BigMapPresence b
forall (ty :: T). Sing ty -> BigMapPresence ty
checkBigMapPresence Sing b
s3
           , Sing b -> ContractPresence b
forall (ty :: T). Sing ty -> ContractPresence ty
checkContractTypePresence Sing b
s3
           , Sing b -> OpPresence b
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing b
s3
           ) of
        (NestedBigMapsAbsent, BigMapAbsent, ContractAbsent, OpAbsent) ->
          RemFail Instr '[a] '[b] -> Value t
forall (inp :: T) (out :: T) (instr :: [T] -> [T] -> *).
(KnownT inp, KnownT out,
 forall (i :: [T]) (o :: [T]). Show (instr i o),
 forall (i :: [T]) (o :: [T]). Eq (instr i o),
 forall (i :: [T]) (o :: [T]). NFData (instr i o)) =>
RemFail instr '[inp] '[out] -> Value' instr ('TLambda inp out)
VLam (RemFail Instr '[a] '[b] -> Value t)
-> RemFail Instr '[a] '[b] -> Value t
forall a b. (a -> b) -> a -> b
$ Instr '[a] '[b] -> RemFail Instr '[a] '[b]
forall k (instr :: k -> k -> *) (i :: k) (o :: k).
instr i o -> RemFail instr i o
RfNormal (Instr '[a] '[]
forall (a :: T) (s :: [T]). Instr (a : s) s
DROP Instr '[a] '[] -> Instr '[] '[b] -> Instr '[a] '[b]
forall (a :: [T]) (b :: [T]) (c :: [T]).
Instr a b -> Instr b c -> Instr a c
`Seq` Value' Instr b -> Instr '[] '[b]
forall (t :: T) (s :: [T]).
ConstantScope t =>
Value' Instr t -> Instr s (t : s)
PUSH ((HasCallStack, ParameterScope b) => Value' Instr b
forall (t :: T). (HasCallStack, ParameterScope t) => Value t
sampleTypedValue @t3))
        _ -> RemFail Instr '[a] '[b] -> Value t
forall (inp :: T) (out :: T) (instr :: [T] -> [T] -> *).
(KnownT inp, KnownT out,
 forall (i :: [T]) (o :: [T]). Show (instr i o),
 forall (i :: [T]) (o :: [T]). Eq (instr i o),
 forall (i :: [T]) (o :: [T]). NFData (instr i o)) =>
RemFail instr '[inp] '[out] -> Value' instr ('TLambda inp out)
VLam (RemFail Instr '[a] '[b] -> Value t)
-> RemFail Instr '[a] '[b] -> Value t
forall a b. (a -> b) -> a -> b
$ (forall (o' :: [T]). Instr '[a] o') -> RemFail Instr '[a] '[b]
forall k (instr :: k -> k -> *) (i :: k) (o :: k).
(forall (o' :: k). instr i o') -> RemFail instr i o
RfAlwaysFails (Value' Instr 'TString -> Instr '[a] '[ 'TString, a]
forall (t :: T) (s :: [T]).
ConstantScope t =>
Value' Instr t -> Instr s (t : s)
PUSH (MText -> Value' Instr 'TString
forall (instr :: [T] -> [T] -> *). MText -> Value' instr 'TString
VString [mt|lambda sample|]) Instr '[a] '[ 'TString, a]
-> Instr '[ 'TString, a] o' -> Instr '[a] o'
forall (a :: [T]) (b :: [T]) (c :: [T]).
Instr a b -> Instr b c -> Instr a c
`Seq` Instr '[ 'TString, a] o'
forall (a :: T) (s :: [T]) (t :: [T]). KnownT a => Instr (a : s) t
FAILWITH)
    where
      sampleAddress :: EpAddress
sampleAddress =  HasCallStack => Text -> EpAddress
Text -> EpAddress
unsafeParseEpAddress "KT1AEseqMV6fk2vtvQCVyA7ZCaxv7cpxtXdB"
      samplePublicKey :: PublicKey
samplePublicKey = PublicKey -> Either CryptoParseError PublicKey -> PublicKey
forall b a. b -> Either a b -> b
fromRight (Text -> PublicKey
forall a. HasCallStack => Text -> a
error "impossible") (Either CryptoParseError PublicKey -> PublicKey)
-> Either CryptoParseError PublicKey -> PublicKey
forall a b. (a -> b) -> a -> b
$ Text -> Either CryptoParseError PublicKey
parsePublicKey
        "edpkuwTWKgQNnhR5v17H2DYHbfcxYepARyrPGbf1tbMoGQAj8Ljr3V"
      sampleSignature :: Signature
sampleSignature = Signature -> Either CryptoParseError Signature -> Signature
forall b a. b -> Either a b -> b
fromRight (Text -> Signature
forall a. HasCallStack => Text -> a
error "impossible") (Either CryptoParseError Signature -> Signature)
-> Either CryptoParseError Signature -> Signature
forall a b. (a -> b) -> a -> b
$ Text -> Either CryptoParseError Signature
parseSignature
        "edsigtrs8bK7vNfiR4Kd9dWasVa1bAWaQSu2ipnmLGZuwQa8ktCEMYVKqbWsbJ7zTS8dgYT9tiSUKorWCPFHosL5zPsiDwBQ6vb"
      sampleChainId :: ChainId
sampleChainId = ChainId -> Either ParseChainIdError ChainId -> ChainId
forall b a. b -> Either a b -> b
fromRight (Text -> ChainId
forall a. HasCallStack => Text -> a
error "impossible") (Either ParseChainIdError ChainId -> ChainId)
-> Either ParseChainIdError ChainId -> ChainId
forall a b. (a -> b) -> a -> b
$ Text -> Either ParseChainIdError ChainId
parseChainId "NetXUdfLh6Gm88t"