diff --git a/src/passes/1-parser/pascaligo/AST.ml b/src/passes/1-parser/pascaligo/AST.ml index 6dbf62137..453c15674 100644 --- a/src/passes/1-parser/pascaligo/AST.ml +++ b/src/passes/1-parser/pascaligo/AST.ml @@ -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 diff --git a/src/passes/1-parser/pascaligo/.SParser.ml.tag b/src/passes/1-parser/pascaligo/Misc/.SParser.ml.tag similarity index 100% rename from src/passes/1-parser/pascaligo/.SParser.ml.tag rename to src/passes/1-parser/pascaligo/Misc/.SParser.ml.tag diff --git a/src/passes/1-parser/pascaligo/SParser.ml b/src/passes/1-parser/pascaligo/Misc/SParser.ml similarity index 100% rename from src/passes/1-parser/pascaligo/SParser.ml rename to src/passes/1-parser/pascaligo/Misc/SParser.ml diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index f12cbf035..131362464 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -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,";")) { diff --git a/src/passes/1-parser/pascaligo/ParserLog.ml b/src/passes/1-parser/pascaligo/ParserLog.ml index dae39a4ef..5febaecd1 100644 --- a/src/passes/1-parser/pascaligo/ParserLog.ml +++ b/src/passes/1-parser/pascaligo/ParserLog.ml @@ -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 ""; + pp_parameters state decl.param in + let () = + let state = state#pad 5 2 in + pp_node state ""; + pp_type_expr (state#pad 1 0) decl.ret_type in + let () = + let state = state#pad 5 3 in + pp_node state ""; + 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 ""; + 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 ""; - 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 ""; - 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 ""; - 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 ""; - 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; diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 4f9e92deb..bd6457c03 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -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,9 +985,9 @@ 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 = trace_option (unsupported_cst_constr t) @@ diff --git a/src/passes/2-simplify/pascaligo.mli b/src/passes/2-simplify/pascaligo.mli index 5c0cfe553..42e5e4afe 100644 --- a/src/passes/2-simplify/pascaligo.mli +++ b/src/passes/2-simplify/pascaligo.mli @@ -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 diff --git a/src/test/#multisig_tests.ml# b/src/test/#multisig_tests.ml# deleted file mode 100644 index 490bffff7..000000000 --- a/src/test/#multisig_tests.ml# +++ /dev/null @@ -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 ; - ] diff --git a/vendors/UnionFind/UnionFind.install b/vendors/UnionFind/UnionFind.install new file mode 100644 index 000000000..692984e20 --- /dev/null +++ b/vendors/UnionFind/UnionFind.install @@ -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" +] diff --git a/vendors/ligo-utils/simple-utils/region.ml b/vendors/ligo-utils/simple-utils/region.ml index a0c41b404..c19a1a776 100644 --- a/vendors/ligo-utils/simple-utils/region.ml +++ b/vendors/ligo-utils/simple-utils/region.ml @@ -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 *)