ignore generated variables

src/bin/expect_tests/get_scope.ml

@@ -86,20 +86,19 @@ let%expect_test _ =
   run_ligo_good [ "get-scope" ; gs "rec.mligo" ; "--format=dev" ] ;
   [%expect {|
     Scopes:
-    [ k5 j4 i3 generated2 c1 a0 ] in file "rec.mligo", line 6, characters 4-11
+    [ k4 j3 i2 c1 a0 ] in file "rec.mligo", line 6, characters 4-11
-    [ j4 i3 generated2 c1 a0 ] in file "rec.mligo", line 5, character 4 to line 6, character 11
+    [ j3 i2 c1 a0 ] in file "rec.mligo", line 5, character 4 to line 6, character 11
-    [ i3 generated2 c1 a0 ] in file "rec.mligo", line 4, characters 36-49
+    [ i2 c1 a0 ] in file "rec.mligo", line 4, characters 36-49
-    [ generated2 c1 a0 ] in file "rec.mligo", line 4, characters 36-49
+    [ c1 a0 ] in file "rec.mligo", line 4, characters 36-49
     [ c1 a0 ]
     [ ] in file "rec.mligo", line 1, characters 0-9
 
     Variable definitions:
-    (k5 -> k) in file "rec.mligo", line 5, characters 12-21
+    (k4 -> k) in file "rec.mligo", line 5, characters 12-21
-    (j4 -> j)
+    (j3 -> j)
-    (i3 -> i)
+    (i2 -> i)
-    (generated2 -> generated) in file "rec.mligo", line 4, characters 36-49
     (c1 -> c) in file "rec.mligo", line 4, character 2 to line 8, character 9
-    (b6 -> b) in file "rec.mligo", line 3, character 0 to line 8, character 9
+    (b5 -> b) in file "rec.mligo", line 3, character 0 to line 8, character 9
     (a0 -> a) in file "rec.mligo", line 1, characters 0-9
     Type definitions: |} ] ;
 

src/main/scopes/misc.ml

@@ -2,25 +2,30 @@ open Trace
 open Types
 
 let get_binder_name : 'a Var.t -> string = fun (v: _ Var.t) ->
-  try Var.to_name v with _ -> "generated"
+  if Var.is_generated v
+  then "generated"
+  else Var.to_name v
 
 let make_def_id name i =
   (name ^ (string_of_int i), i+1)
 
 let add_shadowing_def : (int * _ Var.t) -> def -> def_map -> (int * def_map) =  fun (i,var) def env -> 
-  let name = get_binder_name var in
+  if Var.is_generated var then (i,env)
-  let (definition_id,i) = make_def_id name i in
+  else
-  let shadow = Def_map.filter
+    let name = get_binder_name var in
-    (fun _ s_def -> match def, s_def with
+    let (definition_id,i) = make_def_id name i in
-      | Variable _ , Variable _ | Type _ , Type _ ->
+    let shadow = Def_map.filter
-        not @@ String.equal (get_def_name s_def) name
+      (fun _ s_def -> match def, s_def with
-      | _ -> true )
+        | Variable _ , Variable _ | Type _ , Type _ ->
-    env in
+          not @@ String.equal (get_def_name s_def) name
-  let env = Def_map.add definition_id def shadow in
+        | _ -> true )
-  (i,env)
+      env in
+    let env = Def_map.add definition_id def shadow in
+    (i,env)
 
-let make_v_def_from_core : with_types:bool -> string -> string -> string -> Ast_core.expression -> Location.t -> Location.t -> def =
+let make_v_def_from_core : with_types:bool -> string -> string -> ('a Var.t) -> Ast_core.expression -> Location.t -> Location.t -> def =
   fun ~with_types source_file syntax name exp range body_range ->
+    let name = get_binder_name name in
     let t = to_option @@
       let%bind typed_prg,state = Compile.Utils.type_file source_file syntax Env in
       let env = Ast_typed.program_environment Environment.default typed_prg in
@@ -31,8 +36,9 @@ let make_v_def_from_core : with_types:bool -> string -> string -> string -> Ast_
                 otherwise nothing will be typed if an error occurs later in the file *)
     make_v_def ~with_types name t range body_range
 
-let make_v_def_option_type : with_types:bool -> string -> string -> string -> Ast_core.type_expression option -> Location.t -> Location.t -> def =
+let make_v_def_option_type : with_types:bool -> string -> string -> ('a Var.t) -> Ast_core.type_expression option -> Location.t -> Location.t -> def =
   fun ~with_types source_file syntax name maybe_typed range body_range ->
+    let name = get_binder_name name in
     match maybe_typed with
     | Some t ->
       let t' = to_option @@
@@ -43,9 +49,10 @@ let make_v_def_option_type : with_types:bool -> string -> string -> string -> As
     | None -> make_v_def ~with_types name None range body_range
 
 let make_v_def_ppx_type : 
-  with_types:bool -> string -> string -> string -> (Ast_typed.type_expression -> Ast_typed.type_expression) ->
+  with_types:bool -> string -> string -> ('a Var.t) -> (Ast_typed.type_expression -> Ast_typed.type_expression) ->
   Ast_core.expression -> Location.t -> Location.t -> def =
   fun ~with_types source_file syntax name f exp range body_range ->
+    let name = get_binder_name name in
     let t = to_option @@
       let%bind typed_prg,state = Compile.Utils.type_file source_file syntax Env in
       let env = Ast_typed.program_environment Environment.default typed_prg in

src/main/scopes/scopes.ml

@@ -11,26 +11,26 @@ let scopes : with_types:bool -> string -> string -> ((def_map * scopes), Main_er
 
   let rec find_scopes' = fun (i,all_defs,env,scopes,lastloc) (e : Ast_core.expression) ->
     match e.content with
-    | E_let_in { let_binder = (n,_) ; rhs ; let_result } -> (
+    | E_let_in { let_binder = (fn,_) ; rhs ; let_result } -> (
       match rhs.content with
       | E_recursive { fun_name ;  fun_type ; lambda = { result;_ } } -> (
         (* Note:
             It is not entirely true that 'fun_name' is in 'result' scope; because only tail calls are allowed
         *)
-        let def = make_v_def_option_type (get_binder_name fun_name) (Some fun_type) e.location e.location in
+        let def = make_v_def_option_type fun_name (Some fun_type) e.location e.location in
         let (i,env) = add_shadowing_def (i,fun_name) def env in
         find_scopes' (i,all_defs,env,scopes,result.location) result
       )
       | _ -> (
         (*TODO : n needs location and should be  used bellow in union with rhs *)
         let (i,all_defs,_, scopes) = find_scopes' (i,all_defs,env,scopes,e.location) rhs in
-        let (i,env) = add_shadowing_def (i,n) (make_v_def_from_core (get_binder_name n) rhs rhs.location rhs.location) env in
+        let (i,env) = add_shadowing_def (i,fn) (make_v_def_from_core fn rhs rhs.location rhs.location) env in
         let all_defs = merge_defs env all_defs in
         find_scopes' (i,all_defs,env,scopes,let_result.location) let_result
       )
     )
     | E_lambda { binder ; input_type ; output_type = _ ; result } -> (
-      let (i,env) = add_shadowing_def (i,binder) (make_v_def_option_type (get_binder_name binder) input_type result.location result.location) env in
+      let (i,env) = add_shadowing_def (i,binder) (make_v_def_option_type binder input_type result.location result.location) env in
       let all_defs = merge_defs env all_defs in
       find_scopes' (i,all_defs,env,scopes,result.location) result
     )
@@ -45,8 +45,8 @@ let scopes : with_types:bool -> string -> string -> ((def_map * scopes), Main_er
         let list_f = fun (t:Ast_typed.type_expression) -> match Ast_typed.get_t_list t with
           | None -> failwith "Could not get the type of a list"
           | Some t -> t in
-        let hd_def = make_v_def_ppx_type (get_binder_name hd) list_f matchee match_cons.location match_cons.location in
+        let hd_def = make_v_def_ppx_type hd list_f matchee match_cons.location match_cons.location in
-        let tl_def = make_v_def_from_core (get_binder_name tl) matchee match_cons.location match_cons.location in
+        let tl_def = make_v_def_from_core tl matchee match_cons.location match_cons.location in
 
         let (i,env) = add_shadowing_def (i,hd) hd_def env in
         let (i,env) = add_shadowing_def (i,tl) tl_def env in
@@ -60,7 +60,7 @@ let scopes : with_types:bool -> string -> string -> ((def_map * scopes), Main_er
         let all_defs = merge_defs env all_defs in
         (* TODO some needs location and should be used bellow instead of match_some .. *)
 
-        let tl_def = make_v_def_from_core (get_binder_name some) matchee match_some.location match_some.location in
+        let tl_def = make_v_def_from_core some matchee match_some.location match_some.location in
         let (i,env) = add_shadowing_def (i,some) tl_def env in
 
         let (i,all_defs,_,scopes) = find_scopes' (i,all_defs,env,scopes,match_some.location) match_some in
@@ -74,7 +74,7 @@ let scopes : with_types:bool -> string -> string -> ((def_map * scopes), Main_er
             | None -> failwith "Could not get the inner type of a constructor" in
 
           (* TODO proj needs location and should be used bellow instead of match_variant .. *)
-          let proj_def = make_v_def_ppx_type (get_binder_name proj) proj_f matchee match_variant.location match_variant.location in
+          let proj_def = make_v_def_ppx_type proj proj_f matchee match_variant.location match_variant.location in
           let (i,env) = add_shadowing_def (i,proj) proj_def env in
           let (i,all_defs,_,scopes) = find_scopes' (i,all_defs,env,scopes,match_variant.location) match_variant in
           let all_defs = merge_defs env all_defs in
@@ -97,7 +97,7 @@ let scopes : with_types:bool -> string -> string -> ((def_map * scopes), Main_er
     match x.wrap_content with
     | Declaration_constant (v , _o , _i, e) ->
       let (i,inner_def_map,scopes) = find_scopes (i,top_def_map,scopes,x.location) e in
-      let def = make_v_def_from_core (get_binder_name v) e x.location e.location in
+      let def = make_v_def_from_core v e x.location e.location in
       let (i,top_def_map) = add_shadowing_def (i,v) def top_def_map in
       ( i, top_def_map, inner_def_map, scopes )
 

vendors/ligo-utils/simple-utils/var.ml

@@ -49,3 +49,8 @@ let fresh_like v =
   fresh ~name:v.name ()
 
 let debug v = match v.counter with Some c -> Printf.sprintf "%s(%d)" v.name c | None -> Printf.sprintf "%s(None)" v.name
+
+let is_generated var =
+  match var.counter with
+  | None -> false
+  | Some _ -> true

vendors/ligo-utils/simple-utils/var.mli

@@ -45,3 +45,5 @@ val fresh_like : 'a t -> 'b t
 val reset_counter : unit -> unit
 
 val debug : 'a t -> string
+
+val is_generated : 'a t -> bool