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

Merge branch 'rinderknecht-dev' into 'dev'

Browse Source 
Refactoring of PascaLIGO front-end (AST, parser and simplifier)

See merge request ligolang/ligo!322
This commit is contained in:
Christian Rinderknecht 2020-01-09 20:53:44 +00:00
commit 31a16afcf9
10 changed files with 263 additions and 335 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/passes/1-parser/pascaligo/AST.ml
View File

@ -196,18 +196,23 @@ and type_tuple = (type_expr, comma) nsepseq par reg
and fun_expr = { and fun_expr = {
kwd_function : kwd_function; kwd_function : kwd_function;
name : variable option; param : parameters;
colon : colon;
ret_type : type_expr;
kwd_is : kwd_is;
return : expr
}
and fun_decl = {
kwd_function : kwd_function;
fun_name : variable;
param : parameters; param : parameters;
colon : colon; colon : colon;
ret_type : type_expr; ret_type : type_expr;
kwd_is : kwd_is; kwd_is : kwd_is;
block_with : (block reg * kwd_with) option; block_with : (block reg * kwd_with) option;
return : expr return : expr;
} terminator : semi option
and fun_decl = {
fun_expr : fun_expr reg;
terminator : semi option
} }
and parameters = (param_decl, semi) nsepseq par reg and parameters = (param_decl, semi) nsepseq par reg

0
src/passes/1-parser/pascaligo/.SParser.ml.tag → src/passes/1-parser/pascaligo/Misc/.SParser.ml.tag
View File

0
src/passes/1-parser/pascaligo/SParser.ml → src/passes/1-parser/pascaligo/Misc/SParser.ml
View File

76
src/passes/1-parser/pascaligo/Parser.mly
View File

