Safe Haskell | None |
---|---|
Language | Haskell2010 |
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).
Synopsis
- typeCheckContract :: Contract -> TypeCheckOptions -> Either TCError SomeContract
- typeCheckContractAndStorage :: Contract -> Value -> Either TCError SomeContractAndStorage
- typeCheckInstr :: TcInstrHandler
- typeCheckList :: Typeable inp => [ExpandedOp] -> HST inp -> TypeCheck (SomeInstr inp)
- typeCheckListNoExcept :: Typeable inp => [ExpandedOp] -> HST inp -> TypeCheckNoExcept (TypeCheckedSeq inp)
- typeCheckParameter :: TcOriginatedContracts -> Type -> Value -> Either TCError SomeValue
- typeCheckStorage :: Type -> Value -> Either TCError SomeValue
- typeCheckValue :: forall t. SingI t => Value -> TypeCheckInstr (Value t)
- typeVerifyParameter :: SingI t => TcOriginatedContracts -> Value -> Either TCError (Value t)
- typeVerifyStorage :: SingI t => Value -> Either TCError (Value t)
Documentation
typeCheckContractAndStorage :: Contract -> Value -> Either TCError SomeContractAndStorage Source #
Type check a contract and verify that the given storage is of the type expected by the contract.
typeCheckInstr :: TcInstrHandler Source #
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.
typeCheckList :: Typeable inp => [ExpandedOp] -> HST inp -> TypeCheck (SomeInstr inp) Source #
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.
typeCheckListNoExcept :: Typeable inp => [ExpandedOp] -> HST inp -> TypeCheckNoExcept (TypeCheckedSeq inp) Source #
Function typeCheckListNoExcept
converts list of Michelson instructions
given in representation from Michelson.Type
module to representation in a
partially typed tree. See TypeCheckedSeq
and TypeCheckedOp
.
Types are checked along the way. It is necessary to embed well typed node as well as type checking errors into the tree.
typeCheckParameter :: TcOriginatedContracts -> Type -> Value -> Either TCError SomeValue Source #
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).
typeCheckStorage :: Type -> Value -> Either TCError SomeValue Source #
Like typeCheckValue
, but for values to be used as storage.
typeCheckValue :: forall t. SingI t => Value -> TypeCheckInstr (Value t) Source #
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.
typeVerifyParameter :: SingI t => TcOriginatedContracts -> Value -> Either TCError (Value t) Source #