diff --git a/src/bin/cli.ml b/src/bin/cli.ml index 1ad68d049..a35e5d91c 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -134,7 +134,7 @@ let compile_file = let f source_file entry_point syntax display_format michelson_format = toplevel ~display_format @@ let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed,_ = Compile.Of_simplified.compile simplified in + let%bind typed,_ = Compile.Of_simplified.compile (Contract entry_point) simplified in let%bind mini_c = Compile.Of_typed.compile typed in let%bind michelson = Compile.Of_mini_c.aggregate_and_compile_contract mini_c entry_point in let%bind contract = Compile.Of_michelson.build_contract michelson in @@ -174,7 +174,7 @@ let print_typed_ast = let f source_file syntax display_format = ( toplevel ~display_format @@ let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed,_ = Compile.Of_simplified.compile simplified in + let%bind typed,_ = Compile.Of_simplified.compile Env simplified in ok @@ Format.asprintf "%a\n" Compile.Of_typed.pretty_print typed ) in @@ -187,7 +187,7 @@ let print_mini_c = let f source_file syntax display_format = ( toplevel ~display_format @@ let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed,_ = Compile.Of_simplified.compile simplified in + let%bind typed,_ = Compile.Of_simplified.compile Env simplified in let%bind mini_c = Compile.Of_typed.compile typed in ok @@ Format.asprintf "%a\n" Compile.Of_mini_c.pretty_print mini_c ) @@ -201,7 +201,7 @@ let measure_contract = let f source_file entry_point syntax display_format = toplevel ~display_format @@ let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed,_ = Compile.Of_simplified.compile simplified in + let%bind typed,_ = Compile.Of_simplified.compile (Contract entry_point) simplified in let%bind mini_c = Compile.Of_typed.compile typed in let%bind michelson = Compile.Of_mini_c.aggregate_and_compile_contract mini_c entry_point in let%bind contract = Compile.Of_michelson.build_contract michelson in @@ -218,7 +218,7 @@ let compile_parameter = let f source_file entry_point expression syntax amount balance sender source predecessor_timestamp display_format michelson_format = toplevel ~display_format @@ let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed_prg,state = Compile.Of_simplified.compile simplified in + let%bind typed_prg,state = Compile.Of_simplified.compile (Contract entry_point) simplified in let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg entry_point in let env = Ast_typed.program_environment typed_prg in @@ -249,7 +249,7 @@ let interpret = let%bind (decl_list,state,env) = match init_file with | Some init_file -> let%bind simplified = Compile.Of_source.compile init_file (Syntax_name syntax) in - let%bind typed_prg,state = Compile.Of_simplified.compile simplified in + let%bind typed_prg,state = Compile.Of_simplified.compile Env simplified in let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in let env = Ast_typed.program_environment typed_prg in ok (mini_c_prg,state,env) @@ -280,7 +280,7 @@ let temp_ligo_interpreter = let f source_file syntax display_format = toplevel ~display_format @@ let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed,_ = Compile.Of_simplified.compile simplified in + let%bind typed,_ = Compile.Of_simplified.compile Env simplified in let%bind res = Compile.Of_typed.some_interpret typed in ok @@ Format.asprintf "%s\n" res in @@ -294,7 +294,7 @@ let compile_storage = let f source_file entry_point expression syntax amount balance sender source predecessor_timestamp display_format michelson_format = toplevel ~display_format @@ let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed_prg,state = Compile.Of_simplified.compile simplified in + let%bind typed_prg,state = Compile.Of_simplified.compile (Contract entry_point) simplified in let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg entry_point in let env = Ast_typed.program_environment typed_prg in @@ -323,7 +323,7 @@ let dry_run = let f source_file entry_point storage input amount balance sender source predecessor_timestamp syntax display_format = toplevel ~display_format @@ let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed_prg,state = Compile.Of_simplified.compile simplified in + let%bind typed_prg,state = Compile.Of_simplified.compile (Contract entry_point) simplified in let env = Ast_typed.program_environment typed_prg in let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg entry_point in @@ -359,7 +359,7 @@ let run_function = toplevel ~display_format @@ let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in let%bind simplified_prg = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed_prg,state = Compile.Of_simplified.compile simplified_prg in + let%bind typed_prg,state = Compile.Of_simplified.compile Env simplified_prg in let env = Ast_typed.program_environment typed_prg in let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in @@ -390,7 +390,7 @@ let evaluate_value = let f source_file entry_point amount balance sender source predecessor_timestamp syntax display_format = toplevel ~display_format @@ let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in - let%bind typed_prg,_ = Compile.Of_simplified.compile simplified in + let%bind typed_prg,_ = Compile.Of_simplified.compile Env simplified in let%bind mini_c = Compile.Of_typed.compile typed_prg in let%bind (exp,_) = Mini_c.get_entry mini_c entry_point in let%bind compiled = Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp in diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index d570c96ef..6bb8326f7 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -1218,3 +1218,63 @@ ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, char DIP { DIP { DUP } ; SWAP ; CDR } ; PAIR ; DIP { DROP 2 } } } |}] + +let%expect_test _ = + run_ligo_bad [ "compile-contract" ; bad_contract "self_type_annotation.ligo" ; "main" ] ; + [%expect {| + ligo: in file "self_type_annotation.ligo", line 8, characters 41-51. bad self type: expected (TO_Contract (int)) but got (TO_Contract (nat)) {"location":"in file \"self_type_annotation.ligo\", line 8, characters 41-51"} + + + If you're not sure how to fix this error, you can + do one of the following: + + * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/ + * Ask a question on our Discord: https://discord.gg/9rhYaEt + * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new + * Check the changelog by running 'ligo changelog' |}] ; + + run_ligo_good [ "compile-contract" ; contract "self_type_annotation.ligo" ; "main" ] ; + [%expect {| + { parameter nat ; + storage int ; + code { DUP ; SELF ; SWAP ; CDR ; NIL operation ; PAIR ; DIP { DROP 2 } } } |}] + +let%expect_test _ = + run_ligo_bad [ "compile-contract" ; bad_contract "bad_contract.mligo" ; "main" ] ; + [%expect {| + ligo: in file "", line 0, characters 0-0. badly typed contract: unexpected entrypoint type {"location":"in file \"\", line 0, characters 0-0","entrypoint":"main","entrypoint_type":"( nat * int ) -> int"} + + + If you're not sure how to fix this error, you can + do one of the following: + + * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/ + * Ask a question on our Discord: https://discord.gg/9rhYaEt + * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new + * Check the changelog by running 'ligo changelog' |}] ; + + run_ligo_bad [ "compile-contract" ; bad_contract "bad_contract2.mligo" ; "main" ] ; + [%expect {| + ligo: in file "", line 0, characters 0-0. bad return type: expected (TO_list(operation)), got string {"location":"in file \"\", line 0, characters 0-0","entrypoint":"main"} + + + If you're not sure how to fix this error, you can + do one of the following: + + * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/ + * Ask a question on our Discord: https://discord.gg/9rhYaEt + * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new + * Check the changelog by running 'ligo changelog' |}] ; + + run_ligo_bad [ "compile-contract" ; bad_contract "bad_contract3.mligo" ; "main" ] ; + [%expect {| + ligo: in file "", line 0, characters 0-0. badly typed contract: expected {int} and {string} to be the same in the entrypoint type {"location":"in file \"\", line 0, characters 0-0","entrypoint":"main","entrypoint_type":"( nat * int ) -> ( (TO_list(operation)) * string )"} + + + If you're not sure how to fix this error, you can + do one of the following: + + * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/ + * Ask a question on our Discord: https://discord.gg/9rhYaEt + * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new + * Check the changelog by running 'ligo changelog' |}] \ No newline at end of file diff --git a/src/main/compile/of_simplified.ml b/src/main/compile/of_simplified.ml index f5271382c..6a948e6d5 100644 --- a/src/main/compile/of_simplified.ml +++ b/src/main/compile/of_simplified.ml @@ -1,9 +1,15 @@ open Trace -let compile (program : Ast_simplified.program) : (Ast_typed.program * Typer.Solver.state) result = +type form = + | Contract of string + | Env + +let compile (cform: form) (program : Ast_simplified.program) : (Ast_typed.program * Typer.Solver.state) result = let%bind (prog_typed , state) = Typer.type_program program in let () = Typer.Solver.discard_state state in - let%bind prog_typed' = Self_ast_typed.all_program prog_typed in + let%bind prog_typed' = match cform with + | Contract entrypoint -> Self_ast_typed.all_contract entrypoint prog_typed + | Env -> ok prog_typed in ok @@ (prog_typed', state) let compile_expression ?(env = Ast_typed.Environment.full_empty) ~(state : Typer.Solver.state) (ae : Ast_simplified.expression) diff --git a/src/main/compile/wrapper.ml b/src/main/compile/wrapper.ml deleted file mode 100644 index ae8f9043e..000000000 --- a/src/main/compile/wrapper.ml +++ /dev/null @@ -1,12 +0,0 @@ -open Trace - -let source_to_typed syntax source_file = - let%bind simplified = Of_source.compile source_file syntax in - let%bind typed,state = Of_simplified.compile simplified in - let env = Ast_typed.program_environment typed in - ok (typed,state,env) - -let source_to_typed_expression ~env ~state parameter syntax = - let%bind simplified = Of_source.compile_expression syntax parameter in - let%bind (typed,_) = Of_simplified.compile_expression ~env ~state simplified in - ok typed diff --git a/src/passes/5-self_ast_typed/contract_passes.ml b/src/passes/5-self_ast_typed/contract_passes.ml new file mode 100644 index 000000000..9f2e980da --- /dev/null +++ b/src/passes/5-self_ast_typed/contract_passes.ml @@ -0,0 +1,34 @@ +open Ast_typed +open Trace + +type contract_pass_data = { + contract_type : Helpers.contract_type ; + main_name : string ; +} + +module Errors = struct + let bad_self_type expected got loc () = + let title = thunk "bad self type" in + let message () = Format.asprintf "expected %a but got %a" Ast_typed.PP.type_expression expected Ast_typed.PP.type_expression got in + let data = [ + ("location" , fun () -> Format.asprintf "%a" Location.pp loc) + ] in + error ~data title message () + +end + +let self_typing : contract_pass_data -> expression -> (bool * contract_pass_data * expression) result = fun dat e -> + let bad_self_err () = Errors.bad_self_type + e.type_expression + {e.type_expression with type_content = T_operator (TC_contract dat.contract_type.parameter)} + e.location + in + match e.expression_content , e.type_expression with + | E_constant {cons_name=C_SELF ; arguments=[]}, {type_content = T_operator (TC_contract t) ; type_meta=_} -> + let%bind () = + trace_strong (bad_self_err ()) @@ + Ast_typed.assert_type_expression_eq (dat.contract_type.parameter,t) in + ok (true, dat, e) + | E_constant {cons_name=C_SELF ; arguments=[]}, {type_content=_ ; type_meta=_} -> + fail (bad_self_err ()) + | _ -> ok (true,dat,e) diff --git a/src/passes/5-self_ast_typed/helpers.ml b/src/passes/5-self_ast_typed/helpers.ml index e65d497d9..f7d38302a 100644 --- a/src/passes/5-self_ast_typed/helpers.ml +++ b/src/passes/5-self_ast_typed/helpers.ml @@ -309,3 +309,86 @@ and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_exp let%bind (init,lst') = bind_fold_map_list aux init lst in ok @@ (init, Match_variant (lst', te)) ) + +and fold_map_program : 'a fold_mapper -> 'a -> program -> ('a * program) result = fun m init p -> + let aux = fun (acc,acc_prg) (x : declaration Location.wrap) -> + match Location.unwrap x with + | Declaration_constant (v , e , i, env) -> ( + let%bind (acc',e') = fold_map_expression m acc e in + let wrap_content = Declaration_constant (v , e' , i, env) in + ok (acc', List.append acc_prg [{x with wrap_content}]) + ) + in + bind_fold_list aux (init,[]) p + +module Errors = struct + let bad_contract_io entrypoint e () = + let title = thunk "badly typed contract" in + let message () = Format.asprintf "unexpected entrypoint type" in + let data = [ + ("location" , fun () -> Format.asprintf "%a" Location.pp e.location); + ("entrypoint" , fun () -> entrypoint); + ("entrypoint_type" , fun () -> Format.asprintf "%a" Ast_typed.PP.type_expression e.type_expression) + ] in + error ~data title message () + + let expected_list_operation entrypoint got e () = + let title = thunk "bad return type" in + let message () = Format.asprintf "expected %a, got %a" + Ast_typed.PP.type_expression {got with type_content= T_operator (TC_list {got with type_content=T_constant TC_operation})} + Ast_typed.PP.type_expression got + in + let data = [ + ("location" , fun () -> Format.asprintf "%a" Location.pp e.location); + ("entrypoint" , fun () -> entrypoint) + ] in + error ~data title message () + + let expected_same entrypoint t1 t2 e () = + let title = thunk "badly typed contract" in + let message () = Format.asprintf "expected {%a} and {%a} to be the same in the entrypoint type" + Ast_typed.PP.type_expression t1 + Ast_typed.PP.type_expression t2 + in + let data = [ + ("location" , fun () -> Format.asprintf "%a" Location.pp e.location); + ("entrypoint" , fun () -> entrypoint); + ("entrypoint_type" , fun () -> Format.asprintf "%a" Ast_typed.PP.type_expression e.type_expression) + ] in + error ~data title message () + +end + +type contract_type = { + parameter : Ast_typed.type_expression ; + storage : Ast_typed.type_expression ; +} + +let fetch_contract_type : string -> program -> contract_type result = fun main_fname program -> + let main_decl = List.rev @@ List.filter + (fun declt -> + let (Declaration_constant (v , _ , _ , _)) = Location.unwrap declt in + String.equal (Var.to_name v) main_fname + ) + program + in + match main_decl with + | (hd::_) -> ( + let (Declaration_constant (_,e,_,_)) = Location.unwrap hd in + match e.type_expression.type_content with + | T_arrow {type1 ; type2} -> ( + match type1.type_content , type2.type_content with + | T_record tin , T_record tout when (is_tuple_lmap tin) && (is_tuple_lmap tout) -> + let%bind (parameter,storage) = Stage_common.Helpers.get_pair tin in + let%bind (listop,storage') = Stage_common.Helpers.get_pair tout in + let%bind () = trace_strong (Errors.expected_list_operation main_fname listop e) @@ + Ast_typed.assert_t_list_operation listop in + let%bind () = trace_strong (Errors.expected_same main_fname storage storage' e) @@ + Ast_typed.assert_type_expression_eq (storage,storage') in + (* TODO: on storage/parameter : assert_storable, assert_passable ? *) + ok { parameter ; storage } + | _ -> fail @@ Errors.bad_contract_io main_fname e + ) + | _ -> fail @@ Errors.bad_contract_io main_fname e + ) + | [] -> simple_fail ("Entrypoint '"^main_fname^"' does not exist") \ No newline at end of file diff --git a/src/passes/5-self_ast_typed/self_ast_typed.ml b/src/passes/5-self_ast_typed/self_ast_typed.ml index bfe730244..165a1825f 100644 --- a/src/passes/5-self_ast_typed/self_ast_typed.ml +++ b/src/passes/5-self_ast_typed/self_ast_typed.ml @@ -1,17 +1,24 @@ open Trace -let all = [] +let all_passes = [] + +let contract_passes = [ + Contract_passes.self_typing ; +] let all_program = - let all_p = List.map Helpers.map_program all in + let all_p = List.map Helpers.map_program all_passes in bind_chain all_p let all_expression = - let all_p = List.map Helpers.map_expression all in + let all_p = List.map Helpers.map_expression all_passes in bind_chain all_p -let map_expression = Helpers.map_expression - -let fold_expression = Helpers.fold_expression - -let fold_map_expression = Helpers.fold_map_expression +let all_contract main_name prg = + let%bind contract_type = Helpers.fetch_contract_type main_name prg in + let data : Contract_passes.contract_pass_data = { + contract_type = contract_type ; + main_name = main_name ; + } in + let all_p = List.map (fun pass -> Helpers.fold_map_program pass data) contract_passes in + bind_chain_ignore_acc all_p prg diff --git a/src/stages/common/helpers.ml b/src/stages/common/helpers.ml index 9a930215a..d498a1712 100644 --- a/src/stages/common/helpers.ml +++ b/src/stages/common/helpers.ml @@ -38,3 +38,9 @@ let label_range i j = let is_tuple_lmap m = List.for_all (fun i -> LMap.mem i m) @@ (label_range 0 (LMap.cardinal m)) + +let get_pair m = + let open Trace in + match (LMap.find_opt (Label "0") m , LMap.find_opt (Label "1") m) with + | Some e1, Some e2 -> ok (e1,e2) + | _ -> simple_fail "not a pair" diff --git a/src/stages/common/helpers.mli b/src/stages/common/helpers.mli index f35f9a33c..69efa24eb 100644 --- a/src/stages/common/helpers.mli +++ b/src/stages/common/helpers.mli @@ -16,3 +16,6 @@ val bind_map_cmap : 'a Types.constructor_map -> ('b Types.constructor_map * 'c list, 'd) result val is_tuple_lmap : 'a Types.label_map -> bool +val get_pair : + 'a Types.label_map -> + (('a * 'a) * 'b list, unit -> Trace.error) result diff --git a/src/test/coase_tests.ml b/src/test/coase_tests.ml index be36603c7..5df29091f 100644 --- a/src/test/coase_tests.ml +++ b/src/test/coase_tests.ml @@ -5,7 +5,7 @@ open Test_helpers let type_file f = let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in ok @@ (typed,state) let get_program = @@ -21,7 +21,7 @@ let get_program = let compile_main () = let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/coase.ligo" (Syntax_name "pascaligo") in - let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in let%bind (_contract: Tezos_utils.Michelson.michelson) = diff --git a/src/test/contracts/negative/bad_contract.mligo b/src/test/contracts/negative/bad_contract.mligo new file mode 100644 index 000000000..28e5506f3 --- /dev/null +++ b/src/test/contracts/negative/bad_contract.mligo @@ -0,0 +1,5 @@ +type storage = int +type parameter = nat + +let main (action, store : parameter * storage) : storage = + store + 1 \ No newline at end of file diff --git a/src/test/contracts/negative/bad_contract2.mligo b/src/test/contracts/negative/bad_contract2.mligo new file mode 100644 index 000000000..7e95f7175 --- /dev/null +++ b/src/test/contracts/negative/bad_contract2.mligo @@ -0,0 +1,6 @@ +type storage = int +type parameter = nat +type return = string * storage + +let main (action, store : parameter * storage) : return = + ("bad",store + 1) \ No newline at end of file diff --git a/src/test/contracts/negative/bad_contract3.mligo b/src/test/contracts/negative/bad_contract3.mligo new file mode 100644 index 000000000..5c5c71a66 --- /dev/null +++ b/src/test/contracts/negative/bad_contract3.mligo @@ -0,0 +1,6 @@ +type storage = int +type parameter = nat +type return = operation list * string + +let main (action, store : parameter * storage) : return = + (([]: operation list),"bad") \ No newline at end of file diff --git a/src/test/contracts/negative/self_in_lambda.mligo b/src/test/contracts/negative/self_in_lambda.mligo index 4c497e268..b059189da 100644 --- a/src/test/contracts/negative/self_in_lambda.mligo +++ b/src/test/contracts/negative/self_in_lambda.mligo @@ -1,5 +1,5 @@ let foo (u : unit) : address = Tezos.self_address -let main (ps : unit * address) : (operation list * address) = - let dummy = foo () in - ([] : operation list), foo () +let main (ps: unit * address): (operation list * address) = + let dummy = foo () in (* force not to inline foo *) + ( ([] : operation list) , foo ()) diff --git a/src/test/contracts/negative/self_type_annotation.ligo b/src/test/contracts/negative/self_type_annotation.ligo new file mode 100644 index 000000000..1dcab5a61 --- /dev/null +++ b/src/test/contracts/negative/self_type_annotation.ligo @@ -0,0 +1,10 @@ +type parameter is nat +type storage is int +type return is list (operation) * storage + + +function main (const p : parameter; const s : storage) : return is + block { + const self_contract: contract(int) = Tezos.self; + } + with ((nil: list(operation)), s) \ No newline at end of file diff --git a/src/test/contracts/self_type_annotation.ligo b/src/test/contracts/self_type_annotation.ligo new file mode 100644 index 000000000..95c1ce3f2 --- /dev/null +++ b/src/test/contracts/self_type_annotation.ligo @@ -0,0 +1,10 @@ +type parameter is nat +type storage is int +type return is list (operation) * storage + + +function main (const p : parameter; const s : storage) : return is + block { + const self_contract: contract(parameter) = Tezos.self ; + } + with ((nil: list(operation)), s) \ No newline at end of file diff --git a/src/test/contracts/subtle_nontail_fail.mligo b/src/test/contracts/subtle_nontail_fail.mligo index 6b3c52b9b..c285b14a1 100644 --- a/src/test/contracts/subtle_nontail_fail.mligo +++ b/src/test/contracts/subtle_nontail_fail.mligo @@ -1,4 +1,4 @@ -let main (_ : unit * unit) = +let main (ps : unit * unit) : operation list * unit = if true - then failwith "This contract always fails" - else failwith "This contract still always fails" + then (failwith "This contract always fails" : operation list * unit) + else (failwith "This contract still always fails" : operation list * unit) diff --git a/src/test/hash_lock_tests.ml b/src/test/hash_lock_tests.ml index 7da1882ab..7a6db1ea8 100644 --- a/src/test/hash_lock_tests.ml +++ b/src/test/hash_lock_tests.ml @@ -4,7 +4,7 @@ open Ast_simplified let type_file f = let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in ok @@ (typed,state) let get_program = @@ -19,7 +19,7 @@ let get_program = let compile_main () = let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/hashlock.mligo" (Syntax_name "cameligo") in - let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in let%bind (_contract: Tezos_utils.Michelson.michelson) = diff --git a/src/test/id_tests.ml b/src/test/id_tests.ml index db8b78960..294cd08ff 100644 --- a/src/test/id_tests.ml +++ b/src/test/id_tests.ml @@ -5,7 +5,7 @@ open Ast_simplified let mtype_file f = let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in ok (typed,state) let get_program = @@ -20,7 +20,7 @@ let get_program = let compile_main () = let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/id.mligo" (Syntax_name "cameligo") in - let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in let%bind (_contract: Tezos_utils.Michelson.michelson) = diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index e6de67651..ffac8e299 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -5,18 +5,18 @@ open Ast_simplified.Combinators let retype_file f = let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "reasonligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed,state = Ligo.Compile.Of_simplified.compile Env simplified in let () = Typer.Solver.discard_state state in let () = Typer.Solver.discard_state state in ok typed let mtype_file f = let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed,state = Ligo.Compile.Of_simplified.compile Env simplified in let () = Typer.Solver.discard_state state in ok typed let type_file f = let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed,state = Ligo.Compile.Of_simplified.compile Env simplified in let () = Typer.Solver.discard_state state in ok typed diff --git a/src/test/md_file_tests.ml b/src/test/md_file_tests.ml index ca3eb65e3..14748f9c8 100644 --- a/src/test/md_file_tests.ml +++ b/src/test/md_file_tests.ml @@ -69,7 +69,7 @@ let compile_groups _filename grp_list = trace (failed_to_compile_md_file _filename (s,grp,contents)) @@ let%bind v_syntax = Compile.Helpers.syntax_to_variant (Syntax_name s) None in let%bind simplified = Compile.Of_source.compile_string contents v_syntax in - let%bind typed,_ = Compile.Of_simplified.compile simplified in + let%bind typed,_ = Compile.Of_simplified.compile Env simplified in let%bind mini_c = Compile.Of_typed.compile typed in bind_map_list (fun ((_, _, exp),_) -> Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp) diff --git a/src/test/multisig_tests.ml b/src/test/multisig_tests.ml index e71c5ce99..704171e01 100644 --- a/src/test/multisig_tests.ml +++ b/src/test/multisig_tests.ml @@ -7,7 +7,7 @@ let refile = "./contracts/multisig.religo" let type_file f s = let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name s) in - let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in ok @@ (typed,state) let get_program f st = diff --git a/src/test/multisig_v2_tests.ml b/src/test/multisig_v2_tests.ml index 0ed619c1d..391be83d2 100644 --- a/src/test/multisig_v2_tests.ml +++ b/src/test/multisig_v2_tests.ml @@ -3,7 +3,7 @@ open Test_helpers let type_file f = let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in ok @@ (typed,state) let get_program = @@ -18,7 +18,7 @@ let get_program = let compile_main () = let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/multisig-v2.ligo" (Syntax_name "pascaligo") in - let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in let%bind (_contract: Tezos_utils.Michelson.michelson) = diff --git a/src/test/pledge_tests.ml b/src/test/pledge_tests.ml index 189e45a82..d6af4f369 100644 --- a/src/test/pledge_tests.ml +++ b/src/test/pledge_tests.ml @@ -5,7 +5,7 @@ open Ast_simplified let retype_file f = let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "reasonligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed,state = Ligo.Compile.Of_simplified.compile Env simplified in ok (typed,state) let get_program = @@ -20,7 +20,7 @@ let get_program = let compile_main () = let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/pledge.religo" (Syntax_name "reasonligo") in - let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile Env simplified in let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in let%bind (_contract: Tezos_utils.Michelson.michelson) = diff --git a/src/test/replaceable_id_tests.ml b/src/test/replaceable_id_tests.ml index 54d7d1a64..60bcb203e 100644 --- a/src/test/replaceable_id_tests.ml +++ b/src/test/replaceable_id_tests.ml @@ -3,7 +3,7 @@ open Test_helpers let type_file f = let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in ok @@ (typed,state) let get_program = @@ -18,7 +18,7 @@ let get_program = let compile_main () = let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/replaceable_id.ligo" (Syntax_name "pascaligo") in - let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in let%bind (_contract: Tezos_utils.Michelson.michelson) = diff --git a/src/test/time_lock_repeat_tests.ml b/src/test/time_lock_repeat_tests.ml index 4405948bf..b5a3f7427 100644 --- a/src/test/time_lock_repeat_tests.ml +++ b/src/test/time_lock_repeat_tests.ml @@ -4,7 +4,7 @@ open Ast_simplified let type_file f = let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in ok @@ (typed,state) let get_program = @@ -19,7 +19,7 @@ let get_program = let compile_main () = let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/timelock_repeat.mligo" (Syntax_name "cameligo") in - let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in let%bind (_contract: Tezos_utils.Michelson.michelson) = diff --git a/src/test/time_lock_tests.ml b/src/test/time_lock_tests.ml index a3437461a..eb3001f49 100644 --- a/src/test/time_lock_tests.ml +++ b/src/test/time_lock_tests.ml @@ -3,7 +3,7 @@ open Test_helpers let type_file f = let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in ok @@ (typed,state) let get_program = @@ -18,7 +18,7 @@ let get_program = let compile_main () = let%bind simplified = Ligo.Compile.Of_source.compile "./contracts/time-lock.ligo" (Syntax_name "pascaligo") in - let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed_prg,_ = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in let%bind mini_c_prg = Ligo.Compile.Of_typed.compile typed_prg in let%bind michelson_prg = Ligo.Compile.Of_mini_c.aggregate_and_compile_contract mini_c_prg "main" in let%bind (_contract: Tezos_utils.Michelson.michelson) = diff --git a/src/test/vote_tests.ml b/src/test/vote_tests.ml index 3a0a95021..ddc3d620d 100644 --- a/src/test/vote_tests.ml +++ b/src/test/vote_tests.ml @@ -3,7 +3,7 @@ open Test_helpers let type_file f = let%bind simplified = Ligo.Compile.Of_source.compile f (Syntax_name "cameligo") in - let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in + let%bind typed,state = Ligo.Compile.Of_simplified.compile (Contract "main") simplified in ok @@ (typed,state) let get_program = diff --git a/vendors/ligo-utils/simple-utils/trace.ml b/vendors/ligo-utils/simple-utils/trace.ml index 6b7cdde70..0c3bcbcdd 100644 --- a/vendors/ligo-utils/simple-utils/trace.ml +++ b/vendors/ligo-utils/simple-utils/trace.ml @@ -699,6 +699,16 @@ let rec bind_chain : ('a -> 'a result) list -> 'a -> 'a result = fun fs x -> bind aux (ok x) ) +let rec bind_chain_ignore_acc : ('a -> ('b * 'a) result) list -> 'a -> 'a result = fun fs x -> + match fs with + | [] -> ok x + | hd :: tl -> ( + let aux : 'a -> 'a result = fun x -> + hd x >>? fun (_,aa) -> + bind (bind_chain_ignore_acc tl) (ok aa) in + bind aux (ok x) + ) + (** Wraps a call that might trigger an exception in a result. *)