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

-- | Module, providing functions for conversion from
-- instruction and value representation from @Michelson.Type@ module
-- to strictly-typed GADT-based representation from @Michelson.Value@ module.
--
-- This conversion is labeled as type check because that's what we are obliged
-- to do on our way.
--
-- Type check algorithm relies on the property of Michelson language that each
-- instruction on a given input stack type produces a definite output stack
-- type.
-- Michelson contract defines concrete types for storage and parameter, from
-- which input stack type is deduced. Then this type is being combined with
-- each subsequent instruction, producing next stack type after each
-- application.
--
-- Function @typeCheck@ takes list of instructions and returns value of type
-- @Instr inp out@ along with @HST inp@ and @HST out@ all wrapped into
-- @SomeInstr@ data type. This wrapping is done to satsify Haskell type
-- system (which has no support for dependent types).
-- Functions @typeCheckInstr@, @typeCheckValue@ behave similarly.
--
-- When a recursive call is made within @typeCheck@, @typeCheckInstr@ or
-- @typeCheckValue@, result of a call is unwrapped from @SomeInstr@ and type
-- information from @HST inp@ and @HST out@ is being used to assert that
-- recursive call returned instruction of expected type
-- (error is thrown otherwise).
module Michelson.TypeCheck.Instr
    ( typeCheckContract
    , typeCheckContractAndStorage
    , typeCheckValue
    , typeCheckList
    , typeVerifyStorage
    , typeVerifyParameter
    , typeCheckStorage
    , typeCheckParameter
    ) where

import Prelude hiding (EQ, GT, LT)

import Control.Monad.Except (MonadError, liftEither, throwError)
import Data.Default (def)
import Data.Generics (everything, mkQ)
import Data.Singletons (Sing, demote)
import Data.Typeable ((:~:)(..))

import Michelson.ErrorPos
import Michelson.TypeCheck.Error
import Michelson.TypeCheck.Ext
import Michelson.TypeCheck.Helpers
import Michelson.TypeCheck.TypeCheck
import Michelson.TypeCheck.Types
import Michelson.TypeCheck.Value
import Michelson.Typed.Value

import Michelson.Typed
import Util.Peano

import qualified Michelson.Untyped as U
import Michelson.Untyped.Annotation (VarAnn)

-- | Type check a contract and verify that the given storage
-- is of the type expected by the contract.
typeCheckContractAndStorage :: U.Contract -> U.Value -> Either TCError SomeContractAndStorage
typeCheckContractAndStorage :: Contract -> Value -> Either TCError SomeContractAndStorage
typeCheckContractAndStorage uContract :: Contract
uContract uStorage :: Value
uStorage = do
  SomeContract (contract :: Contract cp st
contract@Contract{} :: Contract cp st) <- Contract -> Either TCError SomeContract
typeCheckContract Contract
uContract
  Value st
storage <- Value -> Either TCError (Value st)
forall (t :: T). SingI t => Value -> Either TCError (Value t)
typeVerifyStorage @st Value
uStorage
  SomeContractAndStorage -> Either TCError SomeContractAndStorage
forall a b. b -> Either a b
Right (SomeContractAndStorage -> Either TCError SomeContractAndStorage)
-> SomeContractAndStorage -> Either TCError SomeContractAndStorage
forall a b. (a -> b) -> a -> b
$ Contract cp st -> Value st -> SomeContractAndStorage
forall (cp :: T) (cp :: T).
(StorageScope cp, ParameterScope cp) =>
Contract cp cp -> Value cp -> SomeContractAndStorage
SomeContractAndStorage Contract cp st
contract Value st
storage

typeCheckContract
  :: U.Contract
  -> Either TCError SomeContract
typeCheckContract :: Contract -> Either TCError SomeContract
typeCheckContract c :: Contract
c = do
  SomeParamType
paramType <- ParameterType -> Either TCError SomeParamType
mkSomeParamType (Contract -> ParameterType
forall op. Contract' op -> ParameterType
U.contractParameter Contract
c)
  TypeCheckMode
-> TypeCheck SomeContract -> Either TCError SomeContract
forall a. TypeCheckMode -> TypeCheck a -> Either TCError a
runTypeCheck (SomeParamType -> TypeCheckMode
TypeCheckContract SomeParamType
paramType) (TypeCheck SomeContract -> Either TCError SomeContract)
-> TypeCheck SomeContract -> Either TCError SomeContract
forall a b. (a -> b) -> a -> b
$ Contract -> TypeCheck SomeContract
typeCheckContractImpl Contract
c

withWTP :: forall t a. SingI t => (WellTyped t => TypeCheck a) -> TypeCheck a
withWTP :: (WellTyped t => TypeCheck a) -> TypeCheck a
withWTP fn :: WellTyped t => TypeCheck a
fn = case SingI t => Either NotWellTyped (Dict (WellTyped t))
forall (t :: T).
SingI t =>
Either NotWellTyped (Dict (WellTyped t))
getWTP @t of
  Right Dict -> TypeCheck a
WellTyped t => TypeCheck a
fn
  Left (NotWellTyped t :: T
t) -> TCError -> TypeCheck a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError -> TypeCheck a) -> TCError -> TypeCheck a
forall a b. (a -> b) -> a -> b
$ Text -> Maybe TCTypeError -> TCError
TCContractError ("Not a well typed value: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> T -> Text
forall b a. (Show a, IsString b) => a -> b
show T
t) Maybe TCTypeError
forall a. Maybe a
Nothing

withWTPInstr_ :: forall t a. SingI t => U.ExpandedInstr -> SomeHST -> (WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr_ :: ExpandedInstr
-> SomeHST -> (WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr_ v :: ExpandedInstr
v t :: SomeHST
t fn :: WellTyped t => TypeCheckInstr a
fn = case SingI t => Either NotWellTyped (Dict (WellTyped t))
forall (t :: T).
SingI t =>
Either NotWellTyped (Dict (WellTyped t))
getWTP @t of
  Right Dict -> TypeCheckInstr a
WellTyped t => TypeCheckInstr a
fn
  Left (NotWellTyped badType :: T
badType) -> do
    InstrCallStack
loc <- ReaderT InstrCallStack TypeCheck InstrCallStack
forall r (m :: * -> *). MonadReader r m => m r
ask
    TCError -> TypeCheckInstr a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError -> TypeCheckInstr a) -> TCError -> TypeCheckInstr a
forall a b. (a -> b) -> a -> b
$ ExpandedInstr
-> SomeHST
-> InstrCallStack
-> Maybe TypeContext
-> Maybe TCTypeError
-> TCError
TCFailedOnInstr ExpandedInstr
v SomeHST
t InstrCallStack
loc Maybe TypeContext
forall a. Maybe a
Nothing (TCTypeError -> Maybe TCTypeError
forall a. a -> Maybe a
Just (TCTypeError -> Maybe TCTypeError)
-> TCTypeError -> Maybe TCTypeError
forall a b. (a -> b) -> a -> b
$ T -> BadTypeForScope -> TCTypeError
UnsupportedTypeForScope T
badType BadTypeForScope
BtNotComparable)

typeCheckContractImpl
  :: U.Contract
  -> TypeCheck SomeContract
typeCheckContractImpl :: Contract -> TypeCheck SomeContract
typeCheckContractImpl (U.Contract (U.ParameterType mParam :: Type
mParam rootAnn :: RootAnn
rootAnn) mStorage :: Type
mStorage pCode :: [ExpandedOp]
pCode entriesOrder :: EntriesOrder
entriesOrder) = do
  NonEmpty ExpandedOp
_ <- ExceptT TCError (State TypeCheckEnv) (NonEmpty ExpandedOp)
-> (NonEmpty ExpandedOp
    -> ExceptT TCError (State TypeCheckEnv) (NonEmpty ExpandedOp))
-> Maybe (NonEmpty ExpandedOp)
-> ExceptT TCError (State TypeCheckEnv) (NonEmpty ExpandedOp)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TCError
-> ExceptT TCError (State TypeCheckEnv) (NonEmpty ExpandedOp)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError
 -> ExceptT TCError (State TypeCheckEnv) (NonEmpty ExpandedOp))
-> TCError
-> ExceptT TCError (State TypeCheckEnv) (NonEmpty ExpandedOp)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe TCTypeError -> TCError
TCContractError "no instructions in contract code" (Maybe TCTypeError -> TCError) -> Maybe TCTypeError -> TCError
forall a b. (a -> b) -> a -> b
$ TCTypeError -> Maybe TCTypeError
forall a. a -> Maybe a
Just TCTypeError
EmptyCode)
                NonEmpty ExpandedOp
-> ExceptT TCError (State TypeCheckEnv) (NonEmpty ExpandedOp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ExpandedOp] -> Maybe (NonEmpty ExpandedOp)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [ExpandedOp]
pCode)
  Type
-> (forall (t :: T). KnownT t => Notes t -> TypeCheck SomeContract)
-> TypeCheck SomeContract
forall r. Type -> (forall (t :: T). KnownT t => Notes t -> r) -> r
withUType Type
mParam ((forall (t :: T). KnownT t => Notes t -> TypeCheck SomeContract)
 -> TypeCheck SomeContract)
-> (forall (t :: T). KnownT t => Notes t -> TypeCheck SomeContract)
-> TypeCheck SomeContract
forall a b. (a -> b) -> a -> b
$ \(Notes t
paramNote :: Notes param) ->
    Type
-> (forall (t :: T). KnownT t => Notes t -> TypeCheck SomeContract)
-> TypeCheck SomeContract
forall r. Type -> (forall (t :: T). KnownT t => Notes t -> r) -> r
withUType Type
mStorage ((forall (t :: T). KnownT t => Notes t -> TypeCheck SomeContract)
 -> TypeCheck SomeContract)
-> (forall (t :: T). KnownT t => Notes t -> TypeCheck SomeContract)
-> TypeCheck SomeContract
forall a b. (a -> b) -> a -> b
$ \(Notes t
storageNote :: Notes st) -> do
      forall a. SingI t => (WellTyped t => TypeCheck a) -> TypeCheck a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheck a) -> TypeCheck a
withWTP @st ((WellTyped t => TypeCheck SomeContract) -> TypeCheck SomeContract)
-> (WellTyped t => TypeCheck SomeContract)
-> TypeCheck SomeContract
forall a b. (a -> b) -> a -> b
$ do
        forall a. SingI t => (WellTyped t => TypeCheck a) -> TypeCheck a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheck a) -> TypeCheck a
withWTP @param ((WellTyped t => TypeCheck SomeContract) -> TypeCheck SomeContract)
-> (WellTyped t => TypeCheck SomeContract)
-> TypeCheck SomeContract
forall a b. (a -> b) -> a -> b
$ do
          Dict (ParameterScope t)
Dict <- (BadTypeForScope -> TypeCheck (Dict (ParameterScope t)))
-> (Dict (ParameterScope t) -> TypeCheck (Dict (ParameterScope t)))
-> Either BadTypeForScope (Dict (ParameterScope t))
-> TypeCheck (Dict (ParameterScope t))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> BadTypeForScope -> TypeCheck (Dict (ParameterScope t))
forall (t :: T) a.
SingI t =>
Text -> BadTypeForScope -> TypeCheck a
hasTypeError @param "parameter") Dict (ParameterScope t) -> TypeCheck (Dict (ParameterScope t))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (Either BadTypeForScope (Dict (ParameterScope t))
 -> TypeCheck (Dict (ParameterScope t)))
-> Either BadTypeForScope (Dict (ParameterScope t))
-> TypeCheck (Dict (ParameterScope t))
forall a b. (a -> b) -> a -> b
$ CheckScope (ParameterScope t) =>
Either BadTypeForScope (Dict (ParameterScope t))
forall (c :: Constraint).
CheckScope c =>
Either BadTypeForScope (Dict c)
checkScope @(ParameterScope param)
          Dict (StorageScope t)
Dict <- (BadTypeForScope -> TypeCheck (Dict (StorageScope t)))
-> (Dict (StorageScope t) -> TypeCheck (Dict (StorageScope t)))
-> Either BadTypeForScope (Dict (StorageScope t))
-> TypeCheck (Dict (StorageScope t))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> BadTypeForScope -> TypeCheck (Dict (StorageScope t))
forall (t :: T) a.
SingI t =>
Text -> BadTypeForScope -> TypeCheck a
hasTypeError @st "storage") Dict (StorageScope t) -> TypeCheck (Dict (StorageScope t))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (Either BadTypeForScope (Dict (StorageScope t))
 -> TypeCheck (Dict (StorageScope t)))
-> Either BadTypeForScope (Dict (StorageScope t))
-> TypeCheck (Dict (StorageScope t))
forall a b. (a -> b) -> a -> b
$ CheckScope (StorageScope t) =>
Either BadTypeForScope (Dict (StorageScope t))
forall (c :: Constraint).
CheckScope c =>
Either BadTypeForScope (Dict c)
checkScope @(StorageScope st)
          let inpNote :: Notes ('TPair t t)
inpNote = TypeAnn
-> FieldAnn -> FieldAnn -> Notes t -> Notes t -> Notes ('TPair t t)
forall (p :: T) (p :: T).
TypeAnn
-> FieldAnn -> FieldAnn -> Notes p -> Notes p -> Notes ('TPair p p)
NTPair TypeAnn
forall a. Default a => a
def FieldAnn
forall a. Default a => a
def FieldAnn
forall a. Default a => a
def Notes t
paramNote Notes t
storageNote
          let inp :: HST '[ 'TPair t t]
inp = (Notes ('TPair t t)
inpNote, Dict (WellTyped ('TPair t t))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
forall a. Default a => a
def) (Notes ('TPair t t), Dict (WellTyped ('TPair t t)),
 Annotation VarTag)
-> HST '[] -> HST '[ 'TPair t t]
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST '[]
SNil
          inp' :: HST '[ 'TPair t t]
inp' :/ instrOut :: SomeInstrOut '[ 'TPair t t]
instrOut <- InstrCallStack
-> ReaderT InstrCallStack TypeCheck (SomeInstr '[ 'TPair t t])
-> TypeCheck (SomeInstr '[ 'TPair t t])
forall r (m :: * -> *) a. r -> ReaderT r m a -> m a
usingReaderT InstrCallStack
forall a. Default a => a
def (ReaderT InstrCallStack TypeCheck (SomeInstr '[ 'TPair t t])
 -> TypeCheck (SomeInstr '[ 'TPair t t]))
-> ReaderT InstrCallStack TypeCheck (SomeInstr '[ 'TPair t t])
-> TypeCheck (SomeInstr '[ 'TPair t t])
forall a b. (a -> b) -> a -> b
$ TcInstrHandler
-> [ExpandedOp]
-> HST '[ 'TPair t t]
-> ReaderT InstrCallStack TypeCheck (SomeInstr '[ 'TPair t t])
forall (inp :: [T]).
Typeable inp =>
TcInstrHandler
-> [ExpandedOp] -> HST inp -> TypeCheckInstr (SomeInstr inp)
typeCheckImpl TcInstrHandler
typeCheckInstr [ExpandedOp]
pCode HST '[ 'TPair t t]
inp
          let (paramNotesRaw :: Notes t
paramNotesRaw, cStoreNotes :: Notes t
cStoreNotes) = case HST '[ 'TPair t t]
inp' of
                (NTPair _ _ _ cpNotes :: Notes p
cpNotes stNotes :: Notes q
stNotes, _, _) ::& SNil -> (Notes t
Notes p
cpNotes, Notes t
Notes q
stNotes)
          ParamNotes t
cParamNotes <-
            Either TCError (ParamNotes t)
-> ExceptT TCError (State TypeCheckEnv) (ParamNotes t)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either TCError (ParamNotes t)
 -> ExceptT TCError (State TypeCheckEnv) (ParamNotes t))
-> Either TCError (ParamNotes t)
-> ExceptT TCError (State TypeCheckEnv) (ParamNotes t)
forall a b. (a -> b) -> a -> b
$
            Notes t -> RootAnn -> Either ParamEpError (ParamNotes t)
forall (t :: T).
Notes t -> RootAnn -> Either ParamEpError (ParamNotes t)
mkParamNotes Notes t
paramNotesRaw RootAnn
rootAnn Either ParamEpError (ParamNotes t)
-> (ParamEpError -> TCError) -> Either TCError (ParamNotes t)
forall a c b. Either a c -> (a -> b) -> Either b c
`onLeft`
                (Text -> Maybe TCTypeError -> TCError
TCContractError "invalid parameter declaration: " (Maybe TCTypeError -> TCError)
-> (ParamEpError -> Maybe TCTypeError) -> ParamEpError -> TCError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TCTypeError -> Maybe TCTypeError
forall a. a -> Maybe a
Just (TCTypeError -> Maybe TCTypeError)
-> (ParamEpError -> TCTypeError)
-> ParamEpError
-> Maybe TCTypeError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParamEpError -> TCTypeError
IllegalParamDecl)
          case SomeInstrOut '[ 'TPair t t]
instrOut of
            instr :: Instr '[ 'TPair t t] out
instr ::: out :: HST out
out -> Either TCError SomeContract -> TypeCheck SomeContract
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either TCError SomeContract -> TypeCheck SomeContract)
-> Either TCError SomeContract -> TypeCheck SomeContract
forall a b. (a -> b) -> a -> b
$ do
              case HST out -> Either TCTypeError (out :~: '[ContractOut1 t])
forall (t :: T) (st :: [T]).
(Typeable st, WellTyped t) =>
HST st -> Either TCTypeError (st :~: '[t])
eqHST1 @(ContractOut1 st) HST out
out of
                Right Refl -> do
                  let (outN, _, _) ::& SNil = HST out
out
                  Notes (ContractOut1 t)
_ <- Notes (ContractOut1 t)
-> Notes (ContractOut1 t)
-> Either AnnConvergeError (Notes (ContractOut1 t))
forall (t :: T).
Notes t -> Notes t -> Either AnnConvergeError (Notes t)
converge Notes (ContractOut1 t)
outN (TypeAnn
-> FieldAnn
-> FieldAnn
-> Notes ('TList 'TOperation)
-> Notes t
-> Notes (ContractOut1 t)
forall (p :: T) (p :: T).
TypeAnn
-> FieldAnn -> FieldAnn -> Notes p -> Notes p -> Notes ('TPair p p)
NTPair TypeAnn
forall a. Default a => a
def FieldAnn
forall a. Default a => a
def FieldAnn
forall a. Default a => a
def Notes ('TList 'TOperation)
forall (t :: T). SingI t => Notes t
starNotes Notes t
storageNote)
                          Either AnnConvergeError (Notes (ContractOut1 t))
-> (AnnConvergeError -> TCError)
-> Either TCError (Notes (ContractOut1 t))
forall a c b. Either a c -> (a -> b) -> Either b c
`onLeft`
                      ((Text -> Maybe TCTypeError -> TCError
TCContractError "contract output type violates convention:") (Maybe TCTypeError -> TCError)
-> (AnnConvergeError -> Maybe TCTypeError)
-> AnnConvergeError
-> TCError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TCTypeError -> Maybe TCTypeError
forall a. a -> Maybe a
Just (TCTypeError -> Maybe TCTypeError)
-> (AnnConvergeError -> TCTypeError)
-> AnnConvergeError
-> Maybe TCTypeError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnConvergeError -> TCTypeError
AnnError)
                  pure $ Contract t t -> SomeContract
forall (cp :: T) (st :: T). Contract cp st -> SomeContract
SomeContract $WContract :: forall (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
ContractCode cp st
-> ParamNotes cp -> Notes st -> EntriesOrder -> Contract cp st
Contract
                    { cCode :: ContractCode t t
cCode = Instr '[ 'TPair t t] out
ContractCode t t
instr
                    , ParamNotes t
cParamNotes :: ParamNotes t
cParamNotes :: ParamNotes t
cParamNotes
                    , Notes t
cStoreNotes :: Notes t
cStoreNotes :: Notes t
cStoreNotes
                    , cEntriesOrder :: EntriesOrder
cEntriesOrder = EntriesOrder
entriesOrder
                    }
                Left err :: TCTypeError
err -> TCError -> Either TCError SomeContract
forall a b. a -> Either a b
Left (TCError -> Either TCError SomeContract)
-> TCError -> Either TCError SomeContract
forall a b. (a -> b) -> a -> b
$ Text -> Maybe TCTypeError -> TCError
TCContractError "contract output type violates convention:" (Maybe TCTypeError -> TCError) -> Maybe TCTypeError -> TCError
forall a b. (a -> b) -> a -> b
$ TCTypeError -> Maybe TCTypeError
forall a. a -> Maybe a
Just TCTypeError
err
            AnyOutInstr instr :: forall (out :: [T]). Instr '[ 'TPair t t] out
instr ->
              SomeContract -> TypeCheck SomeContract
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeContract -> TypeCheck SomeContract)
-> SomeContract -> TypeCheck SomeContract
forall a b. (a -> b) -> a -> b
$ Contract t t -> SomeContract
forall (cp :: T) (st :: T). Contract cp st -> SomeContract
SomeContract $WContract :: forall (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
ContractCode cp st
-> ParamNotes cp -> Notes st -> EntriesOrder -> Contract cp st
Contract
                { cCode :: ContractCode t t
cCode = ContractCode t t
forall (out :: [T]). Instr '[ 'TPair t t] out
instr
                , ParamNotes t
cParamNotes :: ParamNotes t
cParamNotes :: ParamNotes t
cParamNotes
                , Notes t
cStoreNotes :: Notes t
cStoreNotes :: Notes t
cStoreNotes
                , cEntriesOrder :: EntriesOrder
cEntriesOrder = EntriesOrder
entriesOrder
                }
  where
    hasTypeError :: forall (t :: T) a. SingI t => Text -> BadTypeForScope -> TypeCheck a
    hasTypeError :: Text -> BadTypeForScope -> TypeCheck a
hasTypeError name :: Text
name reason :: BadTypeForScope
reason = TCError -> TypeCheck a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TCError -> TypeCheck a) -> TCError -> TypeCheck a
forall a b. (a -> b) -> a -> b
$
      Text -> Maybe TCTypeError -> TCError
TCContractError ("contract " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " type error") (Maybe TCTypeError -> TCError) -> Maybe TCTypeError -> TCError
forall a b. (a -> b) -> a -> b
$
      TCTypeError -> Maybe TCTypeError
forall a. a -> Maybe a
Just (TCTypeError -> Maybe TCTypeError)
-> TCTypeError -> Maybe TCTypeError
forall a b. (a -> b) -> a -> b
$ T -> BadTypeForScope -> TCTypeError
UnsupportedTypeForScope ((SingKind T, SingI t) => Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
demote @t) BadTypeForScope
reason

-- | Function @typeCheckList@ converts list of Michelson instructions
-- given in representation from @Michelson.Type@ module to representation
-- in strictly typed GADT.
--
-- Types are checked along the way which is neccessary to construct a
-- strictly typed value.
--
-- As a second argument, @typeCheckList@ accepts input stack type representation.
typeCheckList
  :: (Typeable inp)
  => [U.ExpandedOp]
  -> HST inp
  -> TypeCheck (SomeInstr inp)
typeCheckList :: [ExpandedOp] -> HST inp -> TypeCheck (SomeInstr inp)
typeCheckList = InstrCallStack
-> ReaderT InstrCallStack TypeCheck (SomeInstr inp)
-> TypeCheck (SomeInstr inp)
forall r (m :: * -> *) a. r -> ReaderT r m a -> m a
usingReaderT InstrCallStack
forall a. Default a => a
def (ReaderT InstrCallStack TypeCheck (SomeInstr inp)
 -> TypeCheck (SomeInstr inp))
-> ([ExpandedOp]
    -> HST inp -> ReaderT InstrCallStack TypeCheck (SomeInstr inp))
-> [ExpandedOp]
-> HST inp
-> TypeCheck (SomeInstr inp)
forall a b c. SuperComposition a b c => a -> b -> c
... TcInstrHandler
-> [ExpandedOp]
-> HST inp
-> ReaderT InstrCallStack TypeCheck (SomeInstr inp)
forall (inp :: [T]).
Typeable inp =>
TcInstrHandler
-> [ExpandedOp] -> HST inp -> TypeCheckInstr (SomeInstr inp)
typeCheckImpl TcInstrHandler
typeCheckInstr

-- | Function @typeCheckValue@ converts a single Michelson value
-- given in representation from @Michelson.Untyped@ module hierarchy to
-- representation in strictly typed GADT.
--
-- @typeCheckValue@ is polymorphic in the expected type of value.
--
-- Type checking algorithm pattern-matches on parse value representation,
-- expected type @t@ and constructs @Value t@ value.
--
-- If there was no match on a given pair of value and expected type,
-- that is interpreted as input of wrong type and type check finishes with
-- error.
typeCheckValue
  :: forall t. SingI t
  => U.Value
  -> TypeCheckInstr (Value t)
typeCheckValue :: Value -> TypeCheckInstr (Value t)
typeCheckValue = Maybe TcOriginatedContracts
-> TcInstrHandler -> Value -> TypeCheckInstr (Value t)
forall (ty :: T).
SingI ty =>
Maybe TcOriginatedContracts
-> TcInstrHandler -> Value -> TypeCheckInstr (Value ty)
typeCheckValImpl @t Maybe TcOriginatedContracts
forall a. Maybe a
Nothing TcInstrHandler
typeCheckInstr

typeVerifyParameter
  :: SingI t
  => TcOriginatedContracts -> U.Value -> Either TCError (Value t)
typeVerifyParameter :: TcOriginatedContracts -> Value -> Either TCError (Value t)
typeVerifyParameter originatedContracts :: TcOriginatedContracts
originatedContracts = Maybe TcOriginatedContracts -> Value -> Either TCError (Value t)
forall (t :: T).
SingI t =>
Maybe TcOriginatedContracts -> Value -> Either TCError (Value t)
typeVerifyTopLevelType (TcOriginatedContracts -> Maybe TcOriginatedContracts
forall a. a -> Maybe a
Just TcOriginatedContracts
originatedContracts)

typeVerifyStorage
  :: SingI t
  => U.Value -> Either TCError (Value t)
typeVerifyStorage :: Value -> Either TCError (Value t)
typeVerifyStorage = Maybe TcOriginatedContracts -> Value -> Either TCError (Value t)
forall (t :: T).
SingI t =>
Maybe TcOriginatedContracts -> Value -> Either TCError (Value t)
typeVerifyTopLevelType Maybe TcOriginatedContracts
forall a. Maybe a
Nothing

typeVerifyTopLevelType
  :: forall t. SingI t
  => Maybe TcOriginatedContracts -> U.Value -> Either TCError (Value t)
typeVerifyTopLevelType :: Maybe TcOriginatedContracts -> Value -> Either TCError (Value t)
typeVerifyTopLevelType mOriginatedContracts :: Maybe TcOriginatedContracts
mOriginatedContracts valueU :: Value
valueU =
  TypeCheckMode -> TypeCheck (Value t) -> Either TCError (Value t)
forall a. TypeCheckMode -> TypeCheck a -> Either TCError a
runTypeCheck ((Value, T) -> TypeCheckMode
TypeCheckValue (Value
valueU, (SingKind T, SingI t) => Demote T
forall k (a :: k). (SingKind k, SingI a) => Demote k
demote @t)) (TypeCheck (Value t) -> Either TCError (Value t))
-> TypeCheck (Value t) -> Either TCError (Value t)
forall a b. (a -> b) -> a -> b
$ InstrCallStack
-> ReaderT InstrCallStack TypeCheck (Value t)
-> TypeCheck (Value t)
forall r (m :: * -> *) a. r -> ReaderT r m a -> m a
usingReaderT (InstrCallStack
forall a. Default a => a
def :: InstrCallStack) (ReaderT InstrCallStack TypeCheck (Value t) -> TypeCheck (Value t))
-> ReaderT InstrCallStack TypeCheck (Value t)
-> TypeCheck (Value t)
forall a b. (a -> b) -> a -> b
$
    Maybe TcOriginatedContracts
-> TcInstrHandler
-> Value
-> ReaderT InstrCallStack TypeCheck (Value t)
forall (ty :: T).
SingI ty =>
Maybe TcOriginatedContracts
-> TcInstrHandler -> Value -> TypeCheckInstr (Value ty)
typeCheckValImpl Maybe TcOriginatedContracts
mOriginatedContracts TcInstrHandler
typeCheckInstr Value
valueU

-- | Like 'typeCheckValue', but for values to be used as parameter.
--
-- Also accepts a 'TcOriginatedContracts' in order to be able to type-check
-- @contract p@ values (which can only be part of a parameter).
typeCheckParameter
  :: TcOriginatedContracts -> U.Type -> U.Value -> Either TCError SomeValue
typeCheckParameter :: TcOriginatedContracts -> Type -> Value -> Either TCError SomeValue
typeCheckParameter originatedContracts :: TcOriginatedContracts
originatedContracts = Maybe TcOriginatedContracts
-> Type -> Value -> Either TCError SomeValue
typeCheckTopLevelType (TcOriginatedContracts -> Maybe TcOriginatedContracts
forall a. a -> Maybe a
Just TcOriginatedContracts
originatedContracts)

-- | Like 'typeCheckValue', but for values to be used as storage.
typeCheckStorage
  :: U.Type -> U.Value -> Either TCError SomeValue
typeCheckStorage :: Type -> Value -> Either TCError SomeValue
typeCheckStorage = Maybe TcOriginatedContracts
-> Type -> Value -> Either TCError SomeValue
typeCheckTopLevelType Maybe TcOriginatedContracts
forall a. Maybe a
Nothing

typeCheckTopLevelType
  :: Maybe TcOriginatedContracts -> U.Type -> U.Value -> Either TCError SomeValue
typeCheckTopLevelType :: Maybe TcOriginatedContracts
-> Type -> Value -> Either TCError SomeValue
typeCheckTopLevelType mOriginatedContracts :: Maybe TcOriginatedContracts
mOriginatedContracts typeU :: Type
typeU valueU :: Value
valueU =
  T
-> (forall (a :: T).
    KnownT a =>
    Sing a -> Either TCError SomeValue)
-> Either TCError SomeValue
forall r. T -> (forall (a :: T). KnownT a => Sing a -> r) -> r
withSomeSingT (Type -> T
fromUType Type
typeU) ((forall (a :: T). KnownT a => Sing a -> Either TCError SomeValue)
 -> Either TCError SomeValue)
-> (forall (a :: T).
    KnownT a =>
    Sing a -> Either TCError SomeValue)
-> Either TCError SomeValue
forall a b. (a -> b) -> a -> b
$ \(_ :: Sing t) ->
    Value' Instr a -> SomeValue
forall (t :: T) (instr :: [T] -> [T] -> *).
KnownT t =>
Value' instr t -> SomeValue' instr
SomeValue (Value' Instr a -> SomeValue)
-> Either TCError (Value' Instr a) -> Either TCError SomeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TcOriginatedContracts
-> Value -> Either TCError (Value' Instr a)
forall (t :: T).
SingI t =>
Maybe TcOriginatedContracts -> Value -> Either TCError (Value t)
typeVerifyTopLevelType @t Maybe TcOriginatedContracts
mOriginatedContracts Value
valueU

-- Helper data type we use to typecheck DROPN.
data TCDropHelper inp where
  TCDropHelper ::
    forall (n :: Peano) inp out.
    (Typeable out, SingI n, KnownPeano n, LongerOrSameLength inp n, Drop n inp ~ out) =>
    Sing n -> HST out -> TCDropHelper inp

-- Helper data type we use to typecheck DIG.
data TCDigHelper inp where
  TCDigHelper ::
    forall (n :: Peano) inp out a.
    (Typeable out, ConstraintDIG n inp out a) =>
    Sing n -> HST out -> TCDigHelper inp

-- Helper data type we use to typecheck DUG.
data TCDugHelper inp where
  TCDugHelper ::
    forall (n :: Peano) inp out a.
    (Typeable out, ConstraintDUG n inp out a) =>
    Sing n -> HST out -> TCDugHelper inp

-- | Function @typeCheckInstr@ converts a single Michelson instruction
-- given in representation from @Michelson.Type@ module to representation
-- in strictly typed GADT.
--
-- As a second argument, @typeCheckInstr@ accepts input stack type representation.
--
-- Type checking algorithm pattern-matches on given instruction, input stack
-- type and constructs strictly typed GADT value, checking necessary type
-- equalities when neccessary.
--
-- If there was no match on a given pair of instruction and input stack,
-- that is interpreted as input of wrong type and type check finishes with
-- error.
typeCheckInstr :: TcInstrHandler
typeCheckInstr :: ExpandedInstr -> HST inp -> TypeCheckInstr (SomeInstr inp)
typeCheckInstr uInstr :: ExpandedInstr
uInstr inp :: HST inp
inp = case (ExpandedInstr
uInstr, HST inp
inp) of
  (U.EXT ext :: ExtInstrAbstract ExpandedOp
ext, si :: HST inp
si) ->
    TypeCheckListHandler inp
-> ExtInstrAbstract ExpandedOp
-> HST inp
-> TypeCheckInstr (SomeInstr inp)
forall (s :: [T]).
Typeable s =>
TypeCheckListHandler s
-> ExtInstrAbstract ExpandedOp
-> HST s
-> TypeCheckInstr (SomeInstr s)
typeCheckExt TypeCheckListHandler inp
forall (inp :: [T]).
Typeable inp =>
[ExpandedOp] -> HST inp -> TypeCheck (SomeInstr inp)
typeCheckList ExtInstrAbstract ExpandedOp
ext HST inp
si

  (U.DROP, _ ::& rs :: HST xs
rs) -> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr (x : xs) xs
forall (a :: T) (s :: [T]). Instr (a : s) s
DROP Instr (x : xs) xs -> HST xs -> SomeInstrOut (x : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: HST xs
rs)

  (U.DROP, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.DROPN nTotal :: Word
nTotal, inputHST :: HST inp
inputHST) ->
    Word -> HST inp -> TypeCheckInstr (TCDropHelper inp)
forall (inp :: [T]).
Typeable inp =>
Word -> HST inp -> TypeCheckInstr (TCDropHelper inp)
go Word
nTotal HST inp
inputHST TypeCheckInstr (TCDropHelper inp)
-> (TCDropHelper inp -> SomeInstr inp)
-> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      TCDropHelper s :: Sing n
s out :: HST out
out -> HST inp
inputHST HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Sing n -> Instr inp (Drop n inp)
forall (n :: Peano) (s :: [T]).
(SingI n, KnownPeano n, RequireLongerOrSameLength s n,
 NFData (Sing n)) =>
Sing n -> Instr s (Drop n s)
DROPN Sing n
s Instr inp out -> HST out -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: HST out
out
    where
      go :: forall inp. Typeable inp
        => Word
        -> HST inp
        -> TypeCheckInstr (TCDropHelper inp)
      go :: Word -> HST inp -> TypeCheckInstr (TCDropHelper inp)
go n :: Word
n i :: HST inp
i = case (Word
n, HST inp
i) of
        (0, _) -> TCDropHelper inp -> TypeCheckInstr (TCDropHelper inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sing 'Z -> HST inp -> TCDropHelper inp
forall (a :: Peano) (inp :: [T]) (out :: [T]).
(Typeable out, SingI a, KnownPeano a, LongerOrSameLength inp a,
 Drop a inp ~ out) =>
Sing a -> HST out -> TCDropHelper inp
TCDropHelper Sing 'Z
SingNat 'Z
SZ HST inp
i)

        (_, SNil) -> TypeCheckInstr (TCDropHelper inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

        (_, (_ ::& iTail :: HST xs
iTail)) -> do
          Word -> HST xs -> TypeCheckInstr (TCDropHelper xs)
forall (inp :: [T]).
Typeable inp =>
Word -> HST inp -> TypeCheckInstr (TCDropHelper inp)
go (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1) HST xs
iTail TypeCheckInstr (TCDropHelper xs)
-> (TCDropHelper xs -> TCDropHelper inp)
-> TypeCheckInstr (TCDropHelper inp)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case TCDropHelper s :: Sing n
s out :: HST out
out -> Sing ('S n) -> HST out -> TCDropHelper (x : xs)
forall (a :: Peano) (inp :: [T]) (out :: [T]).
(Typeable out, SingI a, KnownPeano a, LongerOrSameLength inp a,
 Drop a inp ~ out) =>
Sing a -> HST out -> TCDropHelper inp
TCDropHelper (SingNat n -> SingNat ('S n)
forall (n :: Peano).
(SingI n, KnownPeano n) =>
SingNat n -> SingNat ('S n)
SS Sing n
SingNat n
s) HST out
out

  (U.DUP _vn :: Annotation VarTag
_vn, a :: (Notes x, Dict (WellTyped x), Annotation VarTag)
a ::& rs :: HST xs
rs) ->
    SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr (x : xs) (x : x : xs)
forall (a :: T) (a :: [T]). Instr (a : a) (a : a : a)
DUP Instr (x : xs) (x : x : xs)
-> HST (x : x : xs) -> SomeInstrOut (x : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes x, Dict (WellTyped x), Annotation VarTag)
a (Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST (x : xs) -> HST (x : x : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& (Notes x, Dict (WellTyped x), Annotation VarTag)
a(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs))

  (U.DUP _vn :: Annotation VarTag
_vn, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.SWAP, a :: (Notes x, Dict (WellTyped x), Annotation VarTag)
a ::& b :: (Notes x, Dict (WellTyped x), Annotation VarTag)
b ::& rs :: HST xs
rs) ->
    SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr (x : x : xs) (x : x : xs)
forall (a :: T) (b :: T) (s :: [T]). Instr (a : b : s) (b : a : s)
SWAP Instr (x : x : xs) (x : x : xs)
-> HST (x : x : xs) -> SomeInstrOut (x : x : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes x, Dict (WellTyped x), Annotation VarTag)
b (Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST (x : xs) -> HST (x : x : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& (Notes x, Dict (WellTyped x), Annotation VarTag)
a (Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs))

  (U.SWAP, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.DIG nTotal :: Word
nTotal, inputHST :: HST inp
inputHST) ->
    Word -> HST inp -> TypeCheckInstr (TCDigHelper inp)
forall (inp :: [T]).
Typeable inp =>
Word -> HST inp -> TypeCheckInstr (TCDigHelper inp)
go Word
nTotal HST inp
inputHST TypeCheckInstr (TCDigHelper inp)
-> (TCDigHelper inp -> SomeInstr inp)
-> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      TCDigHelper s :: Sing n
s out :: HST out
out -> HST inp
inputHST HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Sing n -> Instr inp out
forall (n :: Peano) (inp :: [T]) (out :: [T]) (n :: T).
(ConstraintDIG n inp out n, NFData (Sing n)) =>
Sing n -> Instr inp out
DIG Sing n
s Instr inp out -> HST out -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: HST out
out
    where
      go :: forall inp. Typeable inp
        => Word
        -> HST inp
        -> TypeCheckInstr (TCDigHelper inp)
      go :: Word -> HST inp -> TypeCheckInstr (TCDigHelper inp)
go n :: Word
n i :: HST inp
i = case (Word
n, HST inp
i) of
        -- Even 'DIG 0' is invalid on empty stack (so it is not strictly `Nop`).
        (_, SNil) -> TypeCheckInstr (TCDigHelper inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

        (0, (_ ::& _)) -> TCDigHelper inp -> TypeCheckInstr (TCDigHelper inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sing 'Z -> HST inp -> TCDigHelper inp
forall (a :: Peano) (inp :: [T]) (out :: [T]) (a :: T).
(Typeable out, ConstraintDIG a inp out a) =>
Sing a -> HST out -> TCDigHelper inp
TCDigHelper Sing 'Z
SingNat 'Z
SZ HST inp
i)

        (_, (b :: (Notes x, Dict (WellTyped x), Annotation VarTag)
b ::& iTail :: HST xs
iTail)) ->
          Word -> HST xs -> TypeCheckInstr (TCDigHelper xs)
forall (inp :: [T]).
Typeable inp =>
Word -> HST inp -> TypeCheckInstr (TCDigHelper inp)
go (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1) HST xs
iTail TypeCheckInstr (TCDigHelper xs)
-> (TCDigHelper xs -> TCDigHelper inp)
-> TypeCheckInstr (TCDigHelper inp)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          TCDigHelper s :: Sing n
s (a :: (Notes x, Dict (WellTyped x), Annotation VarTag)
a ::& resTail :: HST xs
resTail) -> Sing ('S n) -> HST (x : x : xs) -> TCDigHelper (x : xs)
forall (a :: Peano) (inp :: [T]) (out :: [T]) (a :: T).
(Typeable out, ConstraintDIG a inp out a) =>
Sing a -> HST out -> TCDigHelper inp
TCDigHelper (SingNat n -> SingNat ('S n)
forall (n :: Peano).
(SingI n, KnownPeano n) =>
SingNat n -> SingNat ('S n)
SS Sing n
SingNat n
s) ((Notes x, Dict (WellTyped x), Annotation VarTag)
a (Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST (x : xs) -> HST (x : x : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& (Notes x, Dict (WellTyped x), Annotation VarTag)
b (Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
resTail)

  (U.DUG nTotal :: Word
nTotal, inputHST :: HST inp
inputHST) ->
    Word -> HST inp -> TypeCheckInstr (TCDugHelper inp)
forall (inp :: [T]).
Typeable inp =>
Word -> HST inp -> TypeCheckInstr (TCDugHelper inp)
go Word
nTotal HST inp
inputHST TypeCheckInstr (TCDugHelper inp)
-> (TCDugHelper inp -> SomeInstr inp)
-> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      TCDugHelper s :: Sing n
s out :: HST out
out -> HST inp
inputHST HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Sing n -> Instr inp out
forall (n :: Peano) (inp :: [T]) (out :: [T]) (t :: T).
(ConstraintDUG n inp out t, NFData (Sing n)) =>
Sing n -> Instr inp out
DUG Sing n
s Instr inp out -> HST out -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: HST out
out
    where
      go :: forall inp. Typeable inp
        => Word
        -> HST inp
        -> TypeCheckInstr (TCDugHelper inp)
      go :: Word -> HST inp -> TypeCheckInstr (TCDugHelper inp)
go n :: Word
n i :: HST inp
i = case (Word
n, HST inp
i) of
        (0, (_ ::& _)) -> TCDugHelper inp -> TypeCheckInstr (TCDugHelper inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sing 'Z -> HST inp -> TCDugHelper inp
forall (n :: Peano) (inp :: [T]) (out :: [T]) (a :: T).
(Typeable out, ConstraintDUG n inp out a) =>
Sing n -> HST out -> TCDugHelper inp
TCDugHelper Sing 'Z
SingNat 'Z
SZ HST inp
i)

        (_, (a :: (Notes x, Dict (WellTyped x), Annotation VarTag)
a ::& b :: (Notes x, Dict (WellTyped x), Annotation VarTag)
b ::& iTail :: HST xs
iTail)) ->
          Word -> HST (x : xs) -> TypeCheckInstr (TCDugHelper (x : xs))
forall (inp :: [T]).
Typeable inp =>
Word -> HST inp -> TypeCheckInstr (TCDugHelper inp)
go (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1) ((Notes x, Dict (WellTyped x), Annotation VarTag)
a (Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
iTail) TypeCheckInstr (TCDugHelper (x : xs))
-> (TCDugHelper (x : xs) -> TCDugHelper inp)
-> TypeCheckInstr (TCDugHelper inp)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          TCDugHelper s :: Sing n
s resTail :: HST out
resTail -> Sing ('S n) -> HST (x : out) -> TCDugHelper (x : x : xs)
forall (n :: Peano) (inp :: [T]) (out :: [T]) (a :: T).
(Typeable out, ConstraintDUG n inp out a) =>
Sing n -> HST out -> TCDugHelper inp
TCDugHelper (SingNat n -> SingNat ('S n)
forall (n :: Peano).
(SingI n, KnownPeano n) =>
SingNat n -> SingNat ('S n)
SS Sing n
SingNat n
s) ((Notes x, Dict (WellTyped x), Annotation VarTag)
b (Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST out -> HST (x : out)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST out
resTail)

        -- Two cases:
        -- 1. Input stack is empty.
        -- 2. n > 0 and input stack has exactly 1 item.
        _ -> TypeCheckInstr (TCDugHelper inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.PUSH vn :: Annotation VarTag
vn mt :: Type
mt mval :: Value
mval, i :: HST inp
i) ->
    Type
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall r. Type -> (forall (t :: T). KnownT t => Notes t -> r) -> r
withUType Type
mt ((forall (t :: T).
  KnownT t =>
  Notes t -> TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ \(Notes t
nt :: Notes t) -> do
      Value t
val <- Value -> TypeCheckInstr (Value t)
forall (t :: T). SingI t => Value -> TypeCheckInstr (Value t)
typeCheckValue @t Value
mval
      Dict (ConstantScope t)
proofScope <- ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> Either BadTypeForScope (Dict (ConstantScope t))
-> ReaderT InstrCallStack TypeCheck (Dict (ConstantScope t))
forall (t :: T) (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m, SingI t) =>
ExpandedInstr
-> SomeHST -> Maybe TypeContext -> Either BadTypeForScope a -> m a
onScopeCheckInstrErr @t ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
i) Maybe TypeContext
forall a. Maybe a
Nothing
        (Either BadTypeForScope (Dict (ConstantScope t))
 -> ReaderT InstrCallStack TypeCheck (Dict (ConstantScope t)))
-> Either BadTypeForScope (Dict (ConstantScope t))
-> ReaderT InstrCallStack TypeCheck (Dict (ConstantScope t))
forall a b. (a -> b) -> a -> b
$ CheckScope (ConstantScope t) =>
Either BadTypeForScope (Dict (ConstantScope t))
forall (c :: Constraint).
CheckScope c =>
Either BadTypeForScope (Dict c)
checkScope @(ConstantScope t)
      case Dict (ConstantScope t)
proofScope of
        Dict -> forall a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @t ((WellTyped t => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped t => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$  SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
i HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Value t -> Instr inp (t : inp)
forall (t :: T) (s :: [T]).
ConstantScope t =>
Value' Instr t -> Instr s (t : s)
PUSH Value t
val Instr inp (t : inp) -> HST (t : inp) -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes t
nt, Dict (WellTyped t)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes t, Dict (WellTyped t), Annotation VarTag)
-> HST inp -> HST (t : inp)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST inp
i)

  (U.SOME tn :: TypeAnn
tn vn :: Annotation VarTag
vn, (an :: Notes x
an, Dict, _) ::& rs :: HST xs
rs) -> do
    SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr (x : xs) ('TOption x : xs)
forall (a :: T) (a :: [T]). Instr (a : a) ('TOption a : a)
SOME Instr (x : xs) ('TOption x : xs)
-> HST ('TOption x : xs) -> SomeInstrOut (x : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((TypeAnn -> Notes x -> Notes ('TOption x)
forall (t :: T). TypeAnn -> Notes t -> Notes ('TOption t)
NTOption TypeAnn
tn Notes x
an, Dict (WellTyped ('TOption x))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes ('TOption x), Dict (WellTyped ('TOption x)),
 Annotation VarTag)
-> HST xs -> HST ('TOption x : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs))

  (U.SOME _ _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.NONE tn :: TypeAnn
tn vn :: Annotation VarTag
vn elMt :: Type
elMt, _) ->
    Type
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall r. Type -> (forall (t :: T). KnownT t => Notes t -> r) -> r
withUType Type
elMt ((forall (t :: T).
  KnownT t =>
  Notes t -> TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ \(Notes t
elNotes :: Notes t) ->
      forall a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @t ((WellTyped t => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped t => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
        SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr inp ('TOption t : inp)
forall (a :: T) (s :: [T]). KnownT a => Instr s ('TOption a : s)
NONE Instr inp ('TOption t : inp)
-> HST ('TOption t : inp) -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((TypeAnn -> Notes t -> Notes ('TOption t)
forall (t :: T). TypeAnn -> Notes t -> Notes ('TOption t)
NTOption TypeAnn
tn Notes t
elNotes, Dict (WellTyped ('TOption t))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes ('TOption t), Dict (WellTyped ('TOption t)),
 Annotation VarTag)
-> HST inp -> HST ('TOption t : inp)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST inp
inp)

  (U.UNIT tn :: TypeAnn
tn vn :: Annotation VarTag
vn, _) ->
    SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr inp ('TUnit : inp)
forall (s :: [T]). Instr s ('TUnit : s)
UNIT Instr inp ('TUnit : inp) -> HST ('TUnit : inp) -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((TypeAnn -> Notes 'TUnit
NTUnit TypeAnn
tn, Dict (WellTyped 'TUnit)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TUnit, Dict (WellTyped 'TUnit), Annotation VarTag)
-> HST inp -> HST ('TUnit : inp)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST inp
inp)

  (U.IF_NONE mp :: [ExpandedOp]
mp mq :: [ExpandedOp]
mq, (STOption{}, (ons :: Notes ('TOption a)), Dict, ovn :: Annotation VarTag
ovn) ::&+ rs :: HST xs
rs) -> do
    let (an :: Notes a
an, avn :: Annotation VarTag
avn) = Notes ('TOption a)
-> Annotation VarTag -> (Notes a, Annotation VarTag)
forall (a :: T).
Notes ('TOption a)
-> Annotation VarTag -> (Notes a, Annotation VarTag)
deriveNsOption Notes ('TOption a)
ons Annotation VarTag
ovn
    forall a.
SingI a =>
(WellTyped a => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @a ((WellTyped a => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped a => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
      (forall (s' :: [T]).
 Instr xs s' -> Instr (a : xs) s' -> Instr ('TOption a : xs) s')
-> ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr)
-> [ExpandedOp]
-> [ExpandedOp]
-> HST xs
-> HST (a : xs)
-> HST ('TOption a : xs)
-> TypeCheckInstr (SomeInstr ('TOption a : xs))
forall (bti :: [T]) (bfi :: [T]) (cond :: T) (rs :: [T]).
(Typeable bti, Typeable bfi) =>
(forall (s' :: [T]).
 Instr bti s' -> Instr bfi s' -> Instr (cond : rs) s')
-> ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr)
-> [ExpandedOp]
-> [ExpandedOp]
-> HST bti
-> HST bfi
-> HST (cond : rs)
-> TypeCheckInstr (SomeInstr (cond : rs))
genericIf forall (s' :: [T]).
Instr xs s' -> Instr (a : xs) s' -> Instr ('TOption a : xs) s'
forall (s :: [T]) (s' :: [T]) (a :: T).
Instr s s' -> Instr (a : s) s' -> Instr ('TOption a : s) s'
IF_NONE [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
U.IF_NONE [ExpandedOp]
mp [ExpandedOp]
mq HST xs
rs ((Notes a
an, Dict (WellTyped a)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
avn) (Notes a, Dict (WellTyped a), Annotation VarTag)
-> HST xs -> HST (a : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs) HST inp
HST ('TOption a : xs)
inp

  (U.IF_NONE _ _, _ ::& _) ->
    TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (Maybe ExpectType -> ExpectType
ExpectOption Maybe ExpectType
forall a. Maybe a
Nothing ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []

  (U.IF_NONE _ _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.PAIR tn :: TypeAnn
tn vn :: Annotation VarTag
vn pfn :: FieldAnn
pfn qfn :: FieldAnn
qfn, (an :: Notes x
an, _, avn :: Annotation VarTag
avn) ::& (bn :: Notes x
bn, _, bvn :: Annotation VarTag
bvn) ::& rs :: HST xs
rs) -> do
    let (vn' :: Annotation VarTag
vn', pfn' :: FieldAnn
pfn', qfn' :: FieldAnn
qfn') = FieldAnn
-> FieldAnn
-> Annotation VarTag
-> Annotation VarTag
-> (Annotation VarTag, FieldAnn, FieldAnn)
deriveSpecialFNs FieldAnn
pfn FieldAnn
qfn Annotation VarTag
avn Annotation VarTag
bvn
    case TypeAnn
-> FieldAnn -> FieldAnn -> Notes x -> Notes x -> Notes ('TPair x x)
forall (p :: T) (p :: T).
TypeAnn
-> FieldAnn -> FieldAnn -> Notes p -> Notes p -> Notes ('TPair p p)
NTPair TypeAnn
tn FieldAnn
pfn' FieldAnn
qfn' Notes x
an Notes x
bn of
      (Notes ('TPair x x)
ns :: Notes ('TPair a b)) -> forall a.
SingI ('TPair x x) =>
(WellTyped ('TPair x x) => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @('TPair a b) ((WellTyped ('TPair x x) => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped ('TPair x x) => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
        SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ TypeAnn
-> FieldAnn -> FieldAnn -> Instr (x : x : xs) ('TPair x x : xs)
forall (a :: T) (b :: T) (s :: [T]).
TypeAnn
-> FieldAnn -> FieldAnn -> Instr (a : b : s) ('TPair a b : s)
AnnPAIR TypeAnn
tn FieldAnn
pfn FieldAnn
qfn Instr (x : x : xs) ('TPair x x : xs)
-> HST ('TPair x x : xs) -> SomeInstrOut (x : x : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes ('TPair x x)
ns, Dict (WellTyped ('TPair x x))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn Annotation VarTag -> Annotation VarTag -> Annotation VarTag
forall k (t :: k). Annotation t -> Annotation t -> Annotation t
`orAnn` Annotation VarTag
vn') (Notes ('TPair x x), Dict (WellTyped ('TPair x x)),
 Annotation VarTag)
-> HST xs -> HST ('TPair x x : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs))

  (U.PAIR {}, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.CAR vn :: Annotation VarTag
vn fn :: FieldAnn
fn, (STPair{}, NTPair pairTN :: TypeAnn
pairTN pfn :: FieldAnn
pfn qfn :: FieldAnn
qfn (Notes p
pns :: Notes p) (Notes q
qns :: Notes q), _, pairVN :: Annotation VarTag
pairVN) ::&+ rs :: HST xs
rs) -> do
    FieldAnn
pfn' <- ExpandedInstr
-> HST inp
-> Maybe TypeContext
-> Either AnnConvergeError FieldAnn
-> ReaderT InstrCallStack TypeCheck FieldAnn
forall (m :: * -> *) (ts :: [T]) a.
(MonadReader InstrCallStack m, MonadError TCError m,
 Typeable ts) =>
ExpandedInstr
-> HST ts -> Maybe TypeContext -> Either AnnConvergeError a -> m a
onTypeCheckInstrAnnErr ExpandedInstr
uInstr HST inp
inp (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
CarArgument) (FieldAnn -> FieldAnn -> Either AnnConvergeError FieldAnn
forall tag.
(Buildable (Annotation tag), Show (Annotation tag),
 Typeable tag) =>
Annotation tag
-> Annotation tag -> Either AnnConvergeError (Annotation tag)
convergeAnns FieldAnn
fn FieldAnn
pfn)
    forall a.
SingI p =>
(WellTyped p => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @p ((WellTyped p => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped p => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
      forall a.
SingI ('TPair p q) =>
(WellTyped ('TPair p q) => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @('TPair p q) ((WellTyped ('TPair p q) => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped ('TPair p q) => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ do
        let vn' :: Annotation VarTag
vn' = Annotation VarTag
-> FieldAnn -> Annotation VarTag -> Annotation VarTag
deriveSpecialVN Annotation VarTag
vn FieldAnn
pfn' Annotation VarTag
pairVN
            i' :: HST ('TPair p q : xs)
i' = (TypeAnn
-> FieldAnn -> FieldAnn -> Notes p -> Notes q -> Notes ('TPair p q)
forall (p :: T) (p :: T).
TypeAnn
-> FieldAnn -> FieldAnn -> Notes p -> Notes p -> Notes ('TPair p p)
NTPair TypeAnn
pairTN FieldAnn
pfn' FieldAnn
qfn Notes p
pns Notes q
qns, Dict (WellTyped ('TPair p q))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
pairVN) (Notes ('TPair p q), Dict (WellTyped ('TPair p q)),
 Annotation VarTag)
-> HST xs -> HST ('TPair p q : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs
        SomeInstr ('TPair p q : xs) -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr ('TPair p q : xs) -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr ('TPair p q : xs) -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST ('TPair p q : xs)
i' HST ('TPair p q : xs)
-> SomeInstrOut ('TPair p q : xs) -> SomeInstr ('TPair p q : xs)
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ FieldAnn -> Instr ('TPair p q : xs) (p : xs)
forall (a :: T) (b :: T) (s :: [T]).
FieldAnn -> Instr ('TPair a b : s) (a : s)
AnnCAR FieldAnn
fn Instr ('TPair p q : xs) (p : xs)
-> HST (p : xs) -> SomeInstrOut ('TPair p q : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes p
pns, Dict (WellTyped p)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn') (Notes p, Dict (WellTyped p), Annotation VarTag)
-> HST xs -> HST (p : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)

  (U.CAR _ _, _ ::& _) ->
    TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (Maybe ExpectType -> Maybe ExpectType -> ExpectType
ExpectPair Maybe ExpectType
forall a. Maybe a
Nothing Maybe ExpectType
forall a. Maybe a
Nothing ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []

  (U.CAR _ _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.CDR vn :: Annotation VarTag
vn fn :: FieldAnn
fn, (STPair{}, NTPair pairTN :: TypeAnn
pairTN pfn :: FieldAnn
pfn qfn :: FieldAnn
qfn (Notes p
pns :: Notes p) (Notes q
qns :: Notes q), _, pairVN :: Annotation VarTag
pairVN) ::&+ rs :: HST xs
rs) -> do
    FieldAnn
qfn' <- ExpandedInstr
-> HST inp
-> Maybe TypeContext
-> Either AnnConvergeError FieldAnn
-> ReaderT InstrCallStack TypeCheck FieldAnn
forall (m :: * -> *) (ts :: [T]) a.
(MonadReader InstrCallStack m, MonadError TCError m,
 Typeable ts) =>
ExpandedInstr
-> HST ts -> Maybe TypeContext -> Either AnnConvergeError a -> m a
onTypeCheckInstrAnnErr ExpandedInstr
uInstr HST inp
inp (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
CdrArgument) (FieldAnn -> FieldAnn -> Either AnnConvergeError FieldAnn
forall tag.
(Buildable (Annotation tag), Show (Annotation tag),
 Typeable tag) =>
Annotation tag
-> Annotation tag -> Either AnnConvergeError (Annotation tag)
convergeAnns FieldAnn
fn FieldAnn
qfn)

    forall a.
SingI q =>
(WellTyped q => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @q ((WellTyped q => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped q => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
      forall a.
SingI ('TPair p q) =>
(WellTyped ('TPair p q) => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @('TPair p q) ((WellTyped ('TPair p q) => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped ('TPair p q) => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ do
        let vn' :: Annotation VarTag
vn' = Annotation VarTag
-> FieldAnn -> Annotation VarTag -> Annotation VarTag
deriveSpecialVN Annotation VarTag
vn FieldAnn
qfn' Annotation VarTag
pairVN
            i' :: HST ('TPair p q : xs)
i' = (TypeAnn
-> FieldAnn -> FieldAnn -> Notes p -> Notes q -> Notes ('TPair p q)
forall (p :: T) (p :: T).
TypeAnn
-> FieldAnn -> FieldAnn -> Notes p -> Notes p -> Notes ('TPair p p)
NTPair TypeAnn
pairTN FieldAnn
pfn FieldAnn
qfn' Notes p
pns Notes q
qns, Dict (WellTyped ('TPair p q))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
pairVN) (Notes ('TPair p q), Dict (WellTyped ('TPair p q)),
 Annotation VarTag)
-> HST xs -> HST ('TPair p q : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs
        SomeInstr ('TPair p q : xs) -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr ('TPair p q : xs) -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr ('TPair p q : xs) -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST ('TPair p q : xs)
i' HST ('TPair p q : xs)
-> SomeInstrOut ('TPair p q : xs) -> SomeInstr ('TPair p q : xs)
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ FieldAnn -> Instr ('TPair p q : xs) (q : xs)
forall (a :: T) (b :: T) (s :: [T]).
FieldAnn -> Instr ('TPair a b : s) (b : s)
AnnCDR FieldAnn
fn Instr ('TPair p q : xs) (q : xs)
-> HST (q : xs) -> SomeInstrOut ('TPair p q : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes q
qns, Dict (WellTyped q)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn') (Notes q, Dict (WellTyped q), Annotation VarTag)
-> HST xs -> HST (q : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)

  (U.CDR _ _, _ ::& _) ->
    TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (Maybe ExpectType -> Maybe ExpectType -> ExpectType
ExpectPair Maybe ExpectType
forall a. Maybe a
Nothing Maybe ExpectType
forall a. Maybe a
Nothing ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []

  (U.CDR _ _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.LEFT tn :: TypeAnn
tn vn :: Annotation VarTag
vn pfn :: FieldAnn
pfn qfn :: FieldAnn
qfn bMt :: Type
bMt, (Notes x
an :: Notes l, Dict, _) ::& rs :: HST xs
rs) ->
    Type
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall r. Type -> (forall (t :: T). KnownT t => Notes t -> r) -> r
withUType Type
bMt ((forall (t :: T).
  KnownT t =>
  Notes t -> TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ \(Notes t
bn :: Notes r) -> do
      forall a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @r ((WellTyped t => TypeCheckInstr (SomeInstr (x : xs)))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped t => TypeCheckInstr (SomeInstr (x : xs)))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ do
        let ns :: Notes ('TOr x t)
ns = TypeAnn
-> FieldAnn -> FieldAnn -> Notes x -> Notes t -> Notes ('TOr x t)
forall (p :: T) (p :: T).
TypeAnn
-> FieldAnn -> FieldAnn -> Notes p -> Notes p -> Notes ('TOr p p)
NTOr TypeAnn
tn FieldAnn
pfn FieldAnn
qfn Notes x
an Notes t
bn
        SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr (x : xs) ('TOr x t : xs)
forall (b :: T) (a :: T) (s :: [T]).
KnownT b =>
Instr (a : s) ('TOr a b : s)
LEFT Instr (x : xs) ('TOr x t : xs)
-> HST ('TOr x t : xs) -> SomeInstrOut (x : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes ('TOr x t)
ns, Dict (WellTyped ('TOr x t))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes ('TOr x t), Dict (WellTyped ('TOr x t)), Annotation VarTag)
-> HST xs -> HST ('TOr x t : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs))

  (U.LEFT {}, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.RIGHT tn :: TypeAnn
tn vn :: Annotation VarTag
vn pfn :: FieldAnn
pfn qfn :: FieldAnn
qfn aMt :: Type
aMt, (Notes x
bn :: Notes r, Dict, _) ::& rs :: HST xs
rs) ->
    Type
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall r. Type -> (forall (t :: T). KnownT t => Notes t -> r) -> r
withUType Type
aMt ((forall (t :: T).
  KnownT t =>
  Notes t -> TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ \(Notes t
an :: Notes l) -> do
      forall a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @l ((WellTyped t => TypeCheckInstr (SomeInstr (x : xs)))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped t => TypeCheckInstr (SomeInstr (x : xs)))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ do
        let ns :: Notes ('TOr t x)
ns = TypeAnn
-> FieldAnn -> FieldAnn -> Notes t -> Notes x -> Notes ('TOr t x)
forall (p :: T) (p :: T).
TypeAnn
-> FieldAnn -> FieldAnn -> Notes p -> Notes p -> Notes ('TOr p p)
NTOr TypeAnn
tn FieldAnn
pfn FieldAnn
qfn Notes t
an Notes x
bn
        SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr (x : xs) ('TOr t x : xs)
forall (a :: T) (b :: T) (s :: [T]).
KnownT a =>
Instr (b : s) ('TOr a b : s)
RIGHT Instr (x : xs) ('TOr t x : xs)
-> HST ('TOr t x : xs) -> SomeInstrOut (x : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes ('TOr t x)
ns, Dict (WellTyped ('TOr t x))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes ('TOr t x), Dict (WellTyped ('TOr t x)), Annotation VarTag)
-> HST xs -> HST ('TOr t x : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs))

  ( U.RIGHT {}, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.IF_LEFT mp :: [ExpandedOp]
mp mq :: [ExpandedOp]
mq, (STOr{}, ons :: Notes x
ons, _, ovn :: Annotation VarTag
ovn) ::&+ rs :: HST xs
rs) -> do
    case Notes ('TOr a b)
-> Annotation VarTag
-> (Notes a, Notes b, Annotation VarTag, Annotation VarTag)
forall (a :: T) (b :: T).
Notes ('TOr a b)
-> Annotation VarTag
-> (Notes a, Notes b, Annotation VarTag, Annotation VarTag)
deriveNsOr Notes x
Notes ('TOr a b)
ons Annotation VarTag
ovn of
      (Notes a
an :: Notes a, Notes b
bn :: Notes b, avn :: Annotation VarTag
avn, bvn :: Annotation VarTag
bvn) ->
        forall a.
SingI a =>
(WellTyped a => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @a ((WellTyped a => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped a => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
          forall a.
SingI b =>
(WellTyped b => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @b ((WellTyped b => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped b => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ do
            let
              ait :: HST (a : xs)
ait = (Notes a
an, Dict (WellTyped a)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
avn) (Notes a, Dict (WellTyped a), Annotation VarTag)
-> HST xs -> HST (a : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs
              bit :: HST (b : xs)
bit = (Notes b
bn, Dict (WellTyped b)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
bvn) (Notes b, Dict (WellTyped b), Annotation VarTag)
-> HST xs -> HST (b : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs
            (forall (s' :: [T]).
 Instr (a : xs) s' -> Instr (b : xs) s' -> Instr ('TOr a b : xs) s')
-> ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr)
-> [ExpandedOp]
-> [ExpandedOp]
-> HST (a : xs)
-> HST (b : xs)
-> HST ('TOr a b : xs)
-> TypeCheckInstr (SomeInstr ('TOr a b : xs))
forall (bti :: [T]) (bfi :: [T]) (cond :: T) (rs :: [T]).
(Typeable bti, Typeable bfi) =>
(forall (s' :: [T]).
 Instr bti s' -> Instr bfi s' -> Instr (cond : rs) s')
-> ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr)
-> [ExpandedOp]
-> [ExpandedOp]
-> HST bti
-> HST bfi
-> HST (cond : rs)
-> TypeCheckInstr (SomeInstr (cond : rs))
genericIf forall (s' :: [T]).
Instr (a : xs) s' -> Instr (b : xs) s' -> Instr ('TOr a b : xs) s'
forall (a :: T) (s :: [T]) (s' :: [T]) (b :: T).
Instr (a : s) s' -> Instr (b : s) s' -> Instr ('TOr a b : s) s'
IF_LEFT [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
U.IF_LEFT [ExpandedOp]
mp [ExpandedOp]
mq HST (a : xs)
ait HST (b : xs)
bit HST inp
HST ('TOr a b : xs)
inp

  (U.IF_LEFT _ _, _ ::& _) ->
    TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (Maybe ExpectType -> Maybe ExpectType -> ExpectType
ExpectOr Maybe ExpectType
forall a. Maybe a
Nothing Maybe ExpectType
forall a. Maybe a
Nothing ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []

  (U.IF_LEFT _ _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.NIL tn :: TypeAnn
tn vn :: Annotation VarTag
vn elMt :: Type
elMt, i :: HST inp
i) ->
    Type
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall r. Type -> (forall (t :: T). KnownT t => Notes t -> r) -> r
withUType Type
elMt ((forall (t :: T).
  KnownT t =>
  Notes t -> TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ \(Notes t
elNotes :: Notes t) ->
      forall a.
SingI ('TList t) =>
(WellTyped ('TList t) => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @('TList t) ((WellTyped ('TList t) => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped ('TList t) => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
        SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
i HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr inp ('TList t : inp)
forall (p :: T) (s :: [T]). KnownT p => Instr s ('TList p : s)
NIL Instr inp ('TList t : inp)
-> HST ('TList t : inp) -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((TypeAnn -> Notes t -> Notes ('TList t)
forall (t :: T). TypeAnn -> Notes t -> Notes ('TList t)
NTList TypeAnn
tn Notes t
elNotes, Dict (WellTyped ('TList t))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes ('TList t), Dict (WellTyped ('TList t)), Annotation VarTag)
-> HST inp -> HST ('TList t : inp)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST inp
i)

  (U.CONS vn :: Annotation VarTag
vn, ((Notes x
an :: Notes a), _, _)
                ::& ((Notes x
ln :: Notes l), _, _) ::& rs :: HST xs
rs) ->
    case Each '[KnownT] '[ 'TList x, x] =>
Either TCTypeError ('TList x :~: x)
forall (a :: T) (b :: T).
Each '[KnownT] '[a, b] =>
Either TCTypeError (a :~: b)
eqType @('TList a) @l of
      Right Refl -> do
        (Notes x
n :: Notes t) <- ExpandedInstr
-> HST inp
-> Maybe TypeContext
-> Either AnnConvergeError (Notes x)
-> ReaderT InstrCallStack TypeCheck (Notes x)
forall (m :: * -> *) (ts :: [T]) a.
(MonadReader InstrCallStack m, MonadError TCError m,
 Typeable ts) =>
ExpandedInstr
-> HST ts -> Maybe TypeContext -> Either AnnConvergeError a -> m a
onTypeCheckInstrAnnErr ExpandedInstr
uInstr HST inp
inp (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
ConsArgument) (Notes x -> Notes x -> Either AnnConvergeError (Notes x)
forall (t :: T).
Notes t -> Notes t -> Either AnnConvergeError (Notes t)
converge Notes x
ln (TypeAnn -> Notes x -> Notes ('TList x)
forall (t :: T). TypeAnn -> Notes t -> Notes ('TList t)
NTList TypeAnn
forall a. Default a => a
def Notes x
an))
        forall a.
SingI x =>
(WellTyped x => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @t ((WellTyped x => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped x => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
          SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr (x : 'TList x : xs) ('TList x : xs)
forall (a :: T) (a :: [T]). Instr (a : 'TList a : a) ('TList a : a)
CONS Instr (x : 'TList x : xs) ('TList x : xs)
-> HST ('TList x : xs) -> SomeInstrOut (x : 'TList x : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes x
n, Dict (WellTyped x)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)
      Left m :: TCTypeError
m -> ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> TCTypeError
-> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr -> SomeHST -> Maybe TypeContext -> TCTypeError -> m a
typeCheckInstrErr' ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
ConsArgument) TCTypeError
m

  (U.CONS _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.IF_CONS mp :: [ExpandedOp]
mp mq :: [ExpandedOp]
mq, (STList{}, ns :: Notes x
ns, Dict, vn :: Annotation VarTag
vn) ::&+ rs :: HST xs
rs) -> do
    case Notes x
ns of
      NTList _ (Notes t
an :: Notes t1) -> do
        HST (a : 'TList a : xs)
ait <- forall a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @t1 ((WellTyped t => TypeCheckInstr (HST (a : 'TList a : xs)))
 -> TypeCheckInstr (HST (a : 'TList a : xs)))
-> (WellTyped t => TypeCheckInstr (HST (a : 'TList a : xs)))
-> TypeCheckInstr (HST (a : 'TList a : xs))
forall a b. (a -> b) -> a -> b
$ HST (t : x : xs) -> TypeCheckInstr (HST (a : 'TList a : xs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HST (t : x : xs) -> TypeCheckInstr (HST (a : 'TList a : xs)))
-> HST (t : x : xs) -> TypeCheckInstr (HST (a : 'TList a : xs))
forall a b. (a -> b) -> a -> b
$ (Notes t
an, Dict (WellTyped t)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn Annotation VarTag -> Annotation VarTag -> Annotation VarTag
forall a. Semigroup a => a -> a -> a
<> "hd") (Notes t, Dict (WellTyped t), Annotation VarTag)
-> HST (x : xs) -> HST (t : x : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& (Notes x
ns, Dict (WellTyped x)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn Annotation VarTag -> Annotation VarTag -> Annotation VarTag
forall a. Semigroup a => a -> a -> a
<> "tl") (Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs
        (forall (s' :: [T]).
 Instr (a : 'TList a : xs) s'
 -> Instr xs s' -> Instr ('TList a : xs) s')
-> ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr)
-> [ExpandedOp]
-> [ExpandedOp]
-> HST (a : 'TList a : xs)
-> HST xs
-> HST ('TList a : xs)
-> TypeCheckInstr (SomeInstr ('TList a : xs))
forall (bti :: [T]) (bfi :: [T]) (cond :: T) (rs :: [T]).
(Typeable bti, Typeable bfi) =>
(forall (s' :: [T]).
 Instr bti s' -> Instr bfi s' -> Instr (cond : rs) s')
-> ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr)
-> [ExpandedOp]
-> [ExpandedOp]
-> HST bti
-> HST bfi
-> HST (cond : rs)
-> TypeCheckInstr (SomeInstr (cond : rs))
genericIf forall (s' :: [T]).
Instr (a : 'TList a : xs) s'
-> Instr xs s' -> Instr ('TList a : xs) s'
forall (a :: T) (s :: [T]) (s' :: [T]).
Instr (a : 'TList a : s) s'
-> Instr s s' -> Instr ('TList a : s) s'
IF_CONS [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
U.IF_CONS [ExpandedOp]
mp [ExpandedOp]
mq HST (a : 'TList a : xs)
ait HST xs
rs HST inp
HST ('TList a : xs)
inp

  (U.IF_CONS _ _, _ ::& _) ->
    TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (Maybe ExpectType -> ExpectType
ExpectList Maybe ExpectType
forall a. Maybe a
Nothing ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []

  (U.IF_CONS _ _, SNil)-> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.SIZE vn :: Annotation VarTag
vn, (NTList{}, _, _) ::& _) -> HST inp -> Annotation VarTag -> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (inp :: [T]) (rs :: [T]) (m :: * -> *).
(SizeOp c, inp ~ (c : rs), Monad m) =>
HST inp -> Annotation VarTag -> m (SomeInstr inp)
sizeImpl HST inp
inp Annotation VarTag
vn
  (U.SIZE vn :: Annotation VarTag
vn, (NTSet{}, _, _) ::& _) -> HST inp -> Annotation VarTag -> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (inp :: [T]) (rs :: [T]) (m :: * -> *).
(SizeOp c, inp ~ (c : rs), Monad m) =>
HST inp -> Annotation VarTag -> m (SomeInstr inp)
sizeImpl HST inp
inp Annotation VarTag
vn
  (U.SIZE vn :: Annotation VarTag
vn, (NTMap{}, _, _) ::& _) -> HST inp -> Annotation VarTag -> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (inp :: [T]) (rs :: [T]) (m :: * -> *).
(SizeOp c, inp ~ (c : rs), Monad m) =>
HST inp -> Annotation VarTag -> m (SomeInstr inp)
sizeImpl HST inp
inp Annotation VarTag
vn
  (U.SIZE vn :: Annotation VarTag
vn, (NTString{}, _, _) ::& _) -> HST inp -> Annotation VarTag -> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (inp :: [T]) (rs :: [T]) (m :: * -> *).
(SizeOp c, inp ~ (c : rs), Monad m) =>
HST inp -> Annotation VarTag -> m (SomeInstr inp)
sizeImpl HST inp
inp Annotation VarTag
vn
  (U.SIZE vn :: Annotation VarTag
vn, (NTBytes{}, _, _) ::& _) -> HST inp -> Annotation VarTag -> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (inp :: [T]) (rs :: [T]) (m :: * -> *).
(SizeOp c, inp ~ (c : rs), Monad m) =>
HST inp -> Annotation VarTag -> m (SomeInstr inp)
sizeImpl HST inp
inp Annotation VarTag
vn
  (U.SIZE _, _ ::& _) ->
    TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
      (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (Maybe ExpectType -> ExpectType
ExpectList Maybe ExpectType
forall a. Maybe a
Nothing ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:|
      [ (Maybe ExpectType -> ExpectType
ExpectSet Maybe ExpectType
forall a. Maybe a
Nothing ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [])
      , (ExpectType
ExpectMap ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [])
      , (ExpectType
ExpectString ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [])
      , (ExpectType
ExpectByte ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [])
      ]

  (U.SIZE _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.EMPTY_SET tn :: TypeAnn
tn vn :: Annotation VarTag
vn mv :: Type
mv, i :: HST inp
i) ->
    Type
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall r. Type -> (forall (t :: T). KnownT t => Notes t -> r) -> r
withUType Type
mv ((forall (t :: T).
  KnownT t =>
  Notes t -> TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ \(Notes t
vns :: Notes v) ->
      forall a.
SingI ('TSet t) =>
(WellTyped ('TSet t) => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @('TSet v) ((WellTyped ('TSet t) => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped ('TSet t) => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
        Sing t
-> ExpandedInstr
-> HST inp
-> (Comparable t => SomeInstr inp)
-> TypeCheckInstr (SomeInstr inp)
forall (a :: T) (m :: * -> *) v (ts :: [T]).
(Typeable ts, MonadReader InstrCallStack m,
 MonadError TCError m) =>
Sing a -> ExpandedInstr -> HST ts -> (Comparable a => v) -> m v
withCompareableCheck (Notes t -> Sing t
forall (t :: T). SingI t => Notes t -> Sing t
notesSing Notes t
vns) ExpandedInstr
uInstr HST inp
inp ((Comparable t => SomeInstr inp) -> TypeCheckInstr (SomeInstr inp))
-> (Comparable t => SomeInstr inp)
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
i HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr inp ('TSet t : inp)
forall (e :: T) (s :: [T]).
(KnownT e, Comparable e) =>
Instr s ('TSet e : s)
EMPTY_SET Instr inp ('TSet t : inp)
-> HST ('TSet t : inp) -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Sing t -> SingT ('TSet t)
forall (a :: T). KnownT a => Sing a -> SingT ('TSet a)
STSet Sing t
forall k (a :: k). SingI a => Sing a
sing, TypeAnn -> Notes t -> Notes ('TSet t)
forall (t :: T). TypeAnn -> Notes t -> Notes ('TSet t)
NTSet TypeAnn
tn Notes t
vns, Dict (WellTyped ('TSet t))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Sing ('TSet t), Notes ('TSet t), Dict (WellTyped ('TSet t)),
 Annotation VarTag)
-> HST inp -> HST ('TSet t : inp)
forall (ys :: [T]) (x :: T) (xs :: [T]).
(ys ~ (x : xs), KnownT x, Typeable xs) =>
(Sing x, Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST ys
::&+ HST inp
i)

  (U.EMPTY_MAP tn :: TypeAnn
tn vn :: Annotation VarTag
vn mk :: Type
mk mv :: Type
mv, i :: HST inp
i) -> do
    Type
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall r. Type -> (forall (t :: T). KnownT t => Notes t -> r) -> r
withUType Type
mv ((forall (t :: T).
  KnownT t =>
  Notes t -> TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ \(Notes t
vns :: Notes v)  ->
      Type
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall r. Type -> (forall (t :: T). KnownT t => Notes t -> r) -> r
withUType Type
mk ((forall (t :: T).
  KnownT t =>
  Notes t -> TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ \(Notes t
ktn :: Notes k) ->
        forall a.
SingI ('TMap t t) =>
(WellTyped ('TMap t t) => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @('TMap k v) ((WellTyped ('TMap t t) => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped ('TMap t t) => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
          Sing t
-> ExpandedInstr
-> HST inp
-> (Comparable t => SomeInstr inp)
-> TypeCheckInstr (SomeInstr inp)
forall (a :: T) (m :: * -> *) v (ts :: [T]).
(Typeable ts, MonadReader InstrCallStack m,
 MonadError TCError m) =>
Sing a -> ExpandedInstr -> HST ts -> (Comparable a => v) -> m v
withCompareableCheck (Notes t -> Sing t
forall (t :: T). SingI t => Notes t -> Sing t
notesSing Notes t
ktn) ExpandedInstr
uInstr HST inp
inp ((Comparable t => SomeInstr inp) -> TypeCheckInstr (SomeInstr inp))
-> (Comparable t => SomeInstr inp)
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
i HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr inp ('TMap t t : inp)
forall (a :: T) (b :: T) (s :: [T]).
(KnownT a, KnownT b, Comparable a) =>
Instr s ('TMap a b : s)
EMPTY_MAP Instr inp ('TMap t t : inp)
-> HST ('TMap t t : inp) -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Sing t -> Sing t -> SingT ('TMap t t)
forall (a :: T) (a :: T).
(KnownT a, KnownT a) =>
Sing a -> Sing a -> SingT ('TMap a a)
STMap Sing t
forall k (a :: k). SingI a => Sing a
sing Sing t
forall k (a :: k). SingI a => Sing a
sing, TypeAnn -> Notes t -> Notes t -> Notes ('TMap t t)
forall (q :: T) (k :: T).
TypeAnn -> Notes q -> Notes k -> Notes ('TMap q k)
NTMap TypeAnn
tn Notes t
ktn Notes t
vns, Dict (WellTyped ('TMap t t))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Sing ('TMap t t), Notes ('TMap t t), Dict (WellTyped ('TMap t t)),
 Annotation VarTag)
-> HST inp -> HST ('TMap t t : inp)
forall (ys :: [T]) (x :: T) (xs :: [T]).
(ys ~ (x : xs), KnownT x, Typeable xs) =>
(Sing x, Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST ys
::&+ HST inp
i)

  (U.EMPTY_BIG_MAP tn :: TypeAnn
tn vn :: Annotation VarTag
vn mk :: Type
mk mv :: Type
mv, i :: HST inp
i) ->
    Type
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall r. Type -> (forall (t :: T). KnownT t => Notes t -> r) -> r
withUType Type
mv ((forall (t :: T).
  KnownT t =>
  Notes t -> TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ \(Notes t
vns :: Notes v)  ->
      Type
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall r. Type -> (forall (t :: T). KnownT t => Notes t -> r) -> r
withUType Type
mk ((forall (t :: T).
  KnownT t =>
  Notes t -> TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ \(Notes t
ktn :: Notes k) ->
        forall a.
SingI ('TBigMap t t) =>
(WellTyped ('TBigMap t t) => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @('TBigMap k v) ((WellTyped ('TBigMap t t) => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped ('TBigMap t t) => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
          Sing t
-> ExpandedInstr
-> HST inp
-> (Comparable t => SomeInstr inp)
-> TypeCheckInstr (SomeInstr inp)
forall (a :: T) (m :: * -> *) v (ts :: [T]).
(Typeable ts, MonadReader InstrCallStack m,
 MonadError TCError m) =>
Sing a -> ExpandedInstr -> HST ts -> (Comparable a => v) -> m v
withCompareableCheck (Notes t -> Sing t
forall (t :: T). SingI t => Notes t -> Sing t
notesSing Notes t
ktn) ExpandedInstr
uInstr HST inp
inp ((Comparable t => SomeInstr inp) -> TypeCheckInstr (SomeInstr inp))
-> (Comparable t => SomeInstr inp)
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
i HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr inp ('TBigMap t t : inp)
forall (a :: T) (b :: T) (s :: [T]).
(KnownT a, KnownT b, Comparable a) =>
Instr s ('TBigMap a b : s)
EMPTY_BIG_MAP Instr inp ('TBigMap t t : inp)
-> HST ('TBigMap t t : inp) -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Sing t -> Sing t -> SingT ('TBigMap t t)
forall (a :: T) (b :: T).
(KnownT a, KnownT b) =>
Sing a -> Sing b -> SingT ('TBigMap a b)
STBigMap Sing t
forall k (a :: k). SingI a => Sing a
sing Sing t
forall k (a :: k). SingI a => Sing a
sing, TypeAnn -> Notes t -> Notes t -> Notes ('TBigMap t t)
forall (k :: T) (v :: T).
TypeAnn -> Notes k -> Notes v -> Notes ('TBigMap k v)
NTBigMap TypeAnn
tn Notes t
ktn Notes t
vns, Dict (WellTyped ('TBigMap t t))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Sing ('TBigMap t t), Notes ('TBigMap t t),
 Dict (WellTyped ('TBigMap t t)), Annotation VarTag)
-> HST inp -> HST ('TBigMap t t : inp)
forall (ys :: [T]) (x :: T) (xs :: [T]).
(ys ~ (x : xs), KnownT x, Typeable xs) =>
(Sing x, Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST ys
::&+ HST inp
i)

  (U.MAP vn :: Annotation VarTag
vn mp :: [ExpandedOp]
mp, (STList _, NTList _ (Notes t
vns :: Notes t1), Dict, _vn :: Annotation VarTag
_vn) ::&+ _) -> do
    forall a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @t1 ((WellTyped t => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped t => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
      Notes (MapOpInp ('TList a))
-> ExpandedInstr
-> [ExpandedOp]
-> HST ('TList a : xs)
-> (forall (v' :: T).
    KnownT v' =>
    Notes v'
    -> HST xs -> TypeCheckInstr (HST (MapOpRes ('TList a) v' : xs)))
-> TypeCheckInstr (SomeInstr ('TList a : xs))
forall (c :: T) (rs :: [T]).
(MapOp c, WellTyped (MapOpInp c), Typeable (MapOpRes c)) =>
Notes (MapOpInp c)
-> ExpandedInstr
-> [ExpandedOp]
-> HST (c : rs)
-> (forall (v' :: T).
    KnownT v' =>
    Notes v' -> HST rs -> TypeCheckInstr (HST (MapOpRes c v' : rs)))
-> TypeCheckInstr (SomeInstr (c : rs))
mapImpl Notes t
Notes (MapOpInp ('TList a))
vns ExpandedInstr
uInstr [ExpandedOp]
mp HST inp
HST ('TList a : xs)
inp
        (\(Notes v'
rn :: Notes t) hst :: HST xs
hst -> forall a.
SingI v' =>
(WellTyped v' => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @t ((WellTyped v' => TypeCheckInstr (HST ('TList v' : xs)))
 -> ReaderT
      InstrCallStack TypeCheck (HST (MapOpRes ('TList a) v' : xs)))
-> (WellTyped v' => TypeCheckInstr (HST ('TList v' : xs)))
-> ReaderT
     InstrCallStack TypeCheck (HST (MapOpRes ('TList a) v' : xs))
forall a b. (a -> b) -> a -> b
$ HST ('TList v' : xs) -> TypeCheckInstr (HST ('TList v' : xs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HST ('TList v' : xs) -> TypeCheckInstr (HST ('TList v' : xs)))
-> HST ('TList v' : xs) -> TypeCheckInstr (HST ('TList v' : xs))
forall a b. (a -> b) -> a -> b
$  (TypeAnn -> Notes v' -> Notes ('TList v')
forall (t :: T). TypeAnn -> Notes t -> Notes ('TList t)
NTList TypeAnn
forall a. Default a => a
def Notes v'
rn, Dict (WellTyped ('TList v'))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes ('TList v'), Dict (WellTyped ('TList v')),
 Annotation VarTag)
-> HST xs -> HST ('TList v' : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
hst)

  (U.MAP vn :: Annotation VarTag
vn mp :: [ExpandedOp]
mp, (STMap{}, NTMap _ kns :: Notes k
kns vns :: Notes v
vns, Dict, _vn :: Annotation VarTag
_vn) ::&+ _) -> do
    case TypeAnn
-> FieldAnn -> FieldAnn -> Notes k -> Notes v -> Notes ('TPair k v)
forall (p :: T) (p :: T).
TypeAnn
-> FieldAnn -> FieldAnn -> Notes p -> Notes p -> Notes ('TPair p p)
NTPair TypeAnn
forall a. Default a => a
def FieldAnn
forall a. Default a => a
def FieldAnn
forall a. Default a => a
def Notes k
kns Notes v
vns of
      (Notes ('TPair k v)
pns :: Notes ('TPair k v1)) ->
        forall a.
SingI ('TPair k v) =>
(WellTyped ('TPair k v) => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @('TPair k v1) ((WellTyped ('TPair k v) => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped ('TPair k v) => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
          Notes (MapOpInp ('TMap a b))
-> ExpandedInstr
-> [ExpandedOp]
-> HST ('TMap a b : xs)
-> (forall (v' :: T).
    KnownT v' =>
    Notes v'
    -> HST xs -> TypeCheckInstr (HST (MapOpRes ('TMap a b) v' : xs)))
-> TypeCheckInstr (SomeInstr ('TMap a b : xs))
forall (c :: T) (rs :: [T]).
(MapOp c, WellTyped (MapOpInp c), Typeable (MapOpRes c)) =>
Notes (MapOpInp c)
-> ExpandedInstr
-> [ExpandedOp]
-> HST (c : rs)
-> (forall (v' :: T).
    KnownT v' =>
    Notes v' -> HST rs -> TypeCheckInstr (HST (MapOpRes c v' : rs)))
-> TypeCheckInstr (SomeInstr (c : rs))
mapImpl Notes ('TPair k v)
Notes (MapOpInp ('TMap a b))
pns ExpandedInstr
uInstr [ExpandedOp]
mp HST inp
HST ('TMap a b : xs)
inp
             (\(Notes v'
rn :: Notes v) hst :: HST xs
hst -> forall a.
SingI ('TMap k v') =>
(WellTyped ('TMap k v') => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @('TMap k v) ((WellTyped ('TMap k v') => TypeCheckInstr (HST ('TMap a v' : xs)))
 -> ReaderT
      InstrCallStack TypeCheck (HST (MapOpRes ('TMap a b) v' : xs)))
-> (WellTyped ('TMap k v') =>
    TypeCheckInstr (HST ('TMap a v' : xs)))
-> ReaderT
     InstrCallStack TypeCheck (HST (MapOpRes ('TMap a b) v' : xs))
forall a b. (a -> b) -> a -> b
$ HST ('TMap k v' : xs) -> TypeCheckInstr (HST ('TMap a v' : xs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HST ('TMap k v' : xs) -> TypeCheckInstr (HST ('TMap a v' : xs)))
-> HST ('TMap k v' : xs) -> TypeCheckInstr (HST ('TMap a v' : xs))
forall a b. (a -> b) -> a -> b
$ (TypeAnn -> Notes k -> Notes v' -> Notes ('TMap k v')
forall (q :: T) (k :: T).
TypeAnn -> Notes q -> Notes k -> Notes ('TMap q k)
NTMap TypeAnn
forall a. Default a => a
def Notes k
kns Notes v'
rn, Dict (WellTyped ('TMap k v'))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes ('TMap k v'), Dict (WellTyped ('TMap k v')),
 Annotation VarTag)
-> HST xs -> HST ('TMap k v' : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
hst)

  (U.MAP _ _, _ ::& _) ->
    TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
      (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (Maybe ExpectType -> ExpectType
ExpectList Maybe ExpectType
forall a. Maybe a
Nothing ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:|
      [ (ExpectType
ExpectMap ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [])
      ]

  (U.MAP _ _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.ITER is :: [ExpandedOp]
is, (STSet (_ :: Sing t1), NTSet _ en :: Notes t
en, _, _) ::&+ _) -> do
    forall a.
SingI a =>
(WellTyped a => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @t1 ((WellTyped a => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped a => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
      Notes (IterOpEl ('TSet a))
-> ExpandedInstr
-> [ExpandedOp]
-> HST ('TSet a : xs)
-> TypeCheckInstr (SomeInstr ('TSet a : xs))
forall (c :: T) (rs :: [T]).
(IterOp c, WellTyped (IterOpEl c)) =>
Notes (IterOpEl c)
-> ExpandedInstr
-> [ExpandedOp]
-> HST (c : rs)
-> TypeCheckInstr (SomeInstr (c : rs))
iterImpl Notes t
Notes (IterOpEl ('TSet a))
en ExpandedInstr
uInstr [ExpandedOp]
is HST inp
HST ('TSet a : xs)
inp

  (U.ITER is :: [ExpandedOp]
is, (STList (_ :: Sing t1), NTList _ en :: Notes t
en, _, _) ::&+ _) -> do
    forall a.
SingI a =>
(WellTyped a => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @t1 ((WellTyped a => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped a => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
      Notes (IterOpEl ('TList a))
-> ExpandedInstr
-> [ExpandedOp]
-> HST ('TList a : xs)
-> TypeCheckInstr (SomeInstr ('TList a : xs))
forall (c :: T) (rs :: [T]).
(IterOp c, WellTyped (IterOpEl c)) =>
Notes (IterOpEl c)
-> ExpandedInstr
-> [ExpandedOp]
-> HST (c : rs)
-> TypeCheckInstr (SomeInstr (c : rs))
iterImpl Notes t
Notes (IterOpEl ('TList a))
en ExpandedInstr
uInstr [ExpandedOp]
is HST inp
HST ('TList a : xs)
inp

  (U.ITER is :: [ExpandedOp]
is, (STMap _ _, NTMap _ kns :: Notes k
kns vns :: Notes v
vns, _, _) ::&+ _) -> do
    case TypeAnn
-> FieldAnn -> FieldAnn -> Notes k -> Notes v -> Notes ('TPair k v)
forall (p :: T) (p :: T).
TypeAnn
-> FieldAnn -> FieldAnn -> Notes p -> Notes p -> Notes ('TPair p p)
NTPair TypeAnn
forall a. Default a => a
def FieldAnn
forall a. Default a => a
def FieldAnn
forall a. Default a => a
def Notes k
kns Notes v
vns of
      (Notes ('TPair k v)
en :: Notes ('TPair a b)) ->
        forall a.
SingI ('TPair k v) =>
(WellTyped ('TPair k v) => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @('TPair a b) ((WellTyped ('TPair k v) => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped ('TPair k v) => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ Notes (IterOpEl ('TMap a b))
-> ExpandedInstr
-> [ExpandedOp]
-> HST ('TMap a b : xs)
-> TypeCheckInstr (SomeInstr ('TMap a b : xs))
forall (c :: T) (rs :: [T]).
(IterOp c, WellTyped (IterOpEl c)) =>
Notes (IterOpEl c)
-> ExpandedInstr
-> [ExpandedOp]
-> HST (c : rs)
-> TypeCheckInstr (SomeInstr (c : rs))
iterImpl Notes ('TPair k v)
Notes (IterOpEl ('TMap a b))
en ExpandedInstr
uInstr [ExpandedOp]
is HST inp
HST ('TMap a b : xs)
inp

  (U.ITER _, _ ::& _) ->
    TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
      (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (Maybe ExpectType -> ExpectType
ExpectSet Maybe ExpectType
forall a. Maybe a
Nothing ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:|
      [ (Maybe ExpectType -> ExpectType
ExpectList Maybe ExpectType
forall a. Maybe a
Nothing ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [])
      , (ExpectType
ExpectMap ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [])
      ]

  (U.ITER _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.MEM varNotes :: Annotation VarTag
varNotes,
   _ ::& (STSet{}, NTSet _ notesK :: Notes t
notesK, _, _) ::&+ _) ->
    Notes (MemOpKey ('TSet a))
-> HST inp -> Annotation VarTag -> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (memKey :: T) (rs :: [T]) (inp :: [T])
       (m :: * -> *).
(MemOp c, KnownT (MemOpKey c), inp ~ (memKey : c : rs),
 MonadReader InstrCallStack m, MonadError TCError m) =>
Notes (MemOpKey c)
-> HST inp -> Annotation VarTag -> m (SomeInstr inp)
memImpl Notes t
Notes (MemOpKey ('TSet a))
notesK HST inp
inp Annotation VarTag
varNotes
  (U.MEM varNotes :: Annotation VarTag
varNotes,
   _ ::& (STMap{}, NTMap _ notesK :: Notes k
notesK _, _, _) ::&+ _) ->
    Notes (MemOpKey ('TMap a b))
-> HST inp -> Annotation VarTag -> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (memKey :: T) (rs :: [T]) (inp :: [T])
       (m :: * -> *).
(MemOp c, KnownT (MemOpKey c), inp ~ (memKey : c : rs),
 MonadReader InstrCallStack m, MonadError TCError m) =>
Notes (MemOpKey c)
-> HST inp -> Annotation VarTag -> m (SomeInstr inp)
memImpl Notes k
Notes (MemOpKey ('TMap a b))
notesK HST inp
inp Annotation VarTag
varNotes
  (U.MEM varNotes :: Annotation VarTag
varNotes,
   _ ::& (STBigMap{}, NTBigMap _ notesK :: Notes k
notesK _, _, _) ::&+ _) ->
    Notes (MemOpKey ('TBigMap a b))
-> HST inp -> Annotation VarTag -> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (memKey :: T) (rs :: [T]) (inp :: [T])
       (m :: * -> *).
(MemOp c, KnownT (MemOpKey c), inp ~ (memKey : c : rs),
 MonadReader InstrCallStack m, MonadError TCError m) =>
Notes (MemOpKey c)
-> HST inp -> Annotation VarTag -> m (SomeInstr inp)
memImpl Notes k
Notes (MemOpKey ('TBigMap a b))
notesK HST inp
inp Annotation VarTag
varNotes
  (U.MEM _, _ ::& _ ::& _) ->
    TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
      (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectTypeVar ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [Maybe ExpectType -> ExpectType
ExpectSet Maybe ExpectType
forall a. Maybe a
Nothing]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:|
      [ (ExpectType
ExpectTypeVar ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectMap])
      , (ExpectType
ExpectTypeVar ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectBigMap])
      ]

  (U.MEM _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack


  (U.GET varNotes :: Annotation VarTag
varNotes,
   _ ::& (STMap{}, NTMap _ notesK :: Notes k
notesK (Notes v
notesV :: Notes v), _, _) ::&+ _) ->
    forall a.
SingI v =>
(WellTyped v => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @v ((WellTyped v => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped v => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ Notes (GetOpKey ('TMap a b))
-> HST inp
-> Notes (GetOpVal ('TMap a b))
-> Annotation VarTag
-> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (getKey :: T) (rs :: [T]) (inp :: [T])
       (m :: * -> *).
(GetOp c, KnownT (GetOpKey c), WellTyped (GetOpVal c),
 inp ~ (getKey : c : rs), MonadReader InstrCallStack m,
 MonadError TCError m) =>
Notes (GetOpKey c)
-> HST inp
-> Notes (GetOpVal c)
-> Annotation VarTag
-> m (SomeInstr inp)
getImpl Notes k
Notes (GetOpKey ('TMap a b))
notesK HST inp
inp Notes v
Notes (GetOpVal ('TMap a b))
notesV Annotation VarTag
varNotes
  (U.GET varNotes :: Annotation VarTag
varNotes,
   _ ::& (STBigMap{}, NTBigMap _ notesK :: Notes k
notesK (Notes v
notesV :: Notes v), _, _) ::&+ _) ->
    forall a.
SingI v =>
(WellTyped v => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @v ((WellTyped v => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped v => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ Notes (GetOpKey ('TBigMap a b))
-> HST inp
-> Notes (GetOpVal ('TBigMap a b))
-> Annotation VarTag
-> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (getKey :: T) (rs :: [T]) (inp :: [T])
       (m :: * -> *).
(GetOp c, KnownT (GetOpKey c), WellTyped (GetOpVal c),
 inp ~ (getKey : c : rs), MonadReader InstrCallStack m,
 MonadError TCError m) =>
Notes (GetOpKey c)
-> HST inp
-> Notes (GetOpVal c)
-> Annotation VarTag
-> m (SomeInstr inp)
getImpl Notes k
Notes (GetOpKey ('TBigMap a b))
notesK HST inp
inp Notes v
Notes (GetOpVal ('TBigMap a b))
notesV Annotation VarTag
varNotes

  (U.GET _, _ ::& _ ::& _) ->
    TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
      (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectTypeVar ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectMap]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:|
      [ (ExpectType
ExpectTypeVar ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectBigMap])
      ]

  (U.GET _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.UPDATE varNotes :: Annotation VarTag
varNotes,
   _ ::& _ ::& (STMap{}, (NTMap _ notesK :: Notes k
notesK (Notes v
notesV :: Notes v)), _, _) ::&+ _) ->
    Notes (UpdOpKey ('TMap a b))
-> HST inp
-> Notes (UpdOpParams ('TMap a b))
-> Annotation VarTag
-> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (updKey :: T) (updParams :: T) (rs :: [T])
       (inp :: [T]) (m :: * -> *).
(UpdOp c, KnownT (UpdOpKey c), KnownT (UpdOpParams c),
 inp ~ (updKey : updParams : c : rs), MonadReader InstrCallStack m,
 MonadError TCError m) =>
Notes (UpdOpKey c)
-> HST inp
-> Notes (UpdOpParams c)
-> Annotation VarTag
-> m (SomeInstr inp)
updImpl Notes k
Notes (UpdOpKey ('TMap a b))
notesK HST inp
inp (TypeAnn -> Notes v -> Notes ('TOption v)
forall (t :: T). TypeAnn -> Notes t -> Notes ('TOption t)
NTOption TypeAnn
forall k (a :: k). Annotation a
U.noAnn Notes v
notesV) Annotation VarTag
varNotes
  (U.UPDATE varNotes :: Annotation VarTag
varNotes,
   _ ::& _ ::& (STBigMap{}, NTBigMap _ notesK :: Notes k
notesK (Notes v
notesV :: Notes v), _, _) ::&+ _) ->
    Notes (UpdOpKey ('TBigMap a b))
-> HST inp
-> Notes (UpdOpParams ('TBigMap a b))
-> Annotation VarTag
-> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (updKey :: T) (updParams :: T) (rs :: [T])
       (inp :: [T]) (m :: * -> *).
(UpdOp c, KnownT (UpdOpKey c), KnownT (UpdOpParams c),
 inp ~ (updKey : updParams : c : rs), MonadReader InstrCallStack m,
 MonadError TCError m) =>
Notes (UpdOpKey c)
-> HST inp
-> Notes (UpdOpParams c)
-> Annotation VarTag
-> m (SomeInstr inp)
updImpl Notes k
Notes (UpdOpKey ('TBigMap a b))
notesK HST inp
inp (TypeAnn -> Notes v -> Notes ('TOption v)
forall (t :: T). TypeAnn -> Notes t -> Notes ('TOption t)
NTOption TypeAnn
forall k (a :: k). Annotation a
U.noAnn Notes v
notesV) Annotation VarTag
varNotes
  (U.UPDATE varNotes :: Annotation VarTag
varNotes,
   _ ::& _ ::& (STSet{}, NTSet _ (Notes t
notesK :: Notes k), _, _) ::&+ _) ->
    Notes (UpdOpKey ('TSet a))
-> HST inp
-> Notes (UpdOpParams ('TSet a))
-> Annotation VarTag
-> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (updKey :: T) (updParams :: T) (rs :: [T])
       (inp :: [T]) (m :: * -> *).
(UpdOp c, KnownT (UpdOpKey c), KnownT (UpdOpParams c),
 inp ~ (updKey : updParams : c : rs), MonadReader InstrCallStack m,
 MonadError TCError m) =>
Notes (UpdOpKey c)
-> HST inp
-> Notes (UpdOpParams c)
-> Annotation VarTag
-> m (SomeInstr inp)
updImpl Notes t
Notes (UpdOpKey ('TSet a))
notesK HST inp
inp (TypeAnn -> Notes 'TBool
NTBool TypeAnn
forall k (a :: k). Annotation a
U.noAnn) Annotation VarTag
varNotes

  (U.UPDATE _, _ ::& _ ::& _ ::& _) ->
    TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
      (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectTypeVar ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectTypeVar, ExpectType
ExpectMap]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:|
      [ (ExpectType
ExpectTypeVar ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectTypeVar, ExpectType
ExpectBigMap])
      , (ExpectType
ExpectTypeVar ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectTypeVar, Maybe ExpectType -> ExpectType
ExpectSet Maybe ExpectType
forall a. Maybe a
Nothing])
      ]

  (U.UPDATE _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.IF mp :: [ExpandedOp]
mp mq :: [ExpandedOp]
mq, (NTBool{}, _, _) ::& rs :: HST xs
rs) ->
    (forall (s' :: [T]).
 Instr xs s' -> Instr xs s' -> Instr ('TBool : xs) s')
-> ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr)
-> [ExpandedOp]
-> [ExpandedOp]
-> HST xs
-> HST xs
-> HST ('TBool : xs)
-> TypeCheckInstr (SomeInstr ('TBool : xs))
forall (bti :: [T]) (bfi :: [T]) (cond :: T) (rs :: [T]).
(Typeable bti, Typeable bfi) =>
(forall (s' :: [T]).
 Instr bti s' -> Instr bfi s' -> Instr (cond : rs) s')
-> ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr)
-> [ExpandedOp]
-> [ExpandedOp]
-> HST bti
-> HST bfi
-> HST (cond : rs)
-> TypeCheckInstr (SomeInstr (cond : rs))
genericIf forall (s' :: [T]).
Instr xs s' -> Instr xs s' -> Instr ('TBool : xs) s'
forall (s :: [T]) (s' :: [T]).
Instr s s' -> Instr s s' -> Instr ('TBool : s) s'
IF [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
forall op. [op] -> [op] -> InstrAbstract op
U.IF [ExpandedOp]
mp [ExpandedOp]
mq HST xs
rs HST xs
rs HST inp
HST ('TBool : xs)
inp

  (U.IF _ _, _ ::& _) ->
    TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectBool ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []

  (U.IF _ _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.LOOP is :: [ExpandedOp]
is, (NTBool{}, _, _) ::& (HST xs
rs :: HST rs)) -> do
    _ :/ tp :: SomeInstrOut xs
tp <- ExceptT TCError (State TypeCheckEnv) (SomeInstr xs)
-> ReaderT InstrCallStack TypeCheck (SomeInstr xs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT TCError (State TypeCheckEnv) (SomeInstr xs)
 -> ReaderT InstrCallStack TypeCheck (SomeInstr xs))
-> ExceptT TCError (State TypeCheckEnv) (SomeInstr xs)
-> ReaderT InstrCallStack TypeCheck (SomeInstr xs)
forall a b. (a -> b) -> a -> b
$ [ExpandedOp]
-> HST xs -> ExceptT TCError (State TypeCheckEnv) (SomeInstr xs)
forall (inp :: [T]).
Typeable inp =>
[ExpandedOp] -> HST inp -> TypeCheck (SomeInstr inp)
typeCheckList [ExpandedOp]
is HST xs
rs
    case SomeInstrOut xs
tp of
      subI :: Instr xs out
subI ::: (HST out
o :: HST o) -> do
        case HST out
-> HST ('TBool : xs) -> Either TCTypeError (out :~: ('TBool : xs))
forall (as :: [T]) (bs :: [T]).
(Typeable as, Typeable bs) =>
HST as -> HST bs -> Either TCTypeError (as :~: bs)
eqHST HST out
o (SingI 'TBool => Sing 'TBool
forall k (a :: k). SingI a => Sing a
sing @('TBool) Sing 'TBool -> HST xs -> HST ('TBool : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, WellTyped x) =>
Sing x -> HST xs -> HST (x : xs)
-:& HST xs
rs) of
          Right Refl -> do
            let _ ::& rs' = HST out
o
            SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr xs ('TBool : xs) -> Instr ('TBool : xs) xs
forall (s :: [T]). Instr s ('TBool : s) -> Instr ('TBool : s) s
LOOP Instr xs out
Instr xs ('TBool : xs)
subI Instr ('TBool : xs) xs -> HST xs -> SomeInstrOut ('TBool : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: HST xs
rs'
          Left m :: TCTypeError
m -> ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> TCTypeError
-> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr -> SomeHST -> Maybe TypeContext -> TCTypeError -> m a
typeCheckInstrErr' ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
Iteration) TCTypeError
m
      AnyOutInstr subI :: forall (out :: [T]). Instr xs out
subI ->
        SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr xs ('TBool : xs) -> Instr ('TBool : xs) xs
forall (s :: [T]). Instr s ('TBool : s) -> Instr ('TBool : s) s
LOOP Instr xs ('TBool : xs)
forall (out :: [T]). Instr xs out
subI Instr ('TBool : xs) xs -> HST xs -> SomeInstrOut ('TBool : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: HST xs
rs

  (U.LOOP _, _ ::& _ ::& _) ->
    TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
      (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectBool ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectStackVar]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []

  (U.LOOP _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.LOOP_LEFT is :: [ExpandedOp]
is, (os :: Sing x
os@STOr{}, ons :: Notes x
ons, Dict, ovn :: Annotation VarTag
ovn) ::&+ rs :: HST xs
rs) -> do
    case Notes ('TOr a b)
-> Annotation VarTag
-> (Notes a, Notes b, Annotation VarTag, Annotation VarTag)
forall (a :: T) (b :: T).
Notes ('TOr a b)
-> Annotation VarTag
-> (Notes a, Notes b, Annotation VarTag, Annotation VarTag)
deriveNsOr Notes x
Notes ('TOr a b)
ons Annotation VarTag
ovn of
      (Notes a
an :: Notes t, Notes b
bn :: Notes b, avn :: Annotation VarTag
avn, bvn :: Annotation VarTag
bvn) -> do
        forall a.
SingI a =>
(WellTyped a => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @t ((WellTyped a => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped a => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ forall a.
SingI b =>
(WellTyped b => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @b ((WellTyped b => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped b => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ do
          let ait :: HST (a : xs)
ait = (Notes a
an, Dict (WellTyped a)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
avn) (Notes a, Dict (WellTyped a), Annotation VarTag)
-> HST xs -> HST (a : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs
          _ :/ tp :: SomeInstrOut (a : xs)
tp <- ExceptT TCError (State TypeCheckEnv) (SomeInstr (a : xs))
-> ReaderT InstrCallStack TypeCheck (SomeInstr (a : xs))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT TCError (State TypeCheckEnv) (SomeInstr (a : xs))
 -> ReaderT InstrCallStack TypeCheck (SomeInstr (a : xs)))
-> ExceptT TCError (State TypeCheckEnv) (SomeInstr (a : xs))
-> ReaderT InstrCallStack TypeCheck (SomeInstr (a : xs))
forall a b. (a -> b) -> a -> b
$ [ExpandedOp]
-> HST (a : xs)
-> ExceptT TCError (State TypeCheckEnv) (SomeInstr (a : xs))
forall (inp :: [T]).
Typeable inp =>
[ExpandedOp] -> HST inp -> TypeCheck (SomeInstr inp)
typeCheckList [ExpandedOp]
is HST (a : xs)
ait
          case SomeInstrOut (a : xs)
tp of
            subI :: Instr (a : xs) out
subI ::: o :: HST out
o -> do
              case (HST out
-> HST ('TOr a b : xs)
-> Either TCTypeError (out :~: ('TOr a b : xs))
forall (as :: [T]) (bs :: [T]).
(Typeable as, Typeable bs) =>
HST as -> HST bs -> Either TCTypeError (as :~: bs)
eqHST HST out
o (Sing x
Sing ('TOr a b)
os Sing ('TOr a b) -> HST xs -> HST ('TOr a b : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, WellTyped x) =>
Sing x -> HST xs -> HST (x : xs)
-:& HST xs
rs), HST out
o) of
                (Right Refl, ((ons' :: Notes x
ons', Dict, ovn' :: Annotation VarTag
ovn') ::& rs' :: HST xs
rs')) -> do
                    let (_, bn' :: Notes b
bn', _, bvn' :: Annotation VarTag
bvn') = Notes ('TOr a b)
-> Annotation VarTag
-> (Notes a, Notes b, Annotation VarTag, Annotation VarTag)
forall (a :: T) (b :: T).
Notes ('TOr a b)
-> Annotation VarTag
-> (Notes a, Notes b, Annotation VarTag, Annotation VarTag)
deriveNsOr Notes x
Notes ('TOr a b)
ons' Annotation VarTag
ovn'
                    (Notes b, Dict (WellTyped b), Annotation VarTag)
br <- ExpandedInstr
-> HST inp
-> Maybe TypeContext
-> Either
     AnnConvergeError (Notes b, Dict (WellTyped b), Annotation VarTag)
-> ReaderT
     InstrCallStack
     TypeCheck
     (Notes b, Dict (WellTyped b), Annotation VarTag)
forall (m :: * -> *) (ts :: [T]) a.
(MonadReader InstrCallStack m, MonadError TCError m,
 Typeable ts) =>
ExpandedInstr
-> HST ts -> Maybe TypeContext -> Either AnnConvergeError a -> m a
onTypeCheckInstrAnnErr ExpandedInstr
uInstr HST inp
inp
                            (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
Iteration)
                            ((Notes b, Dict (WellTyped b), Annotation VarTag)
-> (Notes b, Dict (WellTyped b), Annotation VarTag)
-> Either
     AnnConvergeError (Notes b, Dict (WellTyped b), Annotation VarTag)
forall (t :: T).
(Notes t, Dict (WellTyped t), Annotation VarTag)
-> (Notes t, Dict (WellTyped t), Annotation VarTag)
-> Either
     AnnConvergeError (Notes t, Dict (WellTyped t), Annotation VarTag)
convergeHSTEl (Notes b
bn, Dict (WellTyped b)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
bvn) (Notes b
bn', Dict (WellTyped b)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
bvn'))
                    pure $ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr (a : xs) ('TOr a b : xs) -> Instr ('TOr a b : xs) (b : xs)
forall (a :: T) (s :: [T]) (b :: T).
Instr (a : s) ('TOr a b : s) -> Instr ('TOr a b : s) (b : s)
LOOP_LEFT Instr (a : xs) out
Instr (a : xs) ('TOr a b : xs)
subI Instr ('TOr a b : xs) (b : xs)
-> HST (b : xs) -> SomeInstrOut ('TOr a b : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes b, Dict (WellTyped b), Annotation VarTag)
br (Notes b, Dict (WellTyped b), Annotation VarTag)
-> HST xs -> HST (b : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs')
                (Left m :: TCTypeError
m, _) -> ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> TCTypeError
-> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr -> SomeHST -> Maybe TypeContext -> TCTypeError -> m a
typeCheckInstrErr' ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
Iteration) TCTypeError
m
            AnyOutInstr subI :: forall (out :: [T]). Instr (a : xs) out
subI -> do
              let br :: (Notes b, Dict (WellTyped b), Annotation VarTag)
br = (Notes b
bn, Dict (WellTyped b)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
bvn)
              SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr (a : xs) ('TOr a b : xs) -> Instr ('TOr a b : xs) (b : xs)
forall (a :: T) (s :: [T]) (b :: T).
Instr (a : s) ('TOr a b : s) -> Instr ('TOr a b : s) (b : s)
LOOP_LEFT Instr (a : xs) ('TOr a b : xs)
forall (out :: [T]). Instr (a : xs) out
subI Instr ('TOr a b : xs) (b : xs)
-> HST (b : xs) -> SomeInstrOut ('TOr a b : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes b, Dict (WellTyped b), Annotation VarTag)
br (Notes b, Dict (WellTyped b), Annotation VarTag)
-> HST xs -> HST (b : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)

  (U.LOOP_LEFT _, _ ::& _) ->
    TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
      (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (Maybe ExpectType -> Maybe ExpectType -> ExpectType
ExpectOr Maybe ExpectType
forall a. Maybe a
Nothing Maybe ExpectType
forall a. Maybe a
Nothing ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectStackVar]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []

  (U.LOOP_LEFT _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.LAMBDA vn :: Annotation VarTag
vn (AsUType (Notes t
ins :: Notes t)) (AsUType (Notes t
ons :: Notes u)) is :: [ExpandedOp]
is, i :: HST inp
i) -> do
    -- further processing is extracted into another function just not to
    -- litter our main typechecking logic
    forall a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @t ((WellTyped t => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped t => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
      forall a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @u ((WellTyped t => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped t => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
        ExpandedInstr
-> [ExpandedOp]
-> Annotation VarTag
-> Notes t
-> Notes t
-> HST inp
-> TypeCheckInstr (SomeInstr inp)
forall (it :: T) (ot :: T) (ts :: [T]).
(WellTyped it, WellTyped ot, Typeable ts) =>
ExpandedInstr
-> [ExpandedOp]
-> Annotation VarTag
-> Notes it
-> Notes ot
-> HST ts
-> TypeCheckInstr (SomeInstr ts)
lamImpl ExpandedInstr
uInstr [ExpandedOp]
is Annotation VarTag
vn Notes t
ins Notes t
ons HST inp
i

  (U.EXEC vn :: Annotation VarTag
vn, ((Notes x
_ :: Notes t1), _, _)
                              ::& ( STLambda _ _
                                  , NTLambda _ (Notes p
_ :: Notes t1') (Notes q
t2n :: Notes t2')
                                  , _
                                  , _
                                  )
                              ::&+ rs :: HST xs
rs) -> do
    x :~: p
Refl <- ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> Either TCTypeError (x :~: p)
-> ReaderT InstrCallStack TypeCheck (x :~: p)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr
-> SomeHST -> Maybe TypeContext -> Either TCTypeError a -> m a
onTypeCheckInstrErr ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
LambdaArgument)
                  (Each '[KnownT] '[x, p] => Either TCTypeError (x :~: p)
forall (a :: T) (b :: T).
Each '[KnownT] '[a, b] =>
Either TCTypeError (a :~: b)
eqType @t1 @t1')
    forall a.
SingI q =>
(WellTyped q => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @t2' ((WellTyped q => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped q => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr (x : 'TLambda x q : xs) (q : xs)
forall (t1 :: T) (t2 :: T) (s :: [T]).
Instr (t1 : 'TLambda t1 t2 : s) (t2 : s)
EXEC Instr (x : 'TLambda x q : xs) (q : xs)
-> HST (q : xs) -> SomeInstrOut (x : 'TLambda x q : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes q
t2n, Dict (WellTyped q)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes q, Dict (WellTyped q), Annotation VarTag)
-> HST xs -> HST (q : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)

  (U.EXEC _, _ ::& _ ::& _) ->
    TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
      (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectTypeVar ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [Maybe ExpectType -> Maybe ExpectType -> ExpectType
ExpectLambda Maybe ExpectType
forall a. Maybe a
Nothing Maybe ExpectType
forall a. Maybe a
Nothing]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []

  (U.EXEC _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.APPLY vn :: Annotation VarTag
vn, ((Notes x
_ :: Notes a'), _, _)
                  ::& ( STLambda (STPair _ _) _
                      , NTLambda vann :: TypeAnn
vann (NTPair _ _ _ (Notes p
_ :: Notes a) (Notes q
nb :: Notes b)) sc :: Notes q
sc
                      , _
                      , _)
                  ::&+ rs :: HST xs
rs) -> do
    case TypeAnn -> Notes q -> Notes q -> Notes ('TLambda q q)
forall (p :: T) (q :: T).
TypeAnn -> Notes p -> Notes q -> Notes ('TLambda p q)
NTLambda TypeAnn
vann Notes q
nb Notes q
sc of
      (Notes ('TLambda q q)
l2n :: Notes ('TLambda t1 t2)) -> forall a.
SingI ('TLambda q q) =>
(WellTyped ('TLambda q q) => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @('TLambda t1 t2) ((WellTyped ('TLambda q q) => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped ('TLambda q q) => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ do

        x :~: p
proofArgEq <- ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> Either TCTypeError (x :~: p)
-> ReaderT InstrCallStack TypeCheck (x :~: p)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr
-> SomeHST -> Maybe TypeContext -> Either TCTypeError a -> m a
onTypeCheckInstrErr ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
LambdaArgument)
                      (Each '[KnownT] '[x, p] => Either TCTypeError (x :~: p)
forall (a :: T) (b :: T).
Each '[KnownT] '[a, b] =>
Either TCTypeError (a :~: b)
eqType @a' @a)
        Dict (ConstantScope p)
proofScope <- ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> Either BadTypeForScope (Dict (ConstantScope p))
-> ReaderT InstrCallStack TypeCheck (Dict (ConstantScope p))
forall (t :: T) (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m, SingI t) =>
ExpandedInstr
-> SomeHST -> Maybe TypeContext -> Either BadTypeForScope a -> m a
onScopeCheckInstrErr @a ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
LambdaArgument)
          (Either BadTypeForScope (Dict (ConstantScope p))
 -> ReaderT InstrCallStack TypeCheck (Dict (ConstantScope p)))
-> Either BadTypeForScope (Dict (ConstantScope p))
-> ReaderT InstrCallStack TypeCheck (Dict (ConstantScope p))
forall a b. (a -> b) -> a -> b
$ CheckScope (ConstantScope p) =>
Either BadTypeForScope (Dict (ConstantScope p))
forall (c :: Constraint).
CheckScope c =>
Either BadTypeForScope (Dict c)
checkScope @(ConstantScope a)
        case (x :~: p
proofArgEq, Dict (ConstantScope p)
proofScope) of
          (Refl, Dict) ->
            SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ (forall (b :: T) (a :: T) (c :: [T]).
(ConstantScope p, KnownT b) =>
Instr (p : 'TLambda ('TPair p b) a : c) ('TLambda b a : c)
forall (a :: T) (b :: T) (a :: T) (c :: [T]).
(ConstantScope a, KnownT b) =>
Instr (a : 'TLambda ('TPair a b) a : c) ('TLambda b a : c)
APPLY @a) Instr (p : 'TLambda ('TPair p q) q : xs) ('TLambda q q : xs)
-> HST ('TLambda q q : xs)
-> SomeInstrOut (p : 'TLambda ('TPair p q) q : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes ('TLambda q q)
l2n, Dict (WellTyped ('TLambda q q))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes ('TLambda q q), Dict (WellTyped ('TLambda q q)),
 Annotation VarTag)
-> HST xs -> HST ('TLambda q q : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)

  (U.APPLY _, _ ::& _ ::& _) ->
    TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
      (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectTypeVar ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [Maybe ExpectType -> Maybe ExpectType -> ExpectType
ExpectLambda (ExpectType -> Maybe ExpectType
forall a. a -> Maybe a
Just (ExpectType -> Maybe ExpectType) -> ExpectType -> Maybe ExpectType
forall a b. (a -> b) -> a -> b
$ Maybe ExpectType -> Maybe ExpectType -> ExpectType
ExpectPair Maybe ExpectType
forall a. Maybe a
Nothing Maybe ExpectType
forall a. Maybe a
Nothing) Maybe ExpectType
forall a. Maybe a
Nothing]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []

  (U.APPLY _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.DIP is :: [ExpandedOp]
is, a :: (Notes x, Dict (WellTyped x), Annotation VarTag)
a ::& s :: HST xs
s) -> do
    ExpandedInstr
-> [ExpandedOp]
-> HST xs
-> (forall (out :: [T]).
    Typeable out =>
    Instr xs out -> HST out -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall (inp :: [T]) r.
Typeable inp =>
ExpandedInstr
-> [ExpandedOp]
-> HST inp
-> (forall (out :: [T]).
    Typeable out =>
    Instr inp out -> HST out -> TypeCheckInstr r)
-> TypeCheckInstr r
typeCheckDipBody ExpandedInstr
uInstr [ExpandedOp]
is HST xs
s ((forall (out :: [T]).
  Typeable out =>
  Instr xs out -> HST out -> TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (forall (out :: [T]).
    Typeable out =>
    Instr xs out -> HST out -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
      \subI :: Instr xs out
subI t :: HST out
t -> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr xs out -> Instr (x : xs) (x : out)
forall (a :: [T]) (c :: [T]) (b :: T).
Instr a c -> Instr (b : a) (b : c)
DIP Instr xs out
subI Instr (x : xs) (x : out) -> HST (x : out) -> SomeInstrOut (x : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes x, Dict (WellTyped x), Annotation VarTag)
a (Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST out -> HST (x : out)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST out
t)

  (U.DIP _is :: [ExpandedOp]
_is, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

  (U.DIPN nTotal :: Word
nTotal instructions :: [ExpandedOp]
instructions, inputHST :: HST inp
inputHST) ->
    Word -> HST inp -> TypeCheckInstr (TCDipHelper inp)
forall (inp :: [T]).
Typeable inp =>
Word -> HST inp -> TypeCheckInstr (TCDipHelper inp)
go Word
nTotal HST inp
inputHST TypeCheckInstr (TCDipHelper inp)
-> (TCDipHelper inp -> SomeInstr inp)
-> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    TCDipHelper s :: Sing n
s subI :: Instr s s'
subI out :: HST out
out -> HST inp
inputHST HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Sing n -> Instr s s' -> Instr inp out
forall (n :: Peano) (inp :: [T]) (out :: [T]) (s :: [T])
       (s' :: [T]).
(ConstraintDIPN n inp out s s', NFData (Sing n)) =>
Sing n -> Instr s s' -> Instr inp out
DIPN Sing n
s Instr s s'
subI Instr inp out -> HST out -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: HST out
out
    where
      go :: forall inp. Typeable inp
        => Word
        -> HST inp
        -> TypeCheckInstr (TCDipHelper inp)
      go :: Word -> HST inp -> TypeCheckInstr (TCDipHelper inp)
go n :: Word
n curHST :: HST inp
curHST = case (Word
n, HST inp
curHST) of
        (0, _) -> ExpandedInstr
-> [ExpandedOp]
-> HST inp
-> (forall (out :: [T]).
    Typeable out =>
    Instr inp out -> HST out -> TypeCheckInstr (TCDipHelper inp))
-> TypeCheckInstr (TCDipHelper inp)
forall (inp :: [T]) r.
Typeable inp =>
ExpandedInstr
-> [ExpandedOp]
-> HST inp
-> (forall (out :: [T]).
    Typeable out =>
    Instr inp out -> HST out -> TypeCheckInstr r)
-> TypeCheckInstr r
typeCheckDipBody ExpandedInstr
uInstr [ExpandedOp]
instructions HST inp
curHST ((forall (out :: [T]).
  Typeable out =>
  Instr inp out -> HST out -> TypeCheckInstr (TCDipHelper inp))
 -> TypeCheckInstr (TCDipHelper inp))
-> (forall (out :: [T]).
    Typeable out =>
    Instr inp out -> HST out -> TypeCheckInstr (TCDipHelper inp))
-> TypeCheckInstr (TCDipHelper inp)
forall a b. (a -> b) -> a -> b
$ \subI :: Instr inp out
subI t :: HST out
t ->
          TCDipHelper inp -> TypeCheckInstr (TCDipHelper inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sing 'Z -> Instr inp out -> HST out -> TCDipHelper inp
forall (n :: Peano) (inp :: [T]) (out :: [T]) (s :: [T])
       (s' :: [T]).
(Typeable out, ConstraintDIPN n inp out s s') =>
Sing n -> Instr s s' -> HST out -> TCDipHelper inp
TCDipHelper Sing 'Z
SingNat 'Z
SZ Instr inp out
subI HST out
t)
        (_, SNil) -> TypeCheckInstr (TCDipHelper inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack
        (_, hstHead :: (Notes x, Dict (WellTyped x), Annotation VarTag)
hstHead ::& hstTail :: HST xs
hstTail) ->
          Word -> HST xs -> TypeCheckInstr (TCDipHelper xs)
forall (inp :: [T]).
Typeable inp =>
Word -> HST inp -> TypeCheckInstr (TCDipHelper inp)
go (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
- 1) HST xs
hstTail TypeCheckInstr (TCDipHelper xs)
-> (TCDipHelper xs -> TCDipHelper inp)
-> TypeCheckInstr (TCDipHelper inp)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          TCDipHelper s :: Sing n
s subI :: Instr s s'
subI out :: HST out
out -> Sing ('S n) -> Instr s s' -> HST (x : out) -> TCDipHelper (x : xs)
forall (n :: Peano) (inp :: [T]) (out :: [T]) (s :: [T])
       (s' :: [T]).
(Typeable out, ConstraintDIPN n inp out s s') =>
Sing n -> Instr s s' -> HST out -> TCDipHelper inp
TCDipHelper (SingNat n -> SingNat ('S n)
forall (n :: Peano).
(SingI n, KnownPeano n) =>
SingNat n -> SingNat ('S n)
SS Sing n
SingNat n
s) Instr s s'
subI ((Notes x, Dict (WellTyped x), Annotation VarTag)
hstHead (Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST out -> HST (x : out)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST out
out)
  (u :: ExpandedInstr
u, v :: HST inp
v) -> case (ExpandedInstr
u, HST inp
v) of -- Workaround for not exceeding -fmax-pmcheck-iterations limit
    (U.FAILWITH, (_ ::& _)) ->
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ (forall (out :: [T]). Instr inp out) -> SomeInstrOut inp
forall (inp :: [T]).
(forall (out :: [T]). Instr inp out) -> SomeInstrOut inp
AnyOutInstr forall (out :: [T]). Instr inp out
forall (a :: T) (s :: [T]) (t :: [T]). KnownT a => Instr (a : s) t
FAILWITH

    (U.FAILWITH, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.CAST vn :: Annotation VarTag
vn (AsUType (Notes t
castToNotes :: Notes t)), (en :: Notes x
en, _, evn :: Annotation VarTag
evn) ::& rs :: HST xs
rs) -> do
      (Refl, _) <- Either TCTypeError (x :~: t, Notes x)
-> ReaderT InstrCallStack TypeCheck (x :~: t, Notes x)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
Either TCTypeError a -> m a
errM (Either TCTypeError (x :~: t, Notes x)
 -> ReaderT InstrCallStack TypeCheck (x :~: t, Notes x))
-> Either TCTypeError (x :~: t, Notes x)
-> ReaderT InstrCallStack TypeCheck (x :~: t, Notes x)
forall a b. (a -> b) -> a -> b
$ Notes x -> Notes t -> Either TCTypeError (x :~: t, Notes x)
forall (t1 :: T) (t2 :: T).
Each '[KnownT] '[t1, t2] =>
Notes t1 -> Notes t2 -> Either TCTypeError (t1 :~: t2, Notes t1)
matchTypes Notes x
en Notes t
castToNotes
      forall a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @t ((WellTyped t => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped t => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
        SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr (t : xs) (t : xs)
forall (a :: T) (a :: [T]). SingI a => Instr (a : a) (a : a)
CAST Instr (t : xs) (t : xs) -> HST (t : xs) -> SomeInstrOut (t : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes t
castToNotes, Dict (WellTyped t)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn Annotation VarTag -> Annotation VarTag -> Annotation VarTag
forall k (t :: k). Annotation t -> Annotation t -> Annotation t
`orAnn` Annotation VarTag
evn) (Notes t, Dict (WellTyped t), Annotation VarTag)
-> HST xs -> HST (t : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)
      where
        errM :: (MonadReader InstrCallStack m, MonadError TCError m) => Either TCTypeError a -> m a
        errM :: Either TCTypeError a -> m a
errM = ExpandedInstr
-> SomeHST -> Maybe TypeContext -> Either TCTypeError a -> m a
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr
-> SomeHST -> Maybe TypeContext -> Either TCTypeError a -> m a
onTypeCheckInstrErr ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
Cast)

    (U.CAST _ _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.RENAME vn :: Annotation VarTag
vn, (an :: Notes x
an, Dict, _) ::& rs :: HST xs
rs) ->
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr (x : xs) (x : xs)
forall (a :: T) (a :: [T]). Instr (a : a) (a : a)
RENAME Instr (x : xs) (x : xs) -> HST (x : xs) -> SomeInstrOut (x : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes x
an, Dict (WellTyped x)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)

    (U.RENAME _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.UNPACK tn :: TypeAnn
tn vn :: Annotation VarTag
vn mt :: Type
mt, (NTBytes{}, _, _) ::& rs :: HST xs
rs) ->
      Type
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall r. Type -> (forall (t :: T). KnownT t => Notes t -> r) -> r
withUType Type
mt ((forall (t :: T).
  KnownT t =>
  Notes t -> TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ \(Notes t
tns :: Notes tn) -> do
        case TypeAnn -> Notes t -> Notes ('TOption t)
forall (t :: T). TypeAnn -> Notes t -> Notes ('TOption t)
NTOption TypeAnn
tn Notes t
tns of
          (Notes ('TOption t)
ns :: Notes ('TOption t1)) -> forall a.
SingI ('TOption t) =>
(WellTyped ('TOption t) => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @('TOption t1) ((WellTyped ('TOption t) =>
  TypeCheckInstr (SomeInstr ('TBytes : xs)))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped ('TOption t) =>
    TypeCheckInstr (SomeInstr ('TBytes : xs)))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ do
            Dict (UnpackedValScope t)
Dict <- ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> Either BadTypeForScope (Dict (UnpackedValScope t))
-> ReaderT InstrCallStack TypeCheck (Dict (UnpackedValScope t))
forall (t :: T) (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m, SingI t) =>
ExpandedInstr
-> SomeHST -> Maybe TypeContext -> Either BadTypeForScope a -> m a
onScopeCheckInstrErr @tn ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) Maybe TypeContext
forall a. Maybe a
Nothing
              (Either BadTypeForScope (Dict (UnpackedValScope t))
 -> ReaderT InstrCallStack TypeCheck (Dict (UnpackedValScope t)))
-> Either BadTypeForScope (Dict (UnpackedValScope t))
-> ReaderT InstrCallStack TypeCheck (Dict (UnpackedValScope t))
forall a b. (a -> b) -> a -> b
$ CheckScope (UnpackedValScope t) =>
Either BadTypeForScope (Dict (UnpackedValScope t))
forall (c :: Constraint).
CheckScope c =>
Either BadTypeForScope (Dict c)
checkScope @(UnpackedValScope tn)
            SomeInstr inp -> TypeCheckInstr (SomeInstr ('TBytes : xs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr ('TBytes : xs)))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr ('TBytes : xs))
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr ('TBytes : xs) ('TOption t : xs)
forall (s :: T) (s :: [T]).
(UnpackedValScope s, KnownT s) =>
Instr ('TBytes : s) ('TOption s : s)
UNPACK Instr ('TBytes : xs) ('TOption t : xs)
-> HST ('TOption t : xs) -> SomeInstrOut ('TBytes : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes ('TOption t)
ns, Dict (WellTyped ('TOption t))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes ('TOption t), Dict (WellTyped ('TOption t)),
 Annotation VarTag)
-> HST xs -> HST ('TOption t : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)

    (U.UNPACK {}, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectByte ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []

    (U.UNPACK {}, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.PACK vn :: Annotation VarTag
vn, (Notes x
_ :: Notes a, _, _) ::& rs :: HST xs
rs) -> do
      Dict (PackedValScope x)
Dict <- ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> Either BadTypeForScope (Dict (PackedValScope x))
-> ReaderT InstrCallStack TypeCheck (Dict (PackedValScope x))
forall (t :: T) (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m, SingI t) =>
ExpandedInstr
-> SomeHST -> Maybe TypeContext -> Either BadTypeForScope a -> m a
onScopeCheckInstrErr @a ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) Maybe TypeContext
forall a. Maybe a
Nothing
        (Either BadTypeForScope (Dict (PackedValScope x))
 -> ReaderT InstrCallStack TypeCheck (Dict (PackedValScope x)))
-> Either BadTypeForScope (Dict (PackedValScope x))
-> ReaderT InstrCallStack TypeCheck (Dict (PackedValScope x))
forall a b. (a -> b) -> a -> b
$ CheckScope (PackedValScope x) =>
Either BadTypeForScope (Dict (PackedValScope x))
forall (c :: Constraint).
CheckScope c =>
Either BadTypeForScope (Dict c)
checkScope @(PackedValScope a)
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr (x : xs) ('TBytes : xs)
forall (a :: T) (s :: [T]).
PackedValScope a =>
Instr (a : s) ('TBytes : s)
PACK Instr (x : xs) ('TBytes : xs)
-> HST ('TBytes : xs) -> SomeInstrOut (x : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TBytes
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TBytes)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TBytes, Dict (WellTyped 'TBytes), Annotation VarTag)
-> HST xs -> HST ('TBytes : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)

    (U.PACK _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.CONCAT vn :: Annotation VarTag
vn, (NTBytes{}, _, _) ::& (NTBytes{}, _, _) ::& _) ->
      HST inp -> Annotation VarTag -> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (inp :: [T]) (rs :: [T]) (m :: * -> *).
(ConcatOp c, inp ~ (c : c : rs), WellTyped c,
 MonadReader InstrCallStack m, MonadError TCError m) =>
HST inp -> Annotation VarTag -> m (SomeInstr inp)
concatImpl HST inp
inp Annotation VarTag
vn
    (U.CONCAT vn :: Annotation VarTag
vn, (NTString{}, _, _) ::& (NTString{}, _, _) ::& _) ->
      HST inp -> Annotation VarTag -> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (inp :: [T]) (rs :: [T]) (m :: * -> *).
(ConcatOp c, inp ~ (c : c : rs), WellTyped c,
 MonadReader InstrCallStack m, MonadError TCError m) =>
HST inp -> Annotation VarTag -> m (SomeInstr inp)
concatImpl HST inp
inp Annotation VarTag
vn
    (U.CONCAT vn :: Annotation VarTag
vn, (STList STBytes, _, _, _) ::&+ _) ->
      HST inp -> Annotation VarTag -> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (inp :: [T]) (rs :: [T]) (m :: * -> *).
(ConcatOp c, WellTyped c, inp ~ ('TList c : rs), Monad m) =>
HST inp -> Annotation VarTag -> m (SomeInstr inp)
concatImpl' HST inp
inp Annotation VarTag
vn
    (U.CONCAT vn :: Annotation VarTag
vn, (STList STString, _, _, _) ::&+ _) ->
      HST inp -> Annotation VarTag -> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (inp :: [T]) (rs :: [T]) (m :: * -> *).
(ConcatOp c, WellTyped c, inp ~ ('TList c : rs), Monad m) =>
HST inp -> Annotation VarTag -> m (SomeInstr inp)
concatImpl' HST inp
inp Annotation VarTag
vn
    (U.CONCAT _, _ ::& _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
        (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectByte ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectByte]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:|
        [ (ExpectType
ExpectString ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectString])
        ]
    (U.CONCAT _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
        (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (Maybe ExpectType -> ExpectType
ExpectList (ExpectType -> Maybe ExpectType
forall a. a -> Maybe a
Just ExpectType
ExpectByte) ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [Maybe ExpectType -> ExpectType
ExpectList (ExpectType -> Maybe ExpectType
forall a. a -> Maybe a
Just ExpectType
ExpectByte)]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:|
        [ (Maybe ExpectType -> ExpectType
ExpectList (ExpectType -> Maybe ExpectType
forall a. a -> Maybe a
Just ExpectType
ExpectString) ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [Maybe ExpectType -> ExpectType
ExpectList (ExpectType -> Maybe ExpectType
forall a. a -> Maybe a
Just ExpectType
ExpectString)])
        ]
    (U.CONCAT _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.SLICE vn :: Annotation VarTag
vn, (NTNat{}, _, _) ::&
                 (NTNat{}, _, _) ::&
                 (NTString{}, _, _) ::& _) -> HST inp -> Annotation VarTag -> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (inp :: [T]) (rs :: [T]) (m :: * -> *).
(SliceOp c, Typeable c, inp ~ ('TNat : 'TNat : c : rs), Monad m) =>
HST inp -> Annotation VarTag -> m (SomeInstr inp)
sliceImpl HST inp
inp Annotation VarTag
vn
    (U.SLICE vn :: Annotation VarTag
vn, (NTNat{}, _, _) ::&
                 (NTNat{}, _, _) ::&
                 (NTBytes{}, _, _) ::& _) -> HST inp -> Annotation VarTag -> TypeCheckInstr (SomeInstr inp)
forall (c :: T) (inp :: [T]) (rs :: [T]) (m :: * -> *).
(SliceOp c, Typeable c, inp ~ ('TNat : 'TNat : c : rs), Monad m) =>
HST inp -> Annotation VarTag -> m (SomeInstr inp)
sliceImpl HST inp
inp Annotation VarTag
vn

    (U.SLICE _, _ ::& _ ::& _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
        (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectNat ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectNat, ExpectType
ExpectString]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:|
        [ (ExpectType
ExpectNat ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectNat, ExpectType
ExpectByte])
        ]
    (U.SLICE _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.ISNAT vn' :: Annotation VarTag
vn', (NTInt{}, _, oldVn :: Annotation VarTag
oldVn) ::& rs :: HST xs
rs) -> do
      let vn :: Annotation VarTag
vn = Annotation VarTag
vn' Annotation VarTag -> Annotation VarTag -> Annotation VarTag
forall k (t :: k). Annotation t -> Annotation t -> Annotation t
`orAnn` Annotation VarTag
oldVn
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr ('TInt : xs) ('TOption 'TNat : xs)
forall (s :: [T]). Instr ('TInt : s) ('TOption 'TNat : s)
ISNAT Instr ('TInt : xs) ('TOption 'TNat : xs)
-> HST ('TOption 'TNat : xs) -> SomeInstrOut ('TInt : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes ('TOption 'TNat)
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped ('TOption 'TNat))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes ('TOption 'TNat), Dict (WellTyped ('TOption 'TNat)),
 Annotation VarTag)
-> HST xs -> HST ('TOption 'TNat : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)

    (U.ISNAT _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectInt ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []

    (U.ISNAT _, SNil)-> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    -- Type checking is already done inside `addImpl`.
    (U.ADD vn :: Annotation VarTag
vn, (a :: Sing x
a, _, _, _) ::&+ (b :: Sing x
b, _, _, _) ::&+ _) -> Sing x
-> Sing x
-> HST inp
-> Annotation VarTag
-> ExpandedInstr
-> TypeCheckInstr (SomeInstr inp)
forall (a :: T) (b :: T) (inp :: [T]) (rs :: [T]) (m :: * -> *).
(Typeable rs, Each '[KnownT] '[a, b], inp ~ (a : b : rs),
 MonadReader InstrCallStack m, MonadError TCError m) =>
Sing a
-> Sing b
-> HST inp
-> Annotation VarTag
-> ExpandedInstr
-> m (SomeInstr inp)
addImpl Sing x
a Sing x
b HST inp
inp Annotation VarTag
vn ExpandedInstr
uInstr

    (U.ADD _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.SUB vn :: Annotation VarTag
vn, (a :: Sing x
a, _, _, _) ::&+ (b :: Sing x
b, _, _, _) ::&+ _) -> Sing x
-> Sing x
-> HST inp
-> Annotation VarTag
-> ExpandedInstr
-> TypeCheckInstr (SomeInstr inp)
forall (a :: T) (b :: T) (inp :: [T]) (rs :: [T]) (m :: * -> *).
(Typeable rs, Each '[KnownT] '[a, b], inp ~ (a : b : rs),
 MonadReader InstrCallStack m, MonadError TCError m) =>
Sing a
-> Sing b
-> HST inp
-> Annotation VarTag
-> ExpandedInstr
-> m (SomeInstr inp)
subImpl Sing x
a Sing x
b HST inp
inp Annotation VarTag
vn ExpandedInstr
uInstr

    (U.SUB _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.MUL vn :: Annotation VarTag
vn, (a :: Sing x
a, _, _, _) ::&+ (b :: Sing x
b, _, _, _) ::&+ _) -> Sing x
-> Sing x
-> HST inp
-> Annotation VarTag
-> ExpandedInstr
-> TypeCheckInstr (SomeInstr inp)
forall (a :: T) (b :: T) (inp :: [T]) (rs :: [T]) (m :: * -> *).
(Typeable rs, Each '[KnownT] '[a, b], inp ~ (a : b : rs),
 MonadReader InstrCallStack m, MonadError TCError m) =>
Sing a
-> Sing b
-> HST inp
-> Annotation VarTag
-> ExpandedInstr
-> m (SomeInstr inp)
mulImpl Sing x
a Sing x
b HST inp
inp Annotation VarTag
vn ExpandedInstr
uInstr

    (U.MUL _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.EDIV vn :: Annotation VarTag
vn, (a :: Sing x
a, _, _, _) ::&+ (b :: Sing x
b, _, _, _) ::&+ _) -> Sing x
-> Sing x
-> HST inp
-> Annotation VarTag
-> ExpandedInstr
-> TypeCheckInstr (SomeInstr inp)
forall (a :: T) (b :: T) (inp :: [T]) (rs :: [T]) (m :: * -> *).
(Typeable rs, Each '[KnownT] '[a, b], inp ~ (a : b : rs),
 MonadReader InstrCallStack m, MonadError TCError m) =>
Sing a
-> Sing b
-> HST inp
-> Annotation VarTag
-> ExpandedInstr
-> m (SomeInstr inp)
edivImpl Sing x
a Sing x
b HST inp
inp Annotation VarTag
vn ExpandedInstr
uInstr

    (U.EDIV _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.ABS vn :: Annotation VarTag
vn, (STInt, _, _, _) ::&+ _) -> Instr ('TInt : xs) (UnaryArithRes Abs 'TInt : xs)
-> HST ('TInt : xs)
-> Annotation VarTag
-> ReaderT InstrCallStack TypeCheck (SomeInstr ('TInt : xs))
forall k (aop :: k) (n :: T) (s :: [T]) (inp :: [T]) (t :: * -> *).
(Typeable (UnaryArithRes aop n : s),
 WellTyped (UnaryArithRes aop n), inp ~ (n : s), Monad t) =>
Instr inp (UnaryArithRes aop n : s)
-> HST inp -> Annotation VarTag -> t (SomeInstr inp)
unaryArithImpl @Abs Instr ('TInt : xs) (UnaryArithRes Abs 'TInt : xs)
forall (n :: T) (n :: [T]).
UnaryArithOp Abs n =>
Instr (n : n) (UnaryArithRes Abs n : n)
ABS HST inp
HST ('TInt : xs)
inp Annotation VarTag
vn
    (U.ABS _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectInt ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []

    (U.ABS _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.NEG vn :: Annotation VarTag
vn, (STInt, _, _, _) ::&+ _) -> Instr ('TInt : xs) (UnaryArithRes Neg 'TInt : xs)
-> HST ('TInt : xs)
-> Annotation VarTag
-> ReaderT InstrCallStack TypeCheck (SomeInstr ('TInt : xs))
forall k (aop :: k) (n :: T) (s :: [T]) (inp :: [T]) (t :: * -> *).
(Typeable (UnaryArithRes aop n : s),
 WellTyped (UnaryArithRes aop n), inp ~ (n : s), Monad t) =>
Instr inp (UnaryArithRes aop n : s)
-> HST inp -> Annotation VarTag -> t (SomeInstr inp)
unaryArithImpl @Neg Instr ('TInt : xs) (UnaryArithRes Neg 'TInt : xs)
forall (n :: T) (n :: [T]).
UnaryArithOp Neg n =>
Instr (n : n) (UnaryArithRes Neg n : n)
NEG HST inp
HST ('TInt : xs)
inp Annotation VarTag
vn
    (U.NEG vn :: Annotation VarTag
vn, (STNat, _, _, _) ::&+ _) -> Instr ('TNat : xs) (UnaryArithRes Neg 'TNat : xs)
-> HST ('TNat : xs)
-> Annotation VarTag
-> ReaderT InstrCallStack TypeCheck (SomeInstr ('TNat : xs))
forall k (aop :: k) (n :: T) (s :: [T]) (inp :: [T]) (t :: * -> *).
(Typeable (UnaryArithRes aop n : s),
 WellTyped (UnaryArithRes aop n), inp ~ (n : s), Monad t) =>
Instr inp (UnaryArithRes aop n : s)
-> HST inp -> Annotation VarTag -> t (SomeInstr inp)
unaryArithImpl @Neg Instr ('TNat : xs) (UnaryArithRes Neg 'TNat : xs)
forall (n :: T) (n :: [T]).
UnaryArithOp Neg n =>
Instr (n : n) (UnaryArithRes Neg n : n)
NEG HST inp
HST ('TNat : xs)
inp Annotation VarTag
vn
    (U.NEG _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
        (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectInt ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:|
        [ (ExpectType
ExpectNat ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [])
        ]
    (U.NEG _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.LSL vn :: Annotation VarTag
vn, (STNat, _, _, _) ::&+
               (STNat, _, _, _) ::&+ _) -> Instr ('TNat : 'TNat : xs) (ArithRes Lsl 'TNat 'TNat : xs)
-> HST ('TNat : 'TNat : xs)
-> Annotation VarTag
-> ExpandedInstr
-> ReaderT
     InstrCallStack TypeCheck (SomeInstr ('TNat : 'TNat : xs))
forall k (aop :: k) (inp :: [T]) (m :: T) (n :: T) (s :: [T])
       (t :: * -> *).
(ArithOp aop n m, Typeable (ArithRes aop n m : s),
 WellTyped (ArithRes aop n m), inp ~ (n : m : s),
 MonadReader InstrCallStack t, MonadError TCError t) =>
Instr inp (ArithRes aop n m : s)
-> HST inp
-> Annotation VarTag
-> ExpandedInstr
-> t (SomeInstr inp)
arithImpl @Lsl Instr ('TNat : 'TNat : xs) (ArithRes Lsl 'TNat 'TNat : xs)
forall (n :: T) (m :: T) (s :: [T]).
(ArithOp Lsl n m, Typeable n, Typeable m) =>
Instr (n : m : s) (ArithRes Lsl n m : s)
LSL HST inp
HST ('TNat : 'TNat : xs)
inp Annotation VarTag
vn ExpandedInstr
uInstr
    (U.LSL _, _ ::& _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectNat ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectNat]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []
    (U.LSL _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.LSR vn :: Annotation VarTag
vn, (STNat, _, _, _) ::&+
               (STNat, _, _, _) ::&+ _) -> Instr ('TNat : 'TNat : xs) (ArithRes Lsr 'TNat 'TNat : xs)
-> HST ('TNat : 'TNat : xs)
-> Annotation VarTag
-> ExpandedInstr
-> ReaderT
     InstrCallStack TypeCheck (SomeInstr ('TNat : 'TNat : xs))
forall k (aop :: k) (inp :: [T]) (m :: T) (n :: T) (s :: [T])
       (t :: * -> *).
(ArithOp aop n m, Typeable (ArithRes aop n m : s),
 WellTyped (ArithRes aop n m), inp ~ (n : m : s),
 MonadReader InstrCallStack t, MonadError TCError t) =>
Instr inp (ArithRes aop n m : s)
-> HST inp
-> Annotation VarTag
-> ExpandedInstr
-> t (SomeInstr inp)
arithImpl @Lsr Instr ('TNat : 'TNat : xs) (ArithRes Lsr 'TNat 'TNat : xs)
forall (n :: T) (m :: T) (s :: [T]).
(ArithOp Lsr n m, Typeable n, Typeable m) =>
Instr (n : m : s) (ArithRes Lsr n m : s)
LSR HST inp
HST ('TNat : 'TNat : xs)
inp Annotation VarTag
vn ExpandedInstr
uInstr
    (U.LSR _, _ ::& _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectNat ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectNat]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []
    (U.LSR _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.OR vn :: Annotation VarTag
vn, (STBool, _, _, _) ::&+
              (STBool, _, _, _) ::&+ _) -> Instr ('TBool : 'TBool : xs) (ArithRes Or 'TBool 'TBool : xs)
-> HST ('TBool : 'TBool : xs)
-> Annotation VarTag
-> ExpandedInstr
-> ReaderT
     InstrCallStack TypeCheck (SomeInstr ('TBool : 'TBool : xs))
forall k (aop :: k) (inp :: [T]) (m :: T) (n :: T) (s :: [T])
       (t :: * -> *).
(ArithOp aop n m, Typeable (ArithRes aop n m : s),
 WellTyped (ArithRes aop n m), inp ~ (n : m : s),
 MonadReader InstrCallStack t, MonadError TCError t) =>
Instr inp (ArithRes aop n m : s)
-> HST inp
-> Annotation VarTag
-> ExpandedInstr
-> t (SomeInstr inp)
arithImpl @Or Instr ('TBool : 'TBool : xs) (ArithRes Or 'TBool 'TBool : xs)
forall (n :: T) (m :: T) (s :: [T]).
(ArithOp Or n m, Typeable n, Typeable m) =>
Instr (n : m : s) (ArithRes Or n m : s)
OR HST inp
HST ('TBool : 'TBool : xs)
inp Annotation VarTag
vn ExpandedInstr
uInstr
    (U.OR vn :: Annotation VarTag
vn, (STNat, _, _, _) ::&+
              (STNat, _, _, _) ::&+ _) -> Instr ('TNat : 'TNat : xs) (ArithRes Or 'TNat 'TNat : xs)
-> HST ('TNat : 'TNat : xs)
-> Annotation VarTag
-> ExpandedInstr
-> ReaderT
     InstrCallStack TypeCheck (SomeInstr ('TNat : 'TNat : xs))
forall k (aop :: k) (inp :: [T]) (m :: T) (n :: T) (s :: [T])
       (t :: * -> *).
(ArithOp aop n m, Typeable (ArithRes aop n m : s),
 WellTyped (ArithRes aop n m), inp ~ (n : m : s),
 MonadReader InstrCallStack t, MonadError TCError t) =>
Instr inp (ArithRes aop n m : s)
-> HST inp
-> Annotation VarTag
-> ExpandedInstr
-> t (SomeInstr inp)
arithImpl @Or Instr ('TNat : 'TNat : xs) (ArithRes Or 'TNat 'TNat : xs)
forall (n :: T) (m :: T) (s :: [T]).
(ArithOp Or n m, Typeable n, Typeable m) =>
Instr (n : m : s) (ArithRes Or n m : s)
OR HST inp
HST ('TNat : 'TNat : xs)
inp Annotation VarTag
vn ExpandedInstr
uInstr
    (U.OR _, _ ::& _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
        (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectBool ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectBool]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:|
        [ (ExpectType
ExpectNat ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectNat])
        ]
    (U.OR _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.AND vn :: Annotation VarTag
vn, (STInt, _, _, _) ::&+
               (STNat, _, _, _) ::&+ _) -> Instr ('TInt : 'TNat : xs) (ArithRes And 'TInt 'TNat : xs)
-> HST ('TInt : 'TNat : xs)
-> Annotation VarTag
-> ExpandedInstr
-> ReaderT
     InstrCallStack TypeCheck (SomeInstr ('TInt : 'TNat : xs))
forall k (aop :: k) (inp :: [T]) (m :: T) (n :: T) (s :: [T])
       (t :: * -> *).
(ArithOp aop n m, Typeable (ArithRes aop n m : s),
 WellTyped (ArithRes aop n m), inp ~ (n : m : s),
 MonadReader InstrCallStack t, MonadError TCError t) =>
Instr inp (ArithRes aop n m : s)
-> HST inp
-> Annotation VarTag
-> ExpandedInstr
-> t (SomeInstr inp)
arithImpl @And Instr ('TInt : 'TNat : xs) (ArithRes And 'TInt 'TNat : xs)
forall (n :: T) (m :: T) (s :: [T]).
(ArithOp And n m, Typeable n, Typeable m) =>
Instr (n : m : s) (ArithRes And n m : s)
AND HST inp
HST ('TInt : 'TNat : xs)
inp Annotation VarTag
vn ExpandedInstr
uInstr
    (U.AND vn :: Annotation VarTag
vn, (STNat, _, _, _) ::&+
               (STNat, _, _, _) ::&+ _) -> Instr ('TNat : 'TNat : xs) (ArithRes And 'TNat 'TNat : xs)
-> HST ('TNat : 'TNat : xs)
-> Annotation VarTag
-> ExpandedInstr
-> ReaderT
     InstrCallStack TypeCheck (SomeInstr ('TNat : 'TNat : xs))
forall k (aop :: k) (inp :: [T]) (m :: T) (n :: T) (s :: [T])
       (t :: * -> *).
(ArithOp aop n m, Typeable (ArithRes aop n m : s),
 WellTyped (ArithRes aop n m), inp ~ (n : m : s),
 MonadReader InstrCallStack t, MonadError TCError t) =>
Instr inp (ArithRes aop n m : s)
-> HST inp
-> Annotation VarTag
-> ExpandedInstr
-> t (SomeInstr inp)
arithImpl @And Instr ('TNat : 'TNat : xs) (ArithRes And 'TNat 'TNat : xs)
forall (n :: T) (m :: T) (s :: [T]).
(ArithOp And n m, Typeable n, Typeable m) =>
Instr (n : m : s) (ArithRes And n m : s)
AND HST inp
HST ('TNat : 'TNat : xs)
inp Annotation VarTag
vn ExpandedInstr
uInstr
    (U.AND vn :: Annotation VarTag
vn, (STBool, _, _, _) ::&+
               (STBool, _, _, _) ::&+ _) -> Instr ('TBool : 'TBool : xs) (ArithRes And 'TBool 'TBool : xs)
-> HST ('TBool : 'TBool : xs)
-> Annotation VarTag
-> ExpandedInstr
-> ReaderT
     InstrCallStack TypeCheck (SomeInstr ('TBool : 'TBool : xs))
forall k (aop :: k) (inp :: [T]) (m :: T) (n :: T) (s :: [T])
       (t :: * -> *).
(ArithOp aop n m, Typeable (ArithRes aop n m : s),
 WellTyped (ArithRes aop n m), inp ~ (n : m : s),
 MonadReader InstrCallStack t, MonadError TCError t) =>
Instr inp (ArithRes aop n m : s)
-> HST inp
-> Annotation VarTag
-> ExpandedInstr
-> t (SomeInstr inp)
arithImpl @And Instr ('TBool : 'TBool : xs) (ArithRes And 'TBool 'TBool : xs)
forall (n :: T) (m :: T) (s :: [T]).
(ArithOp And n m, Typeable n, Typeable m) =>
Instr (n : m : s) (ArithRes And n m : s)
AND HST inp
HST ('TBool : 'TBool : xs)
inp Annotation VarTag
vn ExpandedInstr
uInstr
    (U.AND _, _ ::& _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
        (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectInt ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectNat]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:|
        [ (ExpectType
ExpectNat ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectNat])
        , (ExpectType
ExpectBool ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectBool])
        ]
    (U.AND _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.XOR vn :: Annotation VarTag
vn, (STBool, _, _, _) ::&+
               (STBool, _, _, _) ::&+ _) -> Instr ('TBool : 'TBool : xs) (ArithRes Xor 'TBool 'TBool : xs)
-> HST ('TBool : 'TBool : xs)
-> Annotation VarTag
-> ExpandedInstr
-> ReaderT
     InstrCallStack TypeCheck (SomeInstr ('TBool : 'TBool : xs))
forall k (aop :: k) (inp :: [T]) (m :: T) (n :: T) (s :: [T])
       (t :: * -> *).
(ArithOp aop n m, Typeable (ArithRes aop n m : s),
 WellTyped (ArithRes aop n m), inp ~ (n : m : s),
 MonadReader InstrCallStack t, MonadError TCError t) =>
Instr inp (ArithRes aop n m : s)
-> HST inp
-> Annotation VarTag
-> ExpandedInstr
-> t (SomeInstr inp)
arithImpl @Xor Instr ('TBool : 'TBool : xs) (ArithRes Xor 'TBool 'TBool : xs)
forall (n :: T) (m :: T) (s :: [T]).
(ArithOp Xor n m, Typeable n, Typeable m) =>
Instr (n : m : s) (ArithRes Xor n m : s)
XOR HST inp
HST ('TBool : 'TBool : xs)
inp Annotation VarTag
vn ExpandedInstr
uInstr
    (U.XOR vn :: Annotation VarTag
vn, (STNat, _, _, _) ::&+
               (STNat, _, _, _) ::&+ _) -> Instr ('TNat : 'TNat : xs) (ArithRes Xor 'TNat 'TNat : xs)
-> HST ('TNat : 'TNat : xs)
-> Annotation VarTag
-> ExpandedInstr
-> ReaderT
     InstrCallStack TypeCheck (SomeInstr ('TNat : 'TNat : xs))
forall k (aop :: k) (inp :: [T]) (m :: T) (n :: T) (s :: [T])
       (t :: * -> *).
(ArithOp aop n m, Typeable (ArithRes aop n m : s),
 WellTyped (ArithRes aop n m), inp ~ (n : m : s),
 MonadReader InstrCallStack t, MonadError TCError t) =>
Instr inp (ArithRes aop n m : s)
-> HST inp
-> Annotation VarTag
-> ExpandedInstr
-> t (SomeInstr inp)
arithImpl @Xor Instr ('TNat : 'TNat : xs) (ArithRes Xor 'TNat 'TNat : xs)
forall (n :: T) (m :: T) (s :: [T]).
(ArithOp Xor n m, Typeable n, Typeable m) =>
Instr (n : m : s) (ArithRes Xor n m : s)
XOR HST inp
HST ('TNat : 'TNat : xs)
inp Annotation VarTag
vn ExpandedInstr
uInstr
    (U.XOR _, _ ::& _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
        (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectBool ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectBool]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:|
        [ (ExpectType
ExpectNat ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectNat])
        ]
    (U.XOR _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.NOT vn :: Annotation VarTag
vn, (STNat, _, _, _) ::&+ _) -> Instr ('TNat : xs) (UnaryArithRes Not 'TNat : xs)
-> HST ('TNat : xs)
-> Annotation VarTag
-> ReaderT InstrCallStack TypeCheck (SomeInstr ('TNat : xs))
forall k (aop :: k) (n :: T) (s :: [T]) (inp :: [T]) (t :: * -> *).
(Typeable (UnaryArithRes aop n : s),
 WellTyped (UnaryArithRes aop n), inp ~ (n : s), Monad t) =>
Instr inp (UnaryArithRes aop n : s)
-> HST inp -> Annotation VarTag -> t (SomeInstr inp)
unaryArithImpl @Not Instr ('TNat : xs) (UnaryArithRes Not 'TNat : xs)
forall (n :: T) (n :: [T]).
UnaryArithOp Not n =>
Instr (n : n) (UnaryArithRes Not n : n)
NOT HST inp
HST ('TNat : xs)
inp Annotation VarTag
vn
    (U.NOT vn :: Annotation VarTag
vn, (STBool, _, _, _) ::&+ _) -> Instr ('TBool : xs) (UnaryArithRes Not 'TBool : xs)
-> HST ('TBool : xs)
-> Annotation VarTag
-> ReaderT InstrCallStack TypeCheck (SomeInstr ('TBool : xs))
forall k (aop :: k) (n :: T) (s :: [T]) (inp :: [T]) (t :: * -> *).
(Typeable (UnaryArithRes aop n : s),
 WellTyped (UnaryArithRes aop n), inp ~ (n : s), Monad t) =>
Instr inp (UnaryArithRes aop n : s)
-> HST inp -> Annotation VarTag -> t (SomeInstr inp)
unaryArithImpl @Not Instr ('TBool : xs) (UnaryArithRes Not 'TBool : xs)
forall (n :: T) (n :: [T]).
UnaryArithOp Not n =>
Instr (n : n) (UnaryArithRes Not n : n)
NOT HST inp
HST ('TBool : xs)
inp Annotation VarTag
vn
    (U.NOT vn :: Annotation VarTag
vn, (STInt, _, _, _) ::&+ _) -> Instr ('TInt : xs) (UnaryArithRes Not 'TInt : xs)
-> HST ('TInt : xs)
-> Annotation VarTag
-> ReaderT InstrCallStack TypeCheck (SomeInstr ('TInt : xs))
forall k (aop :: k) (n :: T) (s :: [T]) (inp :: [T]) (t :: * -> *).
(Typeable (UnaryArithRes aop n : s),
 WellTyped (UnaryArithRes aop n), inp ~ (n : s), Monad t) =>
Instr inp (UnaryArithRes aop n : s)
-> HST inp -> Annotation VarTag -> t (SomeInstr inp)
unaryArithImpl @Not Instr ('TInt : xs) (UnaryArithRes Not 'TInt : xs)
forall (n :: T) (n :: [T]).
UnaryArithOp Not n =>
Instr (n : n) (UnaryArithRes Not n : n)
NOT HST inp
HST ('TInt : xs)
inp Annotation VarTag
vn
    (U.NOT _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType
        (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectNat ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:|
        [ (ExpectType
ExpectBool ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [])
        , (ExpectType
ExpectInt ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [])
        ]
    (U.NOT _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.COMPARE vn :: Annotation VarTag
vn,
          (Notes x
an :: Notes aT, _, _)
      ::& (Notes x
bn :: Notes bT, _, _)
      ::& rs :: HST xs
rs
      )
      -> do
      case Each '[KnownT] '[x, x] => Either TCTypeError (x :~: x)
forall (a :: T) (b :: T).
Each '[KnownT] '[a, b] =>
Either TCTypeError (a :~: b)
eqType @aT @bT of
        Right Refl -> do
          ReaderT InstrCallStack TypeCheck (Notes x)
-> ReaderT InstrCallStack TypeCheck ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT InstrCallStack TypeCheck (Notes x)
 -> ReaderT InstrCallStack TypeCheck ())
-> (Either AnnConvergeError (Notes x)
    -> ReaderT InstrCallStack TypeCheck (Notes x))
-> Either AnnConvergeError (Notes x)
-> ReaderT InstrCallStack TypeCheck ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either AnnConvergeError (Notes x)
-> ReaderT InstrCallStack TypeCheck (Notes x)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
Either AnnConvergeError a -> m a
errConv (Either AnnConvergeError (Notes x)
 -> ReaderT InstrCallStack TypeCheck ())
-> Either AnnConvergeError (Notes x)
-> ReaderT InstrCallStack TypeCheck ()
forall a b. (a -> b) -> a -> b
$ Notes x -> Notes x -> Either AnnConvergeError (Notes x)
forall (t :: T).
Notes t -> Notes t -> Either AnnConvergeError (Notes t)
converge Notes x
an Notes x
Notes x
bn
          Dict (ComparabilityScope x)
proofScope <- ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> Either BadTypeForScope (Dict (ComparabilityScope x))
-> ReaderT InstrCallStack TypeCheck (Dict (ComparabilityScope x))
forall (t :: T) (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m, SingI t) =>
ExpandedInstr
-> SomeHST -> Maybe TypeContext -> Either BadTypeForScope a -> m a
onScopeCheckInstrErr @aT (Annotation VarTag -> ExpandedInstr
forall op. Annotation VarTag -> InstrAbstract op
U.COMPARE Annotation VarTag
vn) (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
ComparisonArguments)
            (Either BadTypeForScope (Dict (ComparabilityScope x))
 -> ReaderT InstrCallStack TypeCheck (Dict (ComparabilityScope x)))
-> Either BadTypeForScope (Dict (ComparabilityScope x))
-> ReaderT InstrCallStack TypeCheck (Dict (ComparabilityScope x))
forall a b. (a -> b) -> a -> b
$ CheckScope (ComparabilityScope x) =>
Either BadTypeForScope (Dict (ComparabilityScope x))
forall (c :: Constraint).
CheckScope c =>
Either BadTypeForScope (Dict c)
checkScope @(ComparabilityScope aT)
          case Dict (ComparabilityScope x)
proofScope of
            Dict ->
              SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr (x : x : xs) ('TInt : xs)
forall (n :: T) (n :: [T]).
(Comparable n, KnownT n) =>
Instr (n : n : n) ('TInt : n)
COMPARE Instr (x : x : xs) ('TInt : xs)
-> HST ('TInt : xs) -> SomeInstrOut (x : x : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TInt
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TInt)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TInt, Dict (WellTyped 'TInt), Annotation VarTag)
-> HST xs -> HST ('TInt : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)

        Left err :: TCTypeError
err -> do
          ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> TCTypeError
-> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr -> SomeHST -> Maybe TypeContext -> TCTypeError -> m a
typeCheckInstrErr' ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
ComparisonArguments) TCTypeError
err
      where
        errConv :: (MonadReader InstrCallStack m, MonadError TCError m) => Either AnnConvergeError a -> m a
        errConv :: Either AnnConvergeError a -> m a
errConv = ExpandedInstr
-> HST inp -> Maybe TypeContext -> Either AnnConvergeError a -> m a
forall (m :: * -> *) (ts :: [T]) a.
(MonadReader InstrCallStack m, MonadError TCError m,
 Typeable ts) =>
ExpandedInstr
-> HST ts -> Maybe TypeContext -> Either AnnConvergeError a -> m a
onTypeCheckInstrAnnErr ExpandedInstr
uInstr HST inp
inp (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
ComparisonArguments)

    (U.COMPARE _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.EQ vn :: Annotation VarTag
vn, (NTInt{}, _, _) ::& _) -> Instr ('TInt : xs) (UnaryArithRes Eq' 'TInt : xs)
-> HST ('TInt : xs)
-> Annotation VarTag
-> ReaderT InstrCallStack TypeCheck (SomeInstr ('TInt : xs))
forall k (aop :: k) (n :: T) (s :: [T]) (inp :: [T]) (t :: * -> *).
(Typeable (UnaryArithRes aop n : s),
 WellTyped (UnaryArithRes aop n), inp ~ (n : s), Monad t) =>
Instr inp (UnaryArithRes aop n : s)
-> HST inp -> Annotation VarTag -> t (SomeInstr inp)
unaryArithImpl @Eq' Instr ('TInt : xs) (UnaryArithRes Eq' 'TInt : xs)
forall (n :: T) (n :: [T]).
UnaryArithOp Eq' n =>
Instr (n : n) (UnaryArithRes Eq' n : n)
EQ HST inp
HST ('TInt : xs)
inp Annotation VarTag
vn
    (U.EQ _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectInt ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []
    (U.EQ _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.NEQ vn :: Annotation VarTag
vn, (NTInt{}, _, _) ::& _) -> Instr ('TInt : xs) (UnaryArithRes Neq 'TInt : xs)
-> HST ('TInt : xs)
-> Annotation VarTag
-> ReaderT InstrCallStack TypeCheck (SomeInstr ('TInt : xs))
forall k (aop :: k) (n :: T) (s :: [T]) (inp :: [T]) (t :: * -> *).
(Typeable (UnaryArithRes aop n : s),
 WellTyped (UnaryArithRes aop n), inp ~ (n : s), Monad t) =>
Instr inp (UnaryArithRes aop n : s)
-> HST inp -> Annotation VarTag -> t (SomeInstr inp)
unaryArithImpl @Neq Instr ('TInt : xs) (UnaryArithRes Neq 'TInt : xs)
forall (n :: T) (n :: [T]).
UnaryArithOp Neq n =>
Instr (n : n) (UnaryArithRes Neq n : n)
NEQ HST inp
HST ('TInt : xs)
inp Annotation VarTag
vn
    (U.NEQ _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectInt ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []
    (U.NEQ _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.LT vn :: Annotation VarTag
vn, (NTInt{}, _, _) ::& _) -> Instr ('TInt : xs) (UnaryArithRes Lt 'TInt : xs)
-> HST ('TInt : xs)
-> Annotation VarTag
-> ReaderT InstrCallStack TypeCheck (SomeInstr ('TInt : xs))
forall k (aop :: k) (n :: T) (s :: [T]) (inp :: [T]) (t :: * -> *).
(Typeable (UnaryArithRes aop n : s),
 WellTyped (UnaryArithRes aop n), inp ~ (n : s), Monad t) =>
Instr inp (UnaryArithRes aop n : s)
-> HST inp -> Annotation VarTag -> t (SomeInstr inp)
unaryArithImpl @Lt Instr ('TInt : xs) (UnaryArithRes Lt 'TInt : xs)
forall (n :: T) (n :: [T]).
UnaryArithOp Lt n =>
Instr (n : n) (UnaryArithRes Lt n : n)
LT HST inp
HST ('TInt : xs)
inp Annotation VarTag
vn
    (U.LT _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectInt ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []
    (U.LT _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.GT vn :: Annotation VarTag
vn, (NTInt{}, _, _) ::& _) -> Instr ('TInt : xs) (UnaryArithRes Gt 'TInt : xs)
-> HST ('TInt : xs)
-> Annotation VarTag
-> ReaderT InstrCallStack TypeCheck (SomeInstr ('TInt : xs))
forall k (aop :: k) (n :: T) (s :: [T]) (inp :: [T]) (t :: * -> *).
(Typeable (UnaryArithRes aop n : s),
 WellTyped (UnaryArithRes aop n), inp ~ (n : s), Monad t) =>
Instr inp (UnaryArithRes aop n : s)
-> HST inp -> Annotation VarTag -> t (SomeInstr inp)
unaryArithImpl @Gt Instr ('TInt : xs) (UnaryArithRes Gt 'TInt : xs)
forall (n :: T) (n :: [T]).
UnaryArithOp Gt n =>
Instr (n : n) (UnaryArithRes Gt n : n)
GT HST inp
HST ('TInt : xs)
inp Annotation VarTag
vn
    (U.GT _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectInt ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []
    (U.GT _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.LE vn :: Annotation VarTag
vn, (NTInt{}, _, _) ::& _) -> Instr ('TInt : xs) (UnaryArithRes Le 'TInt : xs)
-> HST ('TInt : xs)
-> Annotation VarTag
-> ReaderT InstrCallStack TypeCheck (SomeInstr ('TInt : xs))
forall k (aop :: k) (n :: T) (s :: [T]) (inp :: [T]) (t :: * -> *).
(Typeable (UnaryArithRes aop n : s),
 WellTyped (UnaryArithRes aop n), inp ~ (n : s), Monad t) =>
Instr inp (UnaryArithRes aop n : s)
-> HST inp -> Annotation VarTag -> t (SomeInstr inp)
unaryArithImpl @Le Instr ('TInt : xs) (UnaryArithRes Le 'TInt : xs)
forall (n :: T) (n :: [T]).
UnaryArithOp Le n =>
Instr (n : n) (UnaryArithRes Le n : n)
LE HST inp
HST ('TInt : xs)
inp Annotation VarTag
vn
    (U.LE _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectInt ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []
    (U.LE _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.GE vn :: Annotation VarTag
vn, (NTInt{}, _, _) ::& _) -> Instr ('TInt : xs) (UnaryArithRes Ge 'TInt : xs)
-> HST ('TInt : xs)
-> Annotation VarTag
-> ReaderT InstrCallStack TypeCheck (SomeInstr ('TInt : xs))
forall k (aop :: k) (n :: T) (s :: [T]) (inp :: [T]) (t :: * -> *).
(Typeable (UnaryArithRes aop n : s),
 WellTyped (UnaryArithRes aop n), inp ~ (n : s), Monad t) =>
Instr inp (UnaryArithRes aop n : s)
-> HST inp -> Annotation VarTag -> t (SomeInstr inp)
unaryArithImpl @Ge Instr ('TInt : xs) (UnaryArithRes Ge 'TInt : xs)
forall (n :: T) (s :: [T]).
UnaryArithOp Ge n =>
Instr (n : s) (UnaryArithRes Ge n : s)
GE HST inp
HST ('TInt : xs)
inp Annotation VarTag
vn
    (U.GE _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectInt ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []
    (U.GE _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.INT vn :: Annotation VarTag
vn, (NTNat{}, _, _) ::& rs :: HST xs
rs) ->
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr ('TNat : xs) ('TInt : xs)
forall (s :: [T]). Instr ('TNat : s) ('TInt : s)
INT Instr ('TNat : xs) ('TInt : xs)
-> HST ('TInt : xs) -> SomeInstrOut ('TNat : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TInt
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TInt)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TInt, Dict (WellTyped 'TInt), Annotation VarTag)
-> HST xs -> HST ('TInt : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)
    (U.INT _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectNat ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []
    (U.INT _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.SELF vn :: Annotation VarTag
vn fn :: FieldAnn
fn, _) -> do
      TypeCheckMode
mode <- (TypeCheckEnv -> TypeCheckMode)
-> ReaderT InstrCallStack TypeCheck TypeCheckMode
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TypeCheckEnv -> TypeCheckMode
tcMode
      case TypeCheckMode
mode of
        TypeCheckValue (value :: Value
value, ty :: T
ty) ->
          Value
-> T -> Text -> Maybe TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a.
Value -> T -> Text -> Maybe TCTypeError -> TypeCheckInstr a
tcFailedOnValue Value
value T
ty "The SELF instruction cannot appear in a lambda." Maybe TCTypeError
forall a. Maybe a
Nothing
        TypeCheckContract (SomeParamType _ notescp :: ParamNotes t
notescp) -> do
          let epName :: EpName
epName = FieldAnn -> EpName
U.epNameFromSelfAnn FieldAnn
fn
          MkEntrypointCallRes (Notes arg
argNotes :: Notes arg) epc :: EntrypointCallT t arg
epc <-
            EpName -> ParamNotes t -> Maybe (MkEntrypointCallRes t)
forall (param :: T).
ParameterScope param =>
EpName -> ParamNotes param -> Maybe (MkEntrypointCallRes param)
mkEntrypointCall EpName
epName ParamNotes t
notescp
              Maybe (MkEntrypointCallRes t)
-> (Maybe (MkEntrypointCallRes t)
    -> Either TCTypeError (MkEntrypointCallRes t))
-> Either TCTypeError (MkEntrypointCallRes t)
forall a b. a -> (a -> b) -> b
& TCTypeError
-> Maybe (MkEntrypointCallRes t)
-> Either TCTypeError (MkEntrypointCallRes t)
forall l r. l -> Maybe r -> Either l r
maybeToRight (EpName -> TCTypeError
EntrypointNotFound EpName
epName)
              Either TCTypeError (MkEntrypointCallRes t)
-> (Either TCTypeError (MkEntrypointCallRes t)
    -> ReaderT InstrCallStack TypeCheck (MkEntrypointCallRes t))
-> ReaderT InstrCallStack TypeCheck (MkEntrypointCallRes t)
forall a b. a -> (a -> b) -> b
& ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> Either TCTypeError (MkEntrypointCallRes t)
-> ReaderT InstrCallStack TypeCheck (MkEntrypointCallRes t)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr
-> SomeHST -> Maybe TypeContext -> Either TCTypeError a -> m a
onTypeCheckInstrErr ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) Maybe TypeContext
forall a. Maybe a
Nothing

          case TypeAnn -> Notes arg -> Notes ('TContract arg)
forall (t :: T). TypeAnn -> Notes t -> Notes ('TContract t)
NTContract TypeAnn
forall k (a :: k). Annotation a
U.noAnn Notes arg
argNotes of
                  (Notes ('TContract arg)
ntRes :: Notes ('TContract t1)) ->
                    forall a.
SingI ('TContract arg) =>
(WellTyped ('TContract arg) => TypeCheckInstr a)
-> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @('TContract t1) ((WellTyped ('TContract arg) => TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (WellTyped ('TContract arg) => TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$
                      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ SomeEntrypointCallT arg -> Instr inp ('TContract arg : inp)
forall (arg :: T) (s :: [T]).
ParameterScope arg =>
SomeEntrypointCallT arg -> Instr s ('TContract arg : s)
SELF @arg (EntrypointCallT t arg -> SomeEntrypointCallT arg
forall (arg :: T) (param :: T).
ParameterScope param =>
EntrypointCallT param arg -> SomeEntrypointCallT arg
SomeEpc EntrypointCallT t arg
epc) Instr inp ('TContract arg : inp)
-> HST ('TContract arg : inp) -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes ('TContract arg)
ntRes, Dict (WellTyped ('TContract arg))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes ('TContract arg), Dict (WellTyped ('TContract arg)),
 Annotation VarTag)
-> HST inp -> HST ('TContract arg : inp)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST inp
inp)
        TypeCheckTest ->
          Text -> TypeCheckInstr (SomeInstr inp)
forall a. HasCallStack => Text -> a
error "'SELF' appears in test typechecking."
        TypeCheckPack ->
          Text -> TypeCheckInstr (SomeInstr inp)
forall a. HasCallStack => Text -> a
error "'SELF' appears in packed data."
    (U.CONTRACT vn :: Annotation VarTag
vn fn :: FieldAnn
fn mt :: Type
mt, (NTAddress{}, _, _) ::& rs :: HST xs
rs) ->
      Type
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall r. Type -> (forall (t :: T). KnownT t => Notes t -> r) -> r
withUType Type
mt ((forall (t :: T).
  KnownT t =>
  Notes t -> TypeCheckInstr (SomeInstr inp))
 -> TypeCheckInstr (SomeInstr inp))
-> (forall (t :: T).
    KnownT t =>
    Notes t -> TypeCheckInstr (SomeInstr inp))
-> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ \(Notes t
tns :: Notes t) -> do
        Dict (ParameterScope t)
proofScope <- ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> Either BadTypeForScope (Dict (ParameterScope t))
-> ReaderT InstrCallStack TypeCheck (Dict (ParameterScope t))
forall (t :: T) (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m, SingI t) =>
ExpandedInstr
-> SomeHST -> Maybe TypeContext -> Either BadTypeForScope a -> m a
onScopeCheckInstrErr @t ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
ContractParameter)
          (Either BadTypeForScope (Dict (ParameterScope t))
 -> ReaderT InstrCallStack TypeCheck (Dict (ParameterScope t)))
-> Either BadTypeForScope (Dict (ParameterScope t))
-> ReaderT InstrCallStack TypeCheck (Dict (ParameterScope t))
forall a b. (a -> b) -> a -> b
$ CheckScope (ParameterScope t) =>
Either BadTypeForScope (Dict (ParameterScope t))
forall (c :: Constraint).
CheckScope c =>
Either BadTypeForScope (Dict c)
checkScope @(ParameterScope t)
        let ns :: Notes ('TOption ('TContract t))
ns = TypeAnn -> Notes ('TContract t) -> Notes ('TOption ('TContract t))
forall (t :: T). TypeAnn -> Notes t -> Notes ('TOption t)
NTOption TypeAnn
forall a. Default a => a
def (Notes ('TContract t) -> Notes ('TOption ('TContract t)))
-> Notes ('TContract t) -> Notes ('TOption ('TContract t))
forall a b. (a -> b) -> a -> b
$ TypeAnn -> Notes t -> Notes ('TContract t)
forall (t :: T). TypeAnn -> Notes t -> Notes ('TContract t)
NTContract TypeAnn
forall a. Default a => a
def Notes t
tns
        EpName
epName <- ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> Either TCTypeError EpName
-> ReaderT InstrCallStack TypeCheck EpName
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr
-> SomeHST -> Maybe TypeContext -> Either TCTypeError a -> m a
onTypeCheckInstrErr ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) Maybe TypeContext
forall a. Maybe a
Nothing
          (Either TCTypeError EpName
 -> ReaderT InstrCallStack TypeCheck EpName)
-> Either TCTypeError EpName
-> ReaderT InstrCallStack TypeCheck EpName
forall a b. (a -> b) -> a -> b
$ FieldAnn -> Either EpNameFromRefAnnError EpName
epNameFromRefAnn FieldAnn
fn Either EpNameFromRefAnnError EpName
-> (EpNameFromRefAnnError -> TCTypeError)
-> Either TCTypeError EpName
forall a c b. Either a c -> (a -> b) -> Either b c
`onLeft` EpNameFromRefAnnError -> TCTypeError
IllegalEntrypoint
        case Dict (ParameterScope t)
proofScope of
          Dict ->
            forall a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
(WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr @t ((WellTyped t => TypeCheckInstr (SomeInstr ('TAddress : xs)))
 -> TypeCheckInstr (SomeInstr ('TAddress : xs)))
-> (WellTyped t => TypeCheckInstr (SomeInstr ('TAddress : xs)))
-> TypeCheckInstr (SomeInstr ('TAddress : xs))
forall a b. (a -> b) -> a -> b
$ SomeInstr inp -> TypeCheckInstr (SomeInstr ('TAddress : xs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr ('TAddress : xs)))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr ('TAddress : xs))
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Notes t
-> EpName -> Instr ('TAddress : xs) ('TOption ('TContract t) : xs)
forall (p :: T) (p :: [T]).
ParameterScope p =>
Notes p
-> EpName -> Instr ('TAddress : p) ('TOption ('TContract p) : p)
CONTRACT Notes t
tns EpName
epName Instr ('TAddress : xs) ('TOption ('TContract t) : xs)
-> HST ('TOption ('TContract t) : xs)
-> SomeInstrOut ('TAddress : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes ('TOption ('TContract t))
ns, Dict (WellTyped ('TOption ('TContract t)))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes ('TOption ('TContract t)),
 Dict (WellTyped ('TOption ('TContract t))), Annotation VarTag)
-> HST xs -> HST ('TOption ('TContract t) : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)

    (U.CONTRACT {}, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectAddress ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []
    (U.CONTRACT {}, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.TRANSFER_TOKENS vn :: Annotation VarTag
vn, ((Notes x
_ :: Notes p'), _, _)
      ::& (NTMutez{}, _, _)
      ::& (STContract (_ :: Sing p), _, _, _) ::&+ rs :: HST xs
rs) -> do
      Dict (ParameterScope a)
proofScope <- ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> Either BadTypeForScope (Dict (ParameterScope a))
-> ReaderT InstrCallStack TypeCheck (Dict (ParameterScope a))
forall (t :: T) (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m, SingI t) =>
ExpandedInstr
-> SomeHST -> Maybe TypeContext -> Either BadTypeForScope a -> m a
onScopeCheckInstrErr @p ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
ContractParameter)
        (Either BadTypeForScope (Dict (ParameterScope a))
 -> ReaderT InstrCallStack TypeCheck (Dict (ParameterScope a)))
-> Either BadTypeForScope (Dict (ParameterScope a))
-> ReaderT InstrCallStack TypeCheck (Dict (ParameterScope a))
forall a b. (a -> b) -> a -> b
$ CheckScope (ParameterScope a) =>
Either BadTypeForScope (Dict (ParameterScope a))
forall (c :: Constraint).
CheckScope c =>
Either BadTypeForScope (Dict c)
checkScope @(ParameterScope p)
      case (Each '[KnownT] '[a, x] => Either TCTypeError (a :~: x)
forall (a :: T) (b :: T).
Each '[KnownT] '[a, b] =>
Either TCTypeError (a :~: b)
eqType @p @p', Dict (ParameterScope a)
proofScope) of
        (Right Refl, Dict) ->
          SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr (x : 'TMutez : 'TContract x : xs) ('TOperation : xs)
forall (p :: T) (s :: [T]).
ParameterScope p =>
Instr (p : 'TMutez : 'TContract p : s) ('TOperation : s)
TRANSFER_TOKENS Instr (x : 'TMutez : 'TContract x : xs) ('TOperation : xs)
-> HST ('TOperation : xs)
-> SomeInstrOut (x : 'TMutez : 'TContract x : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TOperation
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TOperation)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TOperation, Dict (WellTyped 'TOperation),
 Annotation VarTag)
-> HST xs -> HST ('TOperation : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)
        (Left m :: TCTypeError
m, _) ->
          ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> TCTypeError
-> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr -> SomeHST -> Maybe TypeContext -> TCTypeError -> m a
typeCheckInstrErr' ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
ContractParameter) TCTypeError
m

    (U.TRANSFER_TOKENS _, _ ::& _ ::& _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectTypeVar ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectMutez, ExpectType
ExpectContract]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []

    (U.TRANSFER_TOKENS _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.SET_DELEGATE vn :: Annotation VarTag
vn,
      (STOption STKeyHash, NTOption _ NTKeyHash{}, _, _)
      ::&+ rs :: HST xs
rs) -> do
        SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr ('TOption 'TKeyHash : xs) ('TOperation : xs)
forall (s :: [T]). Instr ('TOption 'TKeyHash : s) ('TOperation : s)
SET_DELEGATE Instr ('TOption 'TKeyHash : xs) ('TOperation : xs)
-> HST ('TOperation : xs) -> SomeInstrOut ('TOption 'TKeyHash : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TOperation
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TOperation)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TOperation, Dict (WellTyped 'TOperation),
 Annotation VarTag)
-> HST xs -> HST ('TOperation : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)

    (U.SET_DELEGATE _,  _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (Maybe ExpectType -> ExpectType
ExpectOption (ExpectType -> Maybe ExpectType
forall a. a -> Maybe a
Just ExpectType
ExpectKeyHash) ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []

    (U.SET_DELEGATE _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.CREATE_CONTRACT ovn :: Annotation VarTag
ovn avn :: Annotation VarTag
avn contract :: Contract
contract,
      (STOption STKeyHash, NTOption _ (_ :: Notes ('TKeyHash)), _, _)
      ::&+ (NTMutez{}, _, _)
      ::& (Notes x
gn :: Notes g, Dict, _) ::& rs :: HST xs
rs) -> do
        (SomeContract
          (Contract
            (ContractCode cp st
contr :: ContractCode p' g')
            paramNotes :: ParamNotes cp
paramNotes
            storeNotes :: Notes st
storeNotes
            entriesOrder :: EntriesOrder
entriesOrder))
          <- TypeCheck SomeContract
-> ReaderT InstrCallStack TypeCheck SomeContract
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TypeCheck SomeContract
 -> ReaderT InstrCallStack TypeCheck SomeContract)
-> TypeCheck SomeContract
-> ReaderT InstrCallStack TypeCheck SomeContract
forall a b. (a -> b) -> a -> b
$ Contract -> TypeCheck SomeContract
typeCheckContractImpl Contract
contract
        x :~: st
Refl <- ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> Either TCTypeError (x :~: st)
-> ReaderT InstrCallStack TypeCheck (x :~: st)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr
-> SomeHST -> Maybe TypeContext -> Either TCTypeError a -> m a
onTypeCheckInstrErr ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
ContractStorage)
          (Either TCTypeError (x :~: st)
 -> ReaderT InstrCallStack TypeCheck (x :~: st))
-> Either TCTypeError (x :~: st)
-> ReaderT InstrCallStack TypeCheck (x :~: st)
forall a b. (a -> b) -> a -> b
$ Each '[KnownT] '[x, st] => Either TCTypeError (x :~: st)
forall (a :: T) (b :: T).
Each '[KnownT] '[a, b] =>
Either TCTypeError (a :~: b)
eqType @g @g'
        ReaderT InstrCallStack TypeCheck (Notes x)
-> ReaderT InstrCallStack TypeCheck ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT InstrCallStack TypeCheck (Notes x)
 -> ReaderT InstrCallStack TypeCheck ())
-> ReaderT InstrCallStack TypeCheck (Notes x)
-> ReaderT InstrCallStack TypeCheck ()
forall a b. (a -> b) -> a -> b
$ ExpandedInstr
-> HST inp
-> Maybe TypeContext
-> Either AnnConvergeError (Notes x)
-> ReaderT InstrCallStack TypeCheck (Notes x)
forall (m :: * -> *) (ts :: [T]) a.
(MonadReader InstrCallStack m, MonadError TCError m,
 Typeable ts) =>
ExpandedInstr
-> HST ts -> Maybe TypeContext -> Either AnnConvergeError a -> m a
onTypeCheckInstrAnnErr ExpandedInstr
uInstr HST inp
inp (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
ContractStorage) (Notes x -> Notes x -> Either AnnConvergeError (Notes x)
forall (t :: T).
Notes t -> Notes t -> Either AnnConvergeError (Notes t)
converge Notes x
gn Notes x
Notes st
storeNotes)
        pure
          $ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Contract cp st
-> Instr
     ('TOption 'TKeyHash : 'TMutez : st : xs)
     ('TOperation : 'TAddress : xs)
forall (p :: T) (g :: T) (s :: [T]).
(ParameterScope p, StorageScope g) =>
Contract p g
-> Instr
     ('TOption 'TKeyHash : 'TMutez : g : s)
     ('TOperation : 'TAddress : s)
CREATE_CONTRACT (ContractCode cp st
-> ParamNotes cp -> Notes st -> EntriesOrder -> Contract cp st
forall (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
ContractCode cp st
-> ParamNotes cp -> Notes st -> EntriesOrder -> Contract cp st
Contract ContractCode cp st
contr ParamNotes cp
paramNotes Notes st
storeNotes EntriesOrder
entriesOrder)
          Instr
  ('TOption 'TKeyHash : 'TMutez : st : xs)
  ('TOperation : 'TAddress : xs)
-> HST ('TOperation : 'TAddress : xs)
-> SomeInstrOut ('TOption 'TKeyHash : 'TMutez : st : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TOperation
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TOperation)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
ovn) (Notes 'TOperation, Dict (WellTyped 'TOperation),
 Annotation VarTag)
-> HST ('TAddress : xs) -> HST ('TOperation : 'TAddress : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& (Notes 'TAddress
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TAddress)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
avn) (Notes 'TAddress, Dict (WellTyped 'TAddress), Annotation VarTag)
-> HST xs -> HST ('TAddress : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)

    (U.CREATE_CONTRACT {}, _ ::& _ ::& _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (Maybe ExpectType -> ExpectType
ExpectOption Maybe ExpectType
forall a. Maybe a
Nothing ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectMutez, ExpectType
ExpectTypeVar]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []

    (U.CREATE_CONTRACT {},  _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.IMPLICIT_ACCOUNT vn :: Annotation VarTag
vn, (NTKeyHash{}, _, _) ::& rs :: HST xs
rs) ->
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr ('TKeyHash : xs) ('TContract 'TUnit : xs)
forall (s :: [T]). Instr ('TKeyHash : s) ('TContract 'TUnit : s)
IMPLICIT_ACCOUNT Instr ('TKeyHash : xs) ('TContract 'TUnit : xs)
-> HST ('TContract 'TUnit : xs) -> SomeInstrOut ('TKeyHash : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes ('TContract 'TUnit)
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped ('TContract 'TUnit))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes ('TContract 'TUnit), Dict (WellTyped ('TContract 'TUnit)),
 Annotation VarTag)
-> HST xs -> HST ('TContract 'TUnit : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)

    (U.IMPLICIT_ACCOUNT _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectKeyHash ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []
    (U.IMPLICIT_ACCOUNT _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.NOW vn :: Annotation VarTag
vn, _) ->
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr inp ('TTimestamp : inp)
forall (s :: [T]). Instr s ('TTimestamp : s)
NOW Instr inp ('TTimestamp : inp)
-> HST ('TTimestamp : inp) -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TTimestamp
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TTimestamp)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TTimestamp, Dict (WellTyped 'TTimestamp),
 Annotation VarTag)
-> HST inp -> HST ('TTimestamp : inp)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST inp
inp)

    (U.AMOUNT vn :: Annotation VarTag
vn, _) ->
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr inp ('TMutez : inp)
forall (s :: [T]). Instr s ('TMutez : s)
AMOUNT Instr inp ('TMutez : inp)
-> HST ('TMutez : inp) -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TMutez
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TMutez)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TMutez, Dict (WellTyped 'TMutez), Annotation VarTag)
-> HST inp -> HST ('TMutez : inp)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST inp
inp)

    (U.BALANCE vn :: Annotation VarTag
vn, _) ->
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr inp ('TMutez : inp)
forall (s :: [T]). Instr s ('TMutez : s)
BALANCE Instr inp ('TMutez : inp)
-> HST ('TMutez : inp) -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TMutez
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TMutez)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TMutez, Dict (WellTyped 'TMutez), Annotation VarTag)
-> HST inp -> HST ('TMutez : inp)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST inp
inp)

    (U.CHECK_SIGNATURE vn :: Annotation VarTag
vn,
               (NTKey _, _, _)
               ::& (NTSignature _, _, _) ::& (NTBytes{}, _, _) ::& rs :: HST xs
rs) ->
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr ('TKey : 'TSignature : 'TBytes : xs) ('TBool : xs)
forall (s :: [T]).
Instr ('TKey : 'TSignature : 'TBytes : s) ('TBool : s)
CHECK_SIGNATURE Instr ('TKey : 'TSignature : 'TBytes : xs) ('TBool : xs)
-> HST ('TBool : xs)
-> SomeInstrOut ('TKey : 'TSignature : 'TBytes : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TBool
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TBool)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TBool, Dict (WellTyped 'TBool), Annotation VarTag)
-> HST xs -> HST ('TBool : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)

    (U.CHECK_SIGNATURE _, _ ::& _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectKey ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| [ExpectType
ExpectSignature]) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []
    (U.CHECK_SIGNATURE _, _) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.SHA256 vn :: Annotation VarTag
vn, (NTBytes{}, _, _) ::& rs :: HST xs
rs) ->
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr ('TBytes : xs) ('TBytes : xs)
forall (s :: [T]). Instr ('TBytes : s) ('TBytes : s)
SHA256 Instr ('TBytes : xs) ('TBytes : xs)
-> HST ('TBytes : xs) -> SomeInstrOut ('TBytes : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TBytes
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TBytes)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TBytes, Dict (WellTyped 'TBytes), Annotation VarTag)
-> HST xs -> HST ('TBytes : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)
    (U.SHA256 _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectByte ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []
    (U.SHA256 _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.SHA512 vn :: Annotation VarTag
vn, (NTBytes{}, _, _) ::& rs :: HST xs
rs) ->
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr ('TBytes : xs) ('TBytes : xs)
forall (s :: [T]). Instr ('TBytes : s) ('TBytes : s)
SHA512 Instr ('TBytes : xs) ('TBytes : xs)
-> HST ('TBytes : xs) -> SomeInstrOut ('TBytes : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TBytes
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TBytes)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TBytes, Dict (WellTyped 'TBytes), Annotation VarTag)
-> HST xs -> HST ('TBytes : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)
    (U.SHA512 _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectByte ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []
    (U.SHA512 _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.BLAKE2B vn :: Annotation VarTag
vn, (NTBytes{}, _, _) ::& rs :: HST xs
rs) ->
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr ('TBytes : xs) ('TBytes : xs)
forall (s :: [T]). Instr ('TBytes : s) ('TBytes : s)
BLAKE2B Instr ('TBytes : xs) ('TBytes : xs)
-> HST ('TBytes : xs) -> SomeInstrOut ('TBytes : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TBytes
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TBytes)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TBytes, Dict (WellTyped 'TBytes), Annotation VarTag)
-> HST xs -> HST ('TBytes : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)
    (U.BLAKE2B _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectByte ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []
    (U.BLAKE2B _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.HASH_KEY vn :: Annotation VarTag
vn, (NTKey{}, _, _) ::& rs :: HST xs
rs) ->
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr ('TKey : xs) ('TKeyHash : xs)
forall (s :: [T]). Instr ('TKey : s) ('TKeyHash : s)
HASH_KEY Instr ('TKey : xs) ('TKeyHash : xs)
-> HST ('TKeyHash : xs) -> SomeInstrOut ('TKey : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TKeyHash
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TKeyHash)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TKeyHash, Dict (WellTyped 'TKeyHash), Annotation VarTag)
-> HST xs -> HST ('TKeyHash : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)
    (U.HASH_KEY _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectKey ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []
    (U.HASH_KEY _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.SOURCE vn :: Annotation VarTag
vn, _) ->
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr inp ('TAddress : inp)
forall (s :: [T]). Instr s ('TAddress : s)
SOURCE Instr inp ('TAddress : inp)
-> HST ('TAddress : inp) -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TAddress
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TAddress)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TAddress, Dict (WellTyped 'TAddress), Annotation VarTag)
-> HST inp -> HST ('TAddress : inp)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST inp
inp)

    (U.SENDER vn :: Annotation VarTag
vn, _) ->
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr inp ('TAddress : inp)
forall (s :: [T]). Instr s ('TAddress : s)
SENDER Instr inp ('TAddress : inp)
-> HST ('TAddress : inp) -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TAddress
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TAddress)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TAddress, Dict (WellTyped 'TAddress), Annotation VarTag)
-> HST inp -> HST ('TAddress : inp)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST inp
inp)

    (U.ADDRESS vn :: Annotation VarTag
vn, (NTContract{}, _, _) ::& rs :: HST xs
rs) ->
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr ('TContract t : xs) ('TAddress : xs)
forall (a :: T) (s :: [T]).
Instr ('TContract a : s) ('TAddress : s)
ADDRESS Instr ('TContract t : xs) ('TAddress : xs)
-> HST ('TAddress : xs) -> SomeInstrOut ('TContract t : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TAddress
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TAddress)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TAddress, Dict (WellTyped 'TAddress), Annotation VarTag)
-> HST xs -> HST ('TAddress : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)

    (U.ADDRESS _, _ ::& _) ->
      TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr (TCTypeError -> TypeCheckInstr (SomeInstr inp))
-> TCTypeError -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty ExpectType) -> TCTypeError
UnexpectedType (NonEmpty (NonEmpty ExpectType) -> TCTypeError)
-> NonEmpty (NonEmpty ExpectType) -> TCTypeError
forall a b. (a -> b) -> a -> b
$ (ExpectType
ExpectContract ExpectType -> [ExpectType] -> NonEmpty ExpectType
forall a. a -> [a] -> NonEmpty a
:| []) NonEmpty ExpectType
-> [NonEmpty ExpectType] -> NonEmpty (NonEmpty ExpectType)
forall a. a -> [a] -> NonEmpty a
:| []
    (U.ADDRESS _, SNil) -> TypeCheckInstr (SomeInstr inp)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
m a
notEnoughItemsOnStack

    (U.CHAIN_ID vn :: Annotation VarTag
vn, _) ->
      SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr inp -> TypeCheckInstr (SomeInstr inp))
-> SomeInstr inp -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ HST inp
inp HST inp -> SomeInstrOut inp -> SomeInstr inp
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr inp ('TChainId : inp)
forall (s :: [T]). Instr s ('TChainId : s)
CHAIN_ID Instr inp ('TChainId : inp)
-> HST ('TChainId : inp) -> SomeInstrOut inp
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: ((Notes 'TChainId
forall (t :: T). SingI t => Notes t
starNotes, Dict (WellTyped 'TChainId)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes 'TChainId, Dict (WellTyped 'TChainId), Annotation VarTag)
-> HST inp -> HST ('TChainId : inp)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST inp
inp)

    -- Could not get rid of the catch all clause due to this warning:
    -- @
    -- Pattern match checker exceeded (2000000) iterations in
    -- a case alternative. (Use -fmax-pmcheck-iterations=n
    -- to set the maximum number of iterations to n)
    -- @
    i :: (ExpandedInstr, HST inp)
i ->
      Text -> TypeCheckInstr (SomeInstr inp)
forall a. HasCallStack => Text -> a
error (Text -> TypeCheckInstr (SomeInstr inp))
-> Text -> TypeCheckInstr (SomeInstr inp)
forall a b. (a -> b) -> a -> b
$ "Pattern matches should be exhuastive, but instead got: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ExpandedInstr, HST inp) -> Text
forall b a. (Show a, IsString b) => a -> b
show (ExpandedInstr, HST inp)
i
  where
    withWTPInstr :: forall t a. SingI t => (WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
    withWTPInstr :: (WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr fn :: WellTyped t => TypeCheckInstr a
fn = ExpandedInstr
-> SomeHST -> (WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
forall (t :: T) a.
SingI t =>
ExpandedInstr
-> SomeHST -> (WellTyped t => TypeCheckInstr a) -> TypeCheckInstr a
withWTPInstr_ @t ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) WellTyped t => TypeCheckInstr a
fn

    failWithErr :: (MonadReader InstrCallStack m, MonadError TCError m) => TCTypeError -> m a
    failWithErr :: TCTypeError -> m a
failWithErr = ExpandedInstr -> SomeHST -> Maybe TypeContext -> TCTypeError -> m a
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr -> SomeHST -> Maybe TypeContext -> TCTypeError -> m a
typeCheckInstrErr' ExpandedInstr
uInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inp) Maybe TypeContext
forall a. Maybe a
Nothing

    notEnoughItemsOnStack :: (MonadReader InstrCallStack m, MonadError TCError m) => m a
    notEnoughItemsOnStack :: m a
notEnoughItemsOnStack = TCTypeError -> m a
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
TCTypeError -> m a
failWithErr TCTypeError
NotEnoughItemsOnStack

-- | Helper function for two-branch if where each branch is given a single
-- value.
genericIf
  :: forall bti bfi cond rs .
    (Typeable bti, Typeable bfi)
  => (forall s'.
        Instr bti s' ->
        Instr bfi s' ->
        Instr (cond ': rs) s'
     )
  -> ([U.ExpandedOp] -> [U.ExpandedOp] -> U.ExpandedInstr)
  -> [U.ExpandedOp]
  -> [U.ExpandedOp]
  -> HST bti
  -> HST bfi
  -> HST (cond ': rs)
  -> TypeCheckInstr (SomeInstr (cond ': rs))
genericIf :: (forall (s' :: [T]).
 Instr bti s' -> Instr bfi s' -> Instr (cond : rs) s')
-> ([ExpandedOp] -> [ExpandedOp] -> ExpandedInstr)
-> [ExpandedOp]
-> [ExpandedOp]
-> HST bti
-> HST bfi
-> HST (cond : rs)
-> TypeCheckInstr (SomeInstr (cond : rs))
genericIf cons :: forall (s' :: [T]).
Instr bti s' -> Instr bfi s' -> Instr (cond : rs) s'
cons mCons :: [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
mCons mbt :: [ExpandedOp]
mbt mbf :: [ExpandedOp]
mbf bti :: HST bti
bti bfi :: HST bfi
bfi i :: HST (cond : rs)
i@(_ ::& _) = do
  _ :/ pinstr :: SomeInstrOut bti
pinstr <- ExceptT TCError (State TypeCheckEnv) (SomeInstr bti)
-> ReaderT InstrCallStack TypeCheck (SomeInstr bti)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT TCError (State TypeCheckEnv) (SomeInstr bti)
 -> ReaderT InstrCallStack TypeCheck (SomeInstr bti))
-> ExceptT TCError (State TypeCheckEnv) (SomeInstr bti)
-> ReaderT InstrCallStack TypeCheck (SomeInstr bti)
forall a b. (a -> b) -> a -> b
$ [ExpandedOp]
-> HST bti -> ExceptT TCError (State TypeCheckEnv) (SomeInstr bti)
forall (inp :: [T]).
Typeable inp =>
[ExpandedOp] -> HST inp -> TypeCheck (SomeInstr inp)
typeCheckList [ExpandedOp]
mbt HST bti
bti
  _ :/ qinstr :: SomeInstrOut bfi
qinstr <- ExceptT TCError (State TypeCheckEnv) (SomeInstr bfi)
-> ReaderT InstrCallStack TypeCheck (SomeInstr bfi)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT TCError (State TypeCheckEnv) (SomeInstr bfi)
 -> ReaderT InstrCallStack TypeCheck (SomeInstr bfi))
-> ExceptT TCError (State TypeCheckEnv) (SomeInstr bfi)
-> ReaderT InstrCallStack TypeCheck (SomeInstr bfi)
forall a b. (a -> b) -> a -> b
$ [ExpandedOp]
-> HST bfi -> ExceptT TCError (State TypeCheckEnv) (SomeInstr bfi)
forall (inp :: [T]).
Typeable inp =>
[ExpandedOp] -> HST inp -> TypeCheck (SomeInstr inp)
typeCheckList [ExpandedOp]
mbf HST bfi
bfi
  (SomeInstrOut (cond : rs) -> SomeInstr (cond : rs))
-> ReaderT InstrCallStack TypeCheck (SomeInstrOut (cond : rs))
-> TypeCheckInstr (SomeInstr (cond : rs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HST (cond : rs)
i HST (cond : rs)
-> SomeInstrOut (cond : rs) -> SomeInstr (cond : rs)
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/) (ReaderT InstrCallStack TypeCheck (SomeInstrOut (cond : rs))
 -> TypeCheckInstr (SomeInstr (cond : rs)))
-> ReaderT InstrCallStack TypeCheck (SomeInstrOut (cond : rs))
-> TypeCheckInstr (SomeInstr (cond : rs))
forall a b. (a -> b) -> a -> b
$ case (SomeInstrOut bti
pinstr, SomeInstrOut bfi
qinstr) of
    (p :: Instr bti out
p ::: po :: HST out
po, q :: Instr bfi out
q ::: qo :: HST out
qo) -> do
      let instr :: ExpandedInstr
instr = [ExpandedOp] -> [ExpandedOp] -> ExpandedInstr
mCons [ExpandedOp]
mbt [ExpandedOp]
mbf
      out :~: out
Refl <- ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> Either TCTypeError (out :~: out)
-> ReaderT InstrCallStack TypeCheck (out :~: out)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr
-> SomeHST -> Maybe TypeContext -> Either TCTypeError a -> m a
onTypeCheckInstrErr ExpandedInstr
instr (HST (cond : rs) -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST (cond : rs)
i) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
If)
        (Either TCTypeError (out :~: out)
 -> ReaderT InstrCallStack TypeCheck (out :~: out))
-> Either TCTypeError (out :~: out)
-> ReaderT InstrCallStack TypeCheck (out :~: out)
forall a b. (a -> b) -> a -> b
$ HST out -> HST out -> Either TCTypeError (out :~: out)
forall (as :: [T]) (bs :: [T]).
(Typeable as, Typeable bs) =>
HST as -> HST bs -> Either TCTypeError (as :~: bs)
eqHST HST out
po HST out
qo
      HST out
o <- ExpandedInstr
-> HST (cond : rs)
-> Maybe TypeContext
-> Either AnnConvergeError (HST out)
-> ReaderT InstrCallStack TypeCheck (HST out)
forall (m :: * -> *) (ts :: [T]) a.
(MonadReader InstrCallStack m, MonadError TCError m,
 Typeable ts) =>
ExpandedInstr
-> HST ts -> Maybe TypeContext -> Either AnnConvergeError a -> m a
onTypeCheckInstrAnnErr ExpandedInstr
instr HST (cond : rs)
i (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
If) (HST out -> HST out -> Either AnnConvergeError (HST out)
forall (ts :: [T]).
HST ts -> HST ts -> Either AnnConvergeError (HST ts)
convergeHST HST out
po HST out
HST out
qo)
      pure $ Instr bti out -> Instr bfi out -> Instr (cond : rs) out
forall (s' :: [T]).
Instr bti s' -> Instr bfi s' -> Instr (cond : rs) s'
cons Instr bti out
p Instr bfi out
Instr bfi out
q Instr (cond : rs) out -> HST out -> SomeInstrOut (cond : rs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: HST out
o
    (AnyOutInstr p :: forall (out :: [T]). Instr bti out
p, q :: Instr bfi out
q ::: qo :: HST out
qo) -> do
      SomeInstrOut (cond : rs)
-> ReaderT InstrCallStack TypeCheck (SomeInstrOut (cond : rs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstrOut (cond : rs)
 -> ReaderT InstrCallStack TypeCheck (SomeInstrOut (cond : rs)))
-> SomeInstrOut (cond : rs)
-> ReaderT InstrCallStack TypeCheck (SomeInstrOut (cond : rs))
forall a b. (a -> b) -> a -> b
$ Instr bti out -> Instr bfi out -> Instr (cond : rs) out
forall (s' :: [T]).
Instr bti s' -> Instr bfi s' -> Instr (cond : rs) s'
cons Instr bti out
forall (out :: [T]). Instr bti out
p Instr bfi out
q Instr (cond : rs) out -> HST out -> SomeInstrOut (cond : rs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: HST out
qo
    (p :: Instr bti out
p ::: po :: HST out
po, AnyOutInstr q :: forall (out :: [T]). Instr bfi out
q) -> do
      SomeInstrOut (cond : rs)
-> ReaderT InstrCallStack TypeCheck (SomeInstrOut (cond : rs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstrOut (cond : rs)
 -> ReaderT InstrCallStack TypeCheck (SomeInstrOut (cond : rs)))
-> SomeInstrOut (cond : rs)
-> ReaderT InstrCallStack TypeCheck (SomeInstrOut (cond : rs))
forall a b. (a -> b) -> a -> b
$ Instr bti out -> Instr bfi out -> Instr (cond : rs) out
forall (s' :: [T]).
Instr bti s' -> Instr bfi s' -> Instr (cond : rs) s'
cons Instr bti out
p Instr bfi out
forall (out :: [T]). Instr bfi out
q Instr (cond : rs) out -> HST out -> SomeInstrOut (cond : rs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: HST out
po
    (AnyOutInstr p :: forall (out :: [T]). Instr bti out
p, AnyOutInstr q :: forall (out :: [T]). Instr bfi out
q) ->
      SomeInstrOut (cond : rs)
-> ReaderT InstrCallStack TypeCheck (SomeInstrOut (cond : rs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstrOut (cond : rs)
 -> ReaderT InstrCallStack TypeCheck (SomeInstrOut (cond : rs)))
-> SomeInstrOut (cond : rs)
-> ReaderT InstrCallStack TypeCheck (SomeInstrOut (cond : rs))
forall a b. (a -> b) -> a -> b
$ (forall (out :: [T]). Instr (cond : rs) out)
-> SomeInstrOut (cond : rs)
forall (inp :: [T]).
(forall (out :: [T]). Instr inp out) -> SomeInstrOut inp
AnyOutInstr (Instr bti out -> Instr bfi out -> Instr (cond : rs) out
forall (s' :: [T]).
Instr bti s' -> Instr bfi s' -> Instr (cond : rs) s'
cons Instr bti out
forall (out :: [T]). Instr bti out
p Instr bfi out
forall (out :: [T]). Instr bfi out
q)

mapImpl
  :: forall c rs .
    ( MapOp c
    , WellTyped (MapOpInp c)
    , Typeable (MapOpRes c)
    )
  => Notes (MapOpInp c)
  -> U.ExpandedInstr
  -> [U.ExpandedOp]
  -> HST (c ': rs)
  -> (forall v' . (KnownT v') =>
        Notes v' -> HST rs -> TypeCheckInstr (HST (MapOpRes c v' ': rs)))
  -> TypeCheckInstr (SomeInstr (c ': rs))
mapImpl :: Notes (MapOpInp c)
-> ExpandedInstr
-> [ExpandedOp]
-> HST (c : rs)
-> (forall (v' :: T).
    KnownT v' =>
    Notes v' -> HST rs -> TypeCheckInstr (HST (MapOpRes c v' : rs)))
-> TypeCheckInstr (SomeInstr (c : rs))
mapImpl vn :: Notes (MapOpInp c)
vn instr :: ExpandedInstr
instr mp :: [ExpandedOp]
mp i :: HST (c : rs)
i@(_ ::& rs :: HST xs
rs) mkRes :: forall (v' :: T).
KnownT v' =>
Notes v' -> HST rs -> TypeCheckInstr (HST (MapOpRes c v' : rs))
mkRes = do
  _ :/ subp :: SomeInstrOut (MapOpInp c : xs)
subp <- ExceptT TCError (State TypeCheckEnv) (SomeInstr (MapOpInp c : xs))
-> ReaderT InstrCallStack TypeCheck (SomeInstr (MapOpInp c : xs))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT TCError (State TypeCheckEnv) (SomeInstr (MapOpInp c : xs))
 -> ReaderT InstrCallStack TypeCheck (SomeInstr (MapOpInp c : xs)))
-> ExceptT
     TCError (State TypeCheckEnv) (SomeInstr (MapOpInp c : xs))
-> ReaderT InstrCallStack TypeCheck (SomeInstr (MapOpInp c : xs))
forall a b. (a -> b) -> a -> b
$ [ExpandedOp]
-> HST (MapOpInp c : xs)
-> ExceptT
     TCError (State TypeCheckEnv) (SomeInstr (MapOpInp c : xs))
forall (inp :: [T]).
Typeable inp =>
[ExpandedOp] -> HST inp -> TypeCheck (SomeInstr inp)
typeCheckList [ExpandedOp]
mp ((Notes (MapOpInp c)
vn, Dict (WellTyped (MapOpInp c))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
forall a. Default a => a
def) (Notes (MapOpInp c), Dict (WellTyped (MapOpInp c)),
 Annotation VarTag)
-> HST xs -> HST (MapOpInp c : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)
  case SomeInstrOut (MapOpInp c : xs)
subp of
    sub :: Instr (MapOpInp c : xs) out
sub ::: subo :: HST out
subo ->
      case HST out
subo of
        (bn :: Notes x
bn, _, _bvn :: Annotation VarTag
_bvn) ::& rs' :: HST xs
rs' -> do
          xs :~: xs
Refl <- ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> Either TCTypeError (xs :~: xs)
-> ReaderT InstrCallStack TypeCheck (xs :~: xs)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr
-> SomeHST -> Maybe TypeContext -> Either TCTypeError a -> m a
onTypeCheckInstrErr ExpandedInstr
instr (HST (c : rs) -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST (c : rs)
i) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
Iteration)
            (Either TCTypeError (xs :~: xs)
 -> ReaderT InstrCallStack TypeCheck (xs :~: xs))
-> Either TCTypeError (xs :~: xs)
-> ReaderT InstrCallStack TypeCheck (xs :~: xs)
forall a b. (a -> b) -> a -> b
$ HST xs -> HST xs -> Either TCTypeError (xs :~: xs)
forall (as :: [T]) (bs :: [T]).
(Typeable as, Typeable bs) =>
HST as -> HST bs -> Either TCTypeError (as :~: bs)
eqHST HST xs
rs HST xs
rs'
          HST (MapOpRes c x : rs)
x <- Notes x
-> HST rs
-> ReaderT InstrCallStack TypeCheck (HST (MapOpRes c x : rs))
forall (v' :: T).
KnownT v' =>
Notes v' -> HST rs -> TypeCheckInstr (HST (MapOpRes c v' : rs))
mkRes Notes x
bn HST rs
HST xs
rs'
          pure $ HST (c : rs)
i HST (c : rs) -> SomeInstrOut (c : rs) -> SomeInstr (c : rs)
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr (MapOpInp c : xs) (x : xs)
-> Instr (c : xs) (MapOpRes c x : xs)
forall (c :: T) (b :: T) (s :: [T]).
(MapOp c, KnownT b) =>
Instr (MapOpInp c : s) (b : s) -> Instr (c : s) (MapOpRes c b : s)
MAP Instr (MapOpInp c : xs) out
Instr (MapOpInp c : xs) (x : xs)
sub Instr (c : xs) (MapOpRes c x : rs)
-> HST (MapOpRes c x : rs) -> SomeInstrOut (c : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: HST (MapOpRes c x : rs)
x
        _ -> ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> TypeCheckInstr (SomeInstr (c : rs))
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr -> SomeHST -> Maybe TypeContext -> m a
typeCheckInstrErr ExpandedInstr
instr (HST (c : rs) -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST (c : rs)
i) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
Iteration)
    AnyOutInstr _ ->
      ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> TCTypeError
-> TypeCheckInstr (SomeInstr (c : rs))
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr -> SomeHST -> Maybe TypeContext -> TCTypeError -> m a
typeCheckInstrErr' ExpandedInstr
instr (HST (c : rs) -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST (c : rs)
i) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
Iteration) TCTypeError
CodeAlwaysFails

iterImpl
  :: forall c rs .
    ( IterOp c
    , WellTyped (IterOpEl c)
    )
  => Notes (IterOpEl c)
  -> U.ExpandedInstr
  -> [U.ExpandedOp]
  -> HST (c ': rs)
  -> TypeCheckInstr (SomeInstr (c ': rs))
iterImpl :: Notes (IterOpEl c)
-> ExpandedInstr
-> [ExpandedOp]
-> HST (c : rs)
-> TypeCheckInstr (SomeInstr (c : rs))
iterImpl en :: Notes (IterOpEl c)
en instr :: ExpandedInstr
instr mp :: [ExpandedOp]
mp i :: HST (c : rs)
i@((_, _, lvn :: Annotation VarTag
lvn) ::& rs :: HST xs
rs) = do
  let evn :: Annotation VarTag
evn = Annotation VarTag -> Annotation VarTag -> Annotation VarTag
deriveVN "elt" Annotation VarTag
lvn
  _ :/ subp :: SomeInstrOut (IterOpEl c : xs)
subp <-
    case [ExpandedOp]
mp of
      [] -> ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> TCTypeError
-> ReaderT InstrCallStack TypeCheck (SomeInstr (IterOpEl c : xs))
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr -> SomeHST -> Maybe TypeContext -> TCTypeError -> m a
typeCheckInstrErr' ExpandedInstr
instr (HST (c : rs) -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST (c : rs)
i) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
Iteration) TCTypeError
EmptyCode
      _ -> TcInstrHandler
-> [ExpandedOp]
-> HST (IterOpEl c : xs)
-> ReaderT InstrCallStack TypeCheck (SomeInstr (IterOpEl c : xs))
forall (inp :: [T]).
Typeable inp =>
TcInstrHandler
-> [ExpandedOp] -> HST inp -> TypeCheckInstr (SomeInstr inp)
typeCheckImpl TcInstrHandler
typeCheckInstr [ExpandedOp]
mp ((Notes (IterOpEl c)
en, Dict (WellTyped (IterOpEl c))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
evn) (Notes (IterOpEl c), Dict (WellTyped (IterOpEl c)),
 Annotation VarTag)
-> HST xs -> HST (IterOpEl c : xs)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST xs
rs)
  case SomeInstrOut (IterOpEl c : xs)
subp of
    subI :: Instr (IterOpEl c : xs) out
subI ::: o :: HST out
o -> do
      out :~: xs
Refl <- ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> Either TCTypeError (out :~: xs)
-> ReaderT InstrCallStack TypeCheck (out :~: xs)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr
-> SomeHST -> Maybe TypeContext -> Either TCTypeError a -> m a
onTypeCheckInstrErr ExpandedInstr
instr (HST (c : rs) -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST (c : rs)
i) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
Iteration)
        (Either TCTypeError (out :~: xs)
 -> ReaderT InstrCallStack TypeCheck (out :~: xs))
-> Either TCTypeError (out :~: xs)
-> ReaderT InstrCallStack TypeCheck (out :~: xs)
forall a b. (a -> b) -> a -> b
$ HST out -> HST xs -> Either TCTypeError (out :~: xs)
forall (as :: [T]) (bs :: [T]).
(Typeable as, Typeable bs) =>
HST as -> HST bs -> Either TCTypeError (as :~: bs)
eqHST HST out
o HST xs
rs
      SomeInstr (c : rs) -> TypeCheckInstr (SomeInstr (c : rs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeInstr (c : rs) -> TypeCheckInstr (SomeInstr (c : rs)))
-> SomeInstr (c : rs) -> TypeCheckInstr (SomeInstr (c : rs))
forall a b. (a -> b) -> a -> b
$ HST (c : rs)
i HST (c : rs) -> SomeInstrOut (c : rs) -> SomeInstr (c : rs)
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/ Instr (IterOpEl c : xs) xs -> Instr (c : xs) xs
forall (c :: T) (s :: [T]).
IterOp c =>
Instr (IterOpEl c : s) s -> Instr (c : s) s
ITER Instr (IterOpEl c : xs) xs
Instr (IterOpEl c : xs) out
subI Instr (c : xs) xs -> HST xs -> SomeInstrOut (c : xs)
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: HST xs
HST out
o
    AnyOutInstr _ ->
      ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> TCTypeError
-> TypeCheckInstr (SomeInstr (c : rs))
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr -> SomeHST -> Maybe TypeContext -> TCTypeError -> m a
typeCheckInstrErr' ExpandedInstr
instr (HST (c : rs) -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST (c : rs)
i) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
Iteration) TCTypeError
CodeAlwaysFails

lamImpl
  :: forall it ot ts .
    ( WellTyped it, WellTyped ot
    , Typeable ts
    )
  => U.ExpandedInstr
  -> [U.ExpandedOp]
  -> VarAnn
  -> Notes it
  -> Notes ot
  -> HST ts
  -> TypeCheckInstr (SomeInstr ts)
lamImpl :: ExpandedInstr
-> [ExpandedOp]
-> Annotation VarTag
-> Notes it
-> Notes ot
-> HST ts
-> TypeCheckInstr (SomeInstr ts)
lamImpl instr :: ExpandedInstr
instr is :: [ExpandedOp]
is vn :: Annotation VarTag
vn ins :: Notes it
ins ons :: Notes ot
ons i :: HST ts
i = do
  Maybe ExpandedInstr
-> (ExpandedInstr -> ReaderT InstrCallStack TypeCheck ())
-> ReaderT InstrCallStack TypeCheck ()
forall (f :: * -> *) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust (First ExpandedInstr -> Maybe ExpandedInstr
forall a. First a -> Maybe a
getFirst (First ExpandedInstr -> Maybe ExpandedInstr)
-> First ExpandedInstr -> Maybe ExpandedInstr
forall a b. (a -> b) -> a -> b
$ (Element [ExpandedOp] -> First ExpandedInstr)
-> [ExpandedOp] -> First ExpandedInstr
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap Element [ExpandedOp] -> First ExpandedInstr
ExpandedOp -> First ExpandedInstr
hasSelf [ExpandedOp]
is) ((ExpandedInstr -> ReaderT InstrCallStack TypeCheck ())
 -> ReaderT InstrCallStack TypeCheck ())
-> (ExpandedInstr -> ReaderT InstrCallStack TypeCheck ())
-> ReaderT InstrCallStack TypeCheck ()
forall a b. (a -> b) -> a -> b
$ \selfInstr :: ExpandedInstr
selfInstr ->
    ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> TCTypeError
-> ReaderT InstrCallStack TypeCheck ()
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr -> SomeHST -> Maybe TypeContext -> TCTypeError -> m a
typeCheckInstrErr' ExpandedInstr
instr (HST ts -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST ts
i) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
LambdaCode) (TCTypeError -> ReaderT InstrCallStack TypeCheck ())
-> TCTypeError -> ReaderT InstrCallStack TypeCheck ()
forall a b. (a -> b) -> a -> b
$ ExpandedInstr -> TCTypeError
InvalidInstruction ExpandedInstr
selfInstr
  _ :/ lamI :: SomeInstrOut '[it]
lamI <- ExceptT TCError (State TypeCheckEnv) (SomeInstr '[it])
-> ReaderT InstrCallStack TypeCheck (SomeInstr '[it])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT TCError (State TypeCheckEnv) (SomeInstr '[it])
 -> ReaderT InstrCallStack TypeCheck (SomeInstr '[it]))
-> ExceptT TCError (State TypeCheckEnv) (SomeInstr '[it])
-> ReaderT InstrCallStack TypeCheck (SomeInstr '[it])
forall a b. (a -> b) -> a -> b
$ [ExpandedOp]
-> HST '[it]
-> ExceptT TCError (State TypeCheckEnv) (SomeInstr '[it])
forall (inp :: [T]).
Typeable inp =>
[ExpandedOp] -> HST inp -> TypeCheck (SomeInstr inp)
typeCheckList [ExpandedOp]
is ((Notes it
ins, Dict (WellTyped it)
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
forall a. Default a => a
def) (Notes it, Dict (WellTyped it), Annotation VarTag)
-> HST '[] -> HST '[it]
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST '[]
SNil)
  let lamNotes :: Notes ot -> Notes ('TLambda it ot)
lamNotes onsr :: Notes ot
onsr = TypeAnn -> Notes it -> Notes ot -> Notes ('TLambda it ot)
forall (p :: T) (q :: T).
TypeAnn -> Notes p -> Notes q -> Notes ('TLambda p q)
NTLambda TypeAnn
forall a. Default a => a
def Notes it
ins Notes ot
onsr
  let lamSt :: Notes ot -> HST ('TLambda it ot : ts)
lamSt onsr :: Notes ot
onsr = (Notes ot -> Notes ('TLambda it ot)
lamNotes Notes ot
onsr, Dict (WellTyped ('TLambda it ot))
forall (a :: Constraint). a => Dict a
Dict, Annotation VarTag
vn) (Notes ('TLambda it ot), Dict (WellTyped ('TLambda it ot)),
 Annotation VarTag)
-> HST ts -> HST ('TLambda it ot : ts)
forall (xs :: [T]) (x :: T).
(Typeable xs, KnownT x) =>
(Notes x, Dict (WellTyped x), Annotation VarTag)
-> HST xs -> HST (x : xs)
::& HST ts
i
  (SomeInstrOut ts -> SomeInstr ts)
-> ReaderT InstrCallStack TypeCheck (SomeInstrOut ts)
-> TypeCheckInstr (SomeInstr ts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HST ts
i HST ts -> SomeInstrOut ts -> SomeInstr ts
forall (inp :: [T]). HST inp -> SomeInstrOut inp -> SomeInstr inp
:/) (ReaderT InstrCallStack TypeCheck (SomeInstrOut ts)
 -> TypeCheckInstr (SomeInstr ts))
-> ReaderT InstrCallStack TypeCheck (SomeInstrOut ts)
-> TypeCheckInstr (SomeInstr ts)
forall a b. (a -> b) -> a -> b
$ case SomeInstrOut '[it]
lamI of
    lam :: Instr '[it] out
lam ::: lo :: HST out
lo -> do
      case HST out -> Either TCTypeError (out :~: '[ot])
forall (t :: T) (st :: [T]).
(Typeable st, WellTyped t) =>
HST st -> Either TCTypeError (st :~: '[t])
eqHST1 @ot HST out
lo of
        Right Refl -> do
            let (ons', _, _) ::& SNil = HST out
lo
            Notes ot
onsr <- ExpandedInstr
-> HST ts
-> Maybe TypeContext
-> Either AnnConvergeError (Notes ot)
-> ReaderT InstrCallStack TypeCheck (Notes ot)
forall (m :: * -> *) (ts :: [T]) a.
(MonadReader InstrCallStack m, MonadError TCError m,
 Typeable ts) =>
ExpandedInstr
-> HST ts -> Maybe TypeContext -> Either AnnConvergeError a -> m a
onTypeCheckInstrAnnErr ExpandedInstr
instr HST ts
i (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
LambdaCode) (Notes ot -> Notes ot -> Either AnnConvergeError (Notes ot)
forall (t :: T).
Notes t -> Notes t -> Either AnnConvergeError (Notes t)
converge Notes ot
ons Notes ot
ons')
            pure (Value' Instr ('TLambda it ot) -> Instr ts ('TLambda it ot : ts)
forall (i :: T) (o :: T) (s :: [T]).
(KnownT i, KnownT o) =>
Value' Instr ('TLambda i o) -> Instr s ('TLambda i o : s)
LAMBDA (RemFail Instr '[it] '[ot] -> Value' Instr ('TLambda it ot)
forall (inp :: T) (out :: T) (instr :: [T] -> [T] -> *).
(KnownT inp, KnownT out,
 forall (i :: [T]) (o :: [T]). Show (instr i o),
 forall (i :: [T]) (o :: [T]). Eq (instr i o),
 forall (i :: [T]) (o :: [T]). NFData (instr i o)) =>
RemFail instr '[inp] '[out] -> Value' instr ('TLambda inp out)
VLam (RemFail Instr '[it] '[ot] -> Value' Instr ('TLambda it ot))
-> RemFail Instr '[it] '[ot] -> Value' Instr ('TLambda it ot)
forall a b. (a -> b) -> a -> b
$ Instr '[it] out -> RemFail Instr '[it] out
forall k (instr :: k -> k -> *) (i :: k) (o :: k).
instr i o -> RemFail instr i o
RfNormal Instr '[it] out
lam) Instr ts ('TLambda it ot : ts)
-> HST ('TLambda it ot : ts) -> SomeInstrOut ts
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: Notes ot -> HST ('TLambda it ot : ts)
lamSt Notes ot
onsr)
        Left m :: TCTypeError
m -> ExpandedInstr
-> SomeHST
-> Maybe TypeContext
-> TCTypeError
-> ReaderT InstrCallStack TypeCheck (SomeInstrOut ts)
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr -> SomeHST -> Maybe TypeContext -> TCTypeError -> m a
typeCheckInstrErr' ExpandedInstr
instr (HST ts -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST ts
i) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
LambdaCode) TCTypeError
m
    AnyOutInstr lam :: forall (out :: [T]). Instr '[it] out
lam ->
      SomeInstrOut ts
-> ReaderT InstrCallStack TypeCheck (SomeInstrOut ts)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value' Instr ('TLambda it ot) -> Instr ts ('TLambda it ot : ts)
forall (i :: T) (o :: T) (s :: [T]).
(KnownT i, KnownT o) =>
Value' Instr ('TLambda i o) -> Instr s ('TLambda i o : s)
LAMBDA (RemFail Instr '[it] '[ot] -> Value' Instr ('TLambda it ot)
forall (inp :: T) (out :: T) (instr :: [T] -> [T] -> *).
(KnownT inp, KnownT out,
 forall (i :: [T]) (o :: [T]). Show (instr i o),
 forall (i :: [T]) (o :: [T]). Eq (instr i o),
 forall (i :: [T]) (o :: [T]). NFData (instr i o)) =>
RemFail instr '[inp] '[out] -> Value' instr ('TLambda inp out)
VLam (RemFail Instr '[it] '[ot] -> Value' Instr ('TLambda it ot))
-> RemFail Instr '[it] '[ot] -> Value' Instr ('TLambda it ot)
forall a b. (a -> b) -> a -> b
$ (forall (out :: [T]). Instr '[it] out) -> RemFail Instr '[it] '[ot]
forall k (instr :: k -> k -> *) (i :: k) (o :: k).
(forall (o' :: k). instr i o') -> RemFail instr i o
RfAlwaysFails forall (out :: [T]). Instr '[it] out
lam) Instr ts ('TLambda it ot : ts)
-> HST ('TLambda it ot : ts) -> SomeInstrOut ts
forall (out :: [T]) (inp :: [T]).
Typeable out =>
Instr inp out -> HST out -> SomeInstrOut inp
::: Notes ot -> HST ('TLambda it ot : ts)
lamSt Notes ot
ons)
  where
    hasSelf :: U.ExpandedOp -> First U.ExpandedInstr
    hasSelf :: ExpandedOp -> First ExpandedInstr
hasSelf = (First ExpandedInstr -> First ExpandedInstr -> First ExpandedInstr)
-> GenericQ (First ExpandedInstr) -> GenericQ (First ExpandedInstr)
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything First ExpandedInstr -> First ExpandedInstr -> First ExpandedInstr
forall a. Semigroup a => a -> a -> a
(<>)
      (First ExpandedInstr
-> (ExpandedInstr -> First ExpandedInstr)
-> a
-> First ExpandedInstr
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ (Maybe ExpandedInstr -> First ExpandedInstr
forall a. Maybe a -> First a
First Maybe ExpandedInstr
forall a. Maybe a
Nothing)
       (\case
           selfInstr :: ExpandedInstr
selfInstr@(U.SELF{} :: U.InstrAbstract U.ExpandedOp) -> Maybe ExpandedInstr -> First ExpandedInstr
forall a. Maybe a -> First a
First (Maybe ExpandedInstr -> First ExpandedInstr)
-> Maybe ExpandedInstr -> First ExpandedInstr
forall a b. (a -> b) -> a -> b
$ ExpandedInstr -> Maybe ExpandedInstr
forall a. a -> Maybe a
Just ExpandedInstr
selfInstr
           _ -> Maybe ExpandedInstr -> First ExpandedInstr
forall a. Maybe a -> First a
First Maybe ExpandedInstr
forall a. Maybe a
Nothing
       )
      )

----------------------------------------------------------------------------
-- Helpers for DIP (n) typechecking
----------------------------------------------------------------------------

-- Helper data type we use to typecheck DIPN.
data TCDipHelper inp where
  TCDipHelper ::
    forall (n :: Peano) inp out s s'.
    (Typeable out, ConstraintDIPN n inp out s s') =>
    Sing n -> Instr s s' -> HST out -> TCDipHelper inp

typeCheckDipBody ::
     forall inp r. Typeable inp
  => U.ExpandedInstr
  -> [U.ExpandedOp]
  -> HST inp
  -> (forall out. Typeable out =>
                    Instr inp out -> HST out -> TypeCheckInstr r)
  -> TypeCheckInstr r
typeCheckDipBody :: ExpandedInstr
-> [ExpandedOp]
-> HST inp
-> (forall (out :: [T]).
    Typeable out =>
    Instr inp out -> HST out -> TypeCheckInstr r)
-> TypeCheckInstr r
typeCheckDipBody mainInstr :: ExpandedInstr
mainInstr instructions :: [ExpandedOp]
instructions inputHST :: HST inp
inputHST callback :: forall (out :: [T]).
Typeable out =>
Instr inp out -> HST out -> TypeCheckInstr r
callback = do
  _ :/ tp :: SomeInstrOut inp
tp <- ExceptT TCError (State TypeCheckEnv) (SomeInstr inp)
-> ReaderT InstrCallStack TypeCheck (SomeInstr inp)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([ExpandedOp]
-> HST inp -> ExceptT TCError (State TypeCheckEnv) (SomeInstr inp)
forall (inp :: [T]).
Typeable inp =>
[ExpandedOp] -> HST inp -> TypeCheck (SomeInstr inp)
typeCheckList [ExpandedOp]
instructions HST inp
inputHST)
  case SomeInstrOut inp
tp of
    AnyOutInstr _ ->
      -- This may seem like we throw error because of despair, but in fact,
      -- the reference implementation seems to behave exactly in this way -
      -- if output stack of code block within @DIP@ occurs to be any, an
      -- error "FAILWITH must be at tail position" is raised.
      -- It is not allowed even in `DIP 0`.
      ExpandedInstr
-> SomeHST -> Maybe TypeContext -> TCTypeError -> TypeCheckInstr r
forall (m :: * -> *) a.
(MonadReader InstrCallStack m, MonadError TCError m) =>
ExpandedInstr -> SomeHST -> Maybe TypeContext -> TCTypeError -> m a
typeCheckInstrErr' ExpandedInstr
mainInstr (HST inp -> SomeHST
forall (ts :: [T]). Typeable ts => HST ts -> SomeHST
SomeHST HST inp
inputHST) (TypeContext -> Maybe TypeContext
forall a. a -> Maybe a
Just TypeContext
DipCode) TCTypeError
CodeAlwaysFails
    subI :: Instr inp out
subI ::: t :: HST out
t -> Instr inp out -> HST out -> TypeCheckInstr r
forall (out :: [T]).
Typeable out =>
Instr inp out -> HST out -> TypeCheckInstr r
callback Instr inp out
subI HST out
t