balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

modify proto-alpha

Browse Source
This commit is contained in:
Galfour 2019-03-13 11:56:49 +00:00
parent 4b4c450b9a
commit b197c30299
10 changed files with 920 additions and 808 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/proto_alpha/lib_protocol/alpha_context.ml
View File

@ -65,6 +65,13 @@ module Script_timestamp = struct
Raw_context.current_timestamp ctxt Raw_context.current_timestamp ctxt
|> Timestamp.to_seconds |> Timestamp.to_seconds
|> of_int64 |> of_int64
let set_now ctxt timestamp =
timestamp
|> to_zint
|> Z.to_int64
|> Time.of_seconds
|> (Raw_context.set_current_timestamp ctxt)
end end
module Script = struct module Script = struct
include Michelson_v1_primitives include Michelson_v1_primitives

2
src/proto_alpha/lib_protocol/alpha_context.mli
View File

@ -178,6 +178,7 @@ module Script_timestamp : sig
val add_delta: t -> z num -> t val add_delta: t -> z num -> t
val sub_delta: t -> z num -> t val sub_delta: t -> z num -> t
val now: context -> t val now: context -> t
val set_now: context -> t -> context
val to_zint: t -> Z.t val to_zint: t -> Z.t
val of_zint: Z.t -> t val of_zint: Z.t -> t
end end
@ -248,6 +249,7 @@ module Script : sig
| I_NEQ | I_NEQ
| I_NIL | I_NIL
| I_NONE | I_NONE
| I_NOP
| I_NOT | I_NOT
| I_NOW | I_NOW
| I_OR | I_OR

3
src/proto_alpha/lib_protocol/michelson_v1_primitives.ml
View File

@ -93,6 +93,7 @@ type prim =
| I_NEQ | I_NEQ
| I_NIL | I_NIL
| I_NONE | I_NONE
| I_NOP
| I_NOT | I_NOT
| I_NOW | I_NOW
| I_OR | I_OR
@ -226,6 +227,7 @@ let string_of_prim = function
| I_NEQ -> "NEQ" | I_NEQ -> "NEQ"
| I_NIL -> "NIL" | I_NIL -> "NIL"
| I_NONE -> "NONE" | I_NONE -> "NONE"
| I_NOP -> "NOP"
| I_NOT -> "NOT" | I_NOT -> "NOT"
| I_NOW -> "NOW" | I_NOW -> "NOW"
| I_OR -> "OR" | I_OR -> "OR"
@ -340,6 +342,7 @@ let prim_of_string = function
| "NEQ" -> ok I_NEQ | "NEQ" -> ok I_NEQ
| "NIL" -> ok I_NIL | "NIL" -> ok I_NIL
| "NONE" -> ok I_NONE | "NONE" -> ok I_NONE
| "NOP" -> ok I_NOP
| "NOT" -> ok I_NOT | "NOT" -> ok I_NOT
| "NOW" -> ok I_NOW | "NOW" -> ok I_NOW
| "OR" -> ok I_OR | "OR" -> ok I_OR

1
src/proto_alpha/lib_protocol/michelson_v1_primitives.mli
View File

@ -91,6 +91,7 @@ type prim =
| I_NEQ | I_NEQ
| I_NIL | I_NIL
| I_NONE | I_NONE
| I_NOP
| I_NOT | I_NOT
| I_NOW | I_NOW
| I_OR | I_OR

1
src/proto_alpha/lib_protocol/raw_context.ml
View File

@ -51,6 +51,7 @@ type root_context = t
let current_level ctxt = ctxt.level let current_level ctxt = ctxt.level
let current_timestamp ctxt = ctxt.timestamp let current_timestamp ctxt = ctxt.timestamp
let set_current_timestamp ctxt timestamp = { ctxt with timestamp }
let current_fitness ctxt = ctxt.fitness let current_fitness ctxt = ctxt.fitness
let first_level ctxt = ctxt.first_level let first_level ctxt = ctxt.first_level
let constants ctxt = ctxt.constants let constants ctxt = ctxt.constants

