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

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

module Michelson.Typed.Convert
  ( convertParamNotes
  , convertContractCode
  , convertContract
  , instrToOps
  , instrToOpsOptimized
  , untypeDemoteT
  , untypeValue
  , untypeValueHashable
  , untypeValueOptimized

  -- Helper for generating documentation
  , sampleTypedValue

  -- * Misc
  , flattenEntrypoints
  ) where

import qualified Data.ByteArray as ByteArray
import Data.Constraint (Dict(..))
import Data.List.NonEmpty ((<|))
import qualified Data.Map as Map
import Data.Singletons (Sing, demote, withSingI)
import Data.Vinyl (Rec(..))
import Fmt (Buildable(..), Builder, blockListF, fmt, indentF, listF, pretty, unlinesF)


import Michelson.Text
import Michelson.Typed.Aliases
import Michelson.Typed.Annotation (Notes(..))
import Michelson.Typed.Entrypoints
import Michelson.Typed.Extract (mkUType, toUType)
import Michelson.Typed.Instr as Instr
import Michelson.Typed.Scope
import Michelson.Typed.Sing (SingT(..))
import Michelson.Typed.T (T(..))
import Michelson.Typed.Value
import Michelson.Printer.Util
import qualified Michelson.Untyped as U
import Michelson.Untyped.Annotation (Annotation(unAnnotation))
import Tezos.Address (Address(..), ContractHash(..))
import Tezos.Core
  (ChainId(unChainId), mformatChainId, parseChainId, timestampFromSeconds, timestampToSeconds,
  unMutez, unsafeMkMutez)
import Tezos.Crypto
import qualified Tezos.Crypto.BLS12381 as BLS
import qualified Tezos.Crypto.Ed25519 as Ed25519
import qualified Tezos.Crypto.P256 as P256
import qualified Tezos.Crypto.Secp256k1 as Secp256k1
import Util.PeanoNatural (fromPeanoNatural)
import Util.Sing (eqParamSing, eqParamSing2)

convertParamNotes :: SingI cp => ParamNotes cp -> U.ParameterType
convertParamNotes :: ParamNotes cp -> ParameterType
convertParamNotes (ParamNotes Notes cp
notes RootAnn
rootAnn) =
  Ty -> RootAnn -> ParameterType
U.ParameterType (Notes cp -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes cp
notes) RootAnn
rootAnn

convertContractCode
  :: forall param store . (SingI param, SingI store)
  => ContractCode param store -> U.Contract
convertContractCode :: ContractCode param store -> Contract
convertContractCode ContractCode param store
contract =
  Contract :: forall op.
ParameterType -> Ty -> [op] -> EntriesOrder -> Contract' op
U.Contract
    { contractParameter :: ParameterType
contractParameter = Ty -> RootAnn -> ParameterType
U.ParameterType (SingI param => Ty
forall (t :: T). SingI t => Ty
untypeDemoteT @param) RootAnn
forall k (a :: k). Annotation a
U.noAnn
    , contractStorage :: Ty
contractStorage = SingI store => Ty
forall (t :: T). SingI t => Ty
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 :: Contract param store -> U.Contract
convertContract :: Contract param store -> Contract
convertContract fc :: Contract param store
fc@Contract{} =
  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 = ParamNotes param -> ParameterType
forall (cp :: T). SingI cp => ParamNotes cp -> ParameterType
convertParamNotes (Contract param store -> ParamNotes param
forall (cp :: T) (st :: T). Contract cp st -> ParamNotes cp
cParamNotes Contract param store
fc)
       , contractStorage :: Ty
U.contractStorage = Notes store -> Ty
forall (x :: T). SingI x => Notes x -> Ty
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
       }

-- Note: if you change this type, check 'untypeValueImpl' wildcard patterns.
data UntypingOptions
  = Readable
  -- ^ Convert value to human-readable representation
  | Optimized
  -- ^ Convert value to optimized representation
  | Hashable
  -- ^ Like 'Optimized', but without list notation for pairs.
  -- Created to match 'tezos-client hash data' behavior for typed values.
  -- See https://gitlab.com/morley-framework/morley/-/issues/611
  deriving stock (UntypingOptions -> UntypingOptions -> Bool
(UntypingOptions -> UntypingOptions -> Bool)
-> (UntypingOptions -> UntypingOptions -> Bool)
-> Eq UntypingOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UntypingOptions -> UntypingOptions -> Bool
$c/= :: UntypingOptions -> UntypingOptions -> Bool
== :: UntypingOptions -> UntypingOptions -> Bool
$c== :: UntypingOptions -> UntypingOptions -> Bool
Eq, Int -> UntypingOptions -> ShowS
[UntypingOptions] -> ShowS
UntypingOptions -> String
(Int -> UntypingOptions -> ShowS)
-> (UntypingOptions -> String)
-> ([UntypingOptions] -> ShowS)
-> Show UntypingOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UntypingOptions] -> ShowS
$cshowList :: [UntypingOptions] -> ShowS
show :: UntypingOptions -> String
$cshow :: UntypingOptions -> String
showsPrec :: Int -> UntypingOptions -> ShowS
$cshowsPrec :: Int -> UntypingOptions -> ShowS
Show)

untypeValue :: (SingI t, HasNoOp t) => Value' Instr t -> U.Value
untypeValue :: Value' Instr t -> Value
untypeValue = UntypingOptions -> Value' Instr t -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
Readable

untypeValueHashable :: (SingI t, HasNoOp t) => Value' Instr t -> U.Value
untypeValueHashable :: Value' Instr t -> Value
untypeValueHashable = UntypingOptions -> Value' Instr t -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
Hashable

untypeValueOptimized :: (SingI t, HasNoOp t) => Value' Instr t -> U.Value
untypeValueOptimized :: Value' Instr t -> Value
untypeValueOptimized = UntypingOptions -> Value' Instr t -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
Optimized

-- | 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.
untypeValueImpl ::
     forall t . (SingI t, HasNoOp t)
  => UntypingOptions
  -> Value' Instr t
  -> U.Value
untypeValueImpl :: UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts 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 Integer
i, SingT t
_) -> Integer -> Value
forall op. Integer -> Value' op
U.ValueInt Integer
i
  (VNat Natural
i, SingT t
_) -> 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 MText
s, SingT t
_) -> MText -> Value
forall op. MText -> Value' op
U.ValueString MText
s
  (VBytes ByteString
b, SingT t
_) -> 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 Mutez
m, SingT t
_) -> 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 Bool
True, SingT t
_) -> Value
forall op. Value' op
U.ValueTrue
  (VBool Bool
False, SingT t
_) -> Value
forall op. Value' op
U.ValueFalse
  (VKeyHash KeyHash
h, SingT t
_) ->
    case UntypingOptions
opts of
      UntypingOptions
Readable  -> 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
      UntypingOptions
_         -> 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 -> InternalByteString)
-> ByteString -> InternalByteString
forall a b. (a -> b) -> a -> b
$ KeyHash -> ByteString
keyHashToBytes KeyHash
h
  (VBls12381Fr Bls12381Fr
v, SingT t
_) ->
    case UntypingOptions
opts of
      UntypingOptions
