diff --git a/CHANGELOG.md b/CHANGELOG.md
index fe908e334..3fc44d2cb 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,7 +2,11 @@
## [Unreleased]
-## [Add crypto reference page to docs](https://gitlab.com/ligolang/ligo/-/merge_requests/459)
+## [Support for self] (https://gitlab.com/ligolang/ligo/-/merge_requests/453)
+### Added
+- support for `Tezos.self(%Entrypoint)`
+
+## [Support for create_contract](https://gitlab.com/ligolang/ligo/-/merge_requests/459)
### Added
- support for `Tezos.create_contract` origination
diff --git a/gitlab-pages/docs/reference/current.md b/gitlab-pages/docs/reference/current.md
index 0b5cd7265..642bbb6fe 100644
--- a/gitlab-pages/docs/reference/current.md
+++ b/gitlab-pages/docs/reference/current.md
@@ -321,6 +321,37 @@ let main = (p : unit) : address => Tezos.self_address;
+## Self
+
+Typecast the currently running contract with an entrypoint annotation.
+If your are using entrypoints: use "%bar" for constructor Bar
+If you are not using entrypoints: use "%default"
+
+
+
+```pascaligo
+function main (const p : unit) : contract(unit) is block {
+ const c : contract(unit) = Tezos.self("%Default") ;
+} with c
+```
+
+
+
+
+```cameligo
+let main (p : unit) : unit contract =
+ (Tezos.self("%Default") : unit contract)
+```
+
+
+
+
+```reasonligo
+let main = (p: unit) : contract(unit) =>
+ (Tezos.self("%Default") : contract(unit));
+```
+
+
## Implicit Account
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..49b1563d7 100644
--- a/src/bin/expect_tests/contract_tests.ml
+++ b/src/bin/expect_tests/contract_tests.ml
@@ -1218,3 +1218,117 @@ 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-64. bad self type: expected (TO_Contract (int)) but got (TO_Contract (nat)) {"location":"in file \"self_type_annotation.ligo\", line 8, characters 41-64"}
+
+
+ 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 %default ;
+ 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' |}]
+
+let%expect_test _ =
+ run_ligo_good [ "compile-contract" ; contract "self_with_entrypoint.ligo" ; "main" ] ;
+ [%expect {|
+ { parameter (or (unit %default) (int %toto)) ;
+ storage nat ;
+ code { SELF %toto ;
+ DUP ;
+ PUSH mutez 300000000 ;
+ PUSH int 2 ;
+ TRANSFER_TOKENS ;
+ DUP ;
+ NIL operation ;
+ SWAP ;
+ CONS ;
+ DIP { DIP 2 { DUP } ; DIG 2 ; CDR } ;
+ PAIR ;
+ DIP { DROP 3 } } } |}] ;
+
+ run_ligo_good [ "compile-contract" ; contract "self_without_entrypoint.ligo" ; "main" ] ;
+ [%expect {|
+ { parameter int ;
+ storage nat ;
+ code { SELF %default ;
+ DUP ;
+ PUSH mutez 300000000 ;
+ PUSH int 2 ;
+ TRANSFER_TOKENS ;
+ DUP ;
+ NIL operation ;
+ SWAP ;
+ CONS ;
+ DIP { DIP 2 { DUP } ; DIG 2 ; CDR } ;
+ PAIR ;
+ DIP { DROP 3 } } } |}] ;
+
+ run_ligo_bad [ "compile-contract" ; bad_contract "self_bad_entrypoint_format.ligo" ; "main" ] ;
+ [%expect {|
+ ligo: in file "self_bad_entrypoint_format.ligo", line 8, characters 52-58. bad entrypoint format: entrypoint "Toto" is badly formatted. We expect "%bar" for entrypoint Bar and "%default" when no entrypoint used {"location":"in file \"self_bad_entrypoint_format.ligo\", line 8, characters 52-58"}
+
+
+ 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/dune b/src/main/compile/dune
index e59679ba5..7629e3d2b 100644
--- a/src/main/compile/dune
+++ b/src/main/compile/dune
@@ -9,6 +9,7 @@
interpreter
ast_simplified
self_ast_simplified
+ self_ast_typed
typer_new
typer
ast_typed
diff --git a/src/main/compile/of_simplified.ml b/src/main/compile/of_simplified.ml
index 488e809ac..6a948e6d5 100644
--- a/src/main/compile/of_simplified.ml
+++ b/src/main/compile/of_simplified.ml
@@ -1,14 +1,23 @@
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
- ok @@ (prog_typed, state)
+ 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)
: (Ast_typed.expression * Typer.Solver.state) result =
+ let%bind (ae_typed,state) = Typer.type_expression_subst env state ae in
let () = Typer.Solver.discard_state state in
- Typer.type_expression_subst env state ae
+ let%bind ae_typed' = Self_ast_typed.all_expression ae_typed in
+ ok @@ (ae_typed',state)
let apply (entry_point : string) (param : Ast_simplified.expression) : Ast_simplified.expression result =
let name = Var.of_name entry_point in
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..c16898146
--- /dev/null
+++ b/src/passes/5-self_ast_typed/contract_passes.ml
@@ -0,0 +1,72 @@
+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 ()
+
+ let bad_format_entrypoint_ann ep loc () =
+ let title = thunk "bad entrypoint format" in
+ let message () = Format.asprintf "entrypoint \"%s\" is badly formatted. We expect \"%%bar\" for entrypoint Bar and \"%%default\" when no entrypoint used" ep in
+ let data = [
+ ("location" , fun () -> Format.asprintf "%a" Location.pp loc) ;
+ ] in
+ error ~data title message ()
+
+ let entrypoint_annotation_not_literal loc () =
+ let title = thunk "entrypoint annotation must be a string literal" in
+ let message () = Format.asprintf "" in
+ let data = [
+ ("location" , fun () -> Format.asprintf "%a" Location.pp loc) ;
+ ] in
+ error ~data title message ()
+
+ let unmatched_entrypoint loc () =
+ let title = thunk "No constructor matches the entrypoint annotation" in
+ let message () = Format.asprintf "" in
+ let data = [
+ ("location" , fun () -> Format.asprintf "%a" Location.pp loc) ;
+ ] in
+ error ~data title message ()
+
+end
+
+let check_entrypoint_annotation_format ep exp =
+ match String.split_on_char '%' ep with
+ | [ "" ; ep'] ->
+ let cap = String.capitalize_ascii ep' in
+ if String.equal cap ep' then fail @@ Errors.bad_format_entrypoint_ann ep exp.location
+ else ok cap
+ | _ -> fail @@ Errors.bad_format_entrypoint_ann ep exp.location
+
+
+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=[entrypoint_exp]}, {type_content = T_operator (TC_contract t) ; type_meta=_} ->
+ let%bind entrypoint = match entrypoint_exp.expression_content with
+ | E_literal (Literal_string ep) -> check_entrypoint_annotation_format ep entrypoint_exp
+ | _ -> fail @@ Errors.entrypoint_annotation_not_literal entrypoint_exp.location in
+ let%bind entrypoint_t = match dat.contract_type.parameter.type_content with
+ | T_sum cmap -> trace_option (Errors.unmatched_entrypoint entrypoint_exp.location)
+ @@ Stage_common.Types.CMap.find_opt (Constructor entrypoint) cmap
+ | t -> ok {dat.contract_type.parameter with type_content = t} in
+ let%bind () =
+ trace_strong (bad_self_err ()) @@
+ Ast_typed.assert_type_expression_eq (entrypoint_t , t) in
+ ok (true, dat, e)
+ | _ -> ok (true,dat,e)
diff --git a/src/passes/5-self_ast_typed/dune b/src/passes/5-self_ast_typed/dune
new file mode 100644
index 000000000..0fc22a1d3
--- /dev/null
+++ b/src/passes/5-self_ast_typed/dune
@@ -0,0 +1,12 @@
+(library
+ (name self_ast_typed)
+ (public_name ligo.self_ast_typed)
+ (libraries
+ simple-utils
+ ast_typed
+ )
+ (preprocess
+ (pps ppx_let bisect_ppx --conditional)
+ )
+ (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils ))
+)
diff --git a/src/passes/5-self_ast_typed/helpers.ml b/src/passes/5-self_ast_typed/helpers.ml
new file mode 100644
index 000000000..f7d38302a
--- /dev/null
+++ b/src/passes/5-self_ast_typed/helpers.ml
@@ -0,0 +1,394 @@
+open Ast_typed
+open Trace
+open Stage_common.Helpers
+
+type 'a folder = 'a -> expression -> 'a result
+let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f init e ->
+ let self = fold_expression f in
+ let%bind init' = f init e in
+ match e.expression_content with
+ | E_literal _ | E_variable _ -> ok init'
+ | E_list lst | E_set lst | E_constant {arguments=lst} -> (
+ let%bind res = bind_fold_list self init' lst in
+ ok res
+ )
+ | E_map lst | E_big_map lst -> (
+ let%bind res = bind_fold_list (bind_fold_pair self) init' lst in
+ ok res
+ )
+ | E_look_up ab ->
+ let%bind res = bind_fold_pair self init' ab in
+ ok res
+ | E_loop {condition;body} ->
+ let ab = (condition,body) in
+ let%bind res = bind_fold_pair self init' ab in
+ ok res
+ | E_application {expr1;expr2} -> (
+ let ab = (expr1,expr2) in
+ let%bind res = bind_fold_pair self init' ab in
+ ok res
+ )
+ | E_lambda { binder = _ ; result = e }
+ | E_constructor {element=e} -> (
+ let%bind res = self init' e in
+ ok res
+ )
+ | E_matching {matchee=e; cases} -> (
+ let%bind res = self init' e in
+ let%bind res = fold_cases f res cases in
+ ok res
+ )
+ | E_record m -> (
+ let aux init'' _ expr =
+ let%bind res = fold_expression self init'' expr in
+ ok res
+ in
+ let%bind res = bind_fold_lmap aux (ok init') m in
+ ok res
+ )
+ | E_record_update {record;update} -> (
+ let%bind res = self init' record in
+ let%bind res = fold_expression self res update in
+ ok res
+ )
+ | E_record_accessor {expr} -> (
+ let%bind res = self init' expr in
+ ok res
+ )
+ | E_let_in { let_binder = _ ; rhs ; let_result } -> (
+ let%bind res = self init' rhs in
+ let%bind res = self res let_result in
+ ok res
+ )
+
+and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
+ match m with
+ | Match_bool { match_true ; match_false } -> (
+ let%bind res = fold_expression f init match_true in
+ let%bind res = fold_expression f res match_false in
+ ok res
+ )
+ | Match_list { match_nil ; match_cons = (_ , _ , cons, _) } -> (
+ let%bind res = fold_expression f init match_nil in
+ let%bind res = fold_expression f res cons in
+ ok res
+ )
+ | Match_option { match_none ; match_some = (_ , some, _) } -> (
+ let%bind res = fold_expression f init match_none in
+ let%bind res = fold_expression f res some in
+ ok res
+ )
+ | Match_tuple ((_ , e), _) -> (
+ let%bind res = fold_expression f init e in
+ ok res
+ )
+ | Match_variant (lst, _) -> (
+ let aux init' ((_ , _) , e) =
+ let%bind res' = fold_expression f init' e in
+ ok res' in
+ let%bind res = bind_fold_list aux init lst in
+ ok res
+ )
+
+type mapper = expression -> expression result
+let rec map_expression : mapper -> expression -> expression result = fun f e ->
+ let self = map_expression f in
+ let%bind e' = f e in
+ let return expression_content = ok { e' with expression_content } in
+ match e'.expression_content with
+ | E_list lst -> (
+ let%bind lst' = bind_map_list self lst in
+ return @@ E_list lst'
+ )
+ | E_set lst -> (
+ let%bind lst' = bind_map_list self lst in
+ return @@ E_set lst'
+ )
+ | E_map lst -> (
+ let%bind lst' = bind_map_list (bind_map_pair self) lst in
+ return @@ E_map lst'
+ )
+ | E_big_map lst -> (
+ let%bind lst' = bind_map_list (bind_map_pair self) lst in
+ return @@ E_big_map lst'
+ )
+ | E_look_up ab -> (
+ let%bind ab' = bind_map_pair self ab in
+ return @@ E_look_up ab'
+ )
+ | E_loop {condition;body} -> (
+ let ab = (condition,body) in
+ let%bind (a,b) = bind_map_pair self ab in
+ return @@ E_loop {condition = a; body = b}
+ )
+ | E_matching {matchee=e;cases} -> (
+ let%bind e' = self e in
+ let%bind cases' = map_cases f cases in
+ return @@ E_matching {matchee=e';cases=cases'}
+ )
+ | E_record_accessor acc -> (
+ let%bind e' = self acc.expr in
+ return @@ E_record_accessor {acc with expr = e'}
+ )
+ | E_record m -> (
+ let%bind m' = bind_map_lmap self m in
+ return @@ E_record m'
+ )
+ | E_record_update {record; path; update} -> (
+ let%bind record = self record in
+ let%bind update = self update in
+ return @@ E_record_update {record;path;update}
+ )
+ | E_constructor c -> (
+ let%bind e' = self c.element in
+ return @@ E_constructor {c with element = e'}
+ )
+ | E_application {expr1;expr2} -> (
+ let ab = (expr1,expr2) in
+ let%bind (a,b) = bind_map_pair self ab in
+ return @@ E_application {expr1=a;expr2=b}
+ )
+ | E_let_in { let_binder ; rhs ; let_result; inline } -> (
+ let%bind rhs = self rhs in
+ let%bind let_result = self let_result in
+ return @@ E_let_in { let_binder ; rhs ; let_result; inline }
+ )
+ | E_lambda { binder ; result } -> (
+ let%bind result = self result in
+ return @@ E_lambda { binder ; result }
+ )
+ | E_constant c -> (
+ let%bind args = bind_map_list self c.arguments in
+ return @@ E_constant {c with arguments=args}
+ )
+ | E_literal _ | E_variable _ as e' -> return e'
+
+
+and map_cases : mapper -> matching_expr -> matching_expr result = fun f m ->
+ match m with
+ | Match_bool { match_true ; match_false } -> (
+ let%bind match_true = map_expression f match_true in
+ let%bind match_false = map_expression f match_false in
+ ok @@ Match_bool { match_true ; match_false }
+ )
+ | Match_list { match_nil ; match_cons = (hd , tl , cons, te) } -> (
+ let%bind match_nil = map_expression f match_nil in
+ let%bind cons = map_expression f cons in
+ ok @@ Match_list { match_nil ; match_cons = (hd , tl , cons, te) }
+ )
+ | Match_option { match_none ; match_some = (name , some, te) } -> (
+ let%bind match_none = map_expression f match_none in
+ let%bind some = map_expression f some in
+ ok @@ Match_option { match_none ; match_some = (name , some, te) }
+ )
+ | Match_tuple ((names , e), _) -> (
+ let%bind e' = map_expression f e in
+ ok @@ Match_tuple ((names , e'), [])
+ )
+ | Match_variant (lst, te) -> (
+ let aux ((a , b) , e) =
+ let%bind e' = map_expression f e in
+ ok ((a , b) , e')
+ in
+ let%bind lst' = bind_map_list aux lst in
+ ok @@ Match_variant (lst', te)
+ )
+
+and map_program : mapper -> program -> program result = fun m p ->
+ let aux = fun (x : declaration) ->
+ match x with
+ | Declaration_constant (v , e , i, env) -> (
+ let%bind e' = map_expression m e in
+ ok (Declaration_constant (v , e' , i, env))
+ )
+ in
+ bind_map_list (bind_map_location aux) p
+
+type 'a fold_mapper = 'a -> expression -> (bool * 'a * expression) result
+let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expression) result = fun f a e ->
+ let self = fold_map_expression f in
+ let%bind (continue, init',e') = f a e in
+ if (not continue) then ok(init',e')
+ else
+ let return expression_content = { e' with expression_content } in
+ match e'.expression_content with
+ | E_list lst -> (
+ let%bind (res, lst') = bind_fold_map_list self init' lst in
+ ok (res, return @@ E_list lst')
+ )
+ | E_set lst -> (
+ let%bind (res, lst') = bind_fold_map_list self init' lst in
+ ok (res, return @@ E_set lst')
+ )
+ | E_map lst -> (
+ let%bind (res, lst') = bind_fold_map_list (bind_fold_map_pair self) init' lst in
+ ok (res, return @@ E_map lst')
+ )
+ | E_big_map lst -> (
+ let%bind (res, lst') = bind_fold_map_list (bind_fold_map_pair self) init' lst in
+ ok (res, return @@ E_big_map lst')
+ )
+ | E_look_up ab -> (
+ let%bind (res, ab') = bind_fold_map_pair self init' ab in
+ ok (res, return @@ E_look_up ab')
+ )
+ | E_loop {condition;body} -> (
+ let ab = (condition,body) in
+ let%bind (res,(a,b)) = bind_fold_map_pair self init' ab in
+ ok (res, return @@ E_loop {condition = a; body = b})
+ )
+ | E_matching {matchee=e;cases} -> (
+ let%bind (res, e') = self init' e in
+ let%bind (res,cases') = fold_map_cases f res cases in
+ ok (res, return @@ E_matching {matchee=e';cases=cases'})
+ )
+ | E_record_accessor acc -> (
+ let%bind (res, e') = self init' acc.expr in
+ ok (res, return @@ E_record_accessor {acc with expr = e'})
+ )
+ | E_record m -> (
+ let%bind (res, lst') = bind_fold_map_list (fun res (k,e) -> let%bind (res,e) = self res e in ok (res,(k,e))) init' (LMap.to_kv_list m) in
+ let m' = LMap.of_list lst' in
+ ok (res, return @@ E_record m')
+ )
+ | E_record_update {record; path; update} -> (
+ let%bind (res, record) = self init' record in
+ let%bind (res, update) = self res update in
+ ok (res, return @@ E_record_update {record;path;update})
+ )
+ | E_constructor c -> (
+ let%bind (res,e') = self init' c.element in
+ ok (res, return @@ E_constructor {c with element = e'})
+ )
+ | E_application {expr1;expr2} -> (
+ let ab = (expr1,expr2) in
+ let%bind (res,(a,b)) = bind_fold_map_pair self init' ab in
+ ok (res, return @@ E_application {expr1=a;expr2=b})
+ )
+ | E_let_in { let_binder ; rhs ; let_result; inline } -> (
+ let%bind (res,rhs) = self init' rhs in
+ let%bind (res,let_result) = self res let_result in
+ ok (res, return @@ E_let_in { let_binder ; rhs ; let_result ; inline })
+ )
+ | E_lambda { binder ; result } -> (
+ let%bind (res,result) = self init' result in
+ ok ( res, return @@ E_lambda { binder ; result })
+ )
+ | E_constant c -> (
+ let%bind (res,args) = bind_fold_map_list self init' c.arguments in
+ ok (res, return @@ E_constant {c with arguments=args})
+ )
+ | E_literal _ | E_variable _ as e' -> ok (init', return e')
+
+and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
+ match m with
+ | Match_bool { match_true ; match_false } -> (
+ let%bind (init, match_true) = fold_map_expression f init match_true in
+ let%bind (init, match_false) = fold_map_expression f init match_false in
+ ok @@ (init, Match_bool { match_true ; match_false })
+ )
+ | Match_list { match_nil ; match_cons = (hd , tl , cons, te) } -> (
+ let%bind (init, match_nil) = fold_map_expression f init match_nil in
+ let%bind (init, cons) = fold_map_expression f init cons in
+ ok @@ (init, Match_list { match_nil ; match_cons = (hd , tl , cons, te) })
+ )
+ | Match_option { match_none ; match_some = (name , some, te) } -> (
+ let%bind (init, match_none) = fold_map_expression f init match_none in
+ let%bind (init, some) = fold_map_expression f init some in
+ ok @@ (init, Match_option { match_none ; match_some = (name , some, te) })
+ )
+ | Match_tuple ((names , e), _) -> (
+ let%bind (init, e') = fold_map_expression f init e in
+ ok @@ (init, Match_tuple ((names , e'), []))
+ )
+ | Match_variant (lst, te) -> (
+ let aux init ((a , b) , e) =
+ let%bind (init,e') = fold_map_expression f init e in
+ ok (init, ((a , b) , e'))
+ in
+ 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
new file mode 100644
index 000000000..165a1825f
--- /dev/null
+++ b/src/passes/5-self_ast_typed/self_ast_typed.ml
@@ -0,0 +1,24 @@
+open Trace
+
+let all_passes = []
+
+let contract_passes = [
+ Contract_passes.self_typing ;
+]
+
+let all_program =
+ 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_passes in
+ bind_chain all_p
+
+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/passes/8-compiler/compiler_program.ml b/src/passes/8-compiler/compiler_program.ml
index 73635024e..491b1b91a 100644
--- a/src/passes/8-compiler/compiler_program.ml
+++ b/src/passes/8-compiler/compiler_program.ml
@@ -32,6 +32,20 @@ let rec get_operator : constant' -> type_value -> expression list -> predicate r
| Ok (x,_) -> ok x
| Error _ -> (
match s with
+ | C_SELF -> (
+ let%bind entrypoint_as_string = match lst with
+ | [{ content = E_literal (D_string s); type_value = _ }] -> (
+ match String.split_on_char '%' s with
+ | ["" ; s] -> ok @@ String.concat "" ["%" ; (String.uncapitalize_ascii s)]
+ | _ -> fail @@ corner_case ~loc:__LOC__ "mini_c . SELF"
+ )
+ | _ ->
+ fail @@ corner_case ~loc:__LOC__ "mini_c . SELF" in
+ ok @@ simple_unary @@ seq [
+ i_drop ;
+ prim ~annot:[entrypoint_as_string] I_SELF
+ ]
+ )
| C_NONE -> (
let%bind ty' = Mini_c.get_t_option ty in
let%bind m_ty = Compiler_type.type_ ty' in
diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml
index 9fd521087..e2adcc18f 100644
--- a/src/passes/operators/operators.ml
+++ b/src/passes/operators/operators.ml
@@ -66,7 +66,6 @@ module Simplify = struct
module Pascaligo = struct
let constants = function
(* Tezos module (ex-Michelson) *)
-
| "Tezos.chain_id" -> ok C_CHAIN_ID
| "chain_id" -> ok C_CHAIN_ID (* Deprecated *)
| "get_chain_id" -> ok C_CHAIN_ID (* Deprecated *)
@@ -79,7 +78,8 @@ module Simplify = struct
| "Tezos.sender" -> ok C_SENDER
| "sender" -> ok C_SENDER (* Deprecated *)
| "Tezos.address" -> ok C_ADDRESS
- | "address" -> ok C_ADDRESS (* Deprecated *)
+ | "address" -> ok C_ADDRESS (* Deprecated *)
+ | "Tezos.self" -> ok C_SELF
| "Tezos.self_address" -> ok C_SELF_ADDRESS
| "self_address" -> ok C_SELF_ADDRESS (* Deprecated *)
| "Tezos.implicit_account" -> ok C_IMPLICIT_ACCOUNT
@@ -267,6 +267,7 @@ module Simplify = struct
| "sender" -> ok C_SENDER (* Deprecated *)
| "Tezos.address" -> ok C_ADDRESS
| "Current.address" -> ok C_ADDRESS (* Deprecated *)
+ | "Tezos.self" -> ok C_SELF
| "Tezos.self_address" -> ok C_SELF_ADDRESS
| "Current.self_address" -> ok C_SELF_ADDRESS (* Deprecated *)
| "Tezos.implicit_account" -> ok C_IMPLICIT_ACCOUNT
@@ -791,6 +792,12 @@ module Typer = struct
let self_address = typer_0 "SELF_ADDRESS" @@ fun _ ->
ok @@ t_address ()
+ let self = typer_1_opt "SELF" @@ fun entrypoint_as_string tv_opt ->
+ let%bind () = assert_t_string entrypoint_as_string in
+ match tv_opt with
+ | None -> simple_fail "untyped SELF"
+ | Some t -> ok @@ t
+
let implicit_account = typer_1 "IMPLICIT_ACCOUNT" @@ fun key_hash ->
let%bind () = assert_t_key_hash key_hash in
ok @@ t_contract (t_unit () ) ()
@@ -1228,6 +1235,7 @@ module Typer = struct
| C_SENDER -> ok @@ sender ;
| C_SOURCE -> ok @@ source ;
| C_ADDRESS -> ok @@ address ;
+ | C_SELF -> ok @@ self;
| C_SELF_ADDRESS -> ok @@ self_address;
| C_IMPLICIT_ACCOUNT -> ok @@ implicit_account;
| C_SET_DELEGATE -> ok @@ set_delegate ;
diff --git a/src/stages/ast_typed/combinators.ml b/src/stages/ast_typed/combinators.ml
index d1c0c4b1a..0a54bc708 100644
--- a/src/stages/ast_typed/combinators.ml
+++ b/src/stages/ast_typed/combinators.ml
@@ -233,6 +233,10 @@ let assert_t_bytes = fun t ->
let%bind _ = get_t_bytes t in
ok ()
+let assert_t_string = fun t ->
+ let%bind _ = get_t_string t in
+ ok ()
+
let assert_t_operation (t:type_expression) : unit result =
match t.type_content with
| T_constant (TC_operation) -> ok ()
diff --git a/src/stages/ast_typed/combinators.mli b/src/stages/ast_typed/combinators.mli
index 273fa15be..1b3f31aea 100644
--- a/src/stages/ast_typed/combinators.mli
+++ b/src/stages/ast_typed/combinators.mli
@@ -91,6 +91,7 @@ val is_t_bytes : type_expression -> bool
val is_t_int : type_expression -> bool
val assert_t_bytes : type_expression -> unit result
+val assert_t_string : type_expression -> unit result
(*
val assert_t_operation : type_expression -> unit result
*)
diff --git a/src/stages/common/PP.ml b/src/stages/common/PP.ml
index 14cde83d5..ee232f044 100644
--- a/src/stages/common/PP.ml
+++ b/src/stages/common/PP.ml
@@ -143,6 +143,7 @@ let constant ppf : constant' -> unit = function
| C_SOURCE -> fprintf ppf "SOURCE"
| C_SENDER -> fprintf ppf "SENDER"
| C_ADDRESS -> fprintf ppf "ADDRESS"
+ | C_SELF -> fprintf ppf "SELF"
| C_SELF_ADDRESS -> fprintf ppf "SELF_ADDRESS"
| C_IMPLICIT_ACCOUNT -> fprintf ppf "IMPLICIT_ACCOUNT"
| C_SET_DELEGATE -> fprintf ppf "SET_DELEGATE"
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/stages/common/types.ml b/src/stages/common/types.ml
index d6b0839fd..1eacb7f7c 100644
--- a/src/stages/common/types.ml
+++ b/src/stages/common/types.ml
@@ -285,6 +285,7 @@ and constant' =
| C_SOURCE
| C_SENDER
| C_ADDRESS
+ | C_SELF
| C_SELF_ADDRESS
| C_IMPLICIT_ACCOUNT
| C_SET_DELEGATE
diff --git a/src/stages/mini_c/PP.ml b/src/stages/mini_c/PP.ml
index bb0ff6476..7626081cc 100644
--- a/src/stages/mini_c/PP.ml
+++ b/src/stages/mini_c/PP.ml
@@ -237,6 +237,7 @@ and constant ppf : constant' -> unit = function
| C_SOURCE -> fprintf ppf "SOURCE"
| C_SENDER -> fprintf ppf "SENDER"
| C_ADDRESS -> fprintf ppf "ADDRESS"
+ | C_SELF -> fprintf ppf "SELF"
| C_SELF_ADDRESS -> fprintf ppf "SELF_ADDRESS"
| C_IMPLICIT_ACCOUNT -> fprintf ppf "IMPLICIT_ACCOUNT"
| C_SET_DELEGATE -> fprintf ppf "SET_DELEGATE"
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_bad_entrypoint_format.ligo b/src/test/contracts/negative/self_bad_entrypoint_format.ligo
new file mode 100644
index 000000000..ee22c4979
--- /dev/null
+++ b/src/test/contracts/negative/self_bad_entrypoint_format.ligo
@@ -0,0 +1,11 @@
+type parameter is Default | Toto of int
+type storage is nat
+type return is list (operation) * storage
+
+
+function main (const p : parameter; const s : storage) : return is
+ block {
+ const self_contract: contract(int) = Tezos.self("Toto") ;
+ const op : operation = Tezos.transaction (2, 300tz, self_contract) ;
+ }
+ with (list [op], s)
\ 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..375fbf0af
--- /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 ("%default");
+ }
+ 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..3bd607aa1
--- /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("%default") ;
+ }
+ with ((nil: list(operation)), s)
\ No newline at end of file
diff --git a/src/test/contracts/self_with_entrypoint.ligo b/src/test/contracts/self_with_entrypoint.ligo
new file mode 100644
index 000000000..aede1b5b5
--- /dev/null
+++ b/src/test/contracts/self_with_entrypoint.ligo
@@ -0,0 +1,12 @@
+type parameter is Default | Toto of int
+type storage is nat
+type return is list (operation) * storage
+
+
+function main (const p : parameter; const s : storage) : return is
+ block {
+ // const v : string = "%toto" ;
+ const self_contract: contract(int) = Tezos.self("%toto") ;
+ const op : operation = Tezos.transaction (2, 300tz, self_contract) ;
+ }
+ with (list [op], s)
\ No newline at end of file
diff --git a/src/test/contracts/self_without_entrypoint.ligo b/src/test/contracts/self_without_entrypoint.ligo
new file mode 100644
index 000000000..04701cf1d
--- /dev/null
+++ b/src/test/contracts/self_without_entrypoint.ligo
@@ -0,0 +1,11 @@
+type parameter is int
+type storage is nat
+type return is list (operation) * storage
+
+
+function main (const p : parameter; const s : storage) : return is
+ block {
+ const self_contract: contract(int) = Tezos.self("%default") ;
+ const op : operation = Tezos.transaction (2, 300tz, self_contract) ;
+ }
+ with (list [op], 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.
*)