Skip to content

Commit

Permalink
Browse tree: make pat_extra siblings of pattern nodes
Browse files Browse the repository at this point in the history
PR "Fix wrong type information for constructors under type coercions #1091"
did the same to expressions, but it turns out that we have the same
issue with pattern.

When doing type enclosing on `def` in:

        let def : float = float_of_int 3

The browse structure looks like:
[ core_type; core_type; pattern; value_binding; structure_item; structure ]

The two core types come from a `Tpat_constraint` which is misplaced
because of the typedtree representation.
  • Loading branch information
let-def committed Apr 3, 2020
1 parent f0b2f17 commit fd734f9
Show file tree
Hide file tree
Showing 13 changed files with 85 additions and 100 deletions.
17 changes: 9 additions & 8 deletions src/ocaml/merlin_specific/402/browse_raw.ml
Original file line number Diff line number Diff line change
Expand Up @@ -233,6 +233,7 @@ let option_fold f' o env (f : _ f0) acc = match o with
| Some x -> f' x env f acc

let of_core_type ct = app (Core_type ct)

let of_exp_extra (exp,_,_) = match exp with
| Texp_constraint ct ->
of_core_type ct
Expand All @@ -244,17 +245,18 @@ let of_exp_extra (exp,_,_) = match exp with
id_fold
let of_expression e = app (Expression e) **
list_fold of_exp_extra e.exp_extra

let of_pat_extra (pat,_,_) = match pat with
| Tpat_constraint ct -> of_core_type ct
| Tpat_type _ | Tpat_unpack -> id_fold
let of_pattern p = app (Pattern p) ** list_fold of_pat_extra p.pat_extra

let of_case c = app (Case c)
let of_pattern p = app (Pattern p)
let of_value_binding vb = app (Value_binding vb)
let of_module_type mt = app (Module_type mt)
let of_module_expr me = app (Module_expr me)
let of_typ_param (ct,_) = of_core_type ct

let of_pat_extra (pat,_,_) = match pat with
| Tpat_constraint ct -> of_core_type ct
| Tpat_type _ | Tpat_unpack -> id_fold

let of_record_field obj loc lbl =
fun env (f : _ f0) acc ->
app (Record_field (obj,lbl,loc)) env f acc
Expand Down Expand Up @@ -493,9 +495,8 @@ and of_class_type_field_desc = function

let of_node = function
| Dummy -> id_fold
| Pattern { pat_desc; pat_extra } ->
of_pattern_desc pat_desc **
list_fold of_pat_extra pat_extra
| Pattern { pat_desc; pat_extra=_ } ->
of_pattern_desc pat_desc
| Expression { exp_desc; exp_extra=_; exp_loc } ->
of_expression_desc exp_loc exp_desc
| Case { c_lhs; c_guard; c_rhs } ->
Expand Down
17 changes: 9 additions & 8 deletions src/ocaml/merlin_specific/403/browse_raw.ml
Original file line number Diff line number Diff line change
Expand Up @@ -233,6 +233,7 @@ let option_fold f' o env (f : _ f0) acc = match o with
| Some x -> f' x env f acc

let of_core_type ct = app (Core_type ct)

let of_exp_extra (exp,_,_) = match exp with
| Texp_constraint ct ->
of_core_type ct
Expand All @@ -244,8 +245,13 @@ let of_exp_extra (exp,_,_) = match exp with
id_fold
let of_expression e = app (Expression e) **
list_fold of_exp_extra e.exp_extra

let of_pat_extra (pat,_,_) = match pat with
| Tpat_constraint ct -> of_core_type ct
| Tpat_type _ | Tpat_unpack -> id_fold
let of_pattern p = app (Pattern p) ** list_fold of_pat_extra p.pat_extra

let of_case c = app (Case c)
let of_pattern p = app (Pattern p)
let of_label_declaration ct = app (Label_declaration ct)
let of_value_binding vb = app (Value_binding vb)
let of_module_type mt = app (Module_type mt)
Expand All @@ -255,10 +261,6 @@ let of_constructor_arguments = function
| Cstr_tuple cts -> list_fold of_core_type cts
| Cstr_record lbls -> list_fold of_label_declaration lbls

let of_pat_extra (pat,_,_) = match pat with
| Tpat_constraint ct -> of_core_type ct
| Tpat_type _ | Tpat_unpack -> id_fold

let of_record_field obj loc lbl =
fun env (f : _ f0) acc ->
app (Record_field (obj,lbl,loc)) env f acc
Expand Down Expand Up @@ -499,9 +501,8 @@ and of_class_type_field_desc = function

