temporary fix for PR#5090

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

2 files changed, 73 insertions, 1 deletions

diff --git a/VERSION b/VERSION
index b49be3e0f0..86e1c153c0 100644
--- a/VERSION
+++ b/VERSION
@@ -1,4 +1,4 @@
-3.12.0+dev27 (2010-06-16)
+3.12.0+dev28 (2010-07-30)
 
 # The version string is the first line of this file.
 # It must be in the format described in stdlib/sys.mli
diff --git a/camlp4/Camlp4/Struct/Grammar/Tools.ml b/camlp4/Camlp4/Struct/Grammar/Tools.ml
index 26489d3744..4dae7e713f 100644
--- a/camlp4/Camlp4/Struct/Grammar/Tools.ml
+++ b/camlp4/Camlp4/Struct/Grammar/Tools.ml
@@ -16,6 +16,18 @@
  * - 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;
 
@@ -26,6 +38,64 @@ 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 -> [: :]
@@ -46,6 +116,8 @@ module Make (Structure : Structure.S) = struct
     match Stream.peek strm with
     [ Some (_,r) -> r.prev_loc
     | None -> Loc.ghost ];
+*)
+
 
   value is_level_labelled n lev =
     match lev.lname with