better fix for PR#5090

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

8 files changed, 21 insertions, 79 deletions

diff --git a/VERSION b/VERSION
index 2b578a5645..d0c463f732 100644
--- a/VERSION
+++ b/VERSION
@@ -1,4 +1,4 @@
-3.12.1+dev0 (2010-08-02)
+3.12.1+dev1 (2010-08-13)
 
 # The version string is the first line of this file.
 # It must be in the format described in stdlib/sys.mli
diff --git a/boot/ocamlc b/boot/ocamlc
index 0e7e181189..2d0f7af853 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamldep b/boot/ocamldep
index 59d44704ed..dc111bfc3d 100755
--- a/boot/ocamldep
+++ b/boot/ocamldep
diff --git a/boot/ocamllex b/boot/ocamllex
index 1987b5a3a8..2d72601b6d 100755
--- a/boot/ocamllex
+++ b/boot/ocamllex
diff --git a/camlp4/Camlp4/Struct/Grammar/Tools.ml b/camlp4/Camlp4/Struct/Grammar/Tools.ml
index 4dae7e713f..26489d3744 100644
--- a/camlp4/Camlp4/Struct/Grammar/Tools.ml
+++ b/camlp4/Camlp4/Struct/Grammar/Tools.ml
@@ -16,18 +16,6 @@
  * - Daniel de Rauglaudre: initial version
  * - Nicolas Pouillard: refactoring
  *)
-
-(* BEGIN ugly hack.  See 15 lines down.  FIXME *)
-
-type prev_locs = {
-  pl_strm : mutable Obj.t;
-  pl_locs : mutable list (int * Obj.t)
-};
-
-value prev_locs = ref ([] : list prev_locs);
-
-(* END ugly hack FIXME *)
-
 module Make (Structure : Structure.S) = struct
   open Structure;
 
@@ -38,64 +26,6 @@ module Make (Structure : Structure.S) = struct
     [ [: ` x; strm :] -> [: ` (f x); stream_map f strm :]
     | [: :] -> [: :] ];
 
-(* ******************************************************************* *)
-(* Ugly hack to prevent PR#5090.  See how to do this properly after
-   the 3.12.0 release.  FIXME.
-*)
-
-value keep_prev_loc strm =
-  match Stream.peek strm with
-  [ None -> [: :]
-  | Some (_, init_loc) ->
-     let myrecord = { pl_strm = Obj.repr [: :];
-                      pl_locs = [(0, Obj.repr init_loc)] }
-     in
-     let rec go prev_loc = parser
-       [ [: `(tok, cur_loc); strm :] -> do {
-           myrecord.pl_locs := myrecord.pl_locs
-                               @ [ (Stream.count strm, Obj.repr cur_loc) ];
-           [: `(tok, {prev_loc; cur_loc}); go cur_loc strm :] }
-       | [: :] -> do {
-           prev_locs.val := List.filter ((!=) myrecord) prev_locs.val;
-           [: :] } ]
-     in
-     let result = go init_loc strm in
-     do {
-     prev_locs.val := [myrecord :: prev_locs.val];
-     myrecord.pl_strm := Obj.repr result;
-     result } ];
-
-value drop_prev_loc strm = stream_map (fun (tok,r) -> (tok,r)) strm;
-
-value get_cur_loc strm =
-  match Stream.peek strm with
-  [ Some (_,r) -> r.cur_loc
-  | None -> Loc.ghost ];
-
-value get_prev_loc strm =
-  let c = Stream.count strm in
-  let rec drop l =
-    match l with
-    [ [] -> []
-    | [(i, _) :: ll] -> if i < c then drop ll else l ]
-  in
-  let rec find l =
-    match l with
-    [ [] -> None
-    | [h::t] -> if h.pl_strm == Obj.repr strm then Some h else find t ]
-  in
-  match find prev_locs.val with
-  [ None -> Loc.ghost
-  | Some r -> do {
-      r.pl_locs := drop r.pl_locs;
-      match r.pl_locs with
-      [ [] -> Loc.ghost
-      | [(i, loc) :: _] ->
- if i = c then (Obj.obj loc : Loc.t) else Loc.ghost ] } ];
-
-(* ******************************************************************* *)
-(* END of ugly hack.  This is the previous code.
-
   value keep_prev_loc strm =
     match Stream.peek strm with
     [ None -> [: :]
@@ -116,8 +46,6 @@ value get_prev_loc strm =
     match Stream.peek strm with
     [ Some (_,r) -> r.prev_loc
     | None -> Loc.ghost ];
-*)
-
 
   value is_level_labelled n lev =
     match lev.lname with
diff --git a/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml b/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml
index c7a510a52a..1bfdefc277 100644
--- a/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml
+++ b/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml
@@ -616,11 +616,13 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
         | `UIDENT s -> s
       ] ]
     ;
+    (* Fix for PR#5090: dummy tokens introduced by the toplevel's lexer
+       to compensate for the lookahead done by the location-handling code *)
     top_phrase:
-      [ [ "#"; n = a_LIDENT; dp = opt_expr; ";;" ->
+      [ [ OPT "%%dummy"; "#"; n = a_LIDENT; dp = opt_expr; ";;" ->
             Some <:str_item< # $n$ $dp$ >>
-        | l = LIST1 str_item; ";;" -> Some (Ast.stSem_of_list l)
-        | `EOI -> None
+        | OPT "%%dummy"; l = LIST1 str_item; ";;" -> Some (Ast.stSem_of_list l)
+        | OPT "%%dummy"; `EOI -> None
       ] ]
     ;
   END;
diff --git a/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml
index 11fd025041..f91e6ab37b 100644
--- a/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml
+++ b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml
@@ -1614,9 +1614,11 @@ Very old (no more supported) syntax:\n\
         | l = LIST0 [ st = str_item; semi -> st ] -> Ast.stSem_of_list l
       ] ]
     ;
+    (* Fix for PR#5090: dummy tokens introduced by the toplevel's lexer
+       to compensate for the lookahead done by the location-handling code *)
     top_phrase:
-      [ [ ph = phrase -> Some ph
-        | `EOI -> None
+      [ [ OPT "%% dummy %%"; ph = phrase -> Some ph
+        | OPT "%% dummy %%"; `EOI -> None
       ] ]
     ;
     use_file:
diff --git a/camlp4/Camlp4Top/Top.ml b/camlp4/Camlp4Top/Top.ml
index dcd3aa4607..66b3022aba 100644
--- a/camlp4/Camlp4Top/Top.ml
+++ b/camlp4/Camlp4Top/Top.ml
@@ -62,6 +62,15 @@ end;
 
 value lookup x xs = try Some (List.assq x xs) with [ Not_found -> None ];
 
+(* Fix for PR#5090: dummy tokens introduced by the toplevel's lexer
+   to compensate for the lookahead done by the location-handling code *)
+value rec add_dummies x =
+  match x with parser
+  [ [: `(KEYWORD x, l); strm :] ->
+       [: `(KEYWORD x, l); `(KEYWORD "%% dummy %%", l); add_dummies strm :]
+  | [: `x; strm :] -> [: `x; add_dummies strm :] ]
+;
+
 value wrap parse_fun =
   let token_streams = ref [] in
   let cleanup lb =
@@ -101,7 +110,8 @@ value wrap parse_fun =
         } ];
 
 value toplevel_phrase token_stream =
-  match Gram.parse_tokens_after_filter Syntax.top_phrase token_stream with
+  match Gram.parse_tokens_after_filter Syntax.top_phrase
+                                       (add_dummies token_stream) with
     [ Some str_item ->
         let str_item =
           AstFilters.fold_topphrase_filters (fun t filter -> filter t) str_item