let of_node = function
| Dummy -> id_fold
| Pattern { pat_desc; pat_extra } ->
of_pattern_desc pat_desc **
list_fold of_pat_extra pat_extra
| Pattern { pat_desc; pat_extra=_ } ->
of_pattern_desc pat_desc
| Expression { exp_desc; exp_extra=_; exp_loc } ->
of_expression_desc exp_loc exp_desc
| Case { c_lhs; c_guard; c_rhs } ->
Expand Down
17 changes: 9 additions & 8 deletions src/ocaml/merlin_specific/404/browse_raw.ml
Original file line number Diff line number Diff line change
Expand Up @@ -240,6 +240,7 @@ let option_fold f' o env (f : _ f0) acc = match o with
| Some x -> f' x env f acc

let of_core_type ct = app (Core_type ct)

let of_exp_extra (exp,_,_) = match exp with
| Texp_constraint ct ->
of_core_type ct
Expand All @@ -251,8 +252,13 @@ let of_exp_extra (exp,_,_) = match exp with
id_fold
let of_expression e = app (Expression e) **
list_fold of_exp_extra e.exp_extra

let of_pat_extra (pat,_,_) = match pat with
| Tpat_constraint ct -> of_core_type ct
| Tpat_type _ | Tpat_unpack | Tpat_open _ -> id_fold
let of_pattern p = app (Pattern p) ** list_fold of_pat_extra p.pat_extra

let of_case c = app (Case c)
let of_pattern p = app (Pattern p)
let of_label_declaration ct = app (Label_declaration ct)
let of_value_binding vb = app (Value_binding vb)
let of_module_type mt = app (Module_type mt)
Expand All @@ -262,10 +268,6 @@ let of_constructor_arguments = function
| Cstr_tuple cts -> list_fold of_core_type cts
| Cstr_record lbls -> list_fold of_label_declaration lbls

let of_pat_extra (pat,_,_) = match pat with
| Tpat_constraint ct -> of_core_type ct
| Tpat_type _ | Tpat_unpack | Tpat_open _ -> id_fold

let of_record_field obj loc lbl =
fun env (f : _ f0) acc ->
app (Record_field (obj,lbl,loc)) env f acc
Expand Down Expand Up @@ -512,9 +514,8 @@ and of_class_type_field_desc = function

let of_node = function
| Dummy -> id_fold
| Pattern { pat_desc; pat_extra } ->
of_pattern_desc pat_desc **
list_fold of_pat_extra pat_extra
| Pattern { pat_desc; pat_extra=_ } ->
of_pattern_desc pat_desc
| Expression { exp_desc; exp_extra=_; exp_loc } ->
of_expression_desc exp_loc exp_desc
| Case { c_lhs; c_guard; c_rhs } ->
Expand Down
17 changes: 9 additions & 8 deletions src/ocaml/merlin_specific/405/browse_raw.ml
Original file line number Diff line number Diff line change
Expand Up @@ -240,6 +240,7 @@ let option_fold f' o env (f : _ f0) acc = match o with
| Some x -> f' x env f acc

let of_core_type ct = app (Core_type ct)

let of_exp_extra (exp,_,_) = match exp with
| Texp_constraint ct ->
of_core_type ct
Expand All @@ -251,8 +252,13 @@ let of_exp_extra (exp,_,_) = match exp with
id_fold
let of_expression e = app (Expression e) **
list_fold of_exp_extra e.exp_extra

let of_pat_extra (pat,_,_) = match pat with
| Tpat_constraint ct -> of_core_type ct
| Tpat_type _ | Tpat_unpack | Tpat_open _ -> id_fold
let of_pattern p = app (Pattern p) ** list_fold of_pat_extra p.pat_extra

let of_case c = app (Case c)
let of_pattern p = app (Pattern p)
let of_label_declaration ct = app (Label_declaration ct)
let of_value_binding vb = app (Value_binding vb)
let of_module_type mt = app (Module_type mt)
Expand All @@ -262,10 +268,6 @@ let of_constructor_arguments = function
| Cstr_tuple cts -> list_fold of_core_type cts
| Cstr_record lbls -> list_fold of_label_declaration lbls

let of_pat_extra (pat,_,_) = match pat with
| Tpat_constraint ct -> of_core_type ct
| Tpat_type _ | Tpat_unpack | Tpat_open _ -> id_fold

let of_record_field obj loc lbl =
fun env (f : _ f0) acc ->
app (Record_field (obj,lbl,loc)) env f acc
Expand Down Expand Up @@ -512,9 +514,8 @@ and of_class_type_field_desc = function

