Merge branch 'feature/self' into 'dev'

[LIGO-502] add self & make sure it it typechecked against the main function

See merge request ligolang/ligo!453

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
 

gitlab-pages/docs/reference/current.md

@@ -321,6 +321,37 @@ let main = (p : unit) : address => Tezos.self_address;
 
 </Syntax>
 
+## 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"
+
+<Syntax syntax="pascaligo">
+
+```pascaligo
+function main (const p : unit) : contract(unit) is block {
+  const c : contract(unit) = Tezos.self("%Default") ;
+} with c
+```
+
+</Syntax>
+<Syntax syntax="cameligo">
+
+```cameligo
+let main (p : unit) : unit contract =
+  (Tezos.self("%Default") : unit contract)
+```
+
+</Syntax>
+<Syntax syntax="reasonligo">
+
+```reasonligo
+let main = (p: unit) : contract(unit) =>
+  (Tezos.self("%Default") : contract(unit));
+```
+
+</Syntax>
 
 ## Implicit Account
 

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

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' |}]

src/main/compile/dune

@@ -9,6 +9,7 @@
     interpreter
     ast_simplified
     self_ast_simplified
+    self_ast_typed
     typer_new
     typer
     ast_typed

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

src/main/compile/wrapper.ml

@@ -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

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)

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 ))
+)

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")

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

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

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 *)
@@ -80,6 +79,7 @@ module Simplify = struct
     | "sender"                 -> ok C_SENDER              (* Deprecated *)
     | "Tezos.address"          -> ok C_ADDRESS
     | "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 ;

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 ()

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
 *)

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"

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"

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

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

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"

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) =

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

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)

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")

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)

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 main (ps: unit * address): (operation list * address) =
-  let dummy = foo () in
+  let dummy = foo () in (* force not to inline foo *)
-  ([] : operation list), foo ()
+  ( ([] : operation list) , foo ())

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)

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)

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)

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)

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"
+  then (failwith "This contract always fails" : operation list * unit)
-  else failwith "This contract still always fails"
+  else (failwith "This contract still always fails" : operation list * unit)

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) =

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) =

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
 

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)

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 =

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) =

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) =

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) =

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) =

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) =

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 =

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.
 *)