module Michelson.TypeCheck.TypeCheck
( TcInstrHandler
, TcOriginatedContracts
, TcResult
, TypeCheckEnv (..)
, TypeCheck
, runTypeCheck
, TypeCheckInstr
, runTypeCheckIsolated
, runTypeCheckInstrIsolated
, mapTCError
, tcContractParamL
, tcContractsL
, tcExtFramesL
) where
import Control.Monad.Except (withExceptT)
import Control.Monad.Reader (mapReaderT)
import Data.Default (def)
import Michelson.ErrorPos (InstrCallStack)
import Michelson.TypeCheck.Error (TCError)
import Michelson.TypeCheck.Types
import qualified Michelson.Untyped as U
import Tezos.Address (ContractHash)
import Util.Lens
type TypeCheck =
ExceptT TCError
(State TypeCheckEnv)
type TcOriginatedContracts = Map ContractHash U.ParameterType
data TypeCheckEnv = TypeCheckEnv
{ TypeCheckEnv -> TcExtFrames
tcExtFrames :: ~TcExtFrames
, TypeCheckEnv -> ParameterType
tcContractParam :: ~U.ParameterType
, TypeCheckEnv -> TcOriginatedContracts
tcContracts :: ~TcOriginatedContracts
}
makeLensesWith postfixLFields ''TypeCheckEnv
runTypeCheck :: U.ParameterType -> TcOriginatedContracts -> TypeCheck a -> Either TCError a
runTypeCheck :: ParameterType
-> TcOriginatedContracts -> TypeCheck a -> Either TCError a
runTypeCheck param :: ParameterType
param contracts :: TcOriginatedContracts
contracts act :: TypeCheck a
act =
TypeCheckEnv
-> State TypeCheckEnv (Either TCError a) -> Either TCError a
forall s a. s -> State s a -> a
evaluatingState (TcExtFrames
-> ParameterType -> TcOriginatedContracts -> TypeCheckEnv
TypeCheckEnv [] ParameterType
param TcOriginatedContracts
contracts) (State TypeCheckEnv (Either TCError a) -> Either TCError a)
-> State TypeCheckEnv (Either TCError a) -> Either TCError a
forall a b. (a -> b) -> a -> b
$ TypeCheck a -> State TypeCheckEnv (Either TCError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT TypeCheck a
act
runTypeCheckIsolated :: TypeCheck a -> Either TCError a
runTypeCheckIsolated :: TypeCheck a -> Either TCError a
runTypeCheckIsolated = TypeCheckEnv
-> State TypeCheckEnv (Either TCError a) -> Either TCError a
forall s a. s -> State s a -> a
evaluatingState TypeCheckEnv
initSt (State TypeCheckEnv (Either TCError a) -> Either TCError a)
-> (TypeCheck a -> State TypeCheckEnv (Either TCError a))
-> TypeCheck a
-> Either TCError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeCheck a -> State TypeCheckEnv (Either TCError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
where
initSt :: TypeCheckEnv
initSt =
TypeCheckEnv :: TcExtFrames
-> ParameterType -> TcOriginatedContracts -> TypeCheckEnv
TypeCheckEnv
{ tcExtFrames :: TcExtFrames
tcExtFrames = []
, tcContractParam :: ParameterType
tcContractParam = Text -> ParameterType
forall a. HasCallStack => Text -> a
error "Contract param touched"
, tcContracts :: TcOriginatedContracts
tcContracts = TcOriginatedContracts
forall a. Monoid a => a
mempty
}
type TcResult inp = Either TCError (SomeInstr inp)
type TypeCheckInstr =
ReaderT InstrCallStack TypeCheck
runTypeCheckInstrIsolated :: TypeCheckInstr a -> Either TCError a
runTypeCheckInstrIsolated :: TypeCheckInstr a -> Either TCError a
runTypeCheckInstrIsolated =
TypeCheck a -> Either TCError a
forall a. TypeCheck a -> Either TCError a
runTypeCheckIsolated (TypeCheck a -> Either TCError a)
-> (TypeCheckInstr a -> TypeCheck a)
-> TypeCheckInstr a
-> Either TCError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeCheckInstr a -> InstrCallStack -> TypeCheck a)
-> InstrCallStack -> TypeCheckInstr a -> TypeCheck a
forall a b c. (a -> b -> c) -> b -> a -> c
flip TypeCheckInstr a -> InstrCallStack -> TypeCheck a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT InstrCallStack
forall a. Default a => a
def
mapTCError :: (TCError -> TCError) -> TypeCheckInstr a -> TypeCheckInstr a
mapTCError :: (TCError -> TCError) -> TypeCheckInstr a -> TypeCheckInstr a
mapTCError f :: TCError -> TCError
f = (ExceptT TCError (State TypeCheckEnv) a
-> ExceptT TCError (State TypeCheckEnv) a)
-> TypeCheckInstr a -> TypeCheckInstr a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((TCError -> TCError)
-> ExceptT TCError (State TypeCheckEnv) a
-> ExceptT TCError (State TypeCheckEnv) a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT TCError -> TCError
f)
type TcInstrHandler
= forall inp. Typeable inp
=> U.ExpandedInstr
-> HST inp
-> TypeCheckInstr (SomeInstr inp)