let of_node = function
| Dummy -> id_fold
| Pattern { pat_desc; pat_extra } ->
of_pattern_desc pat_desc **
list_fold of_pat_extra pat_extra
| Pattern { pat_desc; pat_extra=_ } ->
of_pattern_desc pat_desc
| Expression { exp_desc; exp_extra=_; exp_loc } ->
of_expression_desc exp_loc exp_desc
| Case { c_lhs; c_guard; c_rhs } ->
Expand Down
17 changes: 9 additions & 8 deletions src/ocaml/merlin_specific/406/browse_raw.ml
Original file line number Diff line number Diff line change
Expand Up @@ -240,6 +240,7 @@ let option_fold f' o env (f : _ f0) acc = match o with
| Some x -> f' x env f acc

let of_core_type ct = app (Core_type ct)

let of_exp_extra (exp,_,_) = match exp with
| Texp_constraint ct ->
of_core_type ct
Expand All @@ -251,8 +252,13 @@ let of_exp_extra (exp,_,_) = match exp with
id_fold
let of_expression e = app (Expression e) **
list_fold of_exp_extra e.exp_extra

let of_pat_extra (pat,_,_) = match pat with
| Tpat_constraint ct -> of_core_type ct
| Tpat_type _ | Tpat_unpack | Tpat_open _ -> id_fold
let of_pattern p = app (Pattern p) ** list_fold of_pat_extra p.pat_extra

let of_case c = app (Case c)
let of_pattern p = app (Pattern p)
let of_label_declaration ct = app (Label_declaration ct)
let of_value_binding vb = app (Value_binding vb)
let of_module_type mt = app (Module_type mt)
Expand All @@ -262,10 +268,6 @@ let of_constructor_arguments = function
| Cstr_tuple cts -> list_fold of_core_type cts
| Cstr_record lbls -> list_fold of_label_declaration lbls

let of_pat_extra (pat,_,_) = match pat with
| Tpat_constraint ct -> of_core_type ct
| Tpat_type _ | Tpat_unpack | Tpat_open _ -> id_fold

let of_record_field obj loc lbl =
fun env (f : _ f0) acc ->
app (Record_field (obj,lbl,loc)) env f acc
Expand Down Expand Up @@ -516,9 +518,8 @@ and of_class_type_field_desc = function

let of_node = function
| Dummy -> id_fold
| Pattern { pat_desc; pat_extra } ->
of_pattern_desc pat_desc **
list_fold of_pat_extra pat_extra
| Pattern { pat_desc; pat_extra=_ } ->
of_pattern_desc pat_desc
| Expression { exp_desc; exp_extra=_; exp_loc } ->
of_expression_desc exp_loc exp_desc
| Case { c_lhs; c_guard; c_rhs } ->
Expand Down
17 changes: 9 additions & 8 deletions src/ocaml/merlin_specific/407/browse_raw.ml
Original file line number Diff line number Diff line change
Expand Up @@ -240,6 +240,7 @@ let option_fold f' o env (f : _ f0) acc = match o with
| Some x -> f' x env f acc

let of_core_type ct = app (Core_type ct)

let of_exp_extra (exp,_,_) = match exp with
| Texp_constraint ct ->
of_core_type ct
Expand All @@ -251,8 +252,13 @@ let of_exp_extra (exp,_,_) = match exp with
id_fold
let of_expression e = app (Expression e) **
list_fold of_exp_extra e.exp_extra

let of_pat_extra (pat,_,_) = match pat with
| Tpat_constraint ct -> of_core_type ct
| Tpat_type _ | Tpat_unpack | Tpat_open _ -> id_fold
let of_pattern p = app (Pattern p) ** list_fold of_pat_extra p.pat_extra

let of_case c = app (Case c)
let of_pattern p = app (Pattern p)
let of_label_declaration ct = app (Label_declaration ct)
let of_value_binding vb = app (Value_binding vb)
let of_module_type mt = app (Module_type mt)
Expand All @@ -262,10 +268,6 @@ let of_constructor_arguments = function
| Cstr_tuple cts -> list_fold of_core_type cts
| Cstr_record lbls -> list_fold of_label_declaration lbls

let of_pat_extra (pat,_,_) = match pat with
| Tpat_constraint ct -> of_core_type ct
| Tpat_type _ | Tpat_unpack | Tpat_open _ -> id_fold

let of_record_field obj loc lbl =
fun env (f : _ f0) acc ->
app (Record_field (obj,lbl,loc)) env f acc
Expand Down Expand Up @@ -516,9 +518,8 @@ and of_class_type_field_desc = function