1
src/proto_alpha/lib_protocol/raw_context.mli
View File

@ -80,6 +80,7 @@ val recover: context -> Context.t
val current_level: context -> Level_repr.t val current_level: context -> Level_repr.t
val current_timestamp: context -> Time.t val current_timestamp: context -> Time.t
val set_current_timestamp: context -> Time.t -> context
val current_fitness: context -> Int64.t val current_fitness: context -> Int64.t
val set_current_fitness: context -> Int64.t -> t val set_current_fitness: context -> Int64.t -> t

1340
src/proto_alpha/lib_protocol/script_interpreter.ml
View File

File diff suppressed because it is too large Load Diff

24
src/proto_alpha/lib_protocol/script_interpreter.mli
View File

@ -61,3 +61,27 @@ val trace:
parameter: Script.expr -> parameter: Script.expr ->
amount: Tez.t -> amount: Tez.t ->
(execution_result * execution_trace) tzresult Lwt.t (execution_result * execution_trace) tzresult Lwt.t
val interp:
(?log: execution_trace ref ->
context ->
source: Contract.t -> payer:Contract.t -> self: Contract.t -> Tez.t ->
('p, 'r) Script_typed_ir.lambda -> 'p ->
('r * context) tzresult Lwt.t)
type 'tys stack =
| Item : 'ty * 'rest stack -> ('ty * 'rest) stack
| Empty : Script_typed_ir.end_of_stack stack
type ex_descr_stack = Ex_descr_stack : (('a, 'b) Script_typed_ir.descr * 'a stack) -> ex_descr_stack
val step:
?log:execution_trace ref ->
context ->
source:Contract.t ->
self:Contract.t ->
payer:Contract.t ->
?visitor: (ex_descr_stack -> unit) ->
Tez.t -> ('b, 'a) Script_typed_ir.descr
-> 'b stack
-> ('a stack * context) tzresult Lwt.t

313
src/proto_alpha/lib_protocol/script_ir_translator.ml
View File

@ -36,6 +36,7 @@ module Unparse_costs = Michelson_v1_gas.Cost_of.Unparse
type ex_comparable_ty = Ex_comparable_ty : 'a comparable_ty -> ex_comparable_ty type ex_comparable_ty = Ex_comparable_ty : 'a comparable_ty -> ex_comparable_ty
type ex_ty = Ex_ty : 'a ty -> ex_ty type ex_ty = Ex_ty : 'a ty -> ex_ty
type ex_stack_ty = Ex_stack_ty : 'a stack_ty -> ex_stack_ty type ex_stack_ty = Ex_stack_ty : 'a stack_ty -> ex_stack_ty
type ex_typed_value = Ex_typed_value : ('a Script_typed_ir.ty * 'a) -> ex_typed_value
type tc_context = type tc_context =
| Lambda : tc_context | Lambda : tc_context
@ -322,6 +323,7 @@ let namespace = function
| I_NIL | I_NIL
| I_NONE | I_NONE
| I_NOT | I_NOT
| I_NOP
| I_NOW | I_NOW
| I_OR | I_OR
| I_PAIR | I_PAIR
@ -2968,150 +2970,173 @@ let typecheck_data
(* ---- Unparsing (Typed IR -> Untyped expressions) --------------------------*) (* ---- Unparsing (Typed IR -> Untyped expressions) --------------------------*)
let rec unparse_data let rec unparse_data
: type a. context -> unparsing_mode -> a ty -> a -> (Script.node * context) tzresult Lwt.t : type a. context -> ?mapper:(ex_typed_value -> Script.node option tzresult Lwt.t) ->
= fun ctxt mode ty a -> unparsing_mode -> a ty -> a -> (Script.node * context) tzresult Lwt.t
Lwt.return (Gas.consume ctxt Unparse_costs.cycle) >>=? fun ctxt -> = fun ctxt ?(mapper = fun _ -> return None) mode ty a ->
match ty, a with mapper (Ex_typed_value (ty, a)) >>=? function
| Unit_t _, () -> | Some s -> return (s, ctxt)
Lwt.return (Gas.consume ctxt Unparse_costs.unit) >>=? fun ctxt -> | None -> (
return (Prim (-1, D_Unit, [], []), ctxt) let unparse_same ctxt ty a = unparse_data ctxt ~mapper mode ty a in
| Int_t _, v -> Lwt.return (Gas.consume ctxt Unparse_costs.cycle) >>=? fun ctxt ->
Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt -> match ty, a with
return (Int (-1, Script_int.to_zint v), ctxt) | Unit_t _, () ->
| Nat_t _, v -> Lwt.return (Gas.consume ctxt Unparse_costs.unit) >>=? fun ctxt ->
Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt -> return (Prim (-1, D_Unit, [], []), ctxt)
return (Int (-1, Script_int.to_zint v), ctxt) | Int_t _, v ->
| String_t _, s -> Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt ->
Lwt.return (Gas.consume ctxt (Unparse_costs.string s)) >>=? fun ctxt -> return (Int (-1, Script_int.to_zint v), ctxt)
return (String (-1, s), ctxt) | Nat_t _, v ->
| Bytes_t _, s -> Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt ->
Lwt.return (Gas.consume ctxt (Unparse_costs.bytes s)) >>=? fun ctxt -> return (Int (-1, Script_int.to_zint v), ctxt)
return (Bytes (-1, s), ctxt) | String_t _, s ->
| Bool_t _, true -> Lwt.return (Gas.consume ctxt (Unparse_costs.string s)) >>=? fun ctxt ->
Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt -> return (String (-1, s), ctxt)
return (Prim (-1, D_True, [], []), ctxt) | Bytes_t _, s ->
| Bool_t _, false -> Lwt.return (Gas.consume ctxt (Unparse_costs.bytes s)) >>=? fun ctxt ->
Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt -> return (Bytes (-1, s), ctxt)
return (Prim (-1, D_False, [], []), ctxt) | Bool_t _, true ->
| Timestamp_t _, t -> Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt ->
Lwt.return (Gas.consume ctxt (Unparse_costs.timestamp t)) >>=? fun ctxt -> return (Prim (-1, D_True, [], []), ctxt)
begin | Bool_t _, false ->
match mode with Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt ->
| Optimized -> return (Int (-1, Script_timestamp.to_zint t), ctxt) return (Prim (-1, D_False, [], []), ctxt)
| Readable -> | Timestamp_t _, t ->
match Script_timestamp.to_notation t with Lwt.return (Gas.consume ctxt (Unparse_costs.timestamp t)) >>=? fun ctxt ->
| None -> return (Int (-1, Script_timestamp.to_zint t), ctxt) begin
| Some s -> return (String (-1, s), ctxt) match mode with
end | Optimized -> return (Int (-1, Script_timestamp.to_zint t), ctxt)
| Address_t _, c -> | Readable ->
Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt -> match Script_timestamp.to_notation t with
begin | None -> return (Int (-1, Script_timestamp.to_zint t), ctxt)
match mode with | Some s -> return (String (-1, s), ctxt)
| Optimized -> end
let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in | Address_t _, c ->
return (Bytes (-1, bytes), ctxt) Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt ->
| Readable -> return (String (-1, Contract.to_b58check c), ctxt) begin
end match mode with
| Contract_t _, (_, c) -> | Optimized ->
Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt -> let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in
begin return (Bytes (-1, bytes), ctxt)
match mode with | Readable -> return (String (-1, Contract.to_b58check c), ctxt)
| Optimized -> end
let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in | Contract_t _, (_, c) ->
return (Bytes (-1, bytes), ctxt) Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt ->
| Readable -> return (String (-1, Contract.to_b58check c), ctxt) begin
end match mode with
| Signature_t _, s -> | Optimized ->
Lwt.return (Gas.consume ctxt Unparse_costs.signature) >>=? fun ctxt -> let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in
begin return (Bytes (-1, bytes), ctxt)
match mode with | Readable -> return (String (-1, Contract.to_b58check c), ctxt)
| Optimized -> end
let bytes = Data_encoding.Binary.to_bytes_exn Signature.encoding s in | Signature_t _, s ->
return (Bytes (-1, bytes), ctxt) Lwt.return (Gas.consume ctxt Unparse_costs.signature) >>=? fun ctxt ->
| Readable -> begin
return (String (-1, Signature.to_b58check s), ctxt) match mode with
end | Optimized ->
| Mutez_t _, v -> let bytes = Data_encoding.Binary.to_bytes_exn Signature.encoding s in
Lwt.return (Gas.consume ctxt Unparse_costs.tez) >>=? fun ctxt -> return (Bytes (-1, bytes), ctxt)
return (Int (-1, Z.of_int64 (Tez.to_mutez v)), ctxt) | Readable ->
| Key_t _, k -> return (String (-1, Signature.to_b58check s), ctxt)
Lwt.return (Gas.consume ctxt Unparse_costs.key) >>=? fun ctxt -> end
begin | Mutez_t _, v ->
match mode with Lwt.return (Gas.consume ctxt Unparse_costs.tez) >>=? fun ctxt ->
| Optimized -> return (Int (-1, Z.of_int64 (Tez.to_mutez v)), ctxt)
let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding k in | Key_t _, k ->
return (Bytes (-1, bytes), ctxt) Lwt.return (Gas.consume ctxt Unparse_costs.key) >>=? fun ctxt ->
| Readable -> begin
return (String (-1, Signature.Public_key.to_b58check k), ctxt) match mode with
end | Optimized ->
| Key_hash_t _, k -> let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding k in
Lwt.return (Gas.consume ctxt Unparse_costs.key_hash) >>=? fun ctxt -> return (Bytes (-1, bytes), ctxt)
begin | Readable ->
match mode with return (String (-1, Signature.Public_key.to_b58check k), ctxt)
| Optimized -> end
let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key_hash.encoding k in | Key_hash_t _, k ->
return (Bytes (-1, bytes), ctxt) Lwt.return (Gas.consume ctxt Unparse_costs.key_hash) >>=? fun ctxt ->
| Readable -> begin
return (String (-1, Signature.Public_key_hash.to_b58check k), ctxt) match mode with
end | Optimized ->
| Operation_t _, op -> let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key_hash.encoding k in
let bytes = Data_encoding.Binary.to_bytes_exn Operation.internal_operation_encoding op in return (Bytes (-1, bytes), ctxt)
Lwt.return (Gas.consume ctxt (Unparse_costs.operation bytes)) >>=? fun ctxt -> | Readable ->
return (Bytes (-1, bytes), ctxt) return (String (-1, Signature.Public_key_hash.to_b58check k), ctxt)
| Pair_t ((tl, _, _), (tr, _, _), _), (l, r) -> end
Lwt.return (Gas.consume ctxt Unparse_costs.pair) >>=? fun ctxt -> | Operation_t _, op ->
unparse_data ctxt mode tl l >>=? fun (l, ctxt) -> let bytes = Data_encoding.Binary.to_bytes_exn Operation.internal_operation_encoding op in
unparse_data ctxt mode tr r >>=? fun (r, ctxt) -> Lwt.return (Gas.consume ctxt (Unparse_costs.operation bytes)) >>=? fun ctxt ->
return (Prim (-1, D_Pair, [ l; r ], []), ctxt) return (Bytes (-1, bytes), ctxt)
| Union_t ((tl, _), _, _), L l -> | Pair_t ((tl, _, _), (tr, _, _), _), (l, r) ->
Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt -> Lwt.return (Gas.consume ctxt Unparse_costs.pair) >>=? fun ctxt ->
unparse_data ctxt mode tl l >>=? fun (l, ctxt) -> unparse_same ctxt tl l >>=? fun (l, ctxt) ->
return (Prim (-1, D_Left, [ l ], []), ctxt) unparse_same ctxt tr r >>=? fun (r, ctxt) ->
| Union_t (_, (tr, _), _), R r -> return (Prim (-1, D_Pair, [ l; r ], []), ctxt)
Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt -> | Union_t ((tl, _), _, _), L l ->
unparse_data ctxt mode tr r >>=? fun (r, ctxt) -> Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt ->
return (Prim (-1, D_Right, [ r ], []), ctxt) unparse_same ctxt tl l >>=? fun (l, ctxt) ->
| Option_t ((t, _), _, _), Some v -> return (Prim (-1, D_Left, [ l ], []), ctxt)
Lwt.return (Gas.consume ctxt Unparse_costs.some) >>=? fun ctxt -> | Union_t (_, (tr, _), _), R r ->
unparse_data ctxt mode t v >>=? fun (v, ctxt) -> Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt ->
return (Prim (-1, D_Some, [ v ], []), ctxt) unparse_same ctxt tr r >>=? fun (r, ctxt) ->
| Option_t _, None -> return (Prim (-1, D_Right, [ r ], []), ctxt)
Lwt.return (Gas.consume ctxt Unparse_costs.none) >>=? fun ctxt -> | Option_t ((t, _), _, _), Some v ->
return (Prim (-1, D_None, [], []), ctxt) Lwt.return (Gas.consume ctxt Unparse_costs.some) >>=? fun ctxt ->
| List_t (t, _), items -> unparse_same ctxt t v >>=? fun (v, ctxt) ->
fold_left_s return (Prim (-1, D_Some, [ v ], []), ctxt)
(fun (l, ctxt) element -> | Option_t _, None ->
Lwt.return (Gas.consume ctxt Unparse_costs.list_element) >>=? fun ctxt -> Lwt.return (Gas.consume ctxt Unparse_costs.none) >>=? fun ctxt ->
unparse_data ctxt mode t element >>=? fun (unparsed, ctxt) -> return (Prim (-1, D_None, [], []), ctxt)
return (unparsed :: l, ctxt)) | List_t (t, _), items ->
([], ctxt) fold_left_s
items >>=? fun (items, ctxt) -> (fun (l, ctxt) element ->
return (Micheline.Seq (-1, List.rev items), ctxt) Lwt.return (Gas.consume ctxt Unparse_costs.list_element) >>=? fun ctxt ->
| Set_t (t, _), set -> unparse_same ctxt t element >>=? fun (unparsed, ctxt) ->
let t = ty_of_comparable_ty t in return (unparsed :: l, ctxt))
fold_left_s ([], ctxt)
(fun (l, ctxt) item -> items >>=? fun (items, ctxt) ->
Lwt.return (Gas.consume ctxt Unparse_costs.set_element) >>=? fun ctxt -> return (Micheline.Seq (-1, List.rev items), ctxt)
unparse_data ctxt mode t item >>=? fun (item, ctxt) -> | Set_t (t, _), set ->
return (item :: l, ctxt)) let t = ty_of_comparable_ty t in
([], ctxt) fold_left_s
(set_fold (fun e acc -> e :: acc) set []) >>=? fun (items, ctxt) -> (fun (l, ctxt) item ->
return (Micheline.Seq (-1, items), ctxt) Lwt.return (Gas.consume ctxt Unparse_costs.set_element) >>=? fun ctxt ->
| Map_t (kt, vt, _), map -> unparse_same ctxt t item >>=? fun (item, ctxt) ->
let kt = ty_of_comparable_ty kt in return (item :: l, ctxt))
fold_left_s ([], ctxt)
(fun (l, ctxt) (k, v) -> (set_fold (fun e acc -> e :: acc) set []) >>=? fun (items, ctxt) ->
Lwt.return (Gas.consume ctxt Unparse_costs.map_element) >>=? fun ctxt -> return (Micheline.Seq (-1, items), ctxt)
unparse_data ctxt mode kt k >>=? fun (key, ctxt) -> | Map_t (kt, vt, _), map ->
unparse_data ctxt mode vt v >>=? fun (value, ctxt) -> let kt = ty_of_comparable_ty kt in
return (Prim (-1, D_Elt, [ key ; value ], []) :: l, ctxt)) fold_left_s
([], ctxt) (fun (l, ctxt) (k, v) ->
(map_fold (fun k v acc -> (k, v) :: acc) map []) >>=? fun (items, ctxt) -> Lwt.return (Gas.consume ctxt Unparse_costs.map_element) >>=? fun ctxt ->
return (Micheline.Seq (-1, items), ctxt) unparse_same ctxt kt k >>=? fun (key, ctxt) ->
| Big_map_t (_kt, _kv, _), _map -> unparse_same ctxt vt v >>=? fun (value, ctxt) ->
return (Micheline.Seq (-1, []), ctxt) return (Prim (-1, D_Elt, [ key ; value ], []) :: l, ctxt))
| Lambda_t _, Lam (_, original_code) -> ([], ctxt)
unparse_code ctxt mode (root original_code) (map_fold (fun k v acc -> (k, v) :: acc) map []) >>=? fun (items, ctxt) ->
return (Micheline.Seq (-1, items), ctxt)
| Big_map_t (kt, vt, _), map ->
if false then (
let kt = ty_of_comparable_ty kt in
fold_left_s
(fun (l, ctxt) (k, v) ->
Lwt.return (Gas.consume ctxt Unparse_costs.map_element) >>=? fun ctxt ->
match v with
| None -> return (l, ctxt)
| Some v -> (
unparse_same ctxt kt k >>=? fun (key, ctxt) ->
unparse_same ctxt vt v >>=? fun (value, ctxt) ->
return (Prim (-1, D_Elt, [ key ; value ], []) :: l, ctxt))
)
([], ctxt)
(map_fold (fun k v acc -> (k, v) :: acc) map.diff []) >>=? fun (items, ctxt) ->
return (Micheline.Seq (-1, String (-1, "...") :: items), ctxt)
) else (
return (Micheline.Seq (-1, []), ctxt)
)
| Lambda_t _, Lam (_, original_code) ->
unparse_code ctxt mode (root original_code)
)
(* Gas accounting may not be perfect in this function, as it is only called by RPCs. *) (* Gas accounting may not be perfect in this function, as it is only called by RPCs. *)
and unparse_code ctxt mode = function and unparse_code ctxt mode = function

36
src/proto_alpha/lib_protocol/script_ir_translator.mli
View File

@ -32,12 +32,15 @@ type ex_comparable_ty = Ex_comparable_ty : 'a Script_typed_ir.comparable_ty -> e
type ex_ty = Ex_ty : 'a Script_typed_ir.ty -> ex_ty type ex_ty = Ex_ty : 'a Script_typed_ir.ty -> ex_ty
type ex_stack_ty = Ex_stack_ty : 'a Script_typed_ir.stack_ty -> ex_stack_ty type ex_stack_ty = Ex_stack_ty : 'a Script_typed_ir.stack_ty -> ex_stack_ty
type ex_script = Ex_script : ('a, 'b) Script_typed_ir.script -> ex_script type ex_script = Ex_script : ('a, 'b) Script_typed_ir.script -> ex_script
type ex_typed_value = Ex_typed_value : ('a Script_typed_ir.ty * 'a) -> ex_typed_value
type unparsing_mode = Optimized | Readable type unparsing_mode = Optimized | Readable
type type_logger = type type_logger =
int -> (Script.expr * Script.annot) list -> (Script.expr * Script.annot) list -> unit int -> (Script.expr * Script.annot) list -> (Script.expr * Script.annot) list -> unit
val ty_of_comparable_ty : 'a Script_typed_ir.comparable_ty -> 'a Script_typed_ir.ty
(* ---- Sets and Maps -------------------------------------------------------*) (* ---- Sets and Maps -------------------------------------------------------*)
val empty_set : 'a Script_typed_ir.comparable_ty -> 'a Script_typed_ir.set val empty_set : 'a Script_typed_ir.comparable_ty -> 'a Script_typed_ir.set
@ -77,12 +80,19 @@ val ty_eq :
'ta Script_typed_ir.ty -> 'tb Script_typed_ir.ty -> 'ta Script_typed_ir.ty -> 'tb Script_typed_ir.ty ->
(('ta Script_typed_ir.ty, 'tb Script_typed_ir.ty) eq * context) tzresult (('ta Script_typed_ir.ty, 'tb Script_typed_ir.ty) eq * context) tzresult
val stack_ty_eq :
context -> int ->
'ta Script_typed_ir.stack_ty -> 'tb Script_typed_ir.stack_ty ->
(('ta Script_typed_ir.stack_ty, 'tb Script_typed_ir.stack_ty) eq * context) tzresult
val parse_data : val parse_data :
?type_logger: type_logger -> ?type_logger: type_logger ->
context -> context ->
'a Script_typed_ir.ty -> Script.node -> ('a * context) tzresult Lwt.t 'a Script_typed_ir.ty -> Script.node -> ('a * context) tzresult Lwt.t
val unparse_data : val unparse_data :
context -> unparsing_mode -> 'a Script_typed_ir.ty -> 'a -> context -> ?mapper:(ex_typed_value -> Script.node option tzresult Lwt.t)
-> unparsing_mode -> 'a Script_typed_ir.ty -> 'a ->
(Script.node * context) tzresult Lwt.t (Script.node * context) tzresult Lwt.t
val parse_ty : val parse_ty :
@ -94,6 +104,30 @@ val parse_ty :
val unparse_ty : val unparse_ty :
context -> 'a Script_typed_ir.ty -> (Script.node * context) tzresult Lwt.t context -> 'a Script_typed_ir.ty -> (Script.node * context) tzresult Lwt.t
val parse_storage_ty :
context ->
Script.node -> (ex_ty * context) tzresult
type tc_context =
| Lambda : tc_context
| Dip : 'a Script_typed_ir.stack_ty * tc_context -> tc_context
| Toplevel : { storage_type : 'sto Script_typed_ir.ty ; param_type : 'param Script_typed_ir.ty } -> tc_context
type 'bef judgement =
| Typed : ('bef, 'aft) Script_typed_ir.descr -> 'bef judgement
| Failed : { descr : 'aft. 'aft Script_typed_ir.stack_ty -> ('bef, 'aft) Script_typed_ir.descr } -> 'bef judgement
val parse_instr :
?type_logger: type_logger ->
tc_context -> context ->
Script.node -> 'bef Script_typed_ir.stack_ty -> ('bef judgement * context) tzresult Lwt.t
val parse_returning :
?type_logger: type_logger ->
tc_context -> context ->
'arg Script_typed_ir.ty * Script_typed_ir.var_annot option -> 'ret Script_typed_ir.ty -> Script.node ->
(('arg, 'ret) Script_typed_ir.lambda * context) tzresult Lwt.t
val parse_toplevel : val parse_toplevel :
Script.expr -> (Script.node * Script.node * Script.node) tzresult Script.expr -> (Script.node * Script.node * Script.node) tzresult