@ -226,50 +226,54 @@ field_decl:
in {region; value} } in {region; value} }
fun_expr: fun_expr:
"function" fun_name? parameters ":" type_expr "is" "function" parameters ":" type_expr "is" expr {
block let stop = expr_to_region $6 in
"with" expr {
let () = SyntaxError.check_reserved_name_opt $2 in
let stop = expr_to_region $9 in
let region = cover $1 stop let region = cover $1 stop
and value = {kwd_function = $1; and value = {kwd_function = $1;
name = $2; param = $2;
param = $3; colon = $3;
colon = $4; ret_type = $4;
ret_type = $5; kwd_is = $5;
kwd_is = $6; return = $6}
block_with = Some ($7, $8);
return = $9}
in {region; value} } in {region; value} }
| "function" fun_name? parameters ":" type_expr "is" expr {
let () = SyntaxError.check_reserved_name_opt $2 in
let stop = expr_to_region $7 in
let region = cover $1 stop
and value = {kwd_function = $1;
name = $2;
param = $3;
colon = $4;
ret_type = $5;
kwd_is = $6;
block_with = None;
return = $7}
in {region; value} }
(* Function declarations *) (* Function declarations *)
fun_decl: open_fun_decl:
open_fun_decl { $1 } "function" fun_name parameters ":" type_expr "is"
| fun_expr ";" { block
let region = cover $1.region $2 "with" expr {
and value = {fun_expr=$1; terminator = Some $2} let fun_name = SyntaxError.check_reserved_name $2 in
let stop = expr_to_region $9 in
let region = cover $1 stop
and value = {kwd_function = $1;
fun_name;
param = $3;
colon = $4;
ret_type = $5;
kwd_is = $6;
block_with = Some ($7, $8);
return = $9;
terminator = None}
in {region; value} }
| "function" fun_name parameters ":" type_expr "is" expr {
let fun_name = SyntaxError.check_reserved_name $2 in
let stop = expr_to_region $7 in
let region = cover $1 stop
and value = {kwd_function = $1;
fun_name;
param = $3;
colon = $4;
ret_type = $5;
kwd_is = $6;
block_with = None;
return = $7;
terminator = None}
in {region; value} } in {region; value} }
open_fun_decl: fun_decl:
fun_expr { open_fun_decl ";"? {
let region = $1.region {$1 with value = {$1.value with terminator=$2}} }
and value = {fun_expr=$1; terminator=None}
in {region; value} }
parameters: parameters:
par(nsepseq(param_decl,";")) { par(nsepseq(param_decl,";")) {

84
src/passes/1-parser/pascaligo/ParserLog.ml
View File

@ -195,13 +195,12 @@ and print_type_tuple state {value; _} =
print_nsepseq state "," print_type_expr inside; print_nsepseq state "," print_type_expr inside;
print_token state rpar ")" print_token state rpar ")"
and print_fun_expr state {value; _} = and print_fun_decl state {value; _} =
let {kwd_function; name; param; colon; let {kwd_function; fun_name; param; colon;
ret_type; kwd_is; block_with; return} = value in ret_type; kwd_is; block_with;
print_token state kwd_function "function"; return; terminator} = value in
(match name with print_token state kwd_function "function";
None -> print_var state (Region.wrap_ghost "#anon") print_var state fun_name;
| Some var -> print_var state var);
print_parameters state param; print_parameters state param;
print_token state colon ":"; print_token state colon ":";
print_type_expr state ret_type; print_type_expr state ret_type;
@ -212,11 +211,17 @@ and print_fun_expr state {value; _} =
print_block state block; print_block state block;
print_token state kwd_with "with"); print_token state kwd_with "with");
print_expr state return; print_expr state return;
print_terminator state terminator
and print_fun_decl state {value; _} = and print_fun_expr state {value; _} =
let {fun_expr ; terminator;} = value in let {kwd_function; param; colon;
print_fun_expr state fun_expr; ret_type; kwd_is; return} : fun_expr = value in
print_terminator state terminator; print_token state kwd_function "function";
print_parameters state param;
print_token state colon ":";
print_type_expr state ret_type;
print_token state kwd_is "is";
print_expr state return
and print_parameters state {value; _} = and print_parameters state {value; _} =
let {lpar; inside; rpar} = value in let {lpar; inside; rpar} = value in
@ -826,7 +831,33 @@ and pp_declaration state = function
pp_const_decl state value pp_const_decl state value
| FunDecl {value; region} -> | FunDecl {value; region} ->
pp_loc_node state "FunDecl" region; pp_loc_node state "FunDecl" region;
pp_fun_expr state value.fun_expr.value pp_fun_decl state value
and pp_fun_decl state decl =
let () =
let state = state#pad 5 0 in
pp_ident state decl.fun_name in
let () =
let state = state#pad 5 1 in
pp_node state "<parameters>";
pp_parameters state decl.param in
let () =
let state = state#pad 5 2 in
pp_node state "<return type>";
pp_type_expr (state#pad 1 0) decl.ret_type in
let () =
let state = state#pad 5 3 in
pp_node state "<body>";
let statements =
match decl.block_with with
Some (block,_) -> block.value.statements
| None -> Instr (Skip Region.ghost), [] in
pp_statements state statements in
let () =
let state = state#pad 5 4 in
pp_node state "<return>";
pp_expr (state#pad 1 0) decl.return
in ()
and pp_const_decl state decl = and pp_const_decl state decl =
pp_ident (state#pad 3 0) decl.name; pp_ident (state#pad 3 0) decl.name;
@ -888,32 +919,19 @@ and pp_type_tuple state {value; _} =
let apply len rank = pp_type_expr (state#pad len rank) let apply len rank = pp_type_expr (state#pad len rank)
in List.iteri (List.length components |> apply) components in List.iteri (List.length components |> apply) components
and pp_fun_expr state decl = and pp_fun_expr state (expr: fun_expr) =
let () = let () =
let state = state#pad 5 0 in let state = state#pad 3 0 in
match decl.name with
None -> pp_ident state (Region.wrap_ghost "#anon")
| Some var -> pp_ident state var in
let () =
let state = state#pad 5 1 in
pp_node state "<parameters>"; pp_node state "<parameters>";
pp_parameters state decl.param in pp_parameters state expr.param in
let () = let () =
let state = state#pad 5 2 in let state = state#pad 3 1 in
pp_node state "<return type>"; pp_node state "<return type>";
pp_type_expr (state#pad 1 0) decl.ret_type in pp_type_expr (state#pad 1 0) expr.ret_type in
let () = let () =
let state = state#pad 5 3 in let state = state#pad 3 2 in
pp_node state "<body>";
let statements =
match decl.block_with with
Some (block,_) -> block.value.statements
| None -> Instr (Skip Region.ghost), [] in
pp_statements state statements in
let () =
let state = state#pad 5 4 in
pp_node state "<return>"; pp_node state "<return>";
pp_expr (state#pad 1 0) decl.return pp_expr (state#pad 1 0) expr.return
in () in ()
and pp_parameters state {value; _} = and pp_parameters state {value; _} =
@ -1307,7 +1325,7 @@ and pp_data_decl state = function
pp_var_decl state value pp_var_decl state value
| LocalFun {value; region} -> | LocalFun {value; region} ->
pp_loc_node state "LocalFun" region; pp_loc_node state "LocalFun" region;
pp_fun_expr state value.fun_expr.value pp_fun_decl state value
and pp_var_decl state decl = and pp_var_decl state decl =
pp_ident (state#pad 3 0) decl.name; pp_ident (state#pad 3 0) decl.name;

179
src/passes/2-simplify/pascaligo.ml
View File

@ -77,16 +77,6 @@ module Errors = struct
] in ] in
error ~data title message error ~data title message
let bad_bytes loc str =
let title () = "bad bytes string" in
let message () =
Format.asprintf "bytes string contained non-hexadecimal chars" in
let data = [
("location", fun () -> Format.asprintf "%a" Location.pp loc) ;
("bytes", fun () -> str) ;
] in
error ~data title message
let corner_case ~loc message = let corner_case ~loc message =
let title () = "corner case" in let title () = "corner case" in
let content () = "We don't have a good error message for this case. \ let content () = "We don't have a good error message for this case. \
@ -170,22 +160,6 @@ module Errors = struct
] in ] in
error ~data title message error ~data title message
let unexpected_anonymous_function loc =
let title () = "unexpected anonymous function" in
let message () = "you provided a function declaration without name" in
let data = [
("location" , fun () -> Format.asprintf "%a" Location.pp @@ loc)
] in
error ~data title message
let unexpected_named_function loc =
let title () = "unexpected named function" in
let message () = "you provided a function expression with a name (remove it)" in
let data = [
("location" , fun () -> Format.asprintf "%a" Location.pp @@ loc)
] in
error ~data title message
(* Logging *) (* Logging *)
let simplifying_instruction t = let simplifying_instruction t =
@ -205,20 +179,21 @@ open Operators.Simplify.Pascaligo
let r_split = Location.r_split let r_split = Location.r_split
(* (* Statements can't be simplified in isolation. [a ; b ; c] can get
Statements can't be simplified in isolation. `a ; b ; c` can get simplified either simplified either as [let x = expr in (b ; c)] if [a] is a [const x
as `let x = expr in (b ; c)` if `a` is a ` const x = expr` declaration or as = expr] declaration or as [sequence(a, sequence(b, c))] for
`sequence(a , sequence(b , c))` for everything else. everything else. Because of this, simplifying sequences depend on
Because of this, simplifying sequences depend on their contents. To avoid peeking in their contents. To avoid peeking in their contents, we instead
their contents, we instead simplify sequences elements as functions from their next simplify sequences elements as functions from their next elements
elements to the actual result. to the actual result.
For `return_let_in`, if there is no follow-up element, an error is triggered, as For [return_let_in], if there is no follow-up element, an error is
you can't have `let x = expr in ...` with no `...`. A cleaner option might be to add triggered, as you can't have [let x = expr in ...] with no [...]. A
a `unit` instead of erroring. cleaner option might be to add a [unit] instead of failing.
[return_statement] is used for non-let-in statements.
*)
`return_statement` is used for non-let_in statements.
*)
let return_let_in ?loc binder rhs = ok @@ fun expr'_opt -> let return_let_in ?loc binder rhs = ok @@ fun expr'_opt ->
match expr'_opt with match expr'_opt with
| None -> fail @@ corner_case ~loc:__LOC__ "missing return" | None -> fail @@ corner_case ~loc:__LOC__ "missing return"
@ -246,7 +221,8 @@ let rec simpl_type_expression (t:Raw.type_expr) : type_expression result =
| TApp x -> | TApp x ->
let (name, tuple) = x.value in let (name, tuple) = x.value in
let lst = npseq_to_list tuple.value.inside in let lst = npseq_to_list tuple.value.inside in
let%bind lst = bind_list @@ List.map simpl_type_expression lst in (** TODO: fix constant and operator*) let%bind lst =
bind_list @@ List.map simpl_type_expression lst in (** TODO: fix constant and operator*)
let%bind cst = let%bind cst =
trace (unknown_predefined_type name) @@ trace (unknown_predefined_type name) @@
type_operators name.value in type_operators name.value in
@ -481,13 +457,10 @@ let rec simpl_expression (t:Raw.expr) : expr result =
let%bind index = simpl_expression lu.index.value.inside in let%bind index = simpl_expression lu.index.value.inside in
return @@ e_look_up ~loc path index return @@ e_look_up ~loc path index
) )
| EFun f -> ( | EFun f ->
let (f , loc) = r_split f in let (f , loc) = r_split f in
let%bind ((name_opt , _ty_opt) , f') = simpl_fun_expression ~loc f in let%bind (_ty_opt, f') = simpl_fun_expression ~loc f
match name_opt with in return @@ f'
| None -> return @@ f'
| Some _ -> fail @@ unexpected_named_function loc
)
and simpl_logic_expression (t:Raw.logic_expr) : expression result = and simpl_logic_expression (t:Raw.logic_expr) : expression result =
let return x = ok x in let return x = ok x in
@ -589,9 +562,8 @@ and simpl_data_declaration : Raw.data_decl -> _ result = fun t ->
return_let_in ~loc (Var.of_name name , Some t) expression return_let_in ~loc (Var.of_name name , Some t) expression
| LocalFun f -> | LocalFun f ->
let (f , loc) = r_split f in let (f , loc) = r_split f in
let%bind ((name_opt , ty_opt) , e) = simpl_fun_expression ~loc f.fun_expr.value in let%bind (binder, expr) = simpl_fun_decl ~loc f
let%bind name = trace_option (unexpected_anonymous_function loc) name_opt in in return_let_in ~loc binder expr
return_let_in ~loc (name , ty_opt) e
and simpl_param : Raw.param_decl -> (expression_variable * type_expression) result = and simpl_param : Raw.param_decl -> (expression_variable * type_expression) result =
fun t -> fun t ->
@ -607,11 +579,11 @@ and simpl_param : Raw.param_decl -> (expression_variable * type_expression) resu
let%bind type_expression = simpl_type_expression c.param_type in let%bind type_expression = simpl_type_expression c.param_type in
ok (type_name , type_expression) ok (type_name , type_expression)
and simpl_fun_expression : and simpl_fun_decl :
loc:_ -> Raw.fun_expr -> ((expression_variable option * type_expression option) * expression) result = loc:_ -> Raw.fun_decl -> ((expression_variable * type_expression option) * expression) result =
fun ~loc x -> fun ~loc x ->
let open! Raw in let open! Raw in
let {name;param;ret_type;block_with;return} : fun_expr = x in let {fun_name;param;ret_type;block_with;return} : fun_decl = x in
let statements = let statements =
match block_with with match block_with with
| Some (block,_) -> npseq_to_list block.value.statements | Some (block,_) -> npseq_to_list block.value.statements
@ -620,7 +592,6 @@ and simpl_fun_expression :
(match param.value.inside with (match param.value.inside with
a, [] -> ( a, [] -> (
let%bind input = simpl_param a in let%bind input = simpl_param a in
let name = Option.map (fun (x : _ reg) -> Var.of_name x.value) name in
let (binder , input_type) = input in let (binder , input_type) = input in
let%bind instructions = bind_list let%bind instructions = bind_list
@@ List.map simpl_statement @@ List.map simpl_statement
@ -633,19 +604,22 @@ and simpl_fun_expression :
bind_fold_right_list aux result body in bind_fold_right_list aux result body in
let expression : expression = e_lambda ~loc binder (Some input_type) let expression : expression = e_lambda ~loc binder (Some input_type)
(Some output_type) result in (Some output_type) result in
let type_annotation = Some (make_t @@ T_arrow (input_type, output_type)) in let type_annotation =
ok ((name , type_annotation) , expression) Some (make_t @@ T_arrow (input_type, output_type)) in
ok ((Var.of_name fun_name.value, type_annotation), expression)
) )
| lst -> ( | lst -> (
let lst = npseq_to_list lst in let lst = npseq_to_list lst in
let arguments_name = Var.of_name "arguments" in (* TODO wrong, should be fresh? *) (* TODO wrong, should be fresh? *)
let arguments_name = Var.of_name "arguments" in
let%bind params = bind_map_list simpl_param lst in let%bind params = bind_map_list simpl_param lst in
let (binder , input_type) = let (binder , input_type) =
let type_expression = T_tuple (List.map snd params) in let type_expression = T_tuple (List.map snd params) in
(arguments_name , type_expression) in (arguments_name , type_expression) in
let%bind tpl_declarations = let%bind tpl_declarations =
let aux = fun i x -> let aux = fun i x ->
let expr = e_accessor (e_variable arguments_name) [Access_tuple i] in let expr =
e_accessor (e_variable arguments_name) [Access_tuple i] in
let type_variable = Some (snd x) in let type_variable = Some (snd x) in
let ass = return_let_in (fst x , type_variable) expr in let ass = return_let_in (fst x , type_variable) expr in
ass ass
@ -663,34 +637,91 @@ and simpl_fun_expression :
let expression = let expression =
e_lambda ~loc binder (Some (make_t @@ input_type)) (Some output_type) result in e_lambda ~loc binder (Some (make_t @@ input_type)) (Some output_type) result in
let type_annotation = Some (make_t @@ T_arrow (make_t input_type, output_type)) in let type_annotation = Some (make_t @@ T_arrow (make_t input_type, output_type)) in
let name = Option.map (fun (x : _ reg) -> Var.of_name x.value) name in ok ((Var.of_name fun_name.value, type_annotation), expression)
ok ((name , type_annotation) , expression)
) )
) )
and simpl_fun_expression :
loc:_ -> Raw.fun_expr -> (type_expression option * expression) result =
fun ~loc x ->
let open! Raw in
let {param;ret_type;return;_} : fun_expr = x in
let statements = [] in
(match param.value.inside with
a, [] -> (
let%bind input = simpl_param a in
let (binder , input_type) = input in
let%bind instructions = bind_list
@@ List.map simpl_statement
@@ statements in
let%bind result = simpl_expression return in
let%bind output_type = simpl_type_expression ret_type in
let body = instructions in
let%bind result =
let aux prec cur = cur (Some prec) in
bind_fold_right_list aux result body in
let expression : expression = e_lambda ~loc binder (Some input_type)
(Some output_type) result in
let type_annotation =
Some (make_t @@ T_arrow (input_type, output_type)) in
ok (type_annotation, expression)
)
| lst -> (
let lst = npseq_to_list lst in
(* TODO wrong, should be fresh? *)
let arguments_name = Var.of_name "arguments" in
let%bind params = bind_map_list simpl_param lst in
let (binder , input_type) =
let type_expression = T_tuple (List.map snd params) in
(arguments_name , type_expression) in
let%bind tpl_declarations =
let aux = fun i x ->
let expr =
e_accessor (e_variable arguments_name) [Access_tuple i] in
let type_variable = Some (snd x) in
let ass = return_let_in (fst x , type_variable) expr in
ass
in
bind_list @@ List.mapi aux params in
let%bind instructions = bind_list
@@ List.map simpl_statement
@@ statements in
let%bind result = simpl_expression return in
let%bind output_type = simpl_type_expression ret_type in
let body = tpl_declarations @ instructions in
let%bind result =
let aux prec cur = cur (Some prec) in
bind_fold_right_list aux result body in
let expression =
e_lambda ~loc binder (Some (make_t @@ input_type)) (Some output_type) result in
let type_annotation = Some (make_t @@ T_arrow (make_t input_type, output_type)) in
ok (type_annotation, expression)
)
)
and simpl_declaration : Raw.declaration -> declaration Location.wrap result = and simpl_declaration : Raw.declaration -> declaration Location.wrap result =
fun t -> fun t ->
let open! Raw in let open! Raw in
match t with match t with
| TypeDecl x -> ( | TypeDecl x ->
let (x , loc) = r_split x in let decl, loc = r_split x in
let {name;type_expr} : Raw.type_decl = x in let {name;type_expr} : Raw.type_decl = decl in
let%bind type_expression = simpl_type_expression type_expr in let%bind type_expression = simpl_type_expression type_expr in
ok @@ Location.wrap ~loc (Declaration_type (Var.of_name name.value , type_expression)) ok @@ Location.wrap ~loc (Declaration_type
) (Var.of_name name.value, type_expression))
| ConstDecl x -> | ConstDecl x ->
let simpl_const_decl = fun {name;const_type;init} -> let simpl_const_decl = fun {name;const_type;init} ->
let%bind expression = simpl_expression init in let%bind expression = simpl_expression init in
let%bind t = simpl_type_expression const_type in let%bind t = simpl_type_expression const_type in
let type_annotation = Some t in let type_annotation = Some t in
ok @@ Declaration_constant (Var.of_name name.value , type_annotation , expression) ok @@ Declaration_constant
in (Var.of_name name.value, type_annotation, expression)
bind_map_location simpl_const_decl (Location.lift_region x) in bind_map_location simpl_const_decl (Location.lift_region x)
| FunDecl x -> ( | FunDecl x ->
let (x , loc) = r_split x in let decl, loc = r_split x in
let%bind ((name_opt , ty_opt) , expr) = simpl_fun_expression ~loc x.fun_expr.value in let%bind ((name, ty_opt), expr) = simpl_fun_decl ~loc decl in
let%bind name = trace_option (unexpected_anonymous_function loc) name_opt in ok @@ Location.wrap ~loc (Declaration_constant (name, ty_opt, expr))
ok @@ Location.wrap ~loc (Declaration_constant (name , ty_opt , expr))
)
and simpl_statement : Raw.statement -> (_ -> expression result) result = and simpl_statement : Raw.statement -> (_ -> expression result) result =
fun s -> fun s ->
@ -954,8 +985,8 @@ and simpl_cases : type a . (Raw.pattern * a) list -> (a, unit) matching result =
| PConstr (PConstrApp v) -> ( | PConstr (PConstrApp v) -> (
let value = v.value in let value = v.value in
match value with match value with
| constr, None -> | constr, None ->
ok (constr.value, "unit") ok (constr.value, "unit")
| _ -> | _ ->
let const, pat_opt = v.value in let const, pat_opt = v.value in
let%bind pat = let%bind pat =

14
src/passes/2-simplify/pascaligo.mli
View File

@ -6,16 +6,10 @@ open Ast_simplified
module Raw = Parser.Pascaligo.AST module Raw = Parser.Pascaligo.AST
module SMap = Map.String module SMap = Map.String
module Errors : (** Convert a concrete PascaLIGO expression AST to the simplified
sig expression AST used by the compiler. *)
val bad_bytes : Location.t -> string -> unit -> error
end
(** Convert a concrete PascaLIGO expression AST to the simplified expression AST
used by the compiler. *)
val simpl_expression : Raw.expr -> expr result val simpl_expression : Raw.expr -> expr result
(** Convert a concrete PascaLIGO program AST to the simplified program AST used (** Convert a concrete PascaLIGO program AST to the simplified program
by the compiler. *) AST used by the compiler. *)
val simpl_program : Raw.ast -> program result val simpl_program : Raw.ast -> program result

162
src/test/#multisig_tests.ml#
View File

@ -1,162 +0,0 @@
open Trace
open Test_helpers
let type_file f =
let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "pascaligo") f in
ok @@ (typed,state)
let get_program =
let s = ref None in
fun () -> match !s with
| Some s -> ok s
| None -> (
let%bind program = type_file "./contracts/multisig.ligo" in
s := Some program ;
ok program
)
let compile_main () =
let%bind program,_ = get_program () in
let%bind michelson = Compile.Wrapper.typed_to_michelson_value_as_function program "main" in
" let%bind _ex_ty_value = Ligo.Run.Of_michelson.evaluate michelson in
ok ()
open Ast_simplified
let init_storage threshold counter pkeys =
let keys = List.map
(fun el ->
let (_,pk_str,_) = str_keys el in
e_key @@ pk_str)
pkeys in
ez_e_record [
("id" , e_string "MULTISIG" ) ;
("counter" , e_nat counter ) ;
("threshold" , e_nat threshold) ;
("auth" , e_typed_list keys t_key ) ;
]
let empty_op_list =
(e_typed_list [] t_operation)
let empty_message = e_lambda (Var.of_name "arguments")
(Some t_unit) (Some (t_list t_operation))
empty_op_list
let chain_id_zero = e_chain_id @@ Tezos_crypto.Base58.simple_encode
Tezos_base__TzPervasives.Chain_id.b58check_encoding
Tezos_base__TzPervasives.Chain_id.zero
(* sign the message 'msg' with 'keys', if 'is_valid'=false the providid signature will be incorrect *)
let params counter msg keys is_validl =
let%bind program,_ = get_program () in
let aux = fun acc (key,is_valid) ->
let (_,_pk,sk) = key in
let (pkh,_,_) = str_keys key in
let payload = e_tuple
[ msg ;
e_nat counter ;
e_string (if is_valid then "MULTISIG" else "XX") ;
chain_id_zero ] in
let%bind signature = sign_message program payload sk in
ok @@ (e_pair (e_key_hash pkh) (e_signature signature))::acc in
let%bind signed_msgs = Trace.bind_fold_list aux [] (List.rev @@ List.combine keys is_validl) in
ok @@ e_constructor
"CheckMessage"
(ez_e_record [
("counter" , e_nat counter ) ;
("message" , msg) ;
("signatures" , e_typed_list signed_msgs (t_pair (t_key_hash,t_signature)) ) ;
])
(* Provide one valid signature when the threshold is two of two keys *)
let not_enough_1_of_2 () =
let%bind program,_ = get_program () in
let exp_failwith = "Not enough signatures passed the check" in
let keys = gen_keys () in
let%bind test_params = params 0 empty_message [keys] [true] in
let%bind () = expect_string_failwith
program "main" (e_pair test_params (init_storage 2 0 [keys;gen_keys()])) exp_failwith in
ok ()
let unmatching_counter () =
let%bind program,_ = get_program () in
let exp_failwith = "Counters does not match" in
let keys = gen_keys () in
let%bind test_params = params 1 empty_message [keys] [true] in
let%bind () = expect_string_failwith
program "main" (e_pair test_params (init_storage 1 0 [keys])) exp_failwith in
ok ()
(* Provide one invalid signature (correct key but incorrect signature)
when the threshold is one of one key *)
let invalid_1_of_1 () =
let%bind program,_ = get_program () in
let exp_failwith = "Invalid signature" in
let keys = [gen_keys ()] in
let%bind test_params = params 0 empty_message keys [false] in
let%bind () = expect_string_failwith
program "main" (e_pair test_params (init_storage 1 0 keys)) exp_failwith in
ok ()
(* Provide one valid signature when the threshold is one of one key *)
let valid_1_of_1 () =
let%bind program,_ = get_program () in
let keys = gen_keys () in
let%bind () = expect_eq_n_trace_aux [0;1;2] program "main"
(fun n ->
let%bind params = params n empty_message [keys] [true] in
ok @@ e_pair params (init_storage 1 n [keys])
)
(fun n ->
ok @@ e_pair empty_op_list (init_storage 1 (n+1) [keys])
) in
ok ()
(* Provive two valid signatures when the threshold is two of three keys *)
let valid_2_of_3 () =
let%bind program,_ = get_program () in
let param_keys = [gen_keys (); gen_keys ()] in
let st_keys = param_keys @ [gen_keys ()] in
let%bind () = expect_eq_n_trace_aux [0;1;2] program "main"
(fun n ->
let%bind params = params n empty_message param_keys [true;true] in
ok @@ e_pair params (init_storage 2 n st_keys)
)
(fun n ->
ok @@ e_pair empty_op_list (init_storage 2 (n+1) st_keys)
) in
ok ()
(* Provide one invalid signature and two valid signatures when the threshold is two of three keys *)
let invalid_3_of_3 () =
let%bind program,_ = get_program () in
let valid_keys = [gen_keys() ; gen_keys()] in
let invalid_key = gen_keys () in
let param_keys = valid_keys @ [invalid_key] in
let st_keys = valid_keys @ [gen_keys ()] in
let%bind test_params = params 0 empty_message param_keys [false;true;true] in
let exp_failwith = "Invalid signature" in
let%bind () = expect_string_failwith
program "main" (e_pair test_params (init_storage 2 0 st_keys)) exp_failwith in
ok ()
(* Provide two valid signatures when the threshold is three of three keys *)
let not_enough_2_of_3 () =
let%bind program,_ = get_program () in
let valid_keys = [gen_keys() ; gen_keys()] in
let st_keys = gen_keys () :: valid_keys in
let%bind test_params = params 0 empty_message (valid_keys) [true;true] in
let exp_failwith = "Not enough signatures passed the check" in
let%bind () = expect_string_failwith
program "main" (e_pair test_params (init_storage 3 0 st_keys)) exp_failwith in
ok ()
let main = test_suite "Multisig" [
test "compile" compile_main ;
test "unmatching_counter" unmatching_counter ;
test "valid_1_of_1" valid_1_of_1 ;
test "invalid_1_of_1" invalid_1_of_1 ;
test "not_enough_signature" not_enough_1_of_2 ;
test "valid_2_of_3" valid_2_of_3 ;
test "invalid_3_of_3" invalid_3_of_3 ;
test "not_enough_2_of_3" not_enough_2_of_3 ;
]

36
vendors/UnionFind/UnionFind.install vendored Normal file
View File

@ -0,0 +1,36 @@
lib: [
"_build/install/default/lib/UnionFind/META"
"_build/install/default/lib/UnionFind/Partition.cmi"
"_build/install/default/lib/UnionFind/Partition.cmti"
"_build/install/default/lib/UnionFind/Partition.mli"
"_build/install/default/lib/UnionFind/Partition0.cmi"
"_build/install/default/lib/UnionFind/Partition0.cmt"
"_build/install/default/lib/UnionFind/Partition0.cmx"
"_build/install/default/lib/UnionFind/Partition0.ml"
"_build/install/default/lib/UnionFind/Partition1.cmi"
"_build/install/default/lib/UnionFind/Partition1.cmt"
"_build/install/default/lib/UnionFind/Partition1.cmx"
"_build/install/default/lib/UnionFind/Partition1.ml"
"_build/install/default/lib/UnionFind/Partition2.cmi"
"_build/install/default/lib/UnionFind/Partition2.cmt"
"_build/install/default/lib/UnionFind/Partition2.cmx"
"_build/install/default/lib/UnionFind/Partition2.ml"
"_build/install/default/lib/UnionFind/Partition3.cmi"
"_build/install/default/lib/UnionFind/Partition3.cmt"
"_build/install/default/lib/UnionFind/Partition3.cmx"
"_build/install/default/lib/UnionFind/Partition3.ml"
"_build/install/default/lib/UnionFind/UnionFind.a"
"_build/install/default/lib/UnionFind/UnionFind.cma"
"_build/install/default/lib/UnionFind/UnionFind.cmxa"
"_build/install/default/lib/UnionFind/UnionFind.cmxs"
"_build/install/default/lib/UnionFind/dune-package"
"_build/install/default/lib/UnionFind/opam"
"_build/install/default/lib/UnionFind/unionFind.cmi"
"_build/install/default/lib/UnionFind/unionFind.cmt"
"_build/install/default/lib/UnionFind/unionFind.cmx"
"_build/install/default/lib/UnionFind/unionFind.ml"
]
doc: [
"_build/install/default/doc/UnionFind/LICENSE"
"_build/install/default/doc/UnionFind/README.md"
]

26
vendors/ligo-utils/simple-utils/region.ml vendored
View File

@ -98,18 +98,20 @@ let make ~(start: Pos.t) ~(stop: Pos.t) =
info start_offset stop#line horizontal stop_offset info start_offset stop#line horizontal stop_offset
method compact ?(file=true) ?(offsets=true) mode = method compact ?(file=true) ?(offsets=true) mode =
let prefix = if file then start#file ^ ":" else "" if start#is_ghost || stop#is_ghost then "ghost"
and start_str = start#anonymous ~offsets mode else
and stop_str = stop#anonymous ~offsets mode in let prefix = if file then start#file ^ ":" else ""
if start#file = stop#file then and start_str = start#anonymous ~offsets mode
if start#line = stop#line then and stop_str = stop#anonymous ~offsets mode in
sprintf "%s%s-%i" prefix start_str if start#file = stop#file then
(if offsets then stop#offset mode if start#line = stop#line then
else stop#column mode) sprintf "%s%s-%i" prefix start_str
else (if offsets then stop#offset mode
sprintf "%s%s-%s" prefix start_str stop_str else stop#column mode)
else sprintf "%s:%s-%s:%s" else
start#file start_str stop#file stop_str sprintf "%s%s-%s" prefix start_str stop_str
else sprintf "%s:%s-%s:%s"
start#file start_str stop#file stop_str
end end
(* Special regions *) (* Special regions *)