@@ -90,126 +90,126 @@ let app_exp_mapper
90
90
| Some {op; loc} ->
91
91
Location. raise_errorf ~loc " %s expect f%sproperty arg0 arg2 form" op op
92
92
| None ->
93
- match view_as_app e infix_ops with
94
- | Some { op = "|." ; args = [obj_arg; fn];loc} ->
93
+ match view_as_app e infix_ops with
94
+ | Some { op = "|." ; args = [obj_arg; fn];loc} ->
95
95
(*
96
96
a |. f
97
97
a |. f b c [@bs] --> f a b c [@bs]
98
98
a |. M.(f b c) --> M.f a M.b M.c
99
99
a |. (g |. b)
100
100
a |. M.Some
101
101
*)
102
- let new_obj_arg = self.expr self obj_arg in
103
- let fn = self.expr self fn in
104
- begin match fn with
105
- | {pexp_desc = Pexp_apply (fn , args ); pexp_loc; pexp_attributes} ->
106
- Bs_ast_invariant. warn_discarded_unused_attributes pexp_attributes;
107
- { pexp_desc = Pexp_apply (fn, (Ast_compatible. no_label, new_obj_arg) :: args);
108
- pexp_attributes = [] ;
109
- pexp_loc = pexp_loc}
110
- | {pexp_desc = Pexp_construct (ctor ,None); pexp_loc; pexp_attributes} ->
111
- {fn with pexp_desc = Pexp_construct (ctor, Some new_obj_arg)}
112
- | _ ->
113
- begin match Ast_open_cxt. destruct fn [] with
114
- | {pexp_desc = Pexp_tuple xs ; pexp_attributes = tuple_attrs } , wholes ->
115
- Ast_open_cxt. restore_exp (bound new_obj_arg (fun bounded_obj_arg ->
116
- {
117
- pexp_desc =
118
- Pexp_tuple (
119
- Ext_list. map xs (fun fn ->
120
- match fn with
121
- | {pexp_desc = Pexp_apply (fn,args); pexp_loc; pexp_attributes }
122
- ->
123
- Bs_ast_invariant. warn_discarded_unused_attributes pexp_attributes;
124
- { Parsetree. pexp_desc = Pexp_apply (fn, (Ast_compatible. no_label, bounded_obj_arg) :: args);
125
- pexp_attributes = [] ;
126
- pexp_loc = pexp_loc}
127
- | {pexp_desc = Pexp_construct (ctor,None ); pexp_loc; pexp_attributes}
128
- ->
129
- {fn with pexp_desc = Pexp_construct (ctor, Some bounded_obj_arg)}
130
- | _ ->
131
- Ast_compatible. app1 ~loc: fn.pexp_loc fn bounded_obj_arg
132
- ));
133
- pexp_attributes = tuple_attrs;
134
- pexp_loc = fn.pexp_loc;
135
- })) wholes
136
- | {pexp_desc = Pexp_apply (e , args ); pexp_attributes} , (_ :: _ as wholes ) ->
137
- let fn = Ast_open_cxt. restore_exp e wholes in
138
- let args = Ext_list. map args (fun (lab ,exp ) -> lab, Ast_open_cxt. restore_exp exp wholes) in
139
- Bs_ast_invariant. warn_discarded_unused_attributes pexp_attributes;
140
- { pexp_desc = Pexp_apply (fn, (Ast_compatible. no_label, new_obj_arg) :: args);
141
- pexp_attributes = [] ;
142
- pexp_loc = loc}
143
- | _ -> Ast_compatible. app1 ~loc fn new_obj_arg
102
+ let new_obj_arg = self.expr self obj_arg in
103
+ let fn = self.expr self fn in
104
+ begin match fn with
105
+ | {pexp_desc = Pexp_apply (fn , args ); pexp_loc; pexp_attributes} ->
106
+ Bs_ast_invariant. warn_discarded_unused_attributes pexp_attributes;
107
+ { pexp_desc = Pexp_apply (fn, (Ast_compatible. no_label, new_obj_arg) :: args);
108
+ pexp_attributes = [] ;
109
+ pexp_loc = pexp_loc}
110
+ | {pexp_desc = Pexp_construct (ctor ,None); pexp_loc; pexp_attributes} ->
111
+ {fn with pexp_desc = Pexp_construct (ctor, Some new_obj_arg)}
112
+ | _ ->
113
+ begin match Ast_open_cxt. destruct fn [] with
114
+ | {pexp_desc = Pexp_tuple xs ; pexp_attributes = tuple_attrs } , wholes ->
115
+ Ast_open_cxt. restore_exp (bound new_obj_arg (fun bounded_obj_arg ->
116
+ {
117
+ pexp_desc =
118
+ Pexp_tuple (
119
+ Ext_list. map xs (fun fn ->
120
+ match fn with
121
+ | {pexp_desc = Pexp_apply (fn,args); pexp_loc; pexp_attributes }
122
+ ->
123
+ Bs_ast_invariant. warn_discarded_unused_attributes pexp_attributes;
124
+ { Parsetree. pexp_desc = Pexp_apply (fn, (Ast_compatible. no_label, bounded_obj_arg) :: args);
125
+ pexp_attributes = [] ;
126
+ pexp_loc = pexp_loc}
127
+ | {pexp_desc = Pexp_construct (ctor,None ); pexp_loc; pexp_attributes}
128
+ ->
129
+ {fn with pexp_desc = Pexp_construct (ctor, Some bounded_obj_arg)}
130
+ | _ ->
131
+ Ast_compatible. app1 ~loc: fn.pexp_loc fn bounded_obj_arg
132
+ ));
133
+ pexp_attributes = tuple_attrs;
134
+ pexp_loc = fn.pexp_loc;
135
+ })) wholes
136
+ | {pexp_desc = Pexp_apply (e , args ); pexp_attributes} , (_ :: _ as wholes ) ->
137
+ let fn = Ast_open_cxt. restore_exp e wholes in
138
+ let args = Ext_list. map args (fun (lab ,exp ) -> lab, Ast_open_cxt. restore_exp exp wholes) in
139
+ Bs_ast_invariant. warn_discarded_unused_attributes pexp_attributes;
140
+ { pexp_desc = Pexp_apply (fn, (Ast_compatible. no_label, new_obj_arg) :: args);
141
+ pexp_attributes = [] ;
142
+ pexp_loc = loc}
143
+ | _ -> Ast_compatible. app1 ~loc fn new_obj_arg
144
144
end
145
- end
146
- | Some { op = "##" ; loc; args = [obj; rest]} ->
147
- (* - obj##property
148
- - obj#(method a b )
149
- we should warn when we discard attributes
150
- gpr#1063 foo##(bar##baz) we should rewrite (bar##baz)
151
- first before pattern match.
152
- currently the pattern match is written in a top down style.
153
- Another corner case: f##(g a b [@bs])
154
- *)
155
- begin match rest with
156
- {pexp_desc = Pexp_apply (
157
- {pexp_desc = Pexp_ident {txt = Lident name ;_ } ; _} ,
158
- args
159
- ); pexp_attributes = attrs }
145
+ end
146
+ | Some { op = "##" ; loc; args = [obj; rest]} ->
147
+ (* - obj##property
148
+ - obj#(method a b )
149
+ we should warn when we discard attributes
150
+ gpr#1063 foo##(bar##baz) we should rewrite (bar##baz)
151
+ first before pattern match.
152
+ currently the pattern match is written in a top down style.
153
+ Another corner case: f##(g a b [@bs])
154
+ *)
155
+ begin match rest with
156
+ {pexp_desc = Pexp_apply (
157
+ {pexp_desc = Pexp_ident {txt = Lident name ;_ } ; _} ,
158
+ args
159
+ ); pexp_attributes = attrs }
160
+ ->
161
+ Bs_ast_invariant. warn_discarded_unused_attributes attrs ;
162
+ {e with pexp_desc = Ast_util. method_apply loc self obj name (check_and_discard args)}
163
+ |
164
+ {pexp_desc = Pexp_ident {txt = Lident name;_ } ; _}
165
+ (* f##paint *)
166
+ ->
167
+ { e with pexp_desc =
168
+ Ast_util. js_property loc (self.expr self obj) name
169
+ }
170
+ | _ -> Location. raise_errorf ~loc " invalid ## syntax"
171
+ end
172
+
173
+ (* we can not use [:=] for precedece cases
174
+ like {[i @@ x##length := 3 ]}
175
+ is parsed as {[ (i @@ x##length) := 3]}
176
+ since we allow user to create Js objects in OCaml, it can be of
177
+ ref type
178
+ {[
179
+ let u = object (self)
180
+ val x = ref 3
181
+ method setX x = self##x := 32
182
+ method getX () = !self##x
183
+ end
184
+ ]}
185
+ *)
186
+ | Some {op = "#=" ; loc; args = [obj; arg]} ->
187
+ begin match view_as_app obj [" ##" ] with
188
+ | Some { args = [obj; {pexp_desc = Pexp_ident {txt = Lident name}}]}
160
189
->
161
- Bs_ast_invariant. warn_discarded_unused_attributes attrs ;
162
- {e with pexp_desc = Ast_util. method_apply loc self obj name (check_and_discard args)}
163
- |
164
- {pexp_desc = Pexp_ident {txt = Lident name;_ } ; _}
165
- (* f##paint *)
166
- ->
167
- { e with pexp_desc =
168
- Ast_util. js_property loc (self.expr self obj) name
169
- }
170
- | _ -> Location. raise_errorf ~loc " invalid ## syntax"
171
- end
172
-
173
- (* we can not use [:=] for precedece cases
174
- like {[i @@ x##length := 3 ]}
175
- is parsed as {[ (i @@ x##length) := 3]}
176
- since we allow user to create Js objects in OCaml, it can be of
177
- ref type
178
- {[
179
- let u = object (self)
180
- val x = ref 3
181
- method setX x = self##x := 32
182
- method getX () = !self##x
183
- end
184
- ]}
185
- *)
186
- | Some {op = "#=" ; loc; args = [obj; arg]} ->
187
- begin match view_as_app obj [" ##" ] with
188
- | Some { args = [obj; {pexp_desc = Pexp_ident {txt = Lident name}}]}
189
- ->
190
- Exp. constraint_ ~loc
191
- { e with
192
- pexp_desc =
193
- Ast_util. method_apply loc self obj
194
- (name ^ Literals. setter_suffix) [arg] }
195
- (Ast_literal. type_unit ~loc () )
196
- | _ -> assert false
197
- end
198
- | Some { op = "|." ; loc; } ->
199
- Location. raise_errorf ~loc
200
- " invalid |. syntax, it can only be used as binary operator"
201
- | Some {op = "##" ; loc } ->
202
- Location. raise_errorf ~loc
203
- " Js object ## expect syntax like obj##(paint (a,b)) "
204
- | Some {op; } -> Location. raise_errorf " invalid %s syntax" op
205
- | None ->
206
- match
207
- Ext_list. exclude_with_val
208
- e.pexp_attributes
209
- Ast_attributes. is_bs with
210
- | None -> default_expr_mapper self e
211
- | Some pexp_attributes ->
212
- if ! Clflags. bs_only then
213
- {e with pexp_desc = Ast_util. uncurry_fn_apply e.pexp_loc self fn (check_and_discard args) ;
214
- pexp_attributes }
215
- else {e with pexp_attributes } (* BS_NATIVE branch*)
190
+ Exp. constraint_ ~loc
191
+ { e with
192
+ pexp_desc =
193
+ Ast_util. method_apply loc self obj
194
+ (name ^ Literals. setter_suffix) [arg] }
195
+ (Ast_literal. type_unit ~loc () )
196
+ | _ -> assert false
197
+ end
198
+ | Some { op = "|." ; loc; } ->
199
+ Location. raise_errorf ~loc
200
+ " invalid |. syntax, it can only be used as binary operator"
201
+ | Some {op = "##" ; loc } ->
202
+ Location. raise_errorf ~loc
203
+ " Js object ## expect syntax like obj##(paint (a,b)) "
204
+ | Some {op; } -> Location. raise_errorf " invalid %s syntax" op
205
+ | None ->
206
+ match
207
+ Ext_list. exclude_with_val
208
+ e.pexp_attributes
209
+ Ast_attributes. is_bs with
210
+ | None -> default_expr_mapper self e
211
+ | Some pexp_attributes ->
212
+ if ! Clflags. bs_only then
213
+ {e with pexp_desc = Ast_util. uncurry_fn_apply e.pexp_loc self fn (check_and_discard args) ;
214
+ pexp_attributes }
215
+ else {e with pexp_attributes } (* BS_NATIVE branch*)
0 commit comments