@@ -179,25 +179,28 @@ let transform =
179179 object
180180 inherit Ast_traverse. map
181181 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
201204 if debug then Format. printf " %a@." Pprintast. structure_item it;
202205 it
203206 | _ -> it
0 commit comments