haskal
/
xlog
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

use Location.error_extensionf nodes

This commit is contained in:
xenia 2024-04-24 22:59:58 -04:00
parent 4b281e349b
commit 34156743b1
1 changed files with 24 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
ppx/xlog_ppx.ml
View File

@ -2,32 +2,35 @@ open Ppxlib
let log_expander ~ctxt (e : expression) (l : (arg_label * expression) list) : expression = let log_expander ~ctxt (e : expression) (l : (arg_label * expression) list) : expression =
let loc = Expansion_context.Extension.extension_point_loc ctxt in let loc = Expansion_context.Extension.extension_point_loc ctxt in
let is_exn = begin match e.pexp_desc with let open (val Ast_builder.make loc) in
let (is_exn, err) = begin match e.pexp_desc with
| Pexp_ident { txt = Lident "trace"; _ } | Pexp_ident { txt = Lident "trace"; _ }
| Pexp_ident { txt = Lident "debug"; _ } | Pexp_ident { txt = Lident "debug"; _ }
| Pexp_ident { txt = Lident "info"; _ } | Pexp_ident { txt = Lident "info"; _ }
| Pexp_ident { txt = Lident "warn"; _ } | Pexp_ident { txt = Lident "warn"; _ }
| Pexp_ident { txt = Lident "error"; _ } -> false | Pexp_ident { txt = Lident "error"; _ } -> (false, None)
| Pexp_ident { txt = Lident "exn"; _ } -> true | Pexp_ident { txt = Lident "exn"; _ } -> (true, None)
| _ -> | _ ->
raise (Location.Error (Location.Error.make ~loc ~sub:[] (false,
"log type must be one of: trace, debug, info, warn, error, exn")) Some (pexp_extension @@ Location.error_extensionf ~loc
end in "log type must be one of: trace, debug, info, warn, error, exn"))
let open (val Ast_builder.make loc) in end in match err with
if is_exn then | Some err -> err
match l with | None ->
| [] -> if is_exn then
raise (Location.Error (Location.Error.make ~loc ~sub:[] match l with
"must provide exn value")) | [] ->
| (_, v)::l -> pexp_extension @@ Location.error_extensionf ~loc
let application = "must provide exn value"
eapply (pexp_ident { txt = Lident "m"; loc}) (List.map snd l) in | (_, v)::l ->
[%expr [%e e] [%e v] (Printexc.get_raw_backtrace ()) ~__POS__ ~__FUNCTION__ let application =
(fun m -> [%e application])] eapply (pexp_ident { txt = Lident "m"; loc}) (List.map snd l) in
else [%expr [%e e] [%e v] (Printexc.get_raw_backtrace ()) ~__POS__ ~__FUNCTION__
let application = (fun m -> [%e application])]
eapply (pexp_ident { txt = Lident "m"; loc}) (List.map snd l) in else
[%expr [%e e] ~__POS__ ~__FUNCTION__ (fun m -> [%e application])] let application =
eapply (pexp_ident { txt = Lident "m"; loc}) (List.map snd l) in
[%expr [%e e] ~__POS__ ~__FUNCTION__ (fun m -> [%e application])]
let log_extension = let log_extension =
let pattern = let pattern =