module Michelson.TypeCheck.TypeCheck
( TcInstrHandler
, TcOriginatedContracts
, TcResult
, TypeCheckEnv (..)
, TypeCheck
, runTypeCheck
, TypeCheckInstr
, runTypeCheckIsolated
, runTypeCheckInstrIsolated
, mapTCError
, tcContractParamL
, tcContractsL
, tcExtFramesL
) where
import Control.Lens (makeLensesWith)
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.Type
data TypeCheckEnv = TypeCheckEnv
{ tcExtFrames :: ~TcExtFrames
, tcContractParam :: ~U.Type
, tcContracts :: ~TcOriginatedContracts
}
makeLensesWith postfixLFields ''TypeCheckEnv
runTypeCheck :: U.Type -> TcOriginatedContracts -> TypeCheck a -> Either TCError a
runTypeCheck param contracts act =
evaluatingState (TypeCheckEnv [] param contracts) $ runExceptT act
runTypeCheckIsolated :: TypeCheck a -> Either TCError a
runTypeCheckIsolated = evaluatingState initSt . runExceptT
where
initSt =
TypeCheckEnv
{ tcExtFrames = []
, tcContractParam = error "Contract param touched"
, tcContracts = mempty
}
type TcResult inp = Either TCError (SomeInstr inp)
type TypeCheckInstr =
ReaderT InstrCallStack TypeCheck
runTypeCheckInstrIsolated :: TypeCheckInstr a -> Either TCError a
runTypeCheckInstrIsolated =
runTypeCheckIsolated . flip runReaderT def
mapTCError :: (TCError -> TCError) -> TypeCheckInstr a -> TypeCheckInstr a
mapTCError f = mapReaderT (withExceptT f)
type TcInstrHandler
= forall inp. Typeable inp
=> U.ExpandedInstr
-> HST inp
-> TypeCheckInstr (SomeInstr inp)