From 403c0c464f30c87a86886b913df0c0293241dfe6 Mon Sep 17 00:00:00 2001 From: Fabian Date: Thu, 7 Sep 2017 16:49:18 +0200 Subject: [PATCH 1/3] Set the location of the generated body of "let%lwt" to location of the whole expression Previously the location was only set to the location of the binding ("pat = expr") part. However, since it spans both the pattern and the body, it needs to be given a location that contains both. Fixes #337. --- src/ppx/ppx_lwt.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ppx/ppx_lwt.ml b/src/ppx/ppx_lwt.ml index 2fac7d673f..1e94c9adc3 100644 --- a/src/ppx/ppx_lwt.ml +++ b/src/ppx/ppx_lwt.ml @@ -71,7 +71,7 @@ let gen_binds e_loc l e = (evar (gen_name i)) [@metaloc binding.pvb_expr.pexp_loc] in let fun_ = - [%expr (fun [%p binding.pvb_pat] -> [%e aux (i+1) t])] [@metaloc binding.pvb_loc] + [%expr (fun [%p binding.pvb_pat] -> [%e aux (i+1) t])] [@metaloc e_loc] in let new_exp = if !debug then From 566b19a5f7d782462734771dbf756535e047d5e2 Mon Sep 17 00:00:00 2001 From: Fabian Date: Thu, 7 Sep 2017 17:20:03 +0200 Subject: [PATCH 2/3] Fix setting the location of the generated pattern of "let%wt" --- src/ppx/ppx_lwt.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ppx/ppx_lwt.ml b/src/ppx/ppx_lwt.ml index 1e94c9adc3..f6d729b009 100644 --- a/src/ppx/ppx_lwt.ml +++ b/src/ppx/ppx_lwt.ml @@ -56,7 +56,7 @@ let gen_name i = lwt_prefix ^ string_of_int i let gen_bindings l = let aux i binding = { binding with - pvb_pat = (pvar (gen_name i)) [@metaloc binding.pvb_expr.pexp_loc] + pvb_pat = pvar ~loc:binding.pvb_expr.pexp_loc (gen_name i) } in List.mapi aux l @@ -68,7 +68,7 @@ let gen_binds e_loc l e = | [] -> e | binding :: t -> let name = (* __ppx_lwt_$i, at the position of $x$ *) - (evar (gen_name i)) [@metaloc binding.pvb_expr.pexp_loc] + evar ~loc:binding.pvb_expr.pexp_loc (gen_name i) in let fun_ = [%expr (fun [%p binding.pvb_pat] -> [%e aux (i+1) t])] [@metaloc e_loc] From a8a12d96df1de62c51e497ba14e695e3077b962b Mon Sep 17 00:00:00 2001 From: Fabian Date: Fri, 8 Sep 2017 16:46:41 +0200 Subject: [PATCH 3/3] Mark ppx-generated wildcard pattern of "try%lwt" and "match%lwt" as ghost --- src/ppx/ppx_lwt.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ppx/ppx_lwt.ml b/src/ppx/ppx_lwt.ml index f6d729b009..de471b23e9 100644 --- a/src/ppx/ppx_lwt.ml +++ b/src/ppx/ppx_lwt.ml @@ -30,7 +30,7 @@ let add_wildcard_case cases = List.exists is_catchall cases in if not has_wildcard - then cases @ [Exp.case [%pat? exn] [%expr Lwt.fail exn]] + then cases @ [Exp.case [%pat? exn] [%expr Lwt.fail exn]] [@metaloc Location.none] else cases (** {3 Internal names} *)