Use DDs array as location tabale

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

2 files changed, 43 insertions, 24 deletions

diff --git a/camlp4/lib/token.ml b/camlp4/lib/token.ml
index ec4b5efbc6..5bfc6541f1 100644
--- a/camlp4/lib/token.ml
+++ b/camlp4/lib/token.ml
@@ -58,28 +58,38 @@ value lexer_text (con, prm) =
 ;
 
 value locerr () = invalid_arg "Lexer: flocation function";
-value loct_create () = (ref (Array.create 1024 None), ref False);
+
+value tsz = 256; (* up to 2^29 entries on a 32-bit machine, 2^61 on 64-bit *)
+
+value loct_create () = (ref [| |], ref False);
+
 value loct_func (loct, ov) i =
   match
-    if i < 0 || i >= Array.length loct.val then
-      if ov.val then Some (nowhere, nowhere) else None
-    else Array.unsafe_get loct.val i
+    if i < 0 || i/tsz >= Array.length loct.val then None
+    else if loct.val.(i/tsz) = [| |] then
+      if ov.val then Some (nowhere, nowhere) else  None
+    else Array.unsafe_get (Array.unsafe_get loct.val (i/tsz)) (i mod tsz)
   with
   [ Some loc -> loc
   | _ -> locerr () ]
 ;
-value loct_add (loct, ov) i loc =
-  if i >= Array.length loct.val then
-    let new_tmax = Array.length loct.val * 2 in
+
+value loct_add (loct, ov) i loc = do {
+  while i/tsz >= Array.length loct.val && (not ov.val) do {
+    let new_tmax = Array.length loct.val * 2 + 1 in
     if new_tmax < Sys.max_array_length then do {
-      let new_loct = Array.create new_tmax None in
+      let new_loct = Array.make new_tmax [| |] in
       Array.blit loct.val 0 new_loct 0 (Array.length loct.val);
-      loct.val := new_loct;
-      loct.val.(i) := Some loc
-    }
-    else ov.val := True
-  else loct.val.(i) := Some loc
-;
+      loct.val := new_loct
+    } else ov.val := True
+  };
+  if not(ov.val) then do {
+    if loct.val.(i/tsz) = [| |] then
+      loct.val.(i/tsz) := Array.make tsz None
+    else ();
+    loct.val.(i/tsz).(i mod tsz) := Some loc
+  } else ()
+};
 
 value make_stream_and_flocation next_token_loc =
   let loct = loct_create () in
diff --git a/camlp4/ocaml_src/lib/token.ml b/camlp4/ocaml_src/lib/token.ml
index 50bf530d7e..9eea60aa62 100644
--- a/camlp4/ocaml_src/lib/token.ml
+++ b/camlp4/ocaml_src/lib/token.ml
@@ -57,26 +57,35 @@ let lexer_text (con, prm) =
 ;;
 
 let locerr () = invalid_arg "Lexer: flocation function";;
-let loct_create () = ref (Array.create 1024 None), ref false;;
+
+let tsz = 256;; (* up to 2^29 entries on a 32-bit machine, 2^61 on 64-bit *)
+
+let loct_create () = ref [| |], ref false;;
+
 let loct_func (loct, ov) i =
   match
-    if i < 0 || i >= Array.length !loct then
+    if i < 0 || i / tsz >= Array.length !loct then None
+    else if !loct.(i / tsz) = [| |] then
       if !ov then Some (nowhere, nowhere) else None
-    else Array.unsafe_get !loct i
+    else Array.unsafe_get (Array.unsafe_get !loct (i / tsz)) (i mod tsz)
   with
     Some loc -> loc
   | _ -> locerr ()
 ;;
+
 let loct_add (loct, ov) i loc =
-  if i >= Array.length !loct then
-    let new_tmax = Array.length !loct * 2 in
+  while i / tsz >= Array.length !loct && not !ov do
+    let new_tmax = Array.length !loct * 2 + 1 in
     if new_tmax < Sys.max_array_length then
-      let new_loct = Array.create new_tmax None in
-      Array.blit !loct 0 new_loct 0 (Array.length !loct);
-      loct := new_loct;
-      !loct.(i) <- Some loc
+      let new_loct = Array.make new_tmax [| |] in
+      Array.blit !loct 0 new_loct 0 (Array.length !loct); loct := new_loct
     else ov := true
-  else !loct.(i) <- Some loc
+  done;
+  if not !ov then
+    begin
+      if !loct.(i / tsz) = [| |] then !loct.(i / tsz) <- Array.make tsz None;
+      !loct.(i / tsz).(i mod tsz) <- Some loc
+    end
 ;;
 
 let make_stream_and_flocation next_token_loc =