let of_node = function
| Dummy -> id_fold
| Pattern { pat_desc; pat_extra } ->
of_pattern_desc pat_desc **
list_fold of_pat_extra pat_extra
| Pattern { pat_desc; pat_extra=_ } ->
of_pattern_desc pat_desc
| Expression { exp_desc; exp_extra=_; exp_loc } ->
of_expression_desc exp_loc exp_desc
| Case { c_lhs; c_guard; c_rhs } ->
Expand Down
17 changes: 9 additions & 8 deletions src/ocaml/merlin_specific/408/browse_raw.ml
Original file line number Diff line number Diff line change
Expand Up @@ -241,6 +241,7 @@ let option_fold f' o env (f : _ f0) acc = match o with
| Some x -> f' x env f acc

let of_core_type ct = app (Core_type ct)

let of_exp_extra (exp,_,_) = match exp with
| Texp_constraint ct ->
of_core_type ct
Expand All @@ -252,8 +253,13 @@ let of_exp_extra (exp,_,_) = match exp with
id_fold
let of_expression e = app (Expression e) **
list_fold of_exp_extra e.exp_extra

let of_pat_extra (pat,_,_) = match pat with
| Tpat_constraint ct -> of_core_type ct
| Tpat_type _ | Tpat_unpack | Tpat_open _ -> id_fold
let of_pattern p = app (Pattern p) ** list_fold of_pat_extra p.pat_extra

let of_case c = app (Case c)
let of_pattern p = app (Pattern p)
let of_label_declaration ct = app (Label_declaration ct)
let of_value_binding vb = app (Value_binding vb)
let of_module_type mt = app (Module_type mt)
Expand All @@ -266,10 +272,6 @@ let of_constructor_arguments = function
let of_bop { bop_op_path = _; bop_op_val = _; bop_exp; _ } =
of_expression bop_exp

let of_pat_extra (pat,_,_) = match pat with
| Tpat_constraint ct -> of_core_type ct
| Tpat_type _ | Tpat_unpack | Tpat_open _ -> id_fold

let of_record_field obj loc lbl =
fun env (f : _ f0) acc ->
app (Record_field (obj,lbl,loc)) env f acc
Expand Down Expand Up @@ -537,9 +539,8 @@ and of_class_type_field_desc = function

let of_node = function
| Dummy -> id_fold
| Pattern { pat_desc; pat_extra } ->
of_pattern_desc pat_desc **
list_fold of_pat_extra pat_extra
| Pattern { pat_desc; pat_extra=_ } ->
of_pattern_desc pat_desc
| Expression { exp_desc; exp_extra=_; exp_loc } ->
of_expression_desc exp_loc exp_desc
| Case { c_lhs; c_guard; c_rhs } ->
Expand Down
17 changes: 9 additions & 8 deletions src/ocaml/merlin_specific/409/browse_raw.ml
Original file line number Diff line number Diff line change
Expand Up @@ -241,6 +241,7 @@ let option_fold f' o env (f : _ f0) acc = match o with
| Some x -> f' x env f acc

let of_core_type ct = app (Core_type ct)

let of_exp_extra (exp,_,_) = match exp with
| Texp_constraint ct ->
of_core_type ct
Expand All @@ -252,8 +253,13 @@ let of_exp_extra (exp,_,_) = match exp with
id_fold
let of_expression e = app (Expression e) **
list_fold of_exp_extra e.exp_extra

let of_pat_extra (pat,_,_) = match pat with
| Tpat_constraint ct -> of_core_type ct
| Tpat_type _ | Tpat_unpack | Tpat_open _ -> id_fold
let of_pattern p = app (Pattern p) ** list_fold of_pat_extra p.pat_extra

let of_case c = app (Case c)
let of_pattern p = app (Pattern p)
let of_label_declaration ct = app (Label_declaration ct)
let of_value_binding vb = app (Value_binding vb)
let of_module_type mt = app (Module_type mt)
Expand All @@ -266,10 +272,6 @@ let of_constructor_arguments = function
let of_bop { bop_op_path = _; bop_op_val = _; bop_exp; _ } =
of_expression bop_exp

let of_pat_extra (pat,_,_) = match pat with
| Tpat_constraint ct -> of_core_type ct
| Tpat_type _ | Tpat_unpack | Tpat_open _ -> id_fold

let of_record_field obj loc lbl =
fun env (f : _ f0) acc ->
app (Record_field (obj,lbl,loc)) env f acc
Expand Down Expand Up @@ -537,9 +539,8 @@ and of_class_type_field_desc = function

let of_node = function
| Dummy -> id_fold
| Pattern { pat_desc; pat_extra } ->
of_pattern_desc pat_desc **
list_fold of_pat_extra pat_extra
| Pattern { pat_desc; pat_extra=_ } ->
of_pattern_desc pat_desc
| Expression { exp_desc; exp_extra=_; exp_loc } ->
of_expression_desc exp_loc exp_desc
| Case { c_lhs; c_guard; c_rhs } ->
Expand Down
Loading

0 comments on commit fd734f9

Please sign in to comment.