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 = {
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;
colon : colon;
ret_type : type_expr;
kwd_is : kwd_is;
block_with : (block reg * kwd_with) option;
return : expr
}
and fun_decl = {
fun_expr : fun_expr reg;
terminator : semi option
return : expr;
terminator : semi option
}
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} }
fun_expr:
"function" fun_name? parameters ":" type_expr "is"
block
"with" expr {
let () = SyntaxError.check_reserved_name_opt $2 in
let stop = expr_to_region $9 in
"function" parameters ":" type_expr "is" expr {
let stop = expr_to_region $6 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 = Some ($7, $8);
return = $9}
param = $2;
colon = $3;
ret_type = $4;
kwd_is = $5;
return = $6}
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 *)
fun_decl:
open_fun_decl { $1 }
| fun_expr ";" {
let region = cover $1.region $2
and value = {fun_expr=$1; terminator = Some $2}
open_fun_decl:
"function" fun_name parameters ":" type_expr "is"
block
"with" expr {
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} }
open_fun_decl:
fun_expr {
let region = $1.region
and value = {fun_expr=$1; terminator=None}
in {region; value} }
fun_decl:
open_fun_decl ";"? {
{$1 with value = {$1.value with terminator=$2}} }
parameters:
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_token state rpar ")"
and print_fun_expr state {value; _} =
let {kwd_function; name; param; colon;
ret_type; kwd_is; block_with; return} = value in
print_token state kwd_function "function";
(match name with
None -> print_var state (Region.wrap_ghost "#anon")
| Some var -> print_var state var);
and print_fun_decl state {value; _} =
let {kwd_function; fun_name; param; colon;
ret_type; kwd_is; block_with;
return; terminator} = value in
print_token state kwd_function "function";
print_var state fun_name;
print_parameters state param;
print_token state colon ":";
print_type_expr state ret_type;
@ -212,11 +211,17 @@ and print_fun_expr state {value; _} =
print_block state block;
print_token state kwd_with "with");
print_expr state return;
print_terminator state terminator
and print_fun_decl state {value; _} =
let {fun_expr ; terminator;} = value in
print_fun_expr state fun_expr;
print_terminator state terminator;
and print_fun_expr state {value; _} =
let {kwd_function; param; colon;
ret_type; kwd_is; return} : fun_expr = value in
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; _} =
let {lpar; inside; rpar} = value in
@ -826,7 +831,33 @@ and pp_declaration state = function
pp_const_decl state value
| FunDecl {value; 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 =
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)
in List.iteri (List.length components |> apply) components
and pp_fun_expr state decl =
and pp_fun_expr state (expr: fun_expr) =
let () =
let state = state#pad 5 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
let state = state#pad 3 0 in
pp_node state "<parameters>";
pp_parameters state decl.param in
pp_parameters state expr.param in
let () =
let state = state#pad 5 2 in
let state = state#pad 3 1 in
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 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
let state = state#pad 3 2 in
pp_node state "<return>";
pp_expr (state#pad 1 0) decl.return
pp_expr (state#pad 1 0) expr.return
in ()
and pp_parameters state {value; _} =
@ -1307,7 +1325,7 @@ and pp_data_decl state = function
pp_var_decl state value
| LocalFun {value; 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 =
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
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 title () = "corner case" in
let content () = "We don't have a good error message for this case. \
@ -170,22 +160,6 @@ module Errors = struct
] in
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 *)
let simplifying_instruction t =
@ -205,20 +179,21 @@ open Operators.Simplify.Pascaligo
let r_split = Location.r_split
(*
Statements can't be simplified in isolation. `a ; b ; c` can get simplified either
as `let x = expr in (b ; c)` if `a` is a ` const x = expr` declaration or as
`sequence(a , sequence(b , c))` for everything else.
Because of this, simplifying sequences depend on their contents. To avoid peeking in
their contents, we instead simplify sequences elements as functions from their next
elements to the actual result.
(* Statements can't be simplified in isolation. [a ; b ; c] can get
simplified either as [let x = expr in (b ; c)] if [a] is a [const x
= expr] declaration or as [sequence(a, sequence(b, c))] for
everything else. Because of this, simplifying sequences depend on
their contents. To avoid peeking in their contents, we instead
simplify sequences elements as functions from their next elements
to the actual result.
For `return_let_in`, if there is no follow-up element, an error is triggered, as
you can't have `let x = expr in ...` with no `...`. A cleaner option might be to add
a `unit` instead of erroring.
For [return_let_in], if there is no follow-up element, an error is
triggered, as you can't have [let x = expr in ...] with no [...]. A
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 ->
match expr'_opt with
| 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 ->
let (name, tuple) = x.value 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 =
trace (unknown_predefined_type name) @@
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
return @@ e_look_up ~loc path index
)
| EFun f -> (
| EFun f ->
let (f , loc) = r_split f in
let%bind ((name_opt , _ty_opt) , f') = simpl_fun_expression ~loc f in
match name_opt with
| None -> return @@ f'
| Some _ -> fail @@ unexpected_named_function loc
)
let%bind (_ty_opt, f') = simpl_fun_expression ~loc f
in return @@ f'
and simpl_logic_expression (t:Raw.logic_expr) : expression result =
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
| LocalFun f ->
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 name = trace_option (unexpected_anonymous_function loc) name_opt in
return_let_in ~loc (name , ty_opt) e
let%bind (binder, expr) = simpl_fun_decl ~loc f
in return_let_in ~loc binder expr
and simpl_param : Raw.param_decl -> (expression_variable * type_expression) result =
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
ok (type_name , type_expression)
and simpl_fun_expression :
loc:_ -> Raw.fun_expr -> ((expression_variable option * type_expression option) * expression) result =
and simpl_fun_decl :
loc:_ -> Raw.fun_decl -> ((expression_variable * type_expression option) * expression) result =
fun ~loc x ->
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 =
match block_with with
| Some (block,_) -> npseq_to_list block.value.statements
@ -620,7 +592,6 @@ and simpl_fun_expression :
(match param.value.inside with
a, [] -> (
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%bind instructions = bind_list
@@ List.map simpl_statement
@ -633,19 +604,22 @@ and simpl_fun_expression :
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 ((name , type_annotation) , expression)
let type_annotation =
Some (make_t @@ T_arrow (input_type, output_type)) in
ok ((Var.of_name fun_name.value, type_annotation), expression)
)
| lst -> (
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 (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 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
@ -663,34 +637,91 @@ and simpl_fun_expression :
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
let name = Option.map (fun (x : _ reg) -> Var.of_name x.value) name in
ok ((name , type_annotation) , expression)
ok ((Var.of_name fun_name.value, 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 =
fun t ->
let open! Raw in
match t with
| TypeDecl x -> (
let (x , loc) = r_split x in
let {name;type_expr} : Raw.type_decl = x in
| TypeDecl x ->
let decl, loc = r_split x in
let {name;type_expr} : Raw.type_decl = decl 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 ->
let simpl_const_decl = fun {name;const_type;init} ->
let%bind expression = simpl_expression init in
let%bind t = simpl_type_expression const_type in
let type_annotation = Some t in
ok @@ Declaration_constant (Var.of_name name.value , type_annotation , expression)
in
bind_map_location simpl_const_decl (Location.lift_region x)
| FunDecl x -> (
let (x , loc) = r_split x in
let%bind ((name_opt , ty_opt) , expr) = simpl_fun_expression ~loc x.fun_expr.value in
let%bind name = trace_option (unexpected_anonymous_function loc) name_opt in
ok @@ Location.wrap ~loc (Declaration_constant (name , ty_opt , expr))
)
ok @@ Declaration_constant
(Var.of_name name.value, type_annotation, expression)
in bind_map_location simpl_const_decl (Location.lift_region x)
| FunDecl x ->
let decl, loc = r_split x in
let%bind ((name, ty_opt), expr) = simpl_fun_decl ~loc decl in
ok @@ Location.wrap ~loc (Declaration_constant (name, ty_opt, expr))
and simpl_statement : Raw.statement -> (_ -> expression result) result =
fun s ->
@ -954,8 +985,8 @@ and simpl_cases : type a . (Raw.pattern * a) list -> (a, unit) matching result =
| PConstr (PConstrApp v) -> (
let value = v.value in
match value with
| constr, None ->
ok (constr.value, "unit")
| constr, None ->
ok (constr.value, "unit")
| _ ->
let const, pat_opt = v.value in
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 SMap = Map.String
module Errors :
sig
val bad_bytes : Location.t -> string -> unit -> error
end
(** Convert a concrete PascaLIGO expression AST to the simplified expression AST
used by the compiler. *)
(** Convert a concrete PascaLIGO expression AST to the simplified
expression AST used by the compiler. *)
val simpl_expression : Raw.expr -> expr result
(** Convert a concrete PascaLIGO program AST to the simplified program AST used
by the compiler. *)
(** Convert a concrete PascaLIGO program AST to the simplified program
AST used by the compiler. *)
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
method compact ?(file=true) ?(offsets=true) mode =
let prefix = if file then start#file ^ ":" else ""
and start_str = start#anonymous ~offsets mode
and stop_str = stop#anonymous ~offsets mode in
if start#file = stop#file then
if start#line = stop#line then
sprintf "%s%s-%i" prefix start_str
(if offsets then stop#offset mode
else stop#column mode)
else
sprintf "%s%s-%s" prefix start_str stop_str
else sprintf "%s:%s-%s:%s"
start#file start_str stop#file stop_str
if start#is_ghost || stop#is_ghost then "ghost"
else
let prefix = if file then start#file ^ ":" else ""
and start_str = start#anonymous ~offsets mode
and stop_str = stop#anonymous ~offsets mode in
if start#file = stop#file then
if start#line = stop#line then
sprintf "%s%s-%i" prefix start_str
(if offsets then stop#offset mode
else stop#column mode)
else
sprintf "%s%s-%s" prefix start_str stop_str
else sprintf "%s:%s-%s:%s"
start#file start_str stop#file stop_str
end
(* Special regions *)