Readable  -> Integer -> Value
forall op. Integer -> Value' op
U.ValueInt (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Bls12381Fr -> Integer
forall a. Integral a => a -> Integer
toInteger Bls12381Fr
v
      UntypingOptions
_         -> InternalByteString -> Value
forall op. InternalByteString -> Value' op
U.ValueBytes (InternalByteString -> Value)
-> (ByteString -> InternalByteString) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> InternalByteString
U.InternalByteString (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ Bls12381Fr -> ByteString
forall a. CurveObject a => a -> ByteString
BLS.toMichelsonBytes Bls12381Fr
v
  (VBls12381G1 Bls12381G1
v, SingT t
_) ->
    InternalByteString -> Value
forall op. InternalByteString -> Value' op
U.ValueBytes (InternalByteString -> Value)
-> (ByteString -> InternalByteString) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> InternalByteString
U.InternalByteString (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ Bls12381G1 -> ByteString
forall a. CurveObject a => a -> ByteString
BLS.toMichelsonBytes Bls12381G1
v
  (VBls12381G2 Bls12381G2
v, SingT t
_) ->
    InternalByteString -> Value
forall op. InternalByteString -> Value' op
U.ValueBytes (InternalByteString -> Value)
-> (ByteString -> InternalByteString) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> InternalByteString
U.InternalByteString (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ Bls12381G2 -> ByteString
forall a. CurveObject a => a -> ByteString
BLS.toMichelsonBytes Bls12381G2
v
  (VTimestamp Timestamp
t, SingT t
_) ->
    case UntypingOptions
opts of
      UntypingOptions
Readable   -> MText -> Value
forall op. MText -> Value' op
U.ValueString (MText -> Value) -> (Text -> MText) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> MText
Text -> MText
unsafeMkMText (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Timestamp -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Timestamp
t
      UntypingOptions
_          -> Integer -> Value
forall op. Integer -> Value' op
U.ValueInt (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Timestamp -> Integer
forall a. Integral a => Timestamp -> a
timestampToSeconds Timestamp
t
  (VAddress EpAddress
a, SingT t
_) ->
    case UntypingOptions
opts of
      UntypingOptions
Readable  -> 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
      UntypingOptions
_         -> InternalByteString -> Value
forall op. InternalByteString -> Value' op
U.ValueBytes (InternalByteString -> Value)
-> (ByteString -> InternalByteString) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> InternalByteString
U.InternalByteString  (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ EpAddress -> ByteString
encodeEpAddress EpAddress
a
  (VKey PublicKey
b, SingT t
_) ->
    case UntypingOptions
opts of
      UntypingOptions
Readable  -> 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
      UntypingOptions
_         -> InternalByteString -> Value
forall op. InternalByteString -> Value' op
U.ValueBytes (InternalByteString -> Value)
-> (ByteString -> InternalByteString) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> InternalByteString
U.InternalByteString (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ PublicKey -> ByteString
keyToBytes PublicKey
b
  (Value' Instr t
VUnit, SingT t
_) ->
    Value
forall op. Value' op
U.ValueUnit
  (VSignature Signature
b, SingT t
_) ->
    case UntypingOptions
opts of
      UntypingOptions
Readable  -> 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
      UntypingOptions
_         -> InternalByteString -> Value
forall op. InternalByteString -> Value' op
U.ValueBytes (InternalByteString -> Value)
-> (ByteString -> InternalByteString) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> InternalByteString
U.InternalByteString (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ Signature -> ByteString
forall ba. ByteArray ba => Signature -> ba
signatureToBytes Signature
b
  (VChainId ChainId
b, SingT t
_) ->
    case UntypingOptions
opts of
      UntypingOptions
Readable  -> 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
      UntypingOptions
_         ->
        InternalByteString -> Value
forall op. InternalByteString -> Value' op
U.ValueBytes (InternalByteString -> Value)
-> (ByteString -> InternalByteString) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> InternalByteString
U.InternalByteString (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert (ChainId -> ByteString
unChainId ChainId
b)
  (VOption (Just Value' Instr t
x), STOption _) ->
    Value -> Value
forall op. Value' op -> Value' op
U.ValueSome (UntypingOptions -> Value' Instr t -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Value' Instr t
x)
  (VOption Maybe (Value' Instr t)
Nothing, STOption _) ->
    Value
forall op. Value' op
U.ValueNone
  (VList [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 (UntypingOptions -> Value' Instr t -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts) [Value' Instr t]
l
  (VSet 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
      OpPresence t
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 (UntypingOptions -> Value' Instr t -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl @st UntypingOptions
opts) ([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 Address
addr SomeEntrypointCallT arg
sepc, SingT t
_) ->
    case UntypingOptions
opts of
      UntypingOptions
Readable  ->
        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)
      UntypingOptions
_         -> InternalByteString -> Value
forall op. InternalByteString -> Value' op
U.ValueBytes (InternalByteString -> Value)
-> (EpAddress -> InternalByteString) -> EpAddress -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> InternalByteString
U.InternalByteString (ByteString -> InternalByteString)
-> (EpAddress -> ByteString) -> EpAddress -> InternalByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpAddress -> ByteString
encodeEpAddress (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)
  (VTicket Address
s Value' Instr arg
v Natural
a, SingT t
_) ->
    case Value' Instr arg -> Dict (SingI arg)
forall (instr :: [T] -> [T] -> *) (t :: T).
Value' instr t -> Dict (SingI t)
valueTypeSanity Value' Instr arg
v of
      Dict (SingI arg)
Dict ->
        let us :: Value
us = UntypingOptions -> Value' Instr 'TAddress -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts (Value' Instr 'TAddress -> Value)
-> Value' Instr 'TAddress -> Value
forall a b. (a -> b) -> a -> b
$ EpAddress -> Value' Instr 'TAddress
forall (instr :: [T] -> [T] -> *).
EpAddress -> Value' instr 'TAddress
VAddress (Address -> EpName -> EpAddress
EpAddress Address
s EpName
DefEpName)
            uv :: Value
uv = UntypingOptions -> Value' Instr arg -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Value' Instr arg
v
            ua :: Value
ua = UntypingOptions -> Value' Instr 'TNat -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts (Value' Instr 'TNat -> Value) -> Value' Instr 'TNat -> Value
forall a b. (a -> b) -> a -> b
$ Natural -> Value' Instr 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat Natural
a
        in case UntypingOptions
opts of
          UntypingOptions
Optimized -> NonEmpty Value -> Value
forall op. (NonEmpty $ Value' op) -> Value' op
U.ValueSeq (NonEmpty Value -> Value) -> NonEmpty Value -> Value
forall a b. (a -> b) -> a -> b
$ Value
us Value -> [Value] -> NonEmpty Value
forall a. a -> [a] -> NonEmpty a
:| [Value
uv, Value
ua]
          UntypingOptions
_         -> Value -> Value -> Value
forall op. Value' op -> Value' op -> Value' op
U.ValuePair Value
us (Value -> Value -> Value
forall op. Value' op -> Value' op -> Value' op
U.ValuePair Value
uv Value
ua)
  p :: (Value' Instr t, SingT t)
p@(VPair (Value' Instr l
l, Value' Instr r
r), STPair lt rt) ->
    Sing l -> (SingI l => Value) -> Value
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing l
Sing n
lt ((SingI l => Value) -> Value) -> (SingI l => Value) -> Value
forall a b. (a -> b) -> a -> b
$
    Sing r -> (SingI r => Value) -> Value
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing r
Sing n
rt ((SingI r => Value) -> Value) -> (SingI r => Value) -> Value
forall a b. (a -> b) -> a -> b
$
    case Sing l -> OpPresence l
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing l
Sing n
lt of
      OpPresence l
OpAbsent -> case UntypingOptions
opts of
        UntypingOptions
Optimized -> NonEmpty Value -> Value
forall op. (NonEmpty $ Value' op) -> Value' op
U.ValueSeq (NonEmpty Value -> Value) -> NonEmpty Value -> Value
forall a b. (a -> b) -> a -> b
$ (Value' Instr t, Sing t) -> NonEmpty Value
forall (ty :: T).
(SingI ty, HasNoOp ty) =>
(Value ty, Sing ty) -> NonEmpty Value
pairToSeq (Value' Instr t, Sing t)
(Value' Instr t, SingT t)
p
        UntypingOptions
_         -> Value -> Value -> Value
forall op. Value' op -> Value' op -> Value' op
U.ValuePair (UntypingOptions -> Value' Instr l -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Value' Instr l
l) (UntypingOptions -> Value' Instr r -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Value' Instr r
r)

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

  (VOr (Right Value' Instr r
x), STOr lt _) ->
    case Sing l -> OpPresence l
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing l
Sing n
lt of
      OpPresence l
OpAbsent -> Value -> Value
forall op. Value' op -> Value' op
U.ValueRight (UntypingOptions -> Value' Instr r -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts 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]), SingT t
_) ->
    (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
$ UntypingOptions -> Instr '[inp] '[out] -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr '[inp] '[out]
ops

  (VMap 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 n
kt, Sing v -> OpPresence v
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing v
Sing n
vt) of
      (OpPresence k
OpAbsent, OpPresence v
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
<&> \(Value' Instr k
k, Value' Instr v
v) ->
        Value -> Value -> Elt ExpandedOp
forall op. Value' op -> Value' op -> Elt op
U.Elt (UntypingOptions -> Value' Instr k -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Value' Instr k
k) (UntypingOptions -> Value' Instr v -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Value' Instr v
v)

  (VBigMap Maybe Natural
_ 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 n
kt, Sing v -> OpPresence v
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing v
Sing n
vt) of
      (OpPresence k
OpAbsent, OpPresence v
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
<&> \(Value' Instr k
k, Value' Instr v
v) ->
        Value -> Value -> Elt ExpandedOp
forall op. Value' op -> Value' op -> Elt op
U.Elt (UntypingOptions -> Value' Instr k -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Value' Instr k
k) (UntypingOptions -> Value' Instr v -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Value' Instr v
v)
  where
    vList :: (NonEmpty a -> Value' op) -> [a] -> Value' op
vList 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

    pairToSeq :: (SingI ty, HasNoOp ty)
              => (Value ty, Sing ty)
              -> NonEmpty U.Value
    pairToSeq :: (Value ty, Sing ty) -> NonEmpty Value
pairToSeq = \case
      (VPair (Value' Instr l
a, Value' Instr r
b), STPair l r) -> Sing l -> (SingI l => NonEmpty Value) -> NonEmpty Value
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing l
Sing n
l ((SingI l => NonEmpty Value) -> NonEmpty Value)
-> (SingI l => NonEmpty Value) -> NonEmpty Value
forall a b. (a -> b) -> a -> b
$ Sing r -> (SingI r => NonEmpty Value) -> NonEmpty Value
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing r
Sing n
r ((SingI r => NonEmpty Value) -> NonEmpty Value)
-> (SingI r => NonEmpty Value) -> NonEmpty Value
forall a b. (a -> b) -> a -> b
$
        case Sing l -> OpPresence l
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing l
Sing n
l of
          OpPresence l
OpAbsent -> UntypingOptions -> Value' Instr l -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Value' Instr l
a Value -> NonEmpty Value -> NonEmpty Value
forall a. a -> NonEmpty a -> NonEmpty a
<| (Value' Instr r, Sing r) -> NonEmpty Value
forall (ty :: T).
(SingI ty, HasNoOp ty) =>
(Value ty, Sing ty) -> NonEmpty Value
pairToSeq (Value' Instr r
b, Sing r
Sing n
r)
      (Value ty
v, Sing ty
_) -> UntypingOptions -> Value ty -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Value ty
v Value -> [Value] -> NonEmpty Value
forall a. a -> [a] -> NonEmpty a
:| []

    keyHashToBytes :: KeyHash -> ByteString
    keyHashToBytes :: KeyHash -> ByteString
keyHashToBytes KeyHash
kh = (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (KeyHash -> ByteString
khBytes KeyHash
kh)) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
      case KeyHash -> KeyHashTag
khTag KeyHash
kh of
        KeyHashTag
KeyHashEd25519 -> ByteString
"\x00"
        KeyHashTag
KeyHashSecp256k1 -> ByteString
"\x01"
        KeyHashTag
KeyHashP256 -> ByteString
"\x02"

    keyToBytes :: PublicKey -> ByteString
    keyToBytes :: PublicKey -> ByteString
keyToBytes = \case
      PublicKeyEd25519 PublicKey
pk -> ByteString
"\x00" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> PublicKey -> ByteString
forall ba. ByteArray ba => PublicKey -> ba
Ed25519.publicKeyToBytes PublicKey
pk
      PublicKeySecp256k1 PublicKey
pk -> ByteString
"\x01" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> PublicKey -> ByteString
forall ba. ByteArray ba => PublicKey -> ba
Secp256k1.publicKeyToBytes PublicKey
pk
      PublicKeyP256 PublicKey
pk -> ByteString
"\x02" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> PublicKey -> ByteString
forall ba. ByteArray ba => PublicKey -> ba
P256.publicKeyToBytes PublicKey
pk

    encodeEpAddress :: EpAddress -> ByteString
    encodeEpAddress :: EpAddress -> ByteString
encodeEpAddress (EpAddress Address
addr EpName
epName) =
      Address -> ByteString
encodeAddress Address
addr ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> EpName -> ByteString
encodeEpName EpName
epName

    encodeAddress :: Address -> ByteString
    encodeAddress :: Address -> ByteString
encodeAddress = \case
      KeyAddress KeyHash
keyHash ->
        ByteString
"\x00" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> KeyHash -> ByteString
keyHashToBytes KeyHash
keyHash
      ContractAddress (ContractHash ByteString
address) ->
        ByteString
"\x01" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
address ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\x00"

    encodeEpName :: EpName -> ByteString
    encodeEpName :: EpName -> ByteString
encodeEpName = Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> (EpName -> Text) -> EpName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RootAnn -> Text
forall k (tag :: k). Annotation tag -> Text
unAnnotation (RootAnn -> Text) -> (EpName -> RootAnn) -> EpName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpName -> RootAnn
epNameToRefAnn (EpName -> RootAnn) -> (EpName -> EpName) -> EpName -> RootAnn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpName -> EpName
canonicalize
      where
        canonicalize :: EpName -> EpName
        canonicalize :: EpName -> EpName
canonicalize (UnsafeEpName Text
"default") = EpName
DefEpName
        canonicalize EpName
epName                   = EpName
epName

untypeDemoteT :: forall (t :: T). SingI t => U.Ty
untypeDemoteT :: Ty
untypeDemoteT = T -> Ty
toUType (T -> Ty) -> T -> Ty
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

instrToOpsOptimized :: HasCallStack => Instr inp out -> [U.ExpandedOp]
instrToOpsOptimized :: Instr inp out -> [ExpandedOp]
instrToOpsOptimized = UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
Optimized

instrToOps :: HasCallStack => Instr inp out -> [U.ExpandedOp]
instrToOps :: Instr inp out -> [ExpandedOp]
instrToOps = UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
Readable

instrToOpsImpl :: HasCallStack
               => UntypingOptions
               -> Instr inp out
               -> [U.ExpandedOp]
instrToOpsImpl :: UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts = \case
  Instr inp out
Nop -> []
  Seq Instr inp b
i1 Instr b out
i2 -> UntypingOptions -> Instr inp b -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp b
i1 [ExpandedOp] -> [ExpandedOp] -> [ExpandedOp]
forall a. Semigroup a => a -> a -> a
<> UntypingOptions -> Instr b out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr b out
i2
  Nested 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] -> ExpandedOp
U.SeqEx ([ExpandedOp] -> ExpandedOp) -> [ExpandedOp] -> 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 DocGrouping
_ Instr inp out
sq -> UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp out
sq
  Fn Text
t StackFn
sfn Instr inp out
i -> [ExpandedInstr -> ExpandedOp
U.PrimEx (ExpandedInstr -> ExpandedOp)
-> ([ExpandedOp] -> ExpandedInstr) -> [ExpandedOp] -> ExpandedOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtInstrAbstract ExpandedOp -> ExpandedInstr
forall op. ExtInstrAbstract op -> InstrAbstract op
U.EXT (ExtInstrAbstract ExpandedOp -> ExpandedInstr)
-> ([ExpandedOp] -> ExtInstrAbstract ExpandedOp)
-> [ExpandedOp]
-> ExpandedInstr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StackFn -> [ExpandedOp] -> ExtInstrAbstract ExpandedOp
forall op. Text -> StackFn -> [op] -> ExtInstrAbstract op
U.FN Text
t StackFn
sfn ([ExpandedOp] -> ExpandedOp) -> [ExpandedOp] -> 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
i]
  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 Proxy s
_ Instr a b
i -> UntypingOptions -> Instr a b -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts 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 InstrCallStack
_ Instr inp out
i -> UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp out
i
  InstrWithVarAnns VarAnns
_ Instr inp out
i -> UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp out
i
  InstrWithNotes Proxy s
proxy Rec Notes topElems
n Instr inp (topElems ++ s)
i -> case Instr inp (topElems ++ s)
i of
    Instr inp (topElems ++ s)
Nop -> UntypingOptions -> Instr inp inp -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp inp
Instr inp (topElems ++ s)
i
    Seq Instr inp b
_ Instr b (topElems ++ s)
_ -> UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp out
Instr inp (topElems ++ s)
i
    Nested Instr inp (topElems ++ s)
_ -> UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp out
Instr inp (topElems ++ s)
i
    DocGroup DocGrouping
_ Instr inp (topElems ++ s)
_ -> UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp out
Instr inp (topElems ++ s)
i
    Ext ExtInstr inp
_ -> UntypingOptions -> Instr inp inp -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp inp
Instr inp (topElems ++ s)
i
    WithLoc InstrCallStack
_ Instr inp (topElems ++ s)
i0 -> UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts (Proxy s
-> Rec Notes topElems
-> Instr inp (topElems ++ s)
-> Instr inp (topElems ++ s)
forall (a :: [T]) (topElems :: [T]) (s :: [T]).
(RMap topElems, RecordToList topElems,
 ReifyConstraint Show Notes topElems,
 ReifyConstraint NFData Notes topElems, Each '[SingI] topElems) =>
Proxy s
-> Rec Notes topElems
-> Instr a (topElems ++ s)
-> Instr a (topElems ++ s)
InstrWithNotes Proxy s
proxy Rec Notes topElems
n Instr inp (topElems ++ s)
i0)
    InstrWithNotes {} -> UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp out
Instr inp (topElems ++ s)
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.
    InstrWithVarNotes NonEmpty VarAnn
n0 (InstrWithVarAnns VarAnns
_ Instr inp (topElems ++ s)
i0) ->
      UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts (Instr inp out -> [ExpandedOp]) -> Instr inp out -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ Proxy s
-> Rec Notes topElems
-> Instr inp (topElems ++ s)
-> Instr inp (topElems ++ s)
forall (a :: [T]) (topElems :: [T]) (s :: [T]).
(RMap topElems, RecordToList topElems,
 ReifyConstraint Show Notes topElems,
 ReifyConstraint NFData Notes topElems, Each '[SingI] topElems) =>
Proxy s
-> Rec Notes topElems
-> Instr a (topElems ++ s)
-> Instr a (topElems ++ s)
InstrWithNotes Proxy s
proxy Rec Notes topElems
n (Instr inp (topElems ++ s) -> Instr inp (topElems ++ s))
-> Instr inp (topElems ++ s) -> Instr inp (topElems ++ s)
forall a b. (a -> b) -> a -> b
$ NonEmpty VarAnn -> Instr inp out -> Instr inp out
forall (a :: [T]) (b :: [T]).
NonEmpty VarAnn -> Instr a b -> Instr a b
InstrWithVarNotes NonEmpty VarAnn
n0 Instr inp out
Instr inp (topElems ++ s)
i0
    InstrWithVarNotes NonEmpty VarAnn
n0 Instr inp (topElems ++ s)
i0 -> [ExpandedInstr -> ExpandedOp
U.PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Instr inp out
-> Rec Notes topElems -> NonEmpty VarAnn -> ExpandedInstr
forall (inp' :: [T]) (out' :: [T]) (topElems :: [T]).
(HasCallStack, Each '[SingI] topElems) =>
Instr inp' out'
-> Rec Notes topElems -> NonEmpty VarAnn -> ExpandedInstr
handleInstrAnnotateWithVarNotes Instr inp out
Instr inp (topElems ++ s)
i0 Rec Notes topElems
n NonEmpty VarAnn
n0]
    InstrWithVarAnns VarAnns
_ Instr inp (topElems ++ s)
_ -> UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp out
Instr inp (topElems ++ s)
i
    Instr inp (topElems ++ s)
_ -> [ExpandedInstr -> ExpandedOp
U.PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Instr inp out -> Rec Notes topElems -> ExpandedInstr
forall (inp' :: [T]) (out' :: [T]) (topElems :: [T]).
(HasCallStack, Each '[SingI] topElems) =>
Instr inp' out' -> Rec Notes topElems -> ExpandedInstr
handleInstrAnnotate Instr inp out
Instr inp (topElems ++ s)
i Rec Notes topElems
n]
  InstrWithVarNotes NonEmpty VarAnn
n Instr inp out
i -> case Instr inp out
i of
    Instr inp out
Nop -> UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp out
i
    Seq Instr inp b
_ Instr b out
_ -> UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp out
i
    Nested Instr inp out
_ -> UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp out
i
    DocGroup DocGrouping
_ Instr inp out
_ -> UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp out
i
    Ext ExtInstr inp
_ -> UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp out
i
    WithLoc InstrCallStack
_ Instr inp out
i0 -> UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts (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 Proxy s
p0 Rec Notes topElems
n0 (InstrWithVarAnns VarAnns
_ Instr inp (topElems ++ s)
i0) ->
      UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts (Instr inp out -> [ExpandedOp]) -> Instr inp out -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ Proxy s
-> Rec Notes topElems
-> Instr inp (topElems ++ s)
-> Instr inp (topElems ++ s)
forall (a :: [T]) (topElems :: [T]) (s :: [T]).
(RMap topElems, RecordToList topElems,
 ReifyConstraint Show Notes topElems,
 ReifyConstraint NFData Notes topElems, Each '[SingI] topElems) =>
Proxy s
-> Rec Notes topElems
-> Instr a (topElems ++ s)
-> Instr a (topElems ++ s)
InstrWithNotes Proxy s
p0 Rec Notes topElems
n0 (Instr inp (topElems ++ s) -> Instr inp (topElems ++ s))
-> Instr inp (topElems ++ s) -> Instr inp (topElems ++ s)
forall a b. (a -> b) -> a -> b
$ 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
Instr inp (topElems ++ s)
i0
    InstrWithNotes Proxy s
_ Rec Notes topElems
n0 Instr inp (topElems ++ s)
i0 -> [ExpandedInstr -> ExpandedOp
U.PrimEx (ExpandedInstr -> ExpandedOp) -> ExpandedInstr -> ExpandedOp
forall a b. (a -> b) -> a -> b
$ Instr inp out
-> Rec Notes topElems -> NonEmpty VarAnn -> ExpandedInstr
forall (inp' :: [T]) (out' :: [T]) (topElems :: [T]).
(HasCallStack, Each '[SingI] topElems) =>
Instr inp' out'
-> Rec Notes topElems -> NonEmpty VarAnn -> ExpandedInstr
handleInstrAnnotateWithVarNotes Instr inp out
Instr inp (topElems ++ s)
i0 Rec Notes topElems
n0 NonEmpty VarAnn
n]
    InstrWithVarNotes NonEmpty VarAnn
_ Instr inp out
_ -> UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp out
i
    InstrWithVarAnns VarAnns
_ Instr inp out
i0 -> UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts (Instr inp out -> [ExpandedOp]) -> Instr inp out -> [ExpandedOp]
forall a b. (a -> b) -> a -> b
$ 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
    Instr inp out
_ -> [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]
  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
    handleInstrAnnotateWithVarNotes
      :: forall inp' out' topElems
       . (HasCallStack, Each '[SingI] topElems)
      => Instr inp' out'
      -> Rec Notes topElems
      -> NonEmpty U.VarAnn
      -> U.ExpandedInstr
    handleInstrAnnotateWithVarNotes :: Instr inp' out'
-> Rec Notes topElems -> NonEmpty VarAnn -> ExpandedInstr
handleInstrAnnotateWithVarNotes Instr inp' out'
instr Rec Notes topElems
notes NonEmpty VarAnn
varAnns =
      HasCallStack => ExpandedInstr -> NonEmpty VarAnn -> ExpandedInstr
ExpandedInstr -> NonEmpty VarAnn -> ExpandedInstr
addVarNotes (ExpandedInstr -> Rec Notes topElems -> ExpandedInstr
forall (topElems :: [T]).
(Each '[SingI] topElems, HasCallStack) =>
ExpandedInstr -> Rec Notes topElems -> ExpandedInstr
addInstrNote (Instr inp' out' -> ExpandedInstr
forall (inp :: [T]) (out :: [T]). Instr inp out -> ExpandedInstr
handleInstr Instr inp' out'
instr) Rec Notes topElems
notes) NonEmpty VarAnn
varAnns

    handleInstrAnnotate
      :: forall inp' out' topElems.
         (HasCallStack, Each '[SingI] topElems)
      => Instr inp' out' -> Rec Notes topElems -> U.ExpandedInstr
    handleInstrAnnotate :: Instr inp' out' -> Rec Notes topElems -> ExpandedInstr
handleInstrAnnotate Instr inp' out'
ins' Rec Notes topElems
notes =
      ExpandedInstr -> Rec Notes topElems -> ExpandedInstr
forall (topElems :: [T]).
(Each '[SingI] topElems, HasCallStack) =>
ExpandedInstr -> Rec Notes topElems -> ExpandedInstr
addInstrNote (Instr inp' out' -> ExpandedInstr
forall (inp :: [T]) (out :: [T]). Instr inp out -> ExpandedInstr
handleInstr Instr inp' out'
ins') Rec Notes topElems
notes

    addInstrNote
      :: forall topElems. (Each '[SingI] topElems, HasCallStack)
      => U.ExpandedInstr -> Rec Notes topElems -> U.ExpandedInstr
    addInstrNote :: ExpandedInstr -> Rec Notes topElems -> ExpandedInstr
addInstrNote ExpandedInstr
instr Rec Notes topElems
notes =
      case (ExpandedInstr
instr, Rec Notes topElems
notes) of
        (U.PUSH VarAnn
va Ty
_ Value
v, Notes r
notes' :& Rec Notes rs
_) -> VarAnn -> Ty -> Value -> ExpandedInstr
forall op. VarAnn -> Ty -> Value' op -> InstrAbstract op
U.PUSH VarAnn
va (Notes r -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes r
notes') Value
v
        (U.SOME TypeAnn
_ VarAnn
va, NTOption TypeAnn
ta Notes t
_ :& Rec Notes rs
_) -> TypeAnn -> VarAnn -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> InstrAbstract op
U.SOME TypeAnn
ta VarAnn
va
        (U.NONE TypeAnn
_ VarAnn
va Ty
_, (NTOption TypeAnn
ta Notes t
nt :: Notes t) :& Rec Notes rs
_) ->
          case SingI r => Sing r
forall k (a :: k). SingI a => Sing a
sing @t of
            STOption t -> TypeAnn -> VarAnn -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
U.NONE TypeAnn
ta VarAnn
va (Sing t -> (SingI t => Ty) -> Ty
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing t
Sing n
t ((SingI t => Ty) -> Ty) -> (SingI t => Ty) -> Ty
forall a b. (a -> b) -> a -> b
$ Notes t -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes t
nt)
        (U.UNIT TypeAnn
_ VarAnn
va, NTUnit TypeAnn
ta :& Rec Notes rs
_) -> TypeAnn -> VarAnn -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> InstrAbstract op
U.UNIT TypeAnn
ta VarAnn
va
        (U.PAIRN VarAnn
va Word
n, Rec Notes topElems
_) -> VarAnn -> Word -> ExpandedInstr
forall op. VarAnn -> Word -> InstrAbstract op
U.PAIRN VarAnn
va Word
n
        (U.LEFT TypeAnn
ta VarAnn
va RootAnn
fa1 RootAnn
fa2 Ty
_, (NTOr TypeAnn
_ RootAnn
_ RootAnn
_ Notes p
_ Notes q
n2 :: Notes t) :& Rec Notes rs
_) ->
          case SingI r => Sing r
forall k (a :: k). SingI a => Sing a
sing @t of
            STOr _ rt ->
              TypeAnn -> VarAnn -> RootAnn -> RootAnn -> Ty -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> RootAnn -> RootAnn -> Ty -> InstrAbstract op
U.LEFT TypeAnn
ta VarAnn
va RootAnn
fa1 RootAnn
fa2 (Sing q -> (SingI q => Ty) -> Ty
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing q
Sing n
rt ((SingI q => Ty) -> Ty) -> (SingI q => Ty) -> Ty
forall a b. (a -> b) -> a -> b
$ Notes q -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes q
n2)
        (U.RIGHT TypeAnn
ta VarAnn
va RootAnn
fa1 RootAnn
fa2 Ty
_, (NTOr TypeAnn
_ RootAnn
_ RootAnn
_ Notes p
n1 Notes q
_ :: Notes t) :& Rec Notes rs
_) ->
          case SingI r => Sing r
forall k (a :: k). SingI a => Sing a
sing @t of
            STOr lt _ ->
              TypeAnn -> VarAnn -> RootAnn -> RootAnn -> Ty -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> RootAnn -> RootAnn -> Ty -> InstrAbstract op
U.RIGHT TypeAnn
ta VarAnn
va RootAnn
fa1 RootAnn
fa2 (Sing p -> (SingI p => Ty) -> Ty
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing p
Sing n
lt ((SingI p => Ty) -> Ty) -> (SingI p => Ty) -> Ty
forall a b. (a -> b) -> a -> b
$ Notes p -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes p
n1)
        (U.NIL TypeAnn
_ VarAnn
va Ty
_, (NTList TypeAnn
ta Notes t
n :: Notes t) :& Rec Notes rs
_) ->
          case SingI r => Sing r
forall k (a :: k). SingI a => Sing a
sing @t of
            STList l -> TypeAnn -> VarAnn -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
U.NIL TypeAnn
ta VarAnn
va (Sing t -> (SingI t => Ty) -> Ty
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing t
Sing n
l ((SingI t => Ty) -> Ty) -> (SingI t => Ty) -> Ty
forall a b. (a -> b) -> a -> b
$ Notes t -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes t
n)
        (U.EMPTY_SET TypeAnn
_ VarAnn
va Ty
_, (NTSet TypeAnn
ta1 Notes t
n :: Notes t) :& Rec Notes rs
_) ->
          case SingI r => Sing r
forall k (a :: k). SingI a => Sing a
sing @t of
            STSet s -> TypeAnn -> VarAnn -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
U.EMPTY_SET TypeAnn
ta1 VarAnn
va (Sing t -> (SingI t => Ty) -> Ty
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing t
Sing n
s ((SingI t => Ty) -> Ty) -> (SingI t => Ty) -> Ty
forall a b. (a -> b) -> a -> b
$ Notes t -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes t
n)
        (U.EMPTY_MAP TypeAnn
_ VarAnn
va Ty
_ Ty
_, (NTMap TypeAnn
ta1 Notes k
k Notes v
n :: Notes t) :& Rec Notes rs
_) ->
          case SingI r => Sing r
forall k (a :: k). SingI a => Sing a
sing @t of
            STMap kt vt -> TypeAnn -> VarAnn -> Ty -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract op
U.EMPTY_MAP TypeAnn
ta1 VarAnn
va (Sing k -> (SingI k => Ty) -> Ty
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing k
Sing n
kt ((SingI k => Ty) -> Ty) -> (SingI k => Ty) -> Ty
forall a b. (a -> b) -> a -> b
$ Notes k -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes k
k) (Sing v -> (SingI v => Ty) -> Ty
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing v
Sing n
vt ((SingI v => Ty) -> Ty) -> (SingI v => Ty) -> Ty
forall a b. (a -> b) -> a -> b
$ Notes v -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes v
n)
        (U.EMPTY_BIG_MAP TypeAnn
_ VarAnn
va Ty
_ Ty
_, (NTBigMap TypeAnn
ta1 Notes k
k Notes v
n :: Notes t) :& Rec Notes rs
_) ->
          case SingI r => Sing r
forall k (a :: k). SingI a => Sing a
sing @t of
            STBigMap kt vt -> TypeAnn -> VarAnn -> Ty -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract op
U.EMPTY_BIG_MAP TypeAnn
ta1 VarAnn
va (Sing k -> (SingI k => Ty) -> Ty
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing k
Sing n
kt ((SingI k => Ty) -> Ty) -> (SingI k => Ty) -> Ty
forall a b. (a -> b) -> a -> b
$ Notes k -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes k
k) (Sing v -> (SingI v => Ty) -> Ty
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing v
Sing n
vt ((SingI v => Ty) -> Ty) -> (SingI v => Ty) -> Ty
forall a b. (a -> b) -> a -> b
$ Notes v -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes v
n)
        (U.LAMBDA VarAnn
va Ty
_ Ty
_ [ExpandedOp]
ops, (NTLambda TypeAnn
_ Notes p
n1 Notes q
n2 :: Notes t) :& Rec Notes rs
_) ->
          case SingI r => Sing r
forall k (a :: k). SingI a => Sing a
sing @t of
            STLambda v b -> VarAnn -> Ty -> Ty -> [ExpandedOp] -> ExpandedInstr
forall op. VarAnn -> Ty -> Ty -> [op] -> InstrAbstract op
U.LAMBDA VarAnn
va (Sing p -> (SingI p => Ty) -> Ty
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing p
Sing n
v ((SingI p => Ty) -> Ty) -> (SingI p => Ty) -> Ty
forall a b. (a -> b) -> a -> b
$ Notes p -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes p
n1) (Sing q -> (SingI q => Ty) -> Ty
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing q
Sing n
b ((SingI q => Ty) -> Ty) -> (SingI q => Ty) -> Ty
forall a b. (a -> b) -> a -> b
$ Notes q -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes q
n2) [ExpandedOp]
ops
        (U.CAST VarAnn
va Ty
_, Notes r
n :& Rec Notes rs
_) -> VarAnn -> Ty -> ExpandedInstr
forall op. VarAnn -> Ty -> InstrAbstract op
U.CAST VarAnn
va (Notes r -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes r
n)
        (U.UNPACK TypeAnn
_ VarAnn
va Ty
_, (NTOption TypeAnn
ta Notes t
nt :: Notes t) :& Rec Notes rs
_) ->
          case SingI r => Sing r
forall k (a :: k). SingI a => Sing a
sing @t of
            STOption op -> TypeAnn -> VarAnn -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
U.UNPACK TypeAnn
ta VarAnn
va (Sing t -> (SingI t => Ty) -> Ty
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing t
Sing n
op ((SingI t => Ty) -> Ty) -> (SingI t => Ty) -> Ty
forall a b. (a -> b) -> a -> b
$ Notes t -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes t
nt)
        (U.CONTRACT VarAnn
va RootAnn
fa Ty
_, (NTOption TypeAnn
_ (NTContract TypeAnn
_ Notes t
nt :: Notes t) :: Notes t2) :& Rec Notes rs
_) ->
          case SingI r => Sing r
forall k (a :: k). SingI a => Sing a
sing @t2 of
            STOption (STContract c) -> VarAnn -> RootAnn -> Ty -> ExpandedInstr
forall op. VarAnn -> RootAnn -> Ty -> InstrAbstract op
U.CONTRACT VarAnn
va RootAnn
fa (Sing t -> (SingI t => Ty) -> Ty
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing t
Sing n
c ((SingI t => Ty) -> Ty) -> (SingI t => Ty) -> Ty
forall a b. (a -> b) -> a -> b
$ Notes t -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes t
nt)
        (U.CONTRACT VarAnn
va RootAnn
fa Ty
t, NTOption TypeAnn
_ Notes t
_ :& Rec Notes rs
_) -> VarAnn -> RootAnn -> Ty -> ExpandedInstr
forall op. VarAnn -> RootAnn -> Ty -> InstrAbstract op
U.CONTRACT VarAnn
va RootAnn
fa Ty
t
        (U.CAR {}, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.CDR {}, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.PAIR {}, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.UNPAIR {}, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.APPLY {}, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.CHAIN_ID {}, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.EXT ExtInstrAbstract ExpandedOp
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (ExpandedInstr
U.DROP, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.DROPN Word
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.DUP VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.DUPN VarAnn
_ Word
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (ExpandedInstr
U.SWAP, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.DIG {}, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.DUG {}, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.IF_NONE [ExpandedOp]
_ [ExpandedOp]
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.CONS VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.IF_LEFT [ExpandedOp]
_ [ExpandedOp]
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.IF_CONS [ExpandedOp]
_ [ExpandedOp]
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.SIZE VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.MAP VarAnn
_ [ExpandedOp]
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.ITER [ExpandedOp]
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.MEM VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.GET VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.GETN VarAnn
_ Word
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.UPDATE VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.UPDATEN VarAnn
_ Word
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.GET_AND_UPDATE VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.IF [ExpandedOp]
_ [ExpandedOp]
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.LOOP [ExpandedOp]
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.LOOP_LEFT [ExpandedOp]
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.EXEC VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.DIP [ExpandedOp]
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.DIPN {}, Rec Notes topElems
_) -> ExpandedInstr
instr
        (ExpandedInstr
U.FAILWITH, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.RENAME VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.PACK VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.CONCAT VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.SLICE VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.ISNAT VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.ADD VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.SUB VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.MUL VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.EDIV VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.ABS VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.NEG VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.LSL VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.LSR VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.OR VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.AND VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.XOR VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.NOT VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.COMPARE VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.EQ VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.NEQ VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.LT VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.GT VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.LE VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.GE VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.INT VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.SELF VarAnn
_ RootAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.TRANSFER_TOKENS VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.SET_DELEGATE VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.CREATE_CONTRACT {}, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.IMPLICIT_ACCOUNT VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.NOW VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.LEVEL VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.AMOUNT VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.BALANCE VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.VOTING_POWER VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.TOTAL_VOTING_POWER VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.CHECK_SIGNATURE VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.SHA256 VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.SHA512 VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.BLAKE2B VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.SHA3 VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.KECCAK VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.HASH_KEY VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.SOURCE VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.SENDER VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.ADDRESS VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.SELF_ADDRESS VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (ExpandedInstr
U.NEVER, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.TICKET VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.READ_TICKET VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.SPLIT_TICKET VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (U.JOIN_TICKETS VarAnn
_, Rec Notes topElems
_) -> ExpandedInstr
instr
        (ExpandedInstr, Rec Notes topElems)
_ -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error (Text -> ExpandedInstr) -> Text -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
          [ Builder
"addInstrNote: Unexpected instruction/annotation combination"
          , Builder
"Instruction:"
          , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ ExpandedInstr -> Builder
forall p. Buildable p => p -> Builder
build ExpandedInstr
instr
          , Builder
"Annotations:"
          , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
blockListF ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Rec Notes topElems -> [Builder]
forall (ts :: [T]). Rec Notes ts -> [Builder]
buildNotes Rec Notes topElems
notes
          ]
          where
            buildNotes :: Rec Notes ts -> [Builder]
            buildNotes :: Rec Notes ts -> [Builder]
buildNotes = \case
              Rec Notes ts
RNil -> []
              Notes r
n :& Rec Notes rs
ns -> Notes r -> Builder
forall p. Buildable p => p -> Builder
build Notes r
n Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: Rec Notes rs -> [Builder]
forall (ts :: [T]). Rec Notes ts -> [Builder]
buildNotes Rec Notes rs
ns

    handleInstrVarNotes :: forall inp' out' . HasCallStack
      => Instr inp' out' -> NonEmpty U.VarAnn -> U.ExpandedInstr
    handleInstrVarNotes :: Instr inp' out' -> NonEmpty VarAnn -> ExpandedInstr
handleInstrVarNotes Instr inp' out'
ins' 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

    addVarNotes
      :: HasCallStack
      => U.ExpandedInstr -> NonEmpty U.VarAnn -> U.ExpandedInstr
    addVarNotes :: ExpandedInstr -> NonEmpty VarAnn -> ExpandedInstr
addVarNotes ExpandedInstr
ins NonEmpty VarAnn
varNotes = case NonEmpty VarAnn
varNotes of
      VarAnn
va1 :| [VarAnn
va2] -> case ExpandedInstr
ins of
        U.CREATE_CONTRACT VarAnn
_ VarAnn
_ Contract
c -> VarAnn -> VarAnn -> Contract -> ExpandedInstr
forall op. VarAnn -> VarAnn -> Contract' op -> InstrAbstract op
U.CREATE_CONTRACT VarAnn
va1 VarAnn
va2 Contract
c
        ExpandedInstr
_ -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error (Text -> ExpandedInstr) -> Text -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$
          Text
"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
      VarAnn
va :| [] -> case ExpandedInstr
ins of
        U.DUP VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.DUP VarAnn
va
        U.DUPN VarAnn
_ Word
s -> VarAnn -> Word -> ExpandedInstr
forall op. VarAnn -> Word -> InstrAbstract op
U.DUPN VarAnn
va Word
s
        U.PUSH VarAnn
_ Ty
t Value
v -> VarAnn -> Ty -> Value -> ExpandedInstr
forall op. VarAnn -> Ty -> Value' op -> InstrAbstract op
U.PUSH VarAnn
va Ty
t Value
v
        U.SOME TypeAnn
ta VarAnn
_ -> TypeAnn -> VarAnn -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> InstrAbstract op
U.SOME TypeAnn
ta VarAnn
va
        U.NONE TypeAnn
ta VarAnn
_ Ty
t -> TypeAnn -> VarAnn -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
U.NONE TypeAnn
ta VarAnn
va Ty
t
        U.UNIT TypeAnn
ta VarAnn
_ -> TypeAnn -> VarAnn -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> InstrAbstract op
U.UNIT TypeAnn
ta VarAnn
va
        U.PAIR TypeAnn
ta VarAnn
_ RootAnn
fa1 RootAnn
fa2 -> TypeAnn -> VarAnn -> RootAnn -> RootAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> RootAnn -> RootAnn -> InstrAbstract op
U.PAIR TypeAnn
ta VarAnn
va RootAnn
fa1 RootAnn
fa2
        U.PAIRN VarAnn
_ Word
n -> VarAnn -> Word -> ExpandedInstr
forall op. VarAnn -> Word -> InstrAbstract op
U.PAIRN VarAnn
va Word
n
        U.LEFT TypeAnn
ta VarAnn
_ RootAnn
fa1 RootAnn
fa2 Ty
t -> TypeAnn -> VarAnn -> RootAnn -> RootAnn -> Ty -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> RootAnn -> RootAnn -> Ty -> InstrAbstract op
U.LEFT TypeAnn
ta VarAnn
va RootAnn
fa1 RootAnn
fa2 Ty
t
        U.RIGHT TypeAnn
ta VarAnn
_ RootAnn
fa1 RootAnn
fa2 Ty
t -> TypeAnn -> VarAnn -> RootAnn -> RootAnn -> Ty -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> RootAnn -> RootAnn -> Ty -> InstrAbstract op
U.RIGHT TypeAnn
ta VarAnn
va RootAnn
fa1 RootAnn
fa2 Ty
t
        U.NIL TypeAnn
ta VarAnn
_ Ty
t -> TypeAnn -> VarAnn -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
U.NIL TypeAnn
ta VarAnn
va Ty
t
        U.CONS VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CONS VarAnn
va
        U.SIZE VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SIZE VarAnn
va
        U.EMPTY_SET TypeAnn
ta VarAnn
_ Ty
c -> TypeAnn -> VarAnn -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
U.EMPTY_SET TypeAnn
ta VarAnn
va Ty
c
        U.EMPTY_MAP TypeAnn
ta VarAnn
_ Ty
c Ty
t -> TypeAnn -> VarAnn -> Ty -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract op
U.EMPTY_MAP TypeAnn
ta VarAnn
va Ty
c Ty
t
        U.EMPTY_BIG_MAP TypeAnn
ta VarAnn
_ Ty
c Ty
t -> TypeAnn -> VarAnn -> Ty -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> Ty -> InstrAbstract op
U.EMPTY_BIG_MAP TypeAnn
ta VarAnn
va Ty
c Ty
t
        U.MAP VarAnn
_ [ExpandedOp]
ops -> VarAnn -> [ExpandedOp] -> ExpandedInstr
forall op. VarAnn -> [op] -> InstrAbstract op
U.MAP VarAnn
va [ExpandedOp]
ops
        U.MEM VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.MEM VarAnn
va
        U.GET VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.GET VarAnn
va
        U.GETN VarAnn
_ Word
n -> VarAnn -> Word -> ExpandedInstr
forall op. VarAnn -> Word -> InstrAbstract op
U.GETN VarAnn
va Word
n
        U.UPDATE VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.UPDATE VarAnn
va
        U.UPDATEN VarAnn
_ Word
n -> VarAnn -> Word -> ExpandedInstr
forall op. VarAnn -> Word -> InstrAbstract op
U.UPDATEN VarAnn
va Word
n
        U.GET_AND_UPDATE VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.GET_AND_UPDATE VarAnn
va
        U.LAMBDA VarAnn
_ Ty
t1 Ty
t2 [ExpandedOp]
ops -> VarAnn -> Ty -> Ty -> [ExpandedOp] -> ExpandedInstr
forall op. VarAnn -> Ty -> Ty -> [op] -> InstrAbstract op
U.LAMBDA VarAnn
va Ty
t1 Ty
t2 [ExpandedOp]
ops
        U.EXEC VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.EXEC VarAnn
va
        U.APPLY VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.APPLY VarAnn
va
        U.CAST VarAnn
_ Ty
t -> VarAnn -> Ty -> ExpandedInstr
forall op. VarAnn -> Ty -> InstrAbstract op
U.CAST VarAnn
va Ty
t
        U.RENAME VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.RENAME VarAnn
va
        U.PACK VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.PACK VarAnn
va
        U.UNPACK TypeAnn
ta VarAnn
_ Ty
t -> TypeAnn -> VarAnn -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
U.UNPACK TypeAnn
ta VarAnn
va Ty
t
        U.CONCAT VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CONCAT VarAnn
va
        U.SLICE VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SLICE VarAnn
va
        U.ISNAT VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.ISNAT VarAnn
va
        U.ADD VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.ADD VarAnn
va
        U.SUB VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SUB VarAnn
va
        U.MUL VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.MUL VarAnn
va
        U.EDIV VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.EDIV VarAnn
va
        U.ABS VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.ABS VarAnn
va
        U.NEG VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.NEG VarAnn
va
        U.LSL VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.LSL VarAnn
va
        U.LSR VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.LSR VarAnn
va
        U.OR VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.OR VarAnn
va
        U.AND VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.AND VarAnn
va
        U.XOR VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.XOR VarAnn
va
        U.NOT VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.NOT VarAnn
va
        U.COMPARE VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.COMPARE VarAnn
va
        U.EQ VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.EQ VarAnn
va
        U.NEQ VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.NEQ VarAnn
va
        U.LT VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.LT VarAnn
va
        U.GT VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.GT VarAnn
va
        U.LE VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.LE VarAnn
va
        U.GE VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.GE VarAnn
va
        U.INT VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.INT VarAnn
va
        U.SELF VarAnn
_ RootAnn
fa -> VarAnn -> RootAnn -> ExpandedInstr
forall op. VarAnn -> RootAnn -> InstrAbstract op
U.SELF VarAnn
va RootAnn
fa
        U.CONTRACT VarAnn
_ RootAnn
fa Ty
t -> VarAnn -> RootAnn -> Ty -> ExpandedInstr
forall op. VarAnn -> RootAnn -> Ty -> InstrAbstract op
U.CONTRACT VarAnn
va RootAnn
fa Ty
t
        U.TRANSFER_TOKENS VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.TRANSFER_TOKENS VarAnn
va
        U.SET_DELEGATE VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SET_DELEGATE VarAnn
va
        U.CREATE_CONTRACT VarAnn
_ VarAnn
_ 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
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.IMPLICIT_ACCOUNT VarAnn
va
        U.NOW VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.NOW VarAnn
va
        U.AMOUNT VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.AMOUNT VarAnn
va
        U.BALANCE VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.BALANCE VarAnn
va
        U.VOTING_POWER VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.VOTING_POWER VarAnn
va
        U.TOTAL_VOTING_POWER VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.TOTAL_VOTING_POWER VarAnn
va
        U.CHECK_SIGNATURE VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CHECK_SIGNATURE VarAnn
va
        U.SHA256 VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SHA256 VarAnn
va
        U.SHA512 VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SHA512 VarAnn
va
        U.BLAKE2B VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.BLAKE2B VarAnn
va
        U.SHA3 VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SHA3 VarAnn
va
        U.KECCAK VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.KECCAK VarAnn
va
        U.HASH_KEY VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.HASH_KEY VarAnn
va
        U.SOURCE VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SOURCE VarAnn
va
        U.SENDER VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SENDER VarAnn
va
        U.ADDRESS VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.ADDRESS VarAnn
va
        U.CHAIN_ID VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CHAIN_ID VarAnn
va
        U.LEVEL VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.LEVEL VarAnn
va
        U.SELF_ADDRESS VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SELF_ADDRESS VarAnn
va
        U.TICKET VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.TICKET VarAnn
va
        U.READ_TICKET VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.READ_TICKET VarAnn
va
        U.SPLIT_TICKET VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SPLIT_TICKET VarAnn
va
        U.JOIN_TICKETS VarAnn
_ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.JOIN_TICKETS VarAnn
va
        ExpandedInstr
_ -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error (Text -> ExpandedInstr) -> Text -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$
          Text
"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 -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> VarAnn -> Text
forall b a. (Show a, IsString b) => a -> b
show VarAnn
va
      NonEmpty VarAnn
_ -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error (Text -> ExpandedInstr) -> Text -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$
        Text
"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 InstrCallStack
_ Instr inp out
_) -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error Text
"impossible"
      InstrWithNotes {} -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error Text
"impossible"
      (InstrWithVarNotes NonEmpty VarAnn
_ Instr inp out
_) -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error Text
"impossible"
      (InstrWithVarAnns VarAnns
_ Instr inp out
_) -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error Text
"impossible"
      (FrameInstr Proxy s
_ Instr a b
_) -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error Text
"impossible"
      (Seq Instr inp b
_ Instr b out
_) -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error Text
"impossible"
      Instr inp out
Nop -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error Text
"impossible"
      (Ext ExtInstr inp
_) -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error Text
"impossible"
      (Nested Instr inp out
_) -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error Text
"impossible"
      DocGroup{} -> Text -> ExpandedInstr
forall a. HasCallStack => Text -> a
error Text
"impossible"
      Fn Text
t StackFn
sfn Instr inp out
i -> ExtInstrAbstract ExpandedOp -> ExpandedInstr
forall op. ExtInstrAbstract op -> InstrAbstract op
U.EXT (ExtInstrAbstract ExpandedOp -> ExpandedInstr)
-> ([ExpandedOp] -> ExtInstrAbstract ExpandedOp)
-> [ExpandedOp]
-> ExpandedInstr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StackFn -> [ExpandedOp] -> ExtInstrAbstract ExpandedOp
forall op. Text -> StackFn -> [op] -> ExtInstrAbstract op
U.FN Text
t StackFn
sfn ([ExpandedOp] -> ExpandedInstr) -> [ExpandedOp] -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ UntypingOptions -> Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr inp out
i
      Instr inp out
DROP -> ExpandedInstr
forall op. InstrAbstract op
U.DROP
      (DROPN PeanoNatural 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
$ PeanoNatural n -> Natural
forall (n :: Nat). PeanoNatural n -> Natural
fromPeanoNatural PeanoNatural n
s)
      Instr inp out
DUP -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.DUP VarAnn
forall k (a :: k). Annotation a
U.noAnn
      (DUPN PeanoNatural n
s) -> VarAnn -> Word -> ExpandedInstr
forall op. VarAnn -> Word -> InstrAbstract op
U.DUPN VarAnn
forall k (a :: k). Annotation a
U.noAnn (Natural -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word) -> Natural -> Word
forall a b. (a -> b) -> a -> b
$ PeanoNatural n -> Natural
forall (n :: Nat). PeanoNatural n -> Natural
fromPeanoNatural PeanoNatural n
s)
      Instr inp out
SWAP -> ExpandedInstr
forall op. InstrAbstract op
U.SWAP
      (DIG PeanoNatural 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
$ PeanoNatural n -> Natural
forall (n :: Nat). PeanoNatural n -> Natural
fromPeanoNatural PeanoNatural n
s)
      (DUG PeanoNatural 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
$ PeanoNatural n -> Natural
forall (n :: Nat). PeanoNatural n -> Natural
fromPeanoNatural PeanoNatural n
s)
      i :: Instr inp out
i@(PUSH Value' Instr t
val) | _ :: Instr inp1 (t ': s) <- Instr inp out
i ->
        let value :: Value
value = UntypingOptions -> Value' Instr t -> Value
forall (t :: T).
(SingI t, HasNoOp t) =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Value' Instr t
val
        in VarAnn -> Ty -> Value -> ExpandedInstr
forall op. VarAnn -> Ty -> Value' op -> InstrAbstract op
U.PUSH VarAnn
forall k (a :: k). Annotation a
U.noAnn (SingI t => Ty
forall (t :: T). SingI t => Ty
untypeDemoteT @t) Value
value
      i :: Instr inp out
i@Instr inp out
NONE | _ :: Instr inp1 ('TOption a ': inp1) <- Instr inp out
i ->
        TypeAnn -> VarAnn -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
U.NONE TypeAnn
forall k (a :: k). Annotation a
U.noAnn VarAnn
forall k (a :: k). Annotation a
U.noAnn (SingI a => Ty
forall (t :: T). SingI t => Ty
untypeDemoteT @a)
      Instr inp out
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
      Instr inp out
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 Instr s out
i1 Instr (a : s) out
i2) -> [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
U.IF_NONE (UntypingOptions -> Instr s out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr s out
i1) (UntypingOptions -> Instr (a : s) out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr (a : s) out
i2)

      -- `AnnUNPAIR` accepts special var anns, so it carries them inside its constructor,
      -- so we can use them here to re-construct an untyped `U.UNPAIR`.
      -- `AnnPAIR`, on the other hand, doesn't accept special var anns, so the var anns
      -- are carried in the `InstrWithVarNotes` meta-instruction instead.
      --
      -- See: Note [Annotations - Exceptional scenarios] in `Michelson.Typed.Instr`
      --
      -- TODO [#580]
      AnnPAIR TypeAnn
tn RootAnn
fn1 RootAnn
fn2 -> TypeAnn -> VarAnn -> RootAnn -> RootAnn -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> RootAnn -> RootAnn -> InstrAbstract op
U.PAIR TypeAnn
tn VarAnn
forall k (a :: k). Annotation a
U.noAnn RootAnn
fn1 RootAnn
fn2
      AnnUNPAIR VarAnn
vn1 VarAnn
vn2 RootAnn
fn1 RootAnn
fn2 -> VarAnn -> VarAnn -> RootAnn -> RootAnn -> ExpandedInstr
forall op.
VarAnn -> VarAnn -> RootAnn -> RootAnn -> InstrAbstract op
U.UNPAIR VarAnn
vn1 VarAnn
vn2 RootAnn
fn1 RootAnn
fn2

      PAIRN PeanoNatural n
n -> VarAnn -> Word -> ExpandedInstr
forall op. VarAnn -> Word -> InstrAbstract op
U.PAIRN VarAnn
forall k (a :: k). Annotation a
U.noAnn (Natural -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word) -> Natural -> Word
forall a b. (a -> b) -> a -> b
$ PeanoNatural n -> Natural
forall (n :: Nat). PeanoNatural n -> Natural
fromPeanoNatural PeanoNatural n
n)
      UNPAIRN PeanoNatural n
n -> Word -> ExpandedInstr
forall op. Word -> InstrAbstract op
U.UNPAIRN (Natural -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word) -> Natural -> Word
forall a b. (a -> b) -> a -> b
$ PeanoNatural n -> Natural
forall (n :: Nat). PeanoNatural n -> Natural
fromPeanoNatural PeanoNatural n
n)
      (AnnCAR VarAnn
vn RootAnn
fn) -> VarAnn -> RootAnn -> ExpandedInstr
forall op. VarAnn -> RootAnn -> InstrAbstract op
U.CAR VarAnn
vn RootAnn
fn
      (AnnCDR VarAnn
vn RootAnn
fn) -> VarAnn -> RootAnn -> ExpandedInstr
forall op. VarAnn -> RootAnn -> InstrAbstract op
U.CDR VarAnn
vn RootAnn
fn
      i :: Instr inp out
i@(AnnLEFT TypeAnn
tn RootAnn
fn1 RootAnn
fn2) | _ :: Instr (a ': s) ('TOr a b ': s) <- Instr inp out
i ->
        TypeAnn -> VarAnn -> RootAnn -> RootAnn -> Ty -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> RootAnn -> RootAnn -> Ty -> InstrAbstract op
U.LEFT TypeAnn
tn VarAnn
forall k (a :: k). Annotation a
U.noAnn RootAnn
fn1 RootAnn
fn2 (SingI b => Ty
forall (t :: T). SingI t => Ty
untypeDemoteT @b)
      i :: Instr inp out
i@(AnnRIGHT TypeAnn
tn RootAnn
fn1 RootAnn
fn2) | _ :: Instr (b ': s) ('TOr a b ': s) <- Instr inp out
i ->
        TypeAnn -> VarAnn -> RootAnn -> RootAnn -> Ty -> ExpandedInstr
forall op.
TypeAnn -> VarAnn -> RootAnn -> RootAnn -> Ty -> InstrAbstract op
U.RIGHT TypeAnn
tn VarAnn
forall k (a :: k). Annotation a
U.noAnn RootAnn
fn1 RootAnn
fn2 (SingI a => Ty
forall (t :: T). SingI t => Ty
untypeDemoteT @a)
      (IF_LEFT Instr (a : s) out
i1 Instr (b : s) out
i2) -> [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
U.IF_LEFT (UntypingOptions -> Instr (a : s) out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr (a : s) out
i1) (UntypingOptions -> Instr (b : s) out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts 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 -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
U.NIL TypeAnn
forall k (a :: k). Annotation a
U.noAnn VarAnn
forall k (a :: k). Annotation a
U.noAnn (SingI p => Ty
forall (t :: T). SingI t => Ty
untypeDemoteT @p)
      Instr inp out
CONS -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CONS VarAnn
forall k (a :: k). Annotation a
U.noAnn
      (IF_CONS Instr (a : 'TList a : s) out
i1 Instr s out
i2) -> [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
U.IF_CONS (UntypingOptions -> Instr (a : 'TList a : s) out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr (a : 'TList a : s) out
i1) (UntypingOptions -> Instr s out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr s out
i2)
      Instr inp out
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 -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> 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 -> Ty
U.Ty (Ty -> T
U.unwrapT (Ty -> T) -> Ty -> T
forall a b. (a -> b) -> a -> b
$ SingI e => Ty
forall (t :: T). SingI t => Ty
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 -> Ty -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> Ty -> 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 -> Ty
U.Ty (Ty -> T
U.unwrapT (Ty -> T) -> Ty -> T
forall a b. (a -> b) -> a -> b
$ SingI a => Ty
forall (t :: T). SingI t => Ty
untypeDemoteT @a) TypeAnn
forall k (a :: k). Annotation a
U.noAnn)
          (SingI b => Ty
forall (t :: T). SingI t => Ty
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 -> Ty -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> Ty -> 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 -> Ty
U.Ty (Ty -> T
U.unwrapT (Ty -> T) -> Ty -> T
forall a b. (a -> b) -> a -> b
$ SingI a => Ty
forall (t :: T). SingI t => Ty
untypeDemoteT @a) TypeAnn
forall k (a :: k). Annotation a
U.noAnn)
          (SingI b => Ty
forall (t :: T). SingI t => Ty
untypeDemoteT @b)
      (MAP 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
$ UntypingOptions -> Instr (MapOpInp c : s) (b : s) -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr (MapOpInp c : s) (b : s)
op
      (ITER 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
$ UntypingOptions -> Instr (IterOpEl c : out) out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr (IterOpEl c : out) out
op
      Instr inp out
MEM -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.MEM VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
GET -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.GET VarAnn
forall k (a :: k). Annotation a
U.noAnn
      GETN PeanoNatural ix
n -> VarAnn -> Word -> ExpandedInstr
forall op. VarAnn -> Word -> InstrAbstract op
U.GETN VarAnn
forall k (a :: k). Annotation a
U.noAnn (Natural -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word) -> Natural -> Word
forall a b. (a -> b) -> a -> b
$ PeanoNatural ix -> Natural
forall (n :: Nat). PeanoNatural n -> Natural
fromPeanoNatural PeanoNatural ix
n)
      Instr inp out
UPDATE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.UPDATE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      UPDATEN PeanoNatural ix
n -> VarAnn -> Word -> ExpandedInstr
forall op. VarAnn -> Word -> InstrAbstract op
U.UPDATEN VarAnn
forall k (a :: k). Annotation a
U.noAnn (Natural -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word) -> Natural -> Word
forall a b. (a -> b) -> a -> b
$ PeanoNatural ix -> Natural
forall (n :: Nat). PeanoNatural n -> Natural
fromPeanoNatural PeanoNatural ix
n)
      Instr inp out
GET_AND_UPDATE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.GET_AND_UPDATE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      (IF Instr s out
op1 Instr s out
op2) -> [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
U.IF (UntypingOptions -> Instr s out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr s out
op1) (UntypingOptions -> Instr s out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr s out
op2)
      (LOOP Instr out ('TBool : out)
op) -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
U.LOOP (UntypingOptions -> Instr out ('TBool : out) -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr out ('TBool : out)
op)
      (LOOP_LEFT Instr (a : s) ('TOr a b : s)
op) -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
U.LOOP_LEFT (UntypingOptions -> Instr (a : s) ('TOr a b : s) -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts 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 -> Ty -> Ty -> [ExpandedOp] -> ExpandedInstr
forall op. VarAnn -> Ty -> Ty -> [op] -> InstrAbstract op
U.LAMBDA VarAnn
forall k (a :: k). Annotation a
U.noAnn (SingI i => Ty
forall (t :: T). SingI t => Ty
untypeDemoteT @i) (SingI o => Ty
forall (t :: T). SingI t => Ty
untypeDemoteT @o) (UntypingOptions -> Instr '[inp] '[out] -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts (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)
      Instr inp out
EXEC -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.EXEC VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
APPLY -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.APPLY VarAnn
forall k (a :: k). Annotation a
U.noAnn
      (DIP Instr a c
op) -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> InstrAbstract op
U.DIP (UntypingOptions -> Instr a c -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr a c
op)
      (DIPN PeanoNatural n
s 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
$ PeanoNatural n -> Natural
forall (n :: Nat). PeanoNatural n -> Natural
fromPeanoNatural PeanoNatural n
s) (UntypingOptions -> Instr s s' -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
UntypingOptions -> Instr inp out -> [ExpandedOp]
instrToOpsImpl UntypingOptions
opts Instr s s'
op)
      Instr inp out
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 -> Ty -> ExpandedInstr
forall op. VarAnn -> Ty -> InstrAbstract op
U.CAST VarAnn
forall k (a :: k). Annotation a
U.noAnn (SingI a => Ty
forall (t :: T). SingI t => Ty
untypeDemoteT @a)
      Instr inp out
RENAME -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.RENAME VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
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 -> Ty -> ExpandedInstr
forall op. TypeAnn -> VarAnn -> Ty -> InstrAbstract op
U.UNPACK TypeAnn
forall k (a :: k). Annotation a
U.noAnn VarAnn
forall k (a :: k). Annotation a
U.noAnn (SingI a => Ty
forall (t :: T). SingI t => Ty
untypeDemoteT @a)
      Instr inp out
CONCAT -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CONCAT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
CONCAT' -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CONCAT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
SLICE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SLICE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
ISNAT -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.ISNAT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
ADD -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.ADD VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
SUB -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SUB VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
MUL -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.MUL VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
EDIV -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.EDIV VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
ABS -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.ABS VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
NEG -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.NEG VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
LSL -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.LSL VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
LSR -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.LSR VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
OR -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.OR VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
AND -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.AND VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
XOR -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.XOR VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
NOT -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.NOT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
COMPARE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.COMPARE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
Instr.EQ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.EQ VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
NEQ -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.NEQ VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
Instr.LT -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.LT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
Instr.GT -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.GT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
LE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.LE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
GE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.GE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
INT -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.INT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      SELF SomeEntrypointCallT arg
sepc ->
        VarAnn -> RootAnn -> ExpandedInstr
forall op. VarAnn -> RootAnn -> InstrAbstract op
U.SELF VarAnn
forall k (a :: k). Annotation a
U.noAnn (EpName -> RootAnn
epNameToRefAnn (EpName -> RootAnn) -> EpName -> RootAnn
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 Notes p
nt EpName
epName)
        | _ :: Instr ('TAddress ': s) ('TOption ('TContract p) ': s) <- Instr inp out
i ->
            let fa :: RootAnn
fa = EpName -> RootAnn
epNameToRefAnn EpName
epName
            in VarAnn -> RootAnn -> Ty -> ExpandedInstr
forall op. VarAnn -> RootAnn -> Ty -> InstrAbstract op
U.CONTRACT VarAnn
forall k (a :: k). Annotation a
U.noAnn RootAnn
fa (Notes p -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes p
nt)
      Instr inp out
TRANSFER_TOKENS -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.TRANSFER_TOKENS VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
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 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). Contract param store -> Contract
convertContract Contract p g
contract)
      Instr inp out
IMPLICIT_ACCOUNT -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.IMPLICIT_ACCOUNT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
NOW -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.NOW VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
AMOUNT -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.AMOUNT VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
BALANCE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.BALANCE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
VOTING_POWER -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.VOTING_POWER VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
TOTAL_VOTING_POWER -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.TOTAL_VOTING_POWER VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
CHECK_SIGNATURE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CHECK_SIGNATURE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
SHA256 -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SHA256 VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
SHA512 -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SHA512 VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
BLAKE2B -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.BLAKE2B VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
SHA3 -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SHA3 VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
KECCAK -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.KECCAK VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
HASH_KEY -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.HASH_KEY VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
PAIRING_CHECK -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.PAIRING_CHECK VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
SOURCE -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SOURCE VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
SENDER -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SENDER VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
ADDRESS -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.ADDRESS VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
CHAIN_ID -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.CHAIN_ID VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
LEVEL -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.LEVEL VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
SELF_ADDRESS -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SELF_ADDRESS VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
NEVER -> ExpandedInstr
forall op. InstrAbstract op
U.NEVER
      Instr inp out
TICKET -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.TICKET VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
READ_TICKET -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.READ_TICKET VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
SPLIT_TICKET -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.SPLIT_TICKET VarAnn
forall k (a :: k). Annotation a
U.noAnn
      Instr inp out
JOIN_TICKETS -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.JOIN_TICKETS VarAnn
forall k (a :: k). Annotation a
U.noAnn

untypeStackRef :: StackRef s -> U.StackRef
untypeStackRef :: StackRef s -> StackRef
untypeStackRef (StackRef PeanoNatural idx
n) = Natural -> StackRef
U.StackRef (PeanoNatural idx -> Natural
forall (n :: Nat). PeanoNatural n -> Natural
fromPeanoNatural PeanoNatural idx
n)

untypePrintComment :: PrintComment s -> U.PrintComment
untypePrintComment :: PrintComment s -> PrintComment
untypePrintComment (PrintComment [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 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 Text
nm PrintComment s
pc 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 -> ExtInstrAbstract ExpandedOp
forall op. TestAssert op -> ExtInstrAbstract op
U.UTEST_ASSERT (TestAssert ExpandedOp -> ExtInstrAbstract ExpandedOp)
-> TestAssert ExpandedOp -> 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 CommentType
tp ->
    case CommentType
tp of
      FunctionStarts 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 -> ExtInstrAbstract ExpandedOp
forall op. Text -> ExtInstrAbstract op
U.UCOMMENT (Text -> ExtInstrAbstract ExpandedOp)
-> Text -> ExtInstrAbstract ExpandedOp
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" [user func starts]"
      FunctionEnds 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 -> ExtInstrAbstract ExpandedOp
forall op. Text -> ExtInstrAbstract op
U.UCOMMENT (Text -> ExtInstrAbstract ExpandedOp)
-> Text -> ExtInstrAbstract ExpandedOp
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" [user func ends]"
      StatementStarts 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 -> ExtInstrAbstract ExpandedOp
forall op. Text -> ExtInstrAbstract op
U.UCOMMENT (Text -> ExtInstrAbstract ExpandedOp)
-> Text -> ExtInstrAbstract ExpandedOp
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" [user stmt starts]"
      StatementEnds 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 -> ExtInstrAbstract ExpandedOp
forall op. Text -> ExtInstrAbstract op
U.UCOMMENT (Text -> ExtInstrAbstract ExpandedOp)
-> Text -> ExtInstrAbstract ExpandedOp
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" [user stmt ends]"
      JustComment 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
      StackTypeComment (Just [T]
stack) -> 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 -> ExtInstrAbstract ExpandedOp)
-> Text -> ExtInstrAbstract ExpandedOp
forall a b. (a -> b) -> a -> b
$ Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty ([T] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
listF [T]
stack)
      StackTypeComment Maybe [T]
Nothing -> 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 -> ExtInstrAbstract ExpandedOp)
-> Text -> ExtInstrAbstract ExpandedOp
forall a b. (a -> b) -> a -> b
$ Builder -> Text
forall b. FromBuilder b => Builder -> b
fmt Builder
"any stack type"
  STACKTYPE StackTypePattern
s -> 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
$ StackTypePattern -> ExtInstrAbstract ExpandedOp
forall op. StackTypePattern -> ExtInstrAbstract op
U.STACKTYPE StackTypePattern
s

-- 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
  Instr inp out
i1 == :: Instr inp out -> Instr inp out -> Bool
== 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 SingI s => Eq (TestAssert s) where
  TestAssert   Text
name1 PrintComment s
pattern1 Instr s ('TBool : out)
instr1
    == :: TestAssert s -> TestAssert s -> Bool
==
    TestAssert Text
name2 PrintComment s
pattern2 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 -> *).
(SingI a1, SingI a2, SDecide k, Eq (t a1)) =>
t a1 -> t a2 -> Bool
`eqParamSing` 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 -> *).
(SingI a1, SingI a2, SingI b1, SingI b2, SDecide k1, SDecide k2,
 Eq (t a1 b2)) =>
t a1 b1 -> t a2 b2 -> Bool
`eqParamSing2` 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

instance Buildable (Instr inp out) where
  build :: Instr inp out -> Builder
build = Instr inp out -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDocExtended

instance RenderDoc (Instr inp out) where
  renderDoc :: RenderContext -> Instr inp out -> Doc
renderDoc RenderContext
context = RenderContext -> [ExpandedOp] -> Doc
forall a. RenderDoc a => RenderContext -> [a] -> Doc
renderDocList RenderContext
context ([ExpandedOp] -> Doc)
-> (Instr inp out -> [ExpandedOp]) -> Instr inp out -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps

-- | Generate a value used for generating examples in documentation.
--
-- Since not for all types it is possible to produce a sensible example,
-- the result is optional. E.g. for operations, @never@, not proper
-- types like @contract operation@ we return 'Nothing'.
sampleTypedValue :: Sing t -> Maybe (Value t)
sampleTypedValue :: Sing t -> Maybe (Value t)
sampleTypedValue = \case
    Sing t
STInt              -> Value' Instr 'TInt -> Maybe (Value' Instr 'TInt)
forall a. a -> Maybe a
Just (Value' Instr 'TInt -> Maybe (Value' Instr 'TInt))
-> Value' Instr 'TInt -> Maybe (Value' Instr 'TInt)
forall a b. (a -> b) -> a -> b
$ Integer -> Value' Instr 'TInt
forall (instr :: [T] -> [T] -> *). Integer -> Value' instr 'TInt
VInt Integer
-1
    Sing t
STNat              -> Value' Instr 'TNat -> Maybe (Value' Instr 'TNat)
forall a. a -> Maybe a
Just (Value' Instr 'TNat -> Maybe (Value' Instr 'TNat))
-> Value' Instr 'TNat -> Maybe (Value' Instr 'TNat)
forall a b. (a -> b) -> a -> b
$ Natural -> Value' Instr 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat Natural
0
    Sing t
STString           -> Value' Instr 'TString -> Maybe (Value' Instr 'TString)
forall a. a -> Maybe a
Just (Value' Instr 'TString -> Maybe (Value' Instr 'TString))
-> Value' Instr 'TString -> Maybe (Value' Instr 'TString)
forall a b. (a -> b) -> a -> b
$ MText -> Value' Instr 'TString
forall (instr :: [T] -> [T] -> *). MText -> Value' instr 'TString
VString [mt|hello|]
    Sing t
STMutez            -> Value' Instr 'TMutez -> Maybe (Value' Instr 'TMutez)
forall a. a -> Maybe a
Just (Value' Instr 'TMutez -> Maybe (Value' Instr 'TMutez))
-> Value' Instr 'TMutez -> Maybe (Value' Instr 'TMutez)
forall a b. (a -> b) -> a -> b
$ Mutez -> Value' Instr 'TMutez
forall (instr :: [T] -> [T] -> *). Mutez -> Value' instr 'TMutez
VMutez (HasCallStack => Word64 -> Mutez
Word64 -> Mutez
unsafeMkMutez Word64
100)
    Sing t
STBool             -> Value' Instr 'TBool -> Maybe (Value' Instr 'TBool)
forall a. a -> Maybe a
Just (Value' Instr 'TBool -> Maybe (Value' Instr 'TBool))
-> Value' Instr 'TBool -> Maybe (Value' Instr 'TBool)
forall a b. (a -> b) -> a -> b
$ Bool -> Value' Instr 'TBool
forall (instr :: [T] -> [T] -> *). Bool -> Value' instr 'TBool
VBool Bool
True
    Sing t
STKey              -> Value' Instr 'TKey -> Maybe (Value' Instr 'TKey)
forall a. a -> Maybe a
Just (Value' Instr 'TKey -> Maybe (Value' Instr 'TKey))
-> Value' Instr 'TKey -> Maybe (Value' Instr 'TKey)
forall a b. (a -> b) -> a -> b
$ PublicKey -> Value' Instr 'TKey
forall (instr :: [T] -> [T] -> *). PublicKey -> Value' instr 'TKey
VKey PublicKey
samplePublicKey
    Sing t
STKeyHash          -> Value' Instr 'TKeyHash -> Maybe (Value' Instr 'TKeyHash)
forall a. a -> Maybe a
Just (Value' Instr 'TKeyHash -> Maybe (Value' Instr 'TKeyHash))
-> Value' Instr 'TKeyHash -> Maybe (Value' Instr 'TKeyHash)
forall a b. (a -> b) -> a -> b
$ KeyHash -> Value' Instr 'TKeyHash
forall (instr :: [T] -> [T] -> *).
KeyHash -> Value' instr 'TKeyHash
VKeyHash (KeyHash -> Value' Instr 'TKeyHash)
-> KeyHash -> Value' Instr 'TKeyHash
forall a b. (a -> b) -> a -> b
$ PublicKey -> KeyHash
hashKey PublicKey
samplePublicKey
    Sing t
STBls12381Fr       -> Value' Instr 'TBls12381Fr -> Maybe (Value' Instr 'TBls12381Fr)
forall a. a -> Maybe a
Just (Value' Instr 'TBls12381Fr -> Maybe (Value' Instr 'TBls12381Fr))
-> Value' Instr 'TBls12381Fr -> Maybe (Value' Instr 'TBls12381Fr)
forall a b. (a -> b) -> a -> b
$ Bls12381Fr -> Value' Instr 'TBls12381Fr
forall (instr :: [T] -> [T] -> *).
Bls12381Fr -> Value' instr 'TBls12381Fr
VBls12381Fr Bls12381Fr
1
    Sing t
STBls12381G1       -> Value' Instr 'TBls12381G1 -> Maybe (Value' Instr 'TBls12381G1)
forall a. a -> Maybe a
Just (Value' Instr 'TBls12381G1 -> Maybe (Value' Instr 'TBls12381G1))
-> Value' Instr 'TBls12381G1 -> Maybe (Value' Instr 'TBls12381G1)
forall a b. (a -> b) -> a -> b
$ Bls12381G1 -> Value' Instr 'TBls12381G1
forall (instr :: [T] -> [T] -> *).
Bls12381G1 -> Value' instr 'TBls12381G1
VBls12381G1 Bls12381G1
BLS.g1One
    Sing t
STBls12381G2       -> Value' Instr 'TBls12381G2 -> Maybe (Value' Instr 'TBls12381G2)
forall a. a -> Maybe a
Just (Value' Instr 'TBls12381G2 -> Maybe (Value' Instr 'TBls12381G2))
-> Value' Instr 'TBls12381G2 -> Maybe (Value' Instr 'TBls12381G2)
forall a b. (a -> b) -> a -> b
$ Bls12381G2 -> Value' Instr 'TBls12381G2
forall (instr :: [T] -> [T] -> *).
Bls12381G2 -> Value' instr 'TBls12381G2
VBls12381G2 Bls12381G2
BLS.g2One
    Sing t
STTimestamp        -> Value' Instr 'TTimestamp -> Maybe (Value' Instr 'TTimestamp)
forall a. a -> Maybe a
Just (Value' Instr 'TTimestamp -> Maybe (Value' Instr 'TTimestamp))
-> Value' Instr 'TTimestamp -> Maybe (Value' Instr 'TTimestamp)
forall a b. (a -> b) -> a -> b
$ Timestamp -> Value' Instr 'TTimestamp
forall (instr :: [T] -> [T] -> *).
Timestamp -> Value' instr 'TTimestamp
VTimestamp (Timestamp -> Value' Instr 'TTimestamp)
-> Timestamp -> Value' Instr 'TTimestamp
forall a b. (a -> b) -> a -> b
$ Integer -> Timestamp
timestampFromSeconds Integer
1564142952
    Sing t
STBytes            -> Value' Instr 'TBytes -> Maybe (Value' Instr 'TBytes)
forall a. a -> Maybe a
Just (Value' Instr 'TBytes -> Maybe (Value' Instr 'TBytes))
-> Value' Instr 'TBytes -> Maybe (Value' Instr 'TBytes)
forall a b. (a -> b) -> a -> b
$ ByteString -> Value' Instr 'TBytes
forall (instr :: [T] -> [T] -> *).
ByteString -> Value' instr 'TBytes
VBytes ByteString
"\10"
    Sing t
STAddress          -> Value' Instr 'TAddress -> Maybe (Value' Instr 'TAddress)
forall a. a -> Maybe a
Just (Value' Instr 'TAddress -> Maybe (Value' Instr 'TAddress))
-> Value' Instr 'TAddress -> Maybe (Value' Instr 'TAddress)
forall a b. (a -> b) -> a -> b
$ EpAddress -> Value' Instr 'TAddress
forall (instr :: [T] -> [T] -> *).
EpAddress -> Value' instr 'TAddress
VAddress (EpAddress -> Value' Instr 'TAddress)
-> EpAddress -> Value' Instr 'TAddress
forall a b. (a -> b) -> a -> b
$ EpAddress
sampleAddress
    Sing t
STUnit             -> Value' Instr 'TUnit -> Maybe (Value' Instr 'TUnit)
forall a. a -> Maybe a
Just (Value' Instr 'TUnit -> Maybe (Value' Instr 'TUnit))
-> Value' Instr 'TUnit -> Maybe (Value' Instr 'TUnit)
forall a b. (a -> b) -> a -> b
$ Value' Instr 'TUnit
forall (instr :: [T] -> [T] -> *). Value' instr 'TUnit
VUnit
    Sing t
STSignature        -> Value' Instr 'TSignature -> Maybe (Value' Instr 'TSignature)
forall a. a -> Maybe a
Just (Value' Instr 'TSignature -> Maybe (Value' Instr 'TSignature))
-> Value' Instr 'TSignature -> Maybe (Value' Instr 'TSignature)
forall a b. (a -> b) -> a -> b
$ Signature -> Value' Instr 'TSignature
forall (instr :: [T] -> [T] -> *).
Signature -> Value' instr 'TSignature
VSignature (Signature -> Value' Instr 'TSignature)
-> Signature -> Value' Instr 'TSignature
forall a b. (a -> b) -> a -> b
$ Signature
sampleSignature
    Sing t
STChainId          -> Value' Instr 'TChainId -> Maybe (Value' Instr 'TChainId)
forall a. a -> Maybe a
Just (Value' Instr 'TChainId -> Maybe (Value' Instr 'TChainId))
-> Value' Instr 'TChainId -> Maybe (Value' Instr 'TChainId)
forall a b. (a -> b) -> a -> b
$ ChainId -> Value' Instr 'TChainId
forall (instr :: [T] -> [T] -> *).
ChainId -> Value' instr 'TChainId
VChainId ChainId
sampleChainId
    Sing t
STOperation        -> Maybe (Value t)
forall a. Maybe a
Nothing
    Sing t
STNever            -> Maybe (Value t)
forall a. Maybe a
Nothing
    STOption t ->
      Sing n -> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n
t ((SingI n => Maybe (Value t)) -> Maybe (Value t))
-> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall a b. (a -> b) -> a -> b
$ Maybe (Value' Instr n) -> Value' Instr ('TOption n)
forall (t :: T) (instr :: [T] -> [T] -> *).
SingI t =>
Maybe (Value' instr t) -> Value' instr ('TOption t)
VOption (Maybe (Value' Instr n) -> Value' Instr ('TOption n))
-> (Value' Instr n -> Maybe (Value' Instr n))
-> Value' Instr n
-> Value' Instr ('TOption n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value' Instr n -> Maybe (Value' Instr n)
forall a. a -> Maybe a
Just (Value' Instr n -> Value' Instr ('TOption n))
-> Maybe (Value' Instr n) -> Maybe (Value' Instr ('TOption n))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing n -> Maybe (Value' Instr n)
forall (t :: T). Sing t -> Maybe (Value t)
sampleTypedValue Sing n
t
    STList t ->
      Sing n -> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n
t ((SingI n => Maybe (Value t)) -> Maybe (Value t))
-> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall a b. (a -> b) -> a -> b
$ [Value' Instr n] -> Value' Instr ('TList n)
forall (t :: T) (instr :: [T] -> [T] -> *).
SingI t =>
[Value' instr t] -> Value' instr ('TList t)
VList ([Value' Instr n] -> Value' Instr ('TList n))
-> (Value' Instr n -> [Value' Instr n])
-> Value' Instr n
-> Value' Instr ('TList n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value' Instr n -> [Value' Instr n]
forall x. One x => OneItem x -> x
one (Value' Instr n -> Value' Instr ('TList n))
-> Maybe (Value' Instr n) -> Maybe (Value' Instr ('TList n))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing n -> Maybe (Value' Instr n)
forall (t :: T). Sing t -> Maybe (Value t)
sampleTypedValue Sing n
t
    STSet t -> Sing n -> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n
t ((SingI n => Maybe (Value t)) -> Maybe (Value t))
-> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall a b. (a -> b) -> a -> b
$ do
      Dict (Comparable n)
Dict <- Sing n -> Maybe (Dict (Comparable n))
forall (t :: T). Sing t -> Maybe (Dict $ Comparable t)
comparabilityPresence Sing n
t
      Set (Value' Instr n) -> Value' Instr ('TSet n)
forall (t :: T) (instr :: [T] -> [T] -> *).
(SingI t, Comparable t) =>
Set (Value' instr t) -> Value' instr ('TSet t)
VSet (Set (Value' Instr n) -> Value' Instr ('TSet n))
-> (Value' Instr n -> Set (Value' Instr n))
-> Value' Instr n
-> Value' Instr ('TSet n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value' Instr n -> Set (Value' Instr n)
forall x. One x => OneItem x -> x
one (Value' Instr n -> Value' Instr ('TSet n))
-> Maybe (Value' Instr n) -> Maybe (Value' Instr ('TSet n))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing n -> Maybe (Value' Instr n)
forall (t :: T). Sing t -> Maybe (Value t)
sampleTypedValue Sing n
t
    STContract t -> Sing n -> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n
t ((SingI n => Maybe (Value t)) -> Maybe (Value t))
-> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall a b. (a -> b) -> a -> b
$ do
      Dict (HasNoOp n)
Dict <- Sing n -> Maybe (Dict (HasNoOp n))
forall (t :: T). Sing t -> Maybe (Dict $ HasNoOp t)
opAbsense Sing n
t
      Dict (HasNoNestedBigMaps n)
Dict <- Sing n -> Maybe (Dict (HasNoNestedBigMaps n))
forall (t :: T). Sing t -> Maybe (Dict $ HasNoNestedBigMaps t)
nestedBigMapsAbsense Sing n
t
      Value' Instr ('TContract n) -> Maybe (Value' Instr ('TContract n))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' Instr ('TContract n)
 -> Maybe (Value' Instr ('TContract n)))
-> (SomeEntrypointCallT n -> Value' Instr ('TContract n))
-> SomeEntrypointCallT n
-> Maybe (Value' Instr ('TContract n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> SomeEntrypointCallT n -> Value' Instr ('TContract n)
forall (arg :: T) (instr :: [T] -> [T] -> *).
(SingI arg, HasNoOp arg) =>
Address -> SomeEntrypointCallT arg -> Value' instr ('TContract arg)
VContract (EpAddress -> Address
eaAddress EpAddress
sampleAddress) (SomeEntrypointCallT n -> Maybe (Value' Instr ('TContract n)))
-> SomeEntrypointCallT n -> Maybe (Value' Instr ('TContract n))
forall a b. (a -> b) -> a -> b
$ EntrypointCallT n n -> SomeEntrypointCallT n
forall (arg :: T) (param :: T).
ParameterScope param =>
EntrypointCallT param arg -> SomeEntrypointCallT arg
SomeEpc EntrypointCallT n n
forall (param :: T).
ParameterScope param =>
EntrypointCallT param param
unsafeEpcCallRoot
    STTicket t -> Sing n -> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n
t ((SingI n => Maybe (Value t)) -> Maybe (Value t))
-> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall a b. (a -> b) -> a -> b
$ do
      Dict $ Comparable n
cmpProof <- Sing n -> Maybe (Dict $ Comparable n)
forall (t :: T). Sing t -> Maybe (Dict $ Comparable t)
comparabilityPresence Sing n
t
      Value n
dat <- Sing n -> Maybe (Value n)
forall (t :: T). Sing t -> Maybe (Value t)
sampleTypedValue Sing n
t
      VNat Natural
amount <- Sing 'TNat -> Maybe (Value' Instr 'TNat)
forall (t :: T). Sing t -> Maybe (Value t)
sampleTypedValue Sing 'TNat
SingT 'TNat
STNat
      case Dict $ Comparable n
cmpProof of
        Dict $ Comparable n
Dict -> Value ('TTicket n) -> Maybe (Value ('TTicket n))
forall (m :: * -> *) a. Monad m => a -> m a
return (Value ('TTicket n) -> Maybe (Value ('TTicket n)))
-> Value ('TTicket n) -> Maybe (Value ('TTicket n))
forall a b. (a -> b) -> a -> b
$ Address -> Value n -> Natural -> Value ('TTicket n)
forall (arg :: T) (instr :: [T] -> [T] -> *).
Comparable arg =>
Address
-> Value' instr arg -> Natural -> Value' instr ('TTicket arg)
VTicket (EpAddress -> Address
eaAddress EpAddress
sampleAddress) Value n
dat Natural
amount
    STPair t1 t2 -> Sing n -> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n
t1 ((SingI n => Maybe (Value t)) -> Maybe (Value t))
-> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall a b. (a -> b) -> a -> b
$ Sing n -> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n
t2 ((SingI n => Maybe (Value t)) -> Maybe (Value t))
-> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall a b. (a -> b) -> a -> b
$ do
      Value n
val1 <- Sing n -> Maybe (Value n)
forall (t :: T). Sing t -> Maybe (Value t)
sampleTypedValue Sing n
t1
      Value n
val2 <- Sing n -> Maybe (Value n)
forall (t :: T). Sing t -> Maybe (Value t)
sampleTypedValue Sing n
t2
      pure $ (Value n, Value n) -> Value' Instr ('TPair n n)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Value n
val1, Value n
val2)
    STOr tl tr -> Sing n -> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n
tl ((SingI n => Maybe (Value t)) -> Maybe (Value t))
-> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall a b. (a -> b) -> a -> b
$ Sing n -> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n
tr ((SingI n => Maybe (Value t)) -> Maybe (Value t))
-> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall a b. (a -> b) -> a -> b
$ [Maybe (Value' Instr ('TOr n n))]
-> Maybe (Value' Instr ('TOr n n))
forall t (f :: * -> *) a.
(Container t, Alternative f, Element t ~ f a) =>
t -> f a
asum
      [ Either (Value' Instr n) (Value' Instr n) -> Value' Instr ('TOr n n)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(SingI l, SingI r) =>
Either (Value' instr l) (Value' instr r) -> Value' instr ('TOr l r)
VOr (Either (Value' Instr n) (Value' Instr n)
 -> Value' Instr ('TOr n n))
-> (Value' Instr n -> Either (Value' Instr n) (Value' Instr n))
-> Value' Instr n
-> Value' Instr ('TOr n n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value' Instr n -> Either (Value' Instr n) (Value' Instr n)
forall a b. a -> Either a b
Left (Value' Instr n -> Value' Instr ('TOr n n))
-> Maybe (Value' Instr n) -> Maybe (Value' Instr ('TOr n n))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing n -> Maybe (Value' Instr n)
forall (t :: T). Sing t -> Maybe (Value t)
sampleTypedValue Sing n
tl
      , Either (Value' Instr n) (Value' Instr n) -> Value' Instr ('TOr n n)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(SingI l, SingI r) =>
Either (Value' instr l) (Value' instr r) -> Value' instr ('TOr l r)
VOr (Either (Value' Instr n) (Value' Instr n)
 -> Value' Instr ('TOr n n))
-> (Value' Instr n -> Either (Value' Instr n) (Value' Instr n))
-> Value' Instr n
-> Value' Instr ('TOr n n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value' Instr n -> Either (Value' Instr n) (Value' Instr n)
forall a b. b -> Either a b
Right (Value' Instr n -> Value' Instr ('TOr n n))
-> Maybe (Value' Instr n) -> Maybe (Value' Instr ('TOr n n))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing n -> Maybe (Value' Instr n)
forall (t :: T). Sing t -> Maybe (Value t)
sampleTypedValue Sing n
tr
      ]
    STMap t1 t2 -> Sing n -> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n
t1 ((SingI n => Maybe (Value t)) -> Maybe (Value t))
-> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall a b. (a -> b) -> a -> b
$ Sing n -> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n
t2 ((SingI n => Maybe (Value t)) -> Maybe (Value t))
-> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall a b. (a -> b) -> a -> b
$ do
      Value n
val1 <- Sing n -> Maybe (Value n)
forall (t :: T). Sing t -> Maybe (Value t)
sampleTypedValue Sing n
t1
      Value n
val2 <- Sing n -> Maybe (Value n)
forall (t :: T). Sing t -> Maybe (Value t)
sampleTypedValue Sing n
t2
      case Sing n -> Comparability n
forall (t :: T). Sing t -> Comparability t
checkComparability Sing n
t1 of
        Comparability n
CanBeCompared -> Value ('TMap n n) -> Maybe (Value ('TMap n n))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value ('TMap n n) -> Maybe (Value ('TMap n n)))
-> Value ('TMap n n) -> Maybe (Value ('TMap n n))
forall a b. (a -> b) -> a -> b
$ Map (Value n) (Value n) -> Value ('TMap n n)
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
(SingI k, SingI v, Comparable k) =>
Map (Value' instr k) (Value' instr v) -> Value' instr ('TMap k v)
VMap (Map (Value n) (Value n) -> Value ('TMap n n))
-> Map (Value n) (Value n) -> Value ('TMap n n)
forall a b. (a -> b) -> a -> b
$ [(Value n, Value n)] -> Map (Value n) (Value n)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Value n
val1, Value n
val2)]
        Comparability n
CannotBeCompared -> Maybe (Value ('TMap n n))
forall a. Maybe a
Nothing
    STBigMap t1 t2 -> Sing n -> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n
t1 ((SingI n => Maybe (Value t)) -> Maybe (Value t))
-> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall a b. (a -> b) -> a -> b
$ Sing n -> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n
t2 ((SingI n => Maybe (Value t)) -> Maybe (Value t))
-> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall a b. (a -> b) -> a -> b
$ do
      Value n
val1 <- Sing n -> Maybe (Value n)
forall (t :: T). Sing t -> Maybe (Value t)
sampleTypedValue Sing n
t1
      Value n
val2 <- Sing n -> Maybe (Value n)
forall (t :: T). Sing t -> Maybe (Value t)
sampleTypedValue Sing n
t2
      case (Sing n -> Comparability n
forall (t :: T). Sing t -> Comparability t
checkComparability Sing n
t1, Sing n -> Maybe (Dict $ HasNoBigMap n)
forall (t :: T). Sing t -> Maybe (Dict $ HasNoBigMap t)
bigMapAbsense Sing n
t2) of
        (Comparability n
CanBeCompared, Just Dict $ HasNoBigMap n
Dict) -> Value ('TBigMap n n) -> Maybe (Value ('TBigMap n n))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value ('TBigMap n n) -> Maybe (Value ('TBigMap n n)))
-> Value ('TBigMap n n) -> Maybe (Value ('TBigMap n n))
forall a b. (a -> b) -> a -> b
$ Maybe Natural -> Map (Value n) (Value n) -> Value ('TBigMap n n)
forall (k :: T) (v :: T) (instr :: [T] -> [T] -> *).
(SingI k, SingI v, Comparable k, HasNoBigMap v) =>
Maybe Natural
-> Map (Value' instr k) (Value' instr v)
-> Value' instr ('TBigMap k v)
VBigMap Maybe Natural
forall a. Maybe a
Nothing (Map (Value n) (Value n) -> Value ('TBigMap n n))
-> Map (Value n) (Value n) -> Value ('TBigMap n n)
forall a b. (a -> b) -> a -> b
$ [(Value n, Value n)] -> Map (Value n) (Value n)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Value n
val1, Value n
val2)]
        (Comparability n, Maybe (Dict $ HasNoBigMap n))
_                          -> Maybe (Value ('TBigMap n n))
forall a. Maybe a
Nothing
    STLambda v (t2 :: Sing t2) -> Sing n -> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n
v ((SingI n => Maybe (Value t)) -> Maybe (Value t))
-> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall a b. (a -> b) -> a -> b
$ Sing n -> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall k (n :: k) r. Sing n -> (SingI n => r) -> r
withSingI Sing n
t2 ((SingI n => Maybe (Value t)) -> Maybe (Value t))
-> (SingI n => Maybe (Value t)) -> Maybe (Value t)
forall a b. (a -> b) -> a -> b
$
      case CheckScope (ConstantScope n) =>
Either BadTypeForScope (Dict (ConstantScope n))
forall (c :: Constraint).
CheckScope c =>
Either BadTypeForScope (Dict c)
checkScope @(ConstantScope t2) of
        Right Dict (ConstantScope n)
Dict -> do
          Value n
val <- Sing n -> Maybe (Value n)
forall (t :: T). Sing t -> Maybe (Value t)
sampleTypedValue Sing n
t2
          pure $ RemFail Instr '[n] '[n] -> Value' Instr ('TLambda n n)
forall (inp :: T) (out :: T) (instr :: [T] -> [T] -> *).
(SingI inp, SingI 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 '[n] '[n] -> Value' Instr ('TLambda n n))
-> RemFail Instr '[n] '[n] -> Value' Instr ('TLambda n n)
forall a b. (a -> b) -> a -> b
$ Instr '[n] '[n] -> RemFail Instr '[n] '[n]
forall k (instr :: k -> k -> *) (i :: k) (o :: k).
instr i o -> RemFail instr i o
RfNormal (Instr '[n] '[]
forall (a :: T) (s :: [T]). Instr (a : s) s
DROP Instr '[n] '[] -> Instr '[] '[n] -> Instr '[n] '[n]
forall (a :: [T]) (b :: [T]) (c :: [T]).
Instr a b -> Instr b c -> Instr a c
`Seq` Value n -> Instr '[] '[n]
forall (t :: T) (s :: [T]).
ConstantScope t =>
Value' Instr t -> Instr s (t : s)
PUSH Value n
val)
        Either BadTypeForScope (Dict (ConstantScope n))
_ -> Value' Instr ('TLambda n n) -> Maybe (Value' Instr ('TLambda n n))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' Instr ('TLambda n n)
 -> Maybe (Value' Instr ('TLambda n n)))
-> Value' Instr ('TLambda n n)
-> Maybe (Value' Instr ('TLambda n n))
forall a b. (a -> b) -> a -> b
$ RemFail Instr '[n] '[n] -> Value' Instr ('TLambda n n)
forall (inp :: T) (out :: T) (instr :: [T] -> [T] -> *).
(SingI inp, SingI 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 '[n] '[n] -> Value' Instr ('TLambda n n))
-> RemFail Instr '[n] '[n] -> Value' Instr ('TLambda n n)
forall a b. (a -> b) -> a -> b
$ (forall (o' :: [T]). Instr '[n] o') -> RemFail Instr '[n] '[n]
forall k (instr :: k -> k -> *) (i :: k) (o :: k).
(forall (o' :: k). instr i o') -> RemFail instr i o
RfAlwaysFails (Value' Instr 'TString -> Instr '[n] '[ 'TString, n]
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 '[n] '[ 'TString, n]
-> Instr '[ 'TString, n] o' -> Instr '[n] o'
forall (a :: [T]) (b :: [T]) (c :: [T]).
Instr a b -> Instr b c -> Instr a c
`Seq` Instr '[ 'TString, n] o'
forall (a :: T) (s :: [T]) (t :: [T]).
(SingI a, ConstantScope a) =>
Instr (a : s) t
FAILWITH)
    where
      sampleAddress :: EpAddress
sampleAddress = HasCallStack => Text -> EpAddress
Text -> EpAddress
unsafeParseEpAddress Text
"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 Text
"impossible") (Either CryptoParseError PublicKey -> PublicKey)
-> Either CryptoParseError PublicKey -> PublicKey
forall a b. (a -> b) -> a -> b
$ Text -> Either CryptoParseError PublicKey
parsePublicKey
        Text
"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 Text
"impossible") (Either CryptoParseError Signature -> Signature)
-> Either CryptoParseError Signature -> Signature
forall a b. (a -> b) -> a -> b
$ Text -> Either CryptoParseError Signature
parseSignature
        Text
"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 Text
"impossible") (Either ParseChainIdError ChainId -> ChainId)
-> Either ParseChainIdError ChainId -> ChainId
forall a b. (a -> b) -> a -> b
$ Text -> Either ParseChainIdError ChainId
parseChainId Text
"NetXUdfLh6Gm88t"

-- Misc
----------------------------------------------------------------------------

-- | Flatten a provided list of notes to a map of its entrypoints and its
-- corresponding utype. Please refer to 'mkEntrypointsMap' in regards to how
-- duplicate entrypoints are handled.
flattenEntrypoints :: SingI t => ParamNotes t -> Map EpName U.Ty
flattenEntrypoints :: ParamNotes t -> Map EpName Ty
flattenEntrypoints = ParameterType -> Map EpName Ty
U.mkEntrypointsMap (ParameterType -> Map EpName Ty)
-> (ParamNotes t -> ParameterType) -> ParamNotes t -> Map EpName Ty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParamNotes t -> ParameterType
forall (cp :: T). SingI cp => ParamNotes cp -> ParameterType
convertParamNotes