summaryrefslogtreecommitdiffstats
path: root/camlp4/meta/q_MLast.ml
diff options
context:
space:
mode:
authorMichel Mauny <Michel.Mauny@ensta.fr>2005-04-14 09:49:17 +0000
committerMichel Mauny <Michel.Mauny@ensta.fr>2005-04-14 09:49:17 +0000
commit9ba132a8617a2ca649c3c0bc9e505e26e653e859 (patch)
tree3014fd4bd88c34f949226d6d172b700e672deea0 /camlp4/meta/q_MLast.ml
parent41e03a7e7878b9f7bf92073ec4618a7277186d91 (diff)
Fix PR#3549: increment line num in multiline anti-quotations
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@6839 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'camlp4/meta/q_MLast.ml')
-rw-r--r--camlp4/meta/q_MLast.ml47
1 files changed, 41 insertions, 6 deletions
diff --git a/camlp4/meta/q_MLast.ml b/camlp4/meta/q_MLast.ml
index 40a54ae35..a0b9aa290 100644
--- a/camlp4/meta/q_MLast.ml
+++ b/camlp4/meta/q_MLast.ml
@@ -12,7 +12,10 @@
(* $Id$ *)
-value gram = Grammar.gcreate (Plexer.gmake ());
+value (gram, q_position) =
+ let (lexer,pos) = Plexer.make_lexer () in
+ (Grammar.gcreate lexer, pos)
+;
module Qast =
struct
@@ -56,10 +59,20 @@ module Qast =
| Record lal -> <:expr< {$list:List.map to_expr_label lal$} >>
| Loc -> <:expr< $lid:Stdpp.loc_name.val$ >>
| Antiquot loc s ->
+ let (bolpos,lnum, _) = Pcaml.position.val in
+ let (bolposv,lnumv) = (bolpos.val, lnum.val) in
+ let zero_pos () = do { bolpos.val := 0; lnum.val := 1 } in
+ let restore_pos () = do { bolpos.val := bolposv; lnum.val := lnumv } in
let e =
- try Grammar.Entry.parse Pcaml.expr_eoi (Stream.of_string s) with
+ try
+ let _ = zero_pos() in
+ let result = Grammar.Entry.parse Pcaml.expr_eoi (Stream.of_string s) in
+ let _ = restore_pos() in
+ result
+ with
[ Stdpp.Exc_located (bp, ep) exc ->
- raise (Stdpp.Exc_located (Reloc.adjust_loc (fst loc) (bp,ep)) exc) ]
+ do { restore_pos() ; raise (Stdpp.Exc_located (Reloc.adjust_loc (fst loc) (bp,ep)) exc) }
+ | exc -> do { restore_pos(); raise exc } ]
in
<:expr< $anti:e$ >> ]
and to_expr_label (l, a) = (<:patt< MLast.$lid:l$ >>, to_expr a);
@@ -83,10 +96,20 @@ module Qast =
| Record lal -> <:patt< {$list:List.map to_patt_label lal$} >>
| Loc -> <:patt< _ >>
| Antiquot loc s ->
+ let (bolpos,lnum, _) = Pcaml.position.val in
+ let (bolposv,lnumv) = (bolpos.val, lnum.val) in
+ let zero_pos () = do { bolpos.val := 0; lnum.val := 1 } in
+ let restore_pos () = do { bolpos.val := bolposv; lnum.val := lnumv } in
let p =
- try Grammar.Entry.parse Pcaml.patt_eoi (Stream.of_string s) with
+ try
+ let _ = zero_pos() in
+ let result = Grammar.Entry.parse Pcaml.patt_eoi (Stream.of_string s) in
+ let _ = restore_pos() in
+ result
+ with
[ Stdpp.Exc_located (bp, ep) exc ->
- raise (Stdpp.Exc_located (Reloc.adjust_loc (fst loc) (bp, ep)) exc) ]
+ do { restore_pos() ; raise (Stdpp.Exc_located (Reloc.adjust_loc (fst loc) (bp, ep)) exc) }
+ | exc -> do { restore_pos(); raise exc } ]
in
<:patt< $anti:p$ >> ]
and to_patt_label (l, a) = (<:patt< MLast.$lid:l$ >>, to_patt a);
@@ -1401,12 +1424,24 @@ EXTEND
END;
value apply_entry e =
- let f s = Grammar.Entry.parse e (Stream.of_string s) in
+ let f s =
+ let (bolpos,lnum,fname) = q_position in
+ let (bolp,ln,_) = (bolpos.val, lnum.val, fname.val) in
+ let zero_position() = do { bolpos.val := 0; lnum.val := 1 } in
+ let restore_position() = do { bolpos.val := bolp; lnum.val := ln } in
+ let _ = zero_position() in
+ try
+ let result =
+ Grammar.Entry.parse e (Stream.of_string s) in
+ let _ = restore_position() in
+ result
+ with exc -> do { restore_position(); raise exc } in
let expr s = Qast.to_expr (f s) in
let patt s = Qast.to_patt (f s) in
Quotation.ExAst (expr, patt)
;
+
let sig_item_eoi = Grammar.Entry.create gram "signature item" in
do {
EXTEND