@@ -179,25 +179,28 @@ let transform =
179
179
object
180
180
inherit Ast_traverse. map
181
181
method! structure_item it = match it.pstr_desc with
182
- | Pstr_extension (({txt ="err_case" ; _} , PStr [{pstr_desc =Pstr_value (_ , [ vb ]); pstr_loc =loc ; _} ]), _ ) ->
183
- let typ, e, pat = match vb.pvb_expr.pexp_desc, vb.pvb_pat.ppat_desc with
184
- | Pexp_constraint (e , typ ), (Ppat_constraint ({ppat_desc =p ; _} , _ ) | p ) ->
185
- remove_poly typ, e, { vb.pvb_pat with ppat_desc= p }
186
- | _ , Ppat_constraint (p , typ ) ->
187
- remove_poly typ, vb.pvb_expr, p
188
- | _ -> Location. raise_errorf ~loc " no error type given to derive the error case" in
189
- let code, debug, def = match e.pexp_desc with
190
- | Pexp_constant Pconst_integer (s , _ ) -> int_of_string s, false , true
191
- | Pexp_record (l , None) -> get_err_case_options ~loc: e.pexp_loc l
192
- | _ -> Location. raise_errorf ~loc: e.pexp_loc " code not found" in
193
- let typ = match typ.ptyp_desc with
194
- | Ptyp_constr ({txt; _}, [] )
195
- | Ptyp_constr ({txt= (Ldot (Ldot (Lident " EzAPI" , " Err" ), " case" ) | Ldot (Lident " Err" , " case" )) ; _}, [
196
- { ptyp_desc = Ptyp_constr ({txt; _}, [] ); _ }
197
- ]) -> Longident. name txt
198
- | _ -> Location. raise_errorf ~loc: typ.ptyp_loc " couldn't find type to derive error case" in
199
- let expr = type_ext_err_case ~loc ~typ ~def code in
200
- let it = pstr_value ~loc Nonrecursive [ value_binding ~loc ~pat ~expr ] in
182
+ | Pstr_extension (({txt ="err_case" ; _} , PStr [{pstr_desc =Pstr_value (_ , l ); pstr_loc =loc ; _} ]), _ ) ->
183
+ let l, debug = List. fold_left (fun (acc , acc_debug ) vb ->
184
+ let typ, e, pat = match vb.pvb_expr.pexp_desc, vb.pvb_pat.ppat_desc with
185
+ | Pexp_constraint (e , typ ), (Ppat_constraint ({ppat_desc =p ; _} , _ ) | p ) ->
186
+ remove_poly typ, e, { vb.pvb_pat with ppat_desc= p }
187
+ | _ , Ppat_constraint (p , typ ) ->
188
+ remove_poly typ, vb.pvb_expr, p
189
+ | _ -> Location. raise_errorf ~loc " no error type given to derive the error case" in
190
+ let code, debug, def = match e.pexp_desc with
191
+ | Pexp_constant Pconst_integer (s , _ ) -> int_of_string s, false , true
192
+ | Pexp_record (l , None) -> get_err_case_options ~loc: e.pexp_loc l
193
+ | _ -> Location. raise_errorf ~loc: e.pexp_loc " code not found" in
194
+ let typ = match typ.ptyp_desc with
195
+ | Ptyp_constr ({txt; _}, [] )
196
+ | Ptyp_constr ({txt= (Ldot (Ldot (Lident " EzAPI" , " Err" ), " case" ) | Ldot (Lident " Err" , " case" )) ; _}, [
197
+ { ptyp_desc = Ptyp_constr ({txt; _}, [] ); _ }
198
+ ]) -> Longident. name txt
199
+ | _ -> Location. raise_errorf ~loc: typ.ptyp_loc " couldn't find type to derive error case" in
200
+ let expr = type_ext_err_case ~loc ~typ ~def code in
201
+ acc @ [ value_binding ~loc ~pat ~expr ], acc_debug || debug
202
+ ) ([] , false ) l in
203
+ let it = pstr_value ~loc Nonrecursive l in
201
204
if debug then Format. printf " %a@." Pprintast. structure_item it;
202
205
it
203
206
| _ -> it
0 commit comments