fusion des changements jusqu'a 3.08.3

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@6824 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

4 files changed, 61 insertions, 9 deletions

diff --git a/camlp4/lib/grammar.ml b/camlp4/lib/grammar.ml
index bd2ddd7910..4196826281 100644
--- a/camlp4/lib/grammar.ml
+++ b/camlp4/lib/grammar.ml
@@ -461,10 +461,31 @@ value do_recover parser_of_tree entry nlevn alevn bp a s son =
 ;
 
 value strict_parsing = ref False;
+value strict_parsing_warning = ref False;
 
 value recover parser_of_tree entry nlevn alevn bp a s son strm =
   if strict_parsing.val then raise (Stream.Error (tree_failed entry a s son))
-  else do_recover parser_of_tree entry nlevn alevn bp a s son strm
+  else
+    let _ =
+      if strict_parsing_warning.val then
+        do {
+          let msg = tree_failed entry a s son in
+          try
+            let (_,bp2) = floc.val bp in
+            let c =  bp2.Lexing.pos_cnum - bp2.Lexing.pos_bol in
+            match (bp2.Lexing.pos_fname <> "", c > 0) with [
+              (True, True) ->
+                Printf.eprintf "File \"%s\", line %d, character %d:\n"
+                  bp2.Lexing.pos_fname bp2.Lexing.pos_lnum c 
+            | (False, True) -> Printf.eprintf "Character %d:\n" c
+            | _ -> () ]
+          with [ _ -> () ];
+          Printf.eprintf "Warning: trying to recover from syntax error";
+          if entry.ename <> "" then Printf.eprintf " in [%s]\n" entry.ename
+          else Printf.eprintf "\n";
+          Printf.eprintf "%s\n%!" msg
+      } else () in
+    do_recover parser_of_tree entry nlevn alevn bp a s son strm
 ;
 
 value token_count = ref 0;
diff --git a/camlp4/lib/grammar.mli b/camlp4/lib/grammar.mli
index 10074b9e7c..5b9ad39733 100644
--- a/camlp4/lib/grammar.mli
+++ b/camlp4/lib/grammar.mli
@@ -165,6 +165,10 @@ value strict_parsing : ref bool;
    (** Flag to apply strict parsing, without trying to recover errors;
        default = [False] *)
 
+value strict_parsing_warning : ref bool;
+   (** Flag for displaying a warning when entering recovery mode;
+       default = [False] *)
+
 value print_entry : Format.formatter -> Gramext.g_entry 'te -> unit;
    (** General printer for all kinds of entries (obj entries) *)
 
diff --git a/camlp4/lib/plexer.ml b/camlp4/lib/plexer.ml
index d677a0e50d..2417efaa3e 100644
--- a/camlp4/lib/plexer.ml
+++ b/camlp4/lib/plexer.ml
@@ -316,7 +316,18 @@ value next_token_fun dfa ssd find_kwd fname lnum bolpos glexr =
   and string bp len =
     parser
     [ [: `'"' :] -> len
-    | [: `'\\'; `c; s :]  -> string bp (store (store len '\\') c) s
+    | [: `'\\'; `c; s :] ep  ->
+        let len = store len '\\' in
+        match c with [
+          '\010' -> do { bolpos.val := ep; incr lnum; string bp (store len c) s }
+        | '\013' ->
+            let (len, ep) =
+              match Stream.peek s with [
+                Some '\010' -> do { Stream.junk s; (store (store len '\013') '\010', ep+1) }
+              | _ -> (store len '\013', ep) ] in
+            do { bolpos.val := ep; incr lnum; string bp len s }
+        | c -> string bp (store len c) s
+        ]
     | [: `'\010'; s :] ep -> do { bolpos.val := ep; incr lnum; string bp (store len '\010') s }
     | [: `'\013'; s :] ep ->
         let (len, ep) =
@@ -339,8 +350,10 @@ value next_token_fun dfa ssd find_kwd fname lnum bolpos glexr =
         do { bolpos.val := bol; incr lnum; char bp (store len '\013') s}
     | [: `c; s :] -> char bp (store len c) s
     | [: :] ep -> err (mkloc (bp, ep)) "char not terminated" ]
-  and dollar bp len =
-    parser
+  and dollar bp len s =
+    if no_quotations.val then
+      ("", get_buff (ident2 (store 0 '$') s)) 
+    else match s with parser
     [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len)
     | [: `('a'..'z' | 'A'..'Z' as c); s :] -> antiquot bp (store len c) s
     | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s
@@ -558,7 +571,8 @@ value func kwd_table glexr =
   let find = Hashtbl.find kwd_table in
   let dfa = dollar_for_antiquotation.val in
   let ssd = specific_space_dot.val in
-  Token.lexer_func_of_parser (next_token_fun dfa ssd find fname lnum bolpos glexr)
+  (Token.lexer_func_of_parser (next_token_fun dfa ssd find fname lnum bolpos glexr),
+   (bolpos, lnum, fname))
 ;
 
 value rec check_keyword_stream =
@@ -740,7 +754,7 @@ value tok_match =
   | tok -> Token.default_match tok ]
 ;
 
-value gmake () =
+value make_lexer () =
   let kwd_table = Hashtbl.create 301 in
   let id_table = Hashtbl.create 301 in
   let glexr =
@@ -748,13 +762,18 @@ value gmake () =
      {tok_func = fun []; tok_using = fun []; tok_removing = fun [];
       tok_match = fun []; tok_text = fun []; tok_comm = None}
   in
+  let (f,pos) = func kwd_table glexr in
   let glex =
-    {tok_func = func kwd_table glexr;
+    {tok_func = f;
      tok_using = using_token kwd_table id_table;
      tok_removing = removing_token kwd_table id_table; tok_match = tok_match;
      tok_text = text; tok_comm = None}
   in
-  do { glexr.val := glex; glex }
+  do { glexr.val := glex; (glex, pos) }
+;
+
+value gmake () =
+  let (p,_) = make_lexer () in p
 ;
 
 value tparse =
@@ -777,6 +796,6 @@ value make () =
      {tok_func = fun []; tok_using = fun []; tok_removing = fun [];
       tok_match = fun []; tok_text = fun []; tok_comm = None}
   in
-  {func = func kwd_table glexr; using = using_token kwd_table id_table;
+  {func = fst(func kwd_table glexr); using = using_token kwd_table id_table;
    removing = removing_token kwd_table id_table; tparse = tparse; text = text}
 ;
diff --git a/camlp4/lib/plexer.mli b/camlp4/lib/plexer.mli
index 32d8fe6b8e..5e1f92180b 100644
--- a/camlp4/lib/plexer.mli
+++ b/camlp4/lib/plexer.mli
@@ -50,6 +50,14 @@ value gmake : unit -> Token.glexer Token.t;
        The lexer do not use global (mutable) variables: instantiations
        of [Plexer.gmake ()] do not perturb each other.  *)
 
+value make_lexer :
+    unit -> (Token.glexer Token.t * (ref int * ref int * ref string));
+   (** [make_lexer] builds a lexer as [gmake does], but returns also
+       the triple [(bolpos, lnum, fname)] where
+- [bolpos] contains the character number of the beginning of the current line,
+- [lnum] contains the current line number and
+- [fname] contains the name of the file being parsed. *)
+
 value dollar_for_antiquotation : ref bool;
    (** When True (default), the next call to [Plexer.make ()] returns a
        lexer where the dollar sign is used for antiquotations. If False,