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

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

module Morley.Michelson.Typed.Convert
  ( convertParamNotes
  , convertView
  , convertSomeView
  , 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 Text.PrettyPrint.Leijen.Text (Doc)
import qualified Unsafe (fromIntegral)

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

-- | Convert typed parameter annotations to an untyped 'U.ParameterType'.
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

-- | Convert typed 'ContractCode' to an untyped t'U.Contract'.
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 -> [View' op] -> 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
    , contractViews :: [View' ExpandedOp]
contractViews = []
    }

convertView :: forall arg store ret. View arg store ret -> U.View
convertView :: View arg store ret -> View' ExpandedOp
convertView View{ViewName
Notes arg
Notes ret
ViewCode' Instr arg store ret
vCode :: forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> ViewCode' instr arg st ret
vReturn :: forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> Notes ret
vArgument :: forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> Notes arg
vName :: forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> ViewName
vCode :: ViewCode' Instr arg store ret
vReturn :: Notes ret
vArgument :: Notes arg
vName :: ViewName
..} =
  View :: forall op. ViewName -> Ty -> Ty -> [op] -> View' op
U.View
    { viewName :: ViewName
viewName = ViewName
vName
    , viewArgument :: Ty
viewArgument = SingI arg => Ty
forall (t :: T). SingI t => Ty
untypeDemoteT @arg
    , viewReturn :: Ty
viewReturn = SingI ret => Ty
forall (t :: T). SingI t => Ty
untypeDemoteT @ret
    , viewCode :: [ExpandedOp]
viewCode = ViewCode' Instr arg store ret -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps ViewCode' Instr arg store ret
vCode
    }

convertSomeView :: SomeView st -> U.View
convertSomeView :: SomeView st -> View' ExpandedOp
convertSomeView (SomeView View' Instr arg st ret
v) = View' Instr arg st ret -> View' ExpandedOp
forall (arg :: T) (store :: T) (ret :: T).
View arg store ret -> View' ExpandedOp
convertView View' Instr arg st ret
v

-- | Convert typed t'Contract' to an untyped t'U.Contract'.
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 (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ContractCode' instr 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 (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr 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 (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> Notes st
cStoreNotes Contract param store
fc)
       , entriesOrder :: EntriesOrder
U.entriesOrder = Contract param store -> EntriesOrder
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> EntriesOrder
cEntriesOrder Contract param store
fc
       , contractViews :: [View' ExpandedOp]
U.contractViews = SomeView store -> View' ExpandedOp
forall (st :: T). SomeView st -> View' ExpandedOp
convertSomeView (SomeView store -> View' ExpandedOp)
-> [SomeView store] -> [View' ExpandedOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ViewsSet' Instr store -> [Element (ViewsSet' Instr store)]
forall t. Container t => t -> [Element t]
toList (Contract param store -> ViewsSet' Instr store
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ViewsSet' instr st
cViews 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)

-- | Convert a typed value to an untyped human-readable representation
untypeValue :: HasNoOp t => Value' Instr t -> U.Value
untypeValue :: Value' Instr t -> Value
untypeValue = UntypingOptions -> Value' Instr t -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl' UntypingOptions
Readable

-- | Like 'untypeValueOptimized', but without list notation for pairs.
--
-- Created to match @tezos-client hash data@ behaviour for typed values.
untypeValueHashable :: HasNoOp t => Value' Instr t -> U.Value
untypeValueHashable :: Value' Instr t -> Value
untypeValueHashable = UntypingOptions -> Value' Instr t -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl' UntypingOptions
Hashable

-- | Convert a typed value to an untyped optimized representation
untypeValueOptimized :: HasNoOp t => Value' Instr t -> U.Value
untypeValueOptimized :: Value' Instr t -> Value
untypeValueOptimized = UntypingOptions -> Value' Instr t -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Value' Instr t -> Value
untypeValueImpl' UntypingOptions
Optimized

untypeValueImpl'
  :: HasNoOp t
  => UntypingOptions
  -> Value' Instr t
  -> U.Value
untypeValueImpl' :: UntypingOptions -> Value' Instr t -> Value
untypeValueImpl' UntypingOptions
opts Value' Instr t
val = UntypingOptions -> Sing t -> Value' Instr t -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts (SingI t => SingT t
forall k (a :: k). SingI a => Sing a
sing (SingI t => SingT t) -> Dict (SingI t) -> SingT t
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ Value' Instr t -> Dict (SingI t)
forall (instr :: [T] -> [T] -> *) (t :: T).
Value' instr t -> Dict (SingI t)
valueTypeSanity Value' Instr t
val) Value' Instr t
val

-- | Convert a typed t'Morley.Michelson.Typed.Aliases.Value' to an untyped 'Value'.
--
-- For full isomorphism type of the given t'Morley.Michelson.Typed.Aliases.Value' should not contain
-- 'TOperation' - a compile error will be raised otherwise.
-- You can analyse its presence with 'checkOpPresence' function.
untypeValueImpl
  :: HasNoOp t
  => UntypingOptions
  -> Sing t
  -> Value' Instr t
  -> U.Value
untypeValueImpl :: UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Sing t
sng Value' Instr t
val = case (Value' Instr t
val, Sing t
SingT t
sng) 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 op) ->
    Value -> Value
forall op. Value' op -> Value' op
U.ValueSome (UntypingOptions -> Sing t -> Value' Instr t -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Sing t
Sing n
op Value' Instr t
x)
  (VOption Maybe (Value' Instr t)
Nothing, STOption _) ->
    Value
forall op. Value' op
U.ValueNone
  (VList [Value' Instr t]
l, STList lt) ->
    (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 -> Sing t -> Value' Instr t -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Sing t
Sing n
lt) [Value' Instr t]
l
  (VSet Set (Value' Instr t)
s, STSet st) ->
    case Sing t -> OpPresence t
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing t
Sing n
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 -> Sing t -> Value' Instr t -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Sing t
Sing n
st) ([Value' Instr t] -> [Value]) -> [Value' Instr t] -> [Value]
forall a b. (a -> b) -> a -> b
$ Set (Value' Instr t) -> [Element (Set (Value' Instr t))]
forall t. Container t => t -> [Element t]
toList Set (Value' Instr t)
s
  (VContract 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)
  (VChest Chest
c, 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
$ Chest -> ByteString
chestBytes Chest
c
  (VChestKey ChestKey
c, 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
$ ChestKey -> ByteString
chestKeyBytes ChestKey
c
  (VTicket Address
s Value' Instr arg
v Natural
a, STTicket vt) ->
    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
-> Sing 'TAddress -> Value' Instr 'TAddress -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Sing 'TAddress
SingT 'TAddress
STAddress (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 -> Sing arg -> Value' Instr arg -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Sing arg
Sing n
vt Value' Instr arg
v
            ua :: Value
ua = UntypingOptions -> Sing 'TNat -> Value' Instr 'TNat -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Sing 'TNat
SingT 'TNat
STNat (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) ->
    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).
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 -> Sing l -> Value' Instr l -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Sing l
Sing n
lt Value' Instr l
l) (UntypingOptions -> Sing r -> Value' Instr r -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Sing r
Sing n
rt 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 -> Sing l -> Value' Instr l -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Sing l
Sing n
lt Value' Instr l
x)

  (VOr (Right Value' Instr r
x), STOr lt rt) ->
    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 -> Sing r -> Value' Instr r -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Sing r
Sing n
rt 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 -> Sing k -> Value' Instr k -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Sing k
Sing n
kt Value' Instr k
k) (UntypingOptions -> Sing v -> Value' Instr v -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Sing v
Sing n
vt 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 -> Sing k -> Value' Instr k -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Sing k
Sing n
kt Value' Instr k
k) (UntypingOptions -> Sing v -> Value' Instr v -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Sing v
Sing n
vt 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 :: 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) -> case Sing l -> OpPresence l
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing l
Sing n
l of
        OpPresence l
OpAbsent -> UntypingOptions -> Sing l -> Value' Instr l -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Sing l
Sing n
l 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).
HasNoOp ty =>
(Value ty, Sing ty) -> NonEmpty Value
pairToSeq (Value' Instr r
b, Sing r
Sing n
r)
      (Value ty
v, Sing ty
vt) -> UntypingOptions -> Sing ty -> Value ty -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts Sing ty
vt 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

-- | Convert a Haskell type-level type tag into an
-- untyped value representation.
--
-- This function is intended to be used with @TypeApplications@.
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

-- | Convert Haskell-typed 'Instr' to a list of optimized untyped operations
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

-- | Convert Haskell-typed 'Instr' to a list of human-readable untyped operations
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
  Meta SomeMeta
_ 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 (Ty -> ExpandedInstr) -> Ty -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ (Sing t, Notes t) -> Ty
forall (x :: T). (Sing x, Notes x) -> Ty
mkUType' (Sing t
Sing n
t, 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 (Ty -> ExpandedInstr) -> Ty -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ (Sing q, Notes q) -> Ty
forall (x :: T). (Sing x, Notes x) -> Ty
mkUType' (Sing q
Sing n
rt, 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 (Ty -> ExpandedInstr) -> Ty -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ (Sing p, Notes p) -> Ty
forall (x :: T). (Sing x, Notes x) -> Ty
mkUType' (Sing p
Sing n
lt, 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 (Ty -> ExpandedInstr) -> Ty -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ (Sing t, Notes t) -> Ty
forall (x :: T). (Sing x, Notes x) -> Ty
mkUType' (Sing t
Sing n
l, 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 (Ty -> ExpandedInstr) -> Ty -> ExpandedInstr
forall a b. (a -> b) -> a -> b
$ (Sing t, Notes t) -> Ty
forall (x :: T). (Sing x, Notes x) -> Ty
mkUType' (Sing t
Sing n
s, 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, Notes k) -> Ty
forall (x :: T). (Sing x, Notes x) -> Ty
mkUType' (Sing k
Sing n
kt, Notes k
k)) ((Sing v, Notes v) -> Ty
forall (x :: T). (Sing x, Notes x) -> Ty
mkUType' (Sing v
Sing n
vt, 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, Notes k) -> Ty
forall (x :: T). (Sing x, Notes x) -> Ty
mkUType' (Sing k
Sing n
kt, Notes k
k)) ((Sing v, Notes v) -> Ty
forall (x :: T). (Sing x, Notes x) -> Ty
mkUType' (Sing v
Sing n
vt, 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, Notes p) -> Ty
forall (x :: T). (Sing x, Notes x) -> Ty
mkUType' (Sing p
Sing n
v, Notes p
n1)) ((Sing q, Notes q) -> Ty
forall (x :: T). (Sing x, Notes x) -> Ty
mkUType' (Sing q
Sing n
b, 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, Notes t) -> Ty
forall (x :: T). (Sing x, Notes x) -> Ty
mkUType' (Sing t
Sing n
op, 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, Notes t) -> Ty
forall (x :: T). (Sing x, Notes x) -> Ty
mkUType' (Sing t
Sing n
c, 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.VIEW{}, 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.VIEW VarAnn
_ ViewName
n Ty
t -> VarAnn -> ViewName -> Ty -> ExpandedInstr
forall op. VarAnn -> ViewName -> Ty -> InstrAbstract op
U.VIEW VarAnn
va ViewName
n Ty
t
        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"
      Meta SomeMeta
_ 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 ((HasCallStack, Integral Natural, Integral Word) => Natural -> Word
forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Natural @Word (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 ((HasCallStack, Integral Natural, Integral Word) => Natural -> Word
forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Natural @Word (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 ((HasCallStack, Integral Natural, Integral Word) => Natural -> Word
forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Natural @Word (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 ((HasCallStack, Integral Natural, Integral Word) => Natural -> Word
forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Natural @Word (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 -> Sing t -> Value' Instr t -> Value
forall (t :: T).
HasNoOp t =>
UntypingOptions -> Sing t -> Value' Instr t -> Value
untypeValueImpl UntypingOptions
opts (SingI t => Sing t
forall k (a :: k). SingI a => Sing a
sing @t) 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 `Morley.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 ((HasCallStack, Integral Natural, Integral Word) => Natural -> Word
forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Natural @Word (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 ((HasCallStack, Integral Natural, Integral Word) => Natural -> Word
forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Natural @Word (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 ((HasCallStack, Integral Natural, Integral Word) => Natural -> Word
forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Natural @Word (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 ((HasCallStack, Integral Natural, Integral Word) => Natural -> Word
forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Natural @Word (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 ((HasCallStack, Integral Natural, Integral Word) => Natural -> Word
forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Natural @Word (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
      VIEW ViewName
viewName Notes ret
nt -> VarAnn -> ViewName -> Ty -> ExpandedInstr
forall op. VarAnn -> ViewName -> Ty -> InstrAbstract op
U.VIEW VarAnn
forall k (a :: k). Annotation a
U.noAnn ViewName
viewName (Notes ret -> Ty
forall (x :: T). SingI x => Notes x -> Ty
mkUType Notes ret
nt)
      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' Instr 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' Instr p g -> Contract
forall (param :: T) (store :: T). Contract param store -> Contract
convertContract Contract' Instr 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
      Instr inp out
OPEN_CHEST -> VarAnn -> ExpandedInstr
forall op. VarAnn -> InstrAbstract op
U.OPEN_CHEST 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

eqInstrExt :: Instr i1 o1 -> Instr i2 o2 -> Bool
eqInstrExt :: Instr i1 o1 -> Instr i2 o2 -> Bool
eqInstrExt Instr i1 o1
i1 Instr i2 o2
i2 = Instr i1 o1 -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr i1 o1
i1 [ExpandedOp] -> [ExpandedOp] -> Bool
forall a. Eq a => a -> a -> Bool
== Instr i2 o2 -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps Instr i2 o2
i2

-- 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 -> Instr inp out -> Bool
(==) = Instr inp out -> Instr inp out -> Bool
forall (i1 :: [T]) (o1 :: [T]) (i2 :: [T]) (o2 :: [T]).
Instr i1 o1 -> Instr i2 o2 -> Bool
eqInstrExt

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 (i1 :: [T]) (o1 :: [T]) (i2 :: [T]) (o2 :: [T]).
Instr i1 o1 -> Instr i2 o2 -> Bool
`eqInstrExt` Instr s ('TBool : out)
instr2
    ]

instance HasNoOp t => RenderDoc (Value' Instr t) where
  renderDoc :: RenderContext -> Value' Instr t -> Doc
renderDoc RenderContext
pn = RenderContext -> Value -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
pn (Value -> Doc)
-> (Value' Instr t -> Value) -> Value' Instr t -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value' Instr t -> Value
forall (t :: T). HasNoOp t => Value' Instr t -> Value
untypeValue

instance Buildable (Value' Instr t) where
  build :: Value' Instr t -> Builder
build Value' Instr t
val = Bool -> Doc -> Builder
printDocB Bool
True (Doc -> Builder) -> Doc -> Builder
forall a b. (a -> b) -> a -> b
$ let tv :: SingT t
tv = Value' Instr t -> (SingI t => SingT t) -> SingT t
forall (instr :: [T] -> [T] -> *) (t :: T) a.
Value' instr t -> (SingI t => a) -> a
withValueTypeSanity Value' Instr t
val SingI t => SingT t
forall k (a :: k). SingI a => Sing a
sing
    in RenderContext -> OpPresence t -> (Value' Instr t, Sing t) -> Doc
forall (t :: T).
RenderContext -> OpPresence t -> (Value' Instr t, Sing t) -> Doc
renderDocSing RenderContext
doesntNeedParens (Sing t -> OpPresence t
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing t
SingT t
tv) (Value' Instr t
val, Sing t
SingT t
tv)

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 (Word32 -> Mutez
toMutez Word32
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
    -- It's not hard to generate a chest with a matching key, but
    -- representing those in source is extremely unwieldy due to large
    -- primes involved.
    Sing t
STChest            -> Maybe (Value t)
forall a. Maybe a
Nothing
    Sing t
STChestKey         -> 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 'U.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

-------------------------------------------------------------------------------
-- Rendering helpers
-------------------------------------------------------------------------------

-- | An extended version of renderDoc for typed values that handles VOp
-- accepts explicit singleton
renderDocSing :: RenderContext -> OpPresence t -> (Value' Instr t, Sing t) -> Doc
renderDocSing :: RenderContext -> OpPresence t -> (Value' Instr t, Sing t) -> Doc
renderDocSing RenderContext
pn = \case
  OpPresence t
OpAbsent -> RenderContext -> Value -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
pn (Value -> Doc)
-> ((Value' Instr t, SingT t) -> Value)
-> (Value' Instr t, SingT t)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value' Instr t -> Value
forall (t :: T). HasNoOp t => Value' Instr t -> Value
untypeValue (Value' Instr t -> Value)
-> ((Value' Instr t, SingT t) -> Value' Instr t)
-> (Value' Instr t, SingT t)
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value' Instr t, SingT t) -> Value' Instr t
forall a b. (a, b) -> a
fst
  OpPresence t
OpPresent -> \case
    (VOp Operation' Instr
op, Sing t
_) -> Operation' Instr -> Doc
forall a. Buildable a => a -> Doc
renderAnyBuildable Operation' Instr
op
    -- other cases try to mimic instance RenderDoc U.Value, see "Michelson.Untyped.Value"
    (VOption Maybe (Value' Instr t)
Nothing, Sing t
_) -> Doc
U.renderNone
    (VOption (Just Value' Instr t
x), STOption tx) -> RenderContext -> (RenderContext -> Doc) -> Doc
U.renderSome RenderContext
pn ((RenderContext -> Doc) -> Doc) -> (RenderContext -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ \RenderContext
ctx -> RenderContext -> OpPresence t -> (Value' Instr t, Sing t) -> Doc
forall (t :: T).
RenderContext -> OpPresence t -> (Value' Instr t, Sing t) -> Doc
renderDocSing RenderContext
ctx OpPresence t
forall (t :: T). (ContainsOp t ~ 'True) => OpPresence t
OpPresent (Value' Instr t
x, Sing t
Sing n
tx)
    (VList [Value' Instr t]
xs, STList txs) -> OpPresence t -> Sing t -> [Value' Instr t] -> Doc
forall (t :: T). OpPresence t -> Sing t -> [Value' Instr t] -> Doc
renderList OpPresence t
forall (t :: T). (ContainsOp t ~ 'True) => OpPresence t
OpPresent Sing t
Sing n
txs [Value' Instr t]
xs
    (VSet Set (Value' Instr t)
ss, STSet tss) -> OpPresence t -> Sing t -> [Value' Instr t] -> Doc
forall (t :: T). OpPresence t -> Sing t -> [Value' Instr t] -> Doc
renderList OpPresence t
forall (t :: T). (ContainsOp t ~ 'True) => OpPresence t
OpPresent Sing t
Sing n
tss ([Value' Instr t] -> Doc) -> [Value' Instr t] -> Doc
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)
ss
    (VTicket Address
s Value' Instr arg
v Natural
a, STTicket tv) -> RenderContext
-> OpPresence ('TPair 'TAddress ('TPair arg 'TNat))
-> (Value' Instr ('TPair 'TAddress ('TPair arg 'TNat)),
    Sing ('TPair 'TAddress ('TPair arg 'TNat)))
-> Doc
forall (t :: T).
RenderContext -> OpPresence t -> (Value' Instr t, Sing t) -> Doc
renderDocSing
      RenderContext
needsParens
      OpPresence ('TPair 'TAddress ('TPair arg 'TNat))
forall (t :: T). (ContainsOp t ~ 'True) => OpPresence t
OpPresent
      ((Value' Instr 'TAddress, Value' Instr ('TPair arg 'TNat))
-> Value' Instr ('TPair 'TAddress ('TPair arg 'TNat))
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (EpAddress -> Value' Instr 'TAddress
forall (instr :: [T] -> [T] -> *).
EpAddress -> Value' instr 'TAddress
VAddress (Address -> EpName -> EpAddress
EpAddress Address
s EpName
DefEpName), (Value' Instr arg, Value' Instr 'TNat)
-> Value' Instr ('TPair arg 'TNat)
forall (l :: T) (r :: T) (instr :: [T] -> [T] -> *).
(Value' instr l, Value' instr r) -> Value' instr ('TPair l r)
VPair (Value' Instr arg
v, Natural -> Value' Instr 'TNat
forall (instr :: [T] -> [T] -> *). Natural -> Value' instr 'TNat
VNat Natural
a))
        , Sing 'TAddress
-> Sing ('TPair arg 'TNat)
-> SingT ('TPair 'TAddress ('TPair arg 'TNat))
forall (n :: T) (n :: T). Sing n -> Sing n -> SingT ('TPair n n)
STPair Sing 'TAddress
SingT 'TAddress
STAddress (Sing arg -> Sing 'TNat -> SingT ('TPair arg 'TNat)
forall (n :: T) (n :: T). Sing n -> Sing n -> SingT ('TPair n n)
STPair Sing arg
Sing n
tv Sing 'TNat
SingT 'TNat
STNat))
    val :: (Value' Instr t, Sing t)
val@(VPair (Value' Instr l
_, (VPair (Value' Instr l
_, Value' Instr r
_))), Sing t
_) ->
      (Doc -> Doc) -> NonEmpty Doc -> Doc
forall e. (e -> Doc) -> NonEmpty e -> Doc
U.renderValuesList Doc -> Doc
forall a. a -> a
id (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ (Value' Instr t, Sing t) -> NonEmpty Doc
forall (t :: T). (Value' Instr t, Sing t) -> NonEmpty Doc
renderLinearizedRightCombValuePair (Value' Instr t, Sing t)
val
    (VPair (Value' Instr l
l, Value' Instr r
r), STPair tl tr) -> RenderContext
-> (RenderContext -> Doc) -> (RenderContext -> Doc) -> Doc
U.renderPair RenderContext
pn (SingT l -> Value' Instr l -> RenderContext -> Doc
forall (t :: T). SingT t -> Value' Instr t -> RenderContext -> Doc
render Sing n
SingT l
tl Value' Instr l
l) (SingT r -> Value' Instr r -> RenderContext -> Doc
forall (t :: T). SingT t -> Value' Instr t -> RenderContext -> Doc
render Sing n
SingT r
tr Value' Instr r
r)
    (VOr (Left Value' Instr l
l), STOr tl _) -> RenderContext -> (RenderContext -> Doc) -> Doc
U.renderLeft RenderContext
pn ((RenderContext -> Doc) -> Doc) -> (RenderContext -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ SingT l -> Value' Instr l -> RenderContext -> Doc
forall (t :: T). SingT t -> Value' Instr t -> RenderContext -> Doc
render Sing n
SingT l
tl Value' Instr l
l
    (VOr (Right Value' Instr r
r), STOr _ tr) -> RenderContext -> (RenderContext -> Doc) -> Doc
U.renderRight RenderContext
pn ((RenderContext -> Doc) -> Doc) -> (RenderContext -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ SingT r -> Value' Instr r -> RenderContext -> Doc
forall (t :: T). SingT t -> Value' Instr t -> RenderContext -> Doc
render Sing n
SingT r
tr Value' Instr r
r
    (VMap Map (Value' Instr k) (Value' Instr v)
m, STMap tk tv) -> (Sing k, Sing v, OpPresence k, OpPresence v)
-> Map (Value' Instr k) (Value' Instr v) -> Doc
forall (tk :: T) (tv :: T).
(Sing tk, Sing tv, OpPresence tk, OpPresence tv)
-> Map (Value' Instr tk) (Value' Instr tv) -> Doc
renderMap (Sing k
Sing n
tk, Sing v
Sing n
tv, Sing k -> OpPresence k
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing k
Sing n
tk, Sing v -> OpPresence v
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing v
Sing n
tv) Map (Value' Instr k) (Value' Instr v)
m
    (VBigMap Maybe Natural
_ Map (Value' Instr k) (Value' Instr v)
m, STBigMap tk tv) -> (Sing k, Sing v, OpPresence k, OpPresence v)
-> Map (Value' Instr k) (Value' Instr v) -> Doc
forall (tk :: T) (tv :: T).
(Sing tk, Sing tv, OpPresence tk, OpPresence tv)
-> Map (Value' Instr tk) (Value' Instr tv) -> Doc
renderMap (Sing k
Sing n
tk, Sing v
Sing n
tv, Sing k -> OpPresence k
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing k
Sing n
tk, Sing v -> OpPresence v
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing v
Sing n
tv) Map (Value' Instr k) (Value' Instr v)
m
  where render :: SingT t -> Value' Instr t -> RenderContext -> Doc
render SingT t
sg Value' Instr t
v RenderContext
ctx = RenderContext -> OpPresence t -> (Value' Instr t, Sing t) -> Doc
forall (t :: T).
RenderContext -> OpPresence t -> (Value' Instr t, Sing t) -> Doc
renderDocSing RenderContext
ctx (Sing t -> OpPresence t
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing t
SingT t
sg) (Value' Instr t
v, Sing t
SingT t
sg)

renderList :: OpPresence t -> Sing t -> [Value' Instr t] -> Doc
renderList :: OpPresence t -> Sing t -> [Value' Instr t] -> Doc
renderList OpPresence t
osg Sing t
sg = (Value' Instr t -> Doc) -> [Value' Instr t] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
renderList' ((Value' Instr t -> Doc) -> [Value' Instr t] -> Doc)
-> (Value' Instr t -> Doc) -> [Value' Instr t] -> Doc
forall a b. (a -> b) -> a -> b
$ RenderContext -> OpPresence t -> (Value' Instr t, Sing t) -> Doc
forall (t :: T).
RenderContext -> OpPresence t -> (Value' Instr t, Sing t) -> Doc
renderDocSing RenderContext
doesntNeedParens OpPresence t
osg ((Value' Instr t, SingT t) -> Doc)
-> (Value' Instr t -> (Value' Instr t, SingT t))
-> Value' Instr t
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, Sing t
SingT t
sg)

renderMap :: (Sing tk, Sing tv, OpPresence tk, OpPresence tv)
          -> Map (Value' Instr tk) (Value' Instr tv) -> Doc
renderMap :: (Sing tk, Sing tv, OpPresence tk, OpPresence tv)
-> Map (Value' Instr tk) (Value' Instr tv) -> Doc
renderMap (Sing tk, Sing tv, OpPresence tk, OpPresence tv)
ctx = ((Value' Instr tk, Value' Instr tv) -> Doc)
-> [(Value' Instr tk, Value' Instr tv)] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
renderList' ((Sing tk, Sing tv, OpPresence tk, OpPresence tv)
-> (Value' Instr tk, Value' Instr tv) -> Doc
forall (tk :: T) (tv :: T).
(Sing tk, Sing tv, OpPresence tk, OpPresence tv)
-> (Value' Instr tk, Value' Instr tv) -> Doc
renderElt (Sing tk, Sing tv, OpPresence tk, OpPresence tv)
ctx) ([(Value' Instr tk, Value' Instr tv)] -> Doc)
-> (Map (Value' Instr tk) (Value' Instr tv)
    -> [(Value' Instr tk, Value' Instr tv)])
-> Map (Value' Instr tk) (Value' Instr tv)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Value' Instr tk) (Value' Instr tv)
-> [(Value' Instr tk, Value' Instr tv)]
forall k a. Map k a -> [(k, a)]
Map.toList

renderList' :: (a -> Doc) -> [a] -> Doc
renderList' :: (a -> Doc) -> [a] -> Doc
renderList' a -> Doc
f = Doc -> (NonEmpty a -> Doc) -> Maybe (NonEmpty a) -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
"{ }" ((a -> Doc) -> NonEmpty a -> Doc
forall e. (e -> Doc) -> NonEmpty e -> Doc
U.renderValuesList a -> Doc
f) (Maybe (NonEmpty a) -> Doc)
-> ([a] -> Maybe (NonEmpty a)) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty

renderElt :: (Sing tk, Sing tv, OpPresence tk, OpPresence tv)
          -> (Value' Instr tk, Value' Instr tv) -> Doc
renderElt :: (Sing tk, Sing tv, OpPresence tk, OpPresence tv)
-> (Value' Instr tk, Value' Instr tv) -> Doc
renderElt (Sing tk
tk, Sing tv
tv, OpPresence tk
otk, OpPresence tv
otv) (Value' Instr tk
k, Value' Instr tv
v) =
  (RenderContext -> Doc) -> (RenderContext -> Doc) -> Doc
U.renderElt' (OpPresence tk
-> Value' Instr tk -> SingT tk -> RenderContext -> Doc
forall (t :: T).
OpPresence t -> Value' Instr t -> SingT t -> RenderContext -> Doc
render OpPresence tk
otk Value' Instr tk
k Sing tk
SingT tk
tk) (OpPresence tv
-> Value' Instr tv -> SingT tv -> RenderContext -> Doc
forall (t :: T).
OpPresence t -> Value' Instr t -> SingT t -> RenderContext -> Doc
render OpPresence tv
otv Value' Instr tv
v Sing tv
SingT tv
tv)
  where render :: OpPresence t -> Value' Instr t -> SingT t -> RenderContext -> Doc
render OpPresence t
o Value' Instr t
x SingT t
tx RenderContext
ctx = RenderContext -> OpPresence t -> (Value' Instr t, Sing t) -> Doc
forall (t :: T).
RenderContext -> OpPresence t -> (Value' Instr t, Sing t) -> Doc
renderDocSing RenderContext
ctx OpPresence t
o (Value' Instr t
x, Sing t
SingT t
tx)

-- | Mimics U.linearizeRightCombValuePair, but for typed values;
-- however, unlike U.linearizeRightCombValuePair renders values on-the-fly.
renderLinearizedRightCombValuePair :: (Value' Instr t, Sing t) -> NonEmpty Doc
renderLinearizedRightCombValuePair :: (Value' Instr t, Sing t) -> NonEmpty Doc
renderLinearizedRightCombValuePair = \case
  (VPair (Value' Instr l
l, Value' Instr r
r), STPair tl tr) -> RenderContext -> OpPresence l -> (Value' Instr l, Sing l) -> Doc
forall (t :: T).
RenderContext -> OpPresence t -> (Value' Instr t, Sing t) -> Doc
renderDocSing RenderContext
doesntNeedParens (Sing l -> OpPresence l
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing l
Sing n
tl) (Value' Instr l
l, Sing l
Sing n
tl)
                               Doc -> NonEmpty Doc -> NonEmpty Doc
forall a. a -> NonEmpty a -> NonEmpty a
<| (Value' Instr r, Sing r) -> NonEmpty Doc
forall (t :: T). (Value' Instr t, Sing t) -> NonEmpty Doc
renderLinearizedRightCombValuePair (Value' Instr r
r, Sing r
Sing n
tr)
  val :: (Value' Instr t, Sing t)
val@(Value' Instr t
_, Sing t
tv)                  -> RenderContext -> OpPresence t -> (Value' Instr t, Sing t) -> Doc
forall (t :: T).
RenderContext -> OpPresence t -> (Value' Instr t, Sing t) -> Doc
renderDocSing RenderContext
doesntNeedParens (Sing t -> OpPresence t
forall (ty :: T). Sing ty -> OpPresence ty
checkOpPresence Sing t
tv) (Value' Instr t, Sing t)
val Doc -> [Doc] -> NonEmpty Doc
forall a. a -> [a] -> NonEmpty a
:| []