ignore generated variables

This commit is contained in:
Lesenechal Remi 2020-06-30 13:15:07 +02:00
parent 4026411e10
commit 8a551114c3
5 changed files with 45 additions and 32 deletions

View File

@ -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
[ j4 i3 generated2 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
[ generated2 c1 a0 ] in file "rec.mligo", line 4, characters 36-49
[ k4 j3 i2 c1 a0 ] in file "rec.mligo", line 6, characters 4-11
[ j3 i2 c1 a0 ] in file "rec.mligo", line 5, character 4 to line 6, character 11
[ i2 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
(j4 -> j)
(i3 -> i)
(generated2 -> generated) in file "rec.mligo", line 4, characters 36-49
(k4 -> k) in file "rec.mligo", line 5, characters 12-21
(j3 -> j)
(i2 -> i)
(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: |} ] ;

View File

@ -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
let (definition_id,i) = make_def_id name i in
let shadow = Def_map.filter
(fun _ s_def -> match def, s_def with
| Variable _ , Variable _ | Type _ , Type _ ->
not @@ String.equal (get_def_name s_def) name
| _ -> true )
env in
let env = Def_map.add definition_id def shadow in
(i,env)
if Var.is_generated var then (i,env)
else
let name = get_binder_name var in
let (definition_id,i) = make_def_id name i in
let shadow = Def_map.filter
(fun _ s_def -> match def, s_def with
| Variable _ , Variable _ | Type _ , Type _ ->
not @@ String.equal (get_def_name s_def) name
| _ -> true )
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

View File

@ -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 tl_def = make_v_def_from_core (get_binder_name tl) 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 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 )

View File

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

View File

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