self operator now takes an entrypoint annotation as parameter

src/bin/expect_tests/contract_tests.ml

@@ -1222,7 +1222,7 @@ ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, char
 let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; bad_contract "self_type_annotation.ligo" ; "main" ] ;
   [%expect {|
-    ligo: in file "self_type_annotation.ligo", line 8, characters 41-51. bad self type: expected (TO_Contract (int)) but got (TO_Contract (nat)) {"location":"in file \"self_type_annotation.ligo\", line 8, characters 41-51"}
+    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
@@ -1237,7 +1237,13 @@ let%expect_test _ =
   [%expect {|
     { parameter nat ;
       storage int ;
-      code { DUP ; SELF ; SWAP ; CDR ; NIL operation ; PAIR ; DIP { DROP 2 } } } |}]
+      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" ] ;
@@ -1271,6 +1277,54 @@ let%expect_test _ =
     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","hint":"try %Toto"}
+
+
      If you're not sure how to fix this error, you can
      do one of the following:
 

src/passes/5-self_ast_typed/contract_passes.ml

@@ -7,6 +7,17 @@ type contract_pass_data = {
 }
 
 module Errors = struct
+  let corner_case loc message =
+    let title () = "corner case" in
+    let content () = "we don't have a good error message for this case. we are
+striving find ways to better report them and find the use-cases that generate
+them. please report this to the developers." in
+    let data = [
+      ("location" , fun () -> loc) ;
+      ("message" , fun () -> message) ;
+    ] in
+    error ~data title content
+  
   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
@@ -15,8 +26,23 @@ module Errors = struct
     ] 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) ;
+      ("hint" , fun () -> Format.asprintf "try %%%s" ep)
+    ] in
+    error ~data title message ()
+
 end
 
+let check_entrypoint_annotation_format ep exp =
+  match String.split_on_char '%' ep with
+    | [ "" ; ep'] -> ok @@ ep'
+    | _ -> 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 
@@ -24,11 +50,27 @@ let self_typing : contract_pass_data -> expression -> (bool * contract_pass_data
     e.location
   in
   match e.expression_content , e.type_expression with
-  | E_constant {cons_name=C_SELF ; arguments=[]}, {type_content = T_operator (TC_contract t) ; type_meta=_} ->
+  | 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
+        | E_variable v -> (
+          match Ast_typed.Environment.get_opt v e.environment with
+          | Some {type_value = _; source_environment = _ ; definition = ED_declaration {expr ; free_variables = _}} -> (
+            match expr.expression_content with
+              | E_literal (Literal_string ep) -> check_entrypoint_annotation_format ep entrypoint_exp
+              | _ -> fail @@ Errors.corner_case __LOC__ "SELF argument do not resolve to a string"
+          )
+          | _ -> fail @@ Errors.corner_case __LOC__ "SELD argument not found in the environment"
+        )
+        | _ -> fail @@ Errors.corner_case __LOC__ "SELF argument is not a string or a variable" in
+    let%bind entrypoint_t = match dat.contract_type.parameter.type_content with
+      | T_sum cmap -> trace_option (simple_error "No constructor matches the entrypoint annotation")
+                      @@ 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 (dat.contract_type.parameter,t) in
+      Ast_typed.assert_type_expression_eq (entrypoint_t , t) in
     ok (true, dat, e)
-  | E_constant {cons_name=C_SELF ; arguments=[]}, {type_content=_ ; type_meta=_} ->
+  | E_constant {cons_name=C_SELF ; arguments=[_]}, {type_content=_ ; type_meta=_} ->
     fail (bad_self_err ())
   | _ -> ok (true,dat,e)

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

@@ -792,7 +792,8 @@ module Typer = struct
   let self_address = typer_0 "SELF_ADDRESS" @@ fun _ ->
     ok @@ t_address ()
 
-  let self = typer_0 "SELF" @@ fun tv_opt ->
+  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
@@ -1310,7 +1311,6 @@ module Compiler = struct
     | C_AMOUNT          -> ok @@ simple_constant @@ prim I_AMOUNT
     | C_ADDRESS         -> ok @@ simple_unary @@ prim I_ADDRESS
     | C_SELF_ADDRESS    -> ok @@ simple_constant @@ seq [prim I_SELF; prim I_ADDRESS]
-    | C_SELF            -> ok @@ simple_constant @@ seq [prim I_SELF]
     | C_IMPLICIT_ACCOUNT -> ok @@ simple_unary @@ prim I_IMPLICIT_ACCOUNT
     | C_SET_DELEGATE    -> ok @@ simple_unary @@ prim I_SET_DELEGATE
     | C_NOW             -> ok @@ simple_constant @@ prim I_NOW

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/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_type_annotation.ligo

@@ -5,6 +5,6 @@ type return is list (operation) * storage
 
 function main (const p : parameter; const s : storage) : return is
   block {
-    const self_contract: contract(int) = Tezos.self;
+    const self_contract: contract(int) = Tezos.self ("%Default");
   }
   with ((nil: list(operation)), s)

src/test/contracts/self_type_annotation.ligo

@@ -5,6 +5,6 @@ type return is list (operation) * storage
 
 function main (const p : parameter; const s : storage) : return is
   block {
-    const self_contract: contract(parameter) = Tezos.self ;
+    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(v) ;
+    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)