[Pkg-ocaml-maint-commits] [hevea] 01/04: Imported Upstream version 2.18
Ralf Treinen
treinen at moszumanska.debian.org
Sun Oct 5 19:12:59 UTC 2014
This is an automated email from the git hooks/post-receive script.
treinen pushed a commit to branch master
in repository hevea.
commit 49d4a8356da89095d129133e7599509ec4306103
Author: Ralf Treinen <treinen at free.fr>
Date: Mon Sep 29 08:37:15 2014 +0200
Imported Upstream version 2.18
---
CHANGES | 6 +++++
Makefile | 7 +++---
README | 26 ++++++++++----------
_tags | 1 +
bytes.mlip | 10 ++++++++
bytes.mlp | 9 +++++++
check402.ml | 6 +++++
counter.ml | 2 +-
cut.mll | 2 +-
doOut.ml | 42 +++++++++++++++++---------------
esp.ml | 2 +-
foot.ml | 8 +++---
handle402.sh | 8 ++++++
length.mll | 2 +-
lexstate.ml | 10 ++++----
myLexing.ml | 2 +-
mysys.ml | 4 +--
outUnicode.ml | 2 +-
save.mll | 14 ++++++++---
simpleRope.ml | 45 +++++++++++++++++++++++++++++-----
simpleRope.mli | 2 +-
table.ml | 4 +--
tabular.mll | 2 +-
text.ml | 77 +++++++++++++++++++++++++++++-----------------------------
ultra.ml | 16 ++++++------
verb.mll | 4 +--
version.ml | 4 +--
videoc.mll | 2 ++
28 files changed, 200 insertions(+), 119 deletions(-)
diff --git a/CHANGES b/CHANGES
index bda4bff..78badd3 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,3 +1,9 @@
+version 2.18
+ * Adapt to ocaml 4.02, use 'Bytes' module + backward compatibility
+ hack.
+ * Some patches by Damien: typos + illegal format strings.
+version 2.17
+ * Adapt to ocaml 4.02 (suppress a few 'Deprecated' warnings)
version 2.16
* Patchy: change fnsymbol from '%' to '$'
version 2.15
diff --git a/Makefile b/Makefile
index b3fe4a8..0ee8e09 100644
--- a/Makefile
+++ b/Makefile
@@ -33,8 +33,9 @@ both: ocb-both
include libs.def
-config.sh: Makefile libs.def
- @(echo PGM=\"$(PGM)\" &&\
+config.sh: Makefile libs.def handle402.sh
+ @( cat handle402.sh &&\
+ echo PGM=\"$(PGM)\" &&\
echo PGMNATIVE=\"$(PGMNATIVE)\" &&\
echo BINDIR=$(BINDIR) &&\
echo LIBDIR=$(LIBDIR) &&\
@@ -44,7 +45,7 @@ config.sh: Makefile libs.def
echo ALLLIB=\"$(ALLLIB)\" && \
echo HTMLLIB=\"$(HTMLLIB)\" && \
echo TEXTLIB=\"$(TEXTLIB)\" && \
- echo INFOLIB=\"$(INFOLIB)\" ) > $@
+ echo INFOLIB=\"$(INFOLIB)\") > $@
clean:: config.sh
sh ocb.sh clean && rm config.sh
diff --git a/README b/README
index bd54cf0..c115c46 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-This is HEVEA, version 2.16, a fast Latex to HTML translator.
+This is HEVEA, version 2.18, a fast Latex to HTML translator.
ADVERTISEMENT
@@ -15,7 +15,7 @@ ADVERTISEMENT
files are understood with little or no modifications.
Furthermore, HEVEA customization is done by writing LaTeX code.
- HEVEA is written in Objective Caml, as many lexers. It is quite fast
+ HEVEA is written in OCaml, as many lexers. It is quite fast
and flexible. Using HEVEA it is possible to translate large documents
such as manuals, books, etc. very quickly. All documents are
translated as one single HTML file. Then, the output file can be cut
@@ -45,10 +45,10 @@ DISTRIBUTION
REQUIREMENTS
HEVEA is written in Objective Caml version 3.12 or later
- (Ocaml). It compiles under Ocaml, which should thus be properly
+ (OCaml). It compiles under OCaml, which should thus be properly
installed.
- More information on Ocaml can be found at
+ More information on OCaml can be found at
http://caml.inria.fr/ocaml/
However there exists binary distributions of HEVEA for PCs
@@ -68,16 +68,16 @@ REQUIREMENTS
INSTALLATION FROM THE SOURCE DISTRIBUTION
Download the source distribution
- http://hevea.inria.fr/distri/hevea-2.09.tar.gz
+ http://hevea.inria.fr/distri/hevea-2.18.tar.gz
Unzip,
- gunzip hevea-2.09.tar.gz
+ gunzip hevea-2.18.tar.gz
Untar,
- tar xf hevea-2.09.tar
+ tar xf hevea-2.18.tar
Go to the source directory
- cd hevea-2.09
+ cd hevea-2.18
CONFIGURATION
There are a few configuration variables at the beginning of
@@ -85,14 +85,14 @@ CONFIGURATION
* TARGET
TARGET=opt makes hevea compile under ocamlopt, the
- Objective Caml compiler that produces native code. This is
+ OCaml compiler that produces native code. This is
the default.
TARGET=byte makes hevea compile under ocamlc, the
- Objective Caml compiler that produces bytecode.
+ OCaml compiler that produces bytecode.
- Using opt, hevea is about three times as fast than
- using byte. However, some Ocaml installations may only
+ Using opt, hevea is about three times faster than
+ using byte. However, some OCaml installations may only
provide ocamlc.
* LIBDIR is the library directory of hevea, that contains
@@ -127,5 +127,5 @@ MAKE
IN CASE OF TROUBLE.
- You do need version 3.12 (or newer) of the Objective Caml System.
- Older versions of OCaml cannot compile hevea 2.09.
+ Older versions of Objective Caml cannot compile hevea 2.18.
diff --git a/_tags b/_tags
index 4cafe7e..118565d 100644
--- a/_tags
+++ b/_tags
@@ -1,2 +1,3 @@
true: annot
+true: safe_string
<mylib.ml> : pp(../expandlib.sh)
diff --git a/bytes.mlip b/bytes.mlip
new file mode 100644
index 0000000..82902e4
--- /dev/null
+++ b/bytes.mlip
@@ -0,0 +1,10 @@
+type t = string
+include module type of String with type t := string
+
+val sub_string : t -> int -> int -> string
+val of_string : string -> t
+val blit_string : string -> int -> t -> int -> int -> unit
+val unsafe_to_string : t -> string
+val to_string : t -> string
+val cat : t -> t -> t
+
diff --git a/bytes.mlp b/bytes.mlp
new file mode 100644
index 0000000..f5e121b
--- /dev/null
+++ b/bytes.mlp
@@ -0,0 +1,9 @@
+include String
+let sub_string = sub
+let of_string = copy
+let blit_string = blit
+
+let unsafe_to_string s = s
+let to_string = copy
+let cat b1 b2 = b1 ^ b2
+
diff --git a/check402.ml b/check402.ml
new file mode 100644
index 0000000..4fc1fc8
--- /dev/null
+++ b/check402.ml
@@ -0,0 +1,6 @@
+let () =
+ if compare Sys.ocaml_version "4.02.0" >= 0 then
+ Printf.printf "ok\n"
+ else
+ Printf.printf "no\n"
+
diff --git a/counter.ml b/counter.ml
index f7cb885..78a6007 100644
--- a/counter.ml
+++ b/counter.ml
@@ -57,7 +57,7 @@ let checkpoint () =
with
| Not_found -> Misc.fatal "Counter.checkpoint" in
- let t = Array.create !count cbidon in
+ let t = Array.make !count cbidon in
RevHash.iter
(fun {count = value ; related = related} (name, i) ->
diff --git a/cut.mll b/cut.mll
index a59b938..bb012d9 100644
--- a/cut.mll
+++ b/cut.mll
@@ -130,7 +130,7 @@ and html = ref "<html>"
let new_filename _from =
incr count ;
- Printf.sprintf "%s%0.3d.html" base !count
+ Printf.sprintf "%s%03d.html" base !count
let out = ref (Out.create_null ())
and out_prefix = ref (Out.create_null ())
diff --git a/doOut.ml b/doOut.ml
index 4cced97..4fd597b 100644
--- a/doOut.ml
+++ b/doOut.ml
@@ -60,13 +60,13 @@ module Make(C:Config) = struct
let max_sz = C.small_length
type buff =
- { mutable b : string ; mutable p : int ;
+ { mutable b : Bytes.t ; mutable p : int ;
mutable sz : int ; mutable r : S.t; }
let start_sz = min 16 max_sz
let alloc_buff () =
- { b = String.create start_sz ; p = 0 ; sz=start_sz; r = S.empty ; }
+ { b = Bytes.create start_sz ; p = 0 ; sz=start_sz; r = S.empty ; }
let dump_buff chan b =
S.output chan b.r ;
@@ -77,36 +77,36 @@ module Make(C:Config) = struct
let length_buff b = b.p + S.length b.r
let to_string_buff b =
- let r = String.create (length_buff b) in
+ let r = Bytes.create (length_buff b) in
S.blit b.r r 0 ;
- String.unsafe_blit b.b 0 r (S.length b.r) b.p ;
- r
+ Bytes.unsafe_blit b.b 0 r (S.length b.r) b.p ;
+ Bytes.unsafe_to_string r
let do_flush_buff b =
- let s = String.create b.p in
- String.unsafe_blit b.b 0 s 0 b.p ;
- b.r <- S.append_string b.r s ;
+ let s = Bytes.create b.p in
+ Bytes.unsafe_blit b.b 0 s 0 b.p ;
+ b.r <- S.append_string b.r (Bytes.unsafe_to_string s) ;
b.p <- 0
let flush_buff b = if b.p > 0 then do_flush_buff b
let realloc b =
let nsz = 2 * b.sz in
- let nbuff = String.create nsz in
- String.unsafe_blit b.b 0 nbuff 0 b.p ;
+ let nbuff = Bytes.create nsz in
+ Bytes.unsafe_blit b.b 0 nbuff 0 b.p ;
b.b <- nbuff ; b.sz <- nsz
let rec vput_buff b s pos len =
if b.p + len < b.sz then begin
- String.unsafe_blit s pos b.b b.p len ;
+ Bytes.blit_string s pos b.b b.p len ;
b.p <- b.p + len
end else if b.sz < max_sz then begin
realloc b ;
vput_buff b s pos len
end else if b.p = 0 then
- let bsz = String.create b.sz in
- String.unsafe_blit s pos bsz 0 b.sz ;
- b.r <- S.append_string b.r bsz ;
+ let bsz = Bytes.create b.sz in
+ Bytes.blit_string s pos bsz 0 b.sz ;
+ b.r <- S.append_string b.r (Bytes.unsafe_to_string bsz) ;
vput_buff b s (pos+b.sz) (len-b.sz)
else begin
let tr = b.sz-b.p in
@@ -127,24 +127,26 @@ module Make(C:Config) = struct
(String.sub s pos len) dump_buff b S.debug b.r ;
()
+ let put_bytes b s pos len = put_buff b (Bytes.unsafe_to_string s) pos len
+
let put_buff_char b c =
if b.p >= b.sz then begin
if b.sz < max_sz then realloc b
else do_flush_buff b
end ;
- String.unsafe_set b.b b.p c ;
+ Bytes.unsafe_set b.b b.p c ;
b.p <- b.p + 1
let get_buff b k =
let len = S.length b.r in
if k < len then S.get b.r k
- else String.unsafe_get b.b (k-len)
+ else Bytes.unsafe_get b.b (k-len)
(* Append src at the end of dst *)
let copy_buff src dst =
flush_buff dst ;
dst.r <- S.append dst.r src.r ;
- put_buff dst src.b 0 src.p
+ put_bytes dst src.b 0 src.p
(*******************)
@@ -202,7 +204,7 @@ module Make(C:Config) = struct
match out with
| Rope b ->
let len = lexbuf.lex_curr_pos - lexbuf.lex_start_pos in
- put_buff b lexbuf.lex_buffer lexbuf.lex_start_pos len
+ put_bytes b lexbuf.lex_buffer lexbuf.lex_start_pos len
| Chan chan ->
let len = lexbuf.lex_curr_pos - lexbuf.lex_start_pos in
output chan lexbuf.lex_buffer lexbuf.lex_start_pos len
@@ -225,7 +227,7 @@ module Make(C:Config) = struct
| Rope b ->
S.iter f b.r ;
let bb = b.b in
- for k = 0 to b.p-1 do f (String.unsafe_get bb k) done ;
+ for k = 0 to b.p-1 do f (Bytes.unsafe_get bb k) done ;
()
let iter_next f = function
@@ -260,7 +262,7 @@ module Make(C:Config) = struct
let to_list = function
| Rope b ->
let xs =
- if b.p > 0 then [String.sub b.b 0 b.p]
+ if b.p > 0 then [Bytes.sub_string b.b 0 b.p]
else [] in
let xs = S.to_list_append b.r xs in
if !verbose > 2 then begin
diff --git a/esp.ml b/esp.ml
index 3ab1fb1..d631379 100644
--- a/esp.ml
+++ b/esp.ml
@@ -189,7 +189,7 @@ let check_output ok in_name out_name =
in_name
end in
if !Emisc.verbose > 0 then begin
- eprintf "Optimized %s: %d -> %d, %0.2f%%\n"
+ eprintf "Optimized %s: %d -> %d, %.2f%%\n"
final_name
size_in size_out
((float (size_in-size_out) *. 100.0) /.
diff --git a/foot.ml b/foot.ml
index 9327bb6..ba266e2 100644
--- a/foot.ml
+++ b/foot.ml
@@ -97,10 +97,10 @@ let flush sticky lexer out sec_notes sec_here =
if anchor > fst then
all := ((mark,anchor),(themark,text)) :: !all)
anchor_to_note ;
- all := Sort.list
- (fun ((m1,a1),_) ((m2,a2),_) ->
- (a1 < a2) ||
- ((a1 = a2) && (m1 <= m2))) !all ;
+ all := List.sort
+ (fun (((m1:int),(a1:int)),_) ((m2,a2),_) -> match Pervasives.compare a1 a2 with
+ | 0 -> Pervasives.compare m1 m2
+ | r -> r) !all ;
List.iter
(fun ((_,anchor),(themark,text)) ->
lexer
diff --git a/handle402.sh b/handle402.sh
new file mode 100644
index 0000000..ea36f85
--- /dev/null
+++ b/handle402.sh
@@ -0,0 +1,8 @@
+DIR=$(dirname $0)
+
+if [ $(ocaml $DIR/check402.ml) = ok ]; then
+ rm -f $DIR/bytes.ml $DIR/bytes.mli
+else
+ cp $DIR/bytes.mlp $DIR/bytes.ml
+ cp $DIR/bytes.mlip $DIR/bytes.mli
+fi
diff --git a/length.mll b/length.mll
index 47c01ce..8b2b886 100644
--- a/length.mll
+++ b/length.mll
@@ -77,6 +77,6 @@ let main lexbuf =
try main_rule lexbuf with
| Cannot ->
let sbuf = lexbuf.lex_buffer in
- No (String.sub sbuf 0 lexbuf.lex_buffer_len)
+ No (Bytes.sub_string sbuf 0 lexbuf.lex_buffer_len)
}
diff --git a/lexstate.ml b/lexstate.ml
index f936fee..ca0c31f 100644
--- a/lexstate.ml
+++ b/lexstate.ml
@@ -157,17 +157,17 @@ let stack_lexbuf = MyStack.create "stack_lexbuf"
;;
let pretty_lexbuf lb =
- let pos = lb.lex_curr_pos and len = String.length lb.lex_buffer in
+ let pos = lb.lex_curr_pos and len = Bytes.length lb.lex_buffer in
prerr_endline "Buff contents:" ;
let size = if !verbose > 3 then len-pos else min (len-pos) 80 in
if size <> len-pos then begin
prerr_string "<<" ;
- prerr_string (String.sub lb.lex_buffer pos (size/2)) ;
+ prerr_string (Bytes.sub_string lb.lex_buffer pos (size/2)) ;
prerr_string "... (omitted) ..." ;
- prerr_string (String.sub lb.lex_buffer (len-size/2-1) (size/2)) ;
+ prerr_string (Bytes.sub_string lb.lex_buffer (len-size/2-1) (size/2)) ;
prerr_endline ">>"
end else
- prerr_endline ("<<"^String.sub lb.lex_buffer pos size^">>");
+ prerr_endline ("<<"^Bytes.sub_string lb.lex_buffer pos size^">>");
prerr_endline ("curr_pos="^string_of_int lb.lex_curr_pos);
prerr_endline "End of buff"
;;
@@ -198,7 +198,7 @@ let plain_of_char = function
raise
(Fatal ("Internal catcode table error: '"^String.make 1 c^"'"))
-and plain = Array.create 14 true
+and plain = Array.make 14 true
let is_plain c = plain.(plain_of_char c)
and set_plain c =
diff --git a/myLexing.ml b/myLexing.ml
index 0188ad8..47cabd2 100644
--- a/myLexing.ml
+++ b/myLexing.ml
@@ -26,7 +26,7 @@ let zero_pos = {
let from_string s =
{ refill_buff = (fun lexbuf -> lexbuf.lex_eof_reached <- true);
- lex_buffer = s ;
+ lex_buffer = Bytes.of_string s ;
lex_buffer_len = String.length s;
lex_abs_pos = 0;
lex_start_pos = 0;
diff --git a/mysys.ml b/mysys.ml
index 6906c7c..079599b 100644
--- a/mysys.ml
+++ b/mysys.ml
@@ -14,12 +14,12 @@ exception Error of string
let put_from_file name put =
try
let size = 1024 in
- let buff = String.create size in
+ let buff = Bytes.create size in
let chan_in = open_in_bin name in
let rec do_rec () =
let i = input chan_in buff 0 size in
if i > 0 then begin
- put (String.sub buff 0 i) ;
+ put (Bytes.sub_string buff 0 i) ;
do_rec ()
end in
do_rec () ;
diff --git a/outUnicode.ml b/outUnicode.ml
index 1ffe0cd..8904c81 100644
--- a/outUnicode.ml
+++ b/outUnicode.ml
@@ -151,7 +151,7 @@ let make_out_translator ps =
with Not_found -> raise CannotTranslate)
and make_in_translator ps =
- let t = Array.create 256 0 in
+ let t = Array.make 256 0 in
List.iter (fun (iso, uni) -> t.(iso) <- uni) ps ;
(fun c _ -> t.(Char.code c))
diff --git a/save.mll b/save.mll
index b337047..d51f08b 100644
--- a/save.mll
+++ b/save.mll
@@ -26,7 +26,7 @@ let rec peek_next_char lb =
peek_next_char lb
end
end else
- lb.lex_buffer.[pos]
+ Bytes.unsafe_get lb.lex_buffer pos
let if_next_char c lb =
try
@@ -34,6 +34,7 @@ let if_next_char c lb =
with
| Not_found -> false
+
let rec if_next_string s lb =
if s = "" then
true
@@ -49,8 +50,13 @@ let rec if_next_string s lb =
if_next_string s lb
end
end else
- let lb_s = String.sub lb.lex_buffer pos slen in
- lb_s = s
+ let b = lb.lex_buffer in
+ let rec do_rec k =
+ if k >= slen then true
+ else
+ Bytes.get b (pos+k) = String.get s k &&
+ do_rec (k+1) in
+ do_rec 0
type kmp_t = Continue of int | Stop of string
@@ -404,7 +410,7 @@ exception Error = SaveUtils.Error
let init_kmp s =
let l = String.length s in
- let r = Array.create l (-1) in
+ let r = Array.make l (-1) in
let rec init_rec i j =
if i+1 < l then begin
diff --git a/simpleRope.ml b/simpleRope.ml
index 3ae8ed2..0f4bd5f 100644
--- a/simpleRope.ml
+++ b/simpleRope.ml
@@ -59,8 +59,42 @@ module Make(C:Config) = struct
let append r1 r2 = app r1 r2
- let append_string r s = app r (of_string s)
- and append_char r c = app r (singleton c)
+
+ let rec app_string r s slen = match r with
+ | Str rs ->
+ if String.length rs < small_length then Str (rs ^ s)
+ else raise Exit
+ | App (r1,r2,len) ->
+ let r2 = app_string r2 s slen in
+ App (r1,r2,len+slen)
+
+ let append_string r s =
+ let slen = String.length s in
+ if slen < small_length then
+ try app_string r s slen
+ with Exit -> App (r,Str s,length r+slen)
+ else App (r,Str s,length r+slen)
+
+ let sc2c s len c =
+ let b = Bytes.create (len+1) in
+ Bytes.blit_string s 0 b 0 len ;
+ Bytes.set b len c ;
+ Bytes.unsafe_to_string b
+
+ let rec app_char r c = match r with
+ | Str s ->
+ let len = String.length s in
+ if len < small_length then begin
+ Str (sc2c s len c)
+ end else
+ raise Exit
+ | App (r1,r2,len) ->
+ let r2 = app_char r2 c in
+ App (r1,r2,len+1)
+
+ let append_char r c =
+ try app_char r c
+ with Exit -> App (r,Str (String.make 1 c),length r+1)
(*************)
(* Substring *)
@@ -142,18 +176,17 @@ let debug = debug_rec ""
let rec blit t buff pos = match t with
| Str s ->
- String.unsafe_blit s 0 buff pos (String.length s)
+ Bytes.blit_string s 0 buff pos (String.length s)
| App (t1,t2,_) ->
blit t1 buff pos ;
blit t2 buff (pos+length t1)
-
let to_string t = match t with
| Str s -> s
| App (_,_,len) ->
- let buff = String.create len in
+ let buff = Bytes.create len in
blit t buff 0 ;
- buff
+ Bytes.unsafe_to_string buff
(***********************)
(* To list (of string) *)
diff --git a/simpleRope.mli b/simpleRope.mli
index a3183e7..3d05a26 100644
--- a/simpleRope.mli
+++ b/simpleRope.mli
@@ -38,7 +38,7 @@ type t
(* Translations *)
val output : out_channel -> t -> unit
val debug : out_channel -> t -> unit
- val blit : t -> string -> int -> unit
+ val blit : t -> Bytes.t -> int -> unit
val to_string : t -> string
val to_list : t -> string list
val to_list_append : t -> string list -> string list
diff --git a/table.ml b/table.ml
index 481bf89..03b284e 100644
--- a/table.ml
+++ b/table.ml
@@ -16,12 +16,12 @@ type 'a t = {mutable next : int ; mutable data : 'a array}
let default_size = 32
;;
-let create x = {next = 0 ; data = Array.create default_size x}
+let create x = {next = 0 ; data = Array.make default_size x}
and reset t = t.next <- 0
;;
let incr_table table new_size =
- let t = Array.create new_size table.data.(0) in
+ let t = Array.make new_size table.data.(0) in
Array.blit table.data 0 t 0 (Array.length table.data) ;
table.data <- t
diff --git a/tabular.mll b/tabular.mll
index 0f8649c..55a49c8 100644
--- a/tabular.mll
+++ b/tabular.mll
@@ -165,7 +165,7 @@ and tfmiddle = parse
| eof {()}
| ""
{let rest =
- String.sub lexbuf.lex_buffer lexbuf.lex_curr_pos
+ Bytes.sub_string lexbuf.lex_buffer lexbuf.lex_curr_pos
(lexbuf.lex_buffer_len - lexbuf.lex_curr_pos) in
raise (Error ("Syntax of array format near: "^rest))}
diff --git a/text.ml b/text.ml
index 5199ca4..0fb6de0 100644
--- a/text.ml
+++ b/text.ml
@@ -408,7 +408,7 @@ let check_stacks () = match stacks with
check_stack after
(* Buffer for one line *)
-let line = String.create (!Parse_opts.width +2);;
+let line = Bytes.make (!Parse_opts.width +2) ' '
type saved = string * flags_t * saved_stacks * saved_out
@@ -416,7 +416,7 @@ let check () =
let saved_flags = copy_flags flags
and saved_stacks = save_stacks ()
and saved_out = save_out () in
- String.copy line, saved_flags, saved_stacks, saved_out
+ Bytes.to_string line, saved_flags, saved_stacks, saved_out
and hot (l,f,s,o) =
@@ -440,7 +440,6 @@ let do_do_put_char c =
let do_do_put s =
Out.put !cur_out.out s;;
-
let do_put_line s =
(* Ligne a formatter selon flags.align, avec les parametres courants.*)
(* soulignage eventuel *)
@@ -456,10 +455,10 @@ let do_put_line s =
| Left -> s
| Center ->
let sp = (flags.hsize - (length -flags.x_start))/2 in
- String.concat "" [String.make sp ' '; s]
+ String.make sp ' ' ^ s
| Right ->
let sp = flags.hsize - length + flags.x_start in
- String.concat "" [ String.make sp ' '; s]
+ String.make sp ' ' ^ s
in
if !verbose > 3 then prerr_endline ("line :"^ligne);
do_do_put ligne;
@@ -467,35 +466,35 @@ let do_put_line s =
if !soul then begin
let souligne =
- let l = String.make taille ' ' in
+ let l = Bytes.create taille in
let len = String.length flags.underline in
if len = 0 then raise (Misc.Fatal ("cannot underline with nothing:#"
^String.escaped flags.underline^"#"^
(if (flags.underline <> "") then "true" else "false"
)));
for i = flags.x_start to length -1 do
- l.[i]<-flags.underline.[(i-flags.x_start) mod len]
+ Bytes.set l i flags.underline.[(i-flags.x_start) mod len]
done;
- if taille <> length then l.[length]<-'\n';
+ if taille <> length then Bytes.set l length '\n';
match flags.align with
| Left -> l
| Center ->
let sp = (flags.hsize - length)/2 +flags.x_start/2 in
- String.concat "" [String.make sp ' '; l]
+ Bytes.cat (Bytes.make sp ' ') l
| Right ->
let sp = (flags.hsize - length) + flags.x_start in
- String.concat "" [ String.make sp ' '; l]
+ Bytes.cat (Bytes.make sp ' ') l
in
- if !verbose >3 then prerr_endline ("line underlined:"^souligne);
+ if !verbose >3 then prerr_endline ("line underlined:"^ Bytes.to_string souligne);
- do_do_put souligne;
+ do_do_put (Bytes.unsafe_to_string souligne);
end
;;
let do_flush () =
if !verbose>3 && flags.x >0 then
- prerr_endline ("flush :#"^(String.sub line 0 (flags.x))^"#");
- if flags.x >0 then do_put_line (String.sub line 0 (flags.x)) ;
+ prerr_endline ("flush :#"^(Bytes.sub_string line 0 (flags.x))^"#");
+ if flags.x >0 then do_put_line (Bytes.sub_string line 0 flags.x) ;
flags.x <- -1;
;;
@@ -509,16 +508,16 @@ let do_put_char_format nbsp c =
(* eprintf "FIRST LINE: %i %i\n" flags.x_start flags.first_line ; *)
flags.x<-flags.x_start + flags.first_line;
for i = 0 to flags.x-1 do
- line.[i]<-' ';
+ Bytes.set line i ' '
done;
flags.last_space<-flags.x-1;
end;
- line.[flags.x]<-c;
+ Bytes.set line flags.x c;
if c='\n' then begin
(* Ligne prete *)
if !verbose > 2 then
- prerr_endline("line not cut :["^line^"]");
- do_put_line (String.sub line 0 (flags.x +1));
+ prerr_endline("line not cut :["^Bytes.to_string line^"]");
+ do_put_line (Bytes.sub_string line 0 (flags.x +1));
flags.x <- -1;
end else
flags.x<-flags.x + 1;
@@ -526,39 +525,39 @@ let do_put_char_format nbsp c =
if (flags.x - flags.last_space) >= flags.hsize then begin
(* On coupe brutalement le mot trop long *)
if !verbose > 2 then
- prerr_endline ("line cut :"^line);
+ prerr_endline ("line cut :"^ Bytes.to_string line);
warning ("line too long");
- line.[flags.x-1]<-'\n';
+ Bytes.set line (flags.x-1) '\n';
(* La ligne est prete et complete*)
- do_put_line (String.sub line 0 (flags.x));
- for i = 0 to flags.x_start-1 do line.[i]<-' ' done;
- line.[flags.x_start]<-c;
+ do_put_line (Bytes.sub_string line 0 flags.x);
+ for i = 0 to flags.x_start-1 do Bytes.set line i ' ' done;
+ Bytes.set line flags.x_start c;
flags.x<-flags.x_start + 1;
flags.last_space<-flags.x_start-1;
end else begin
if !verbose > 2 then begin
- prerr_endline ("Line and the beginning of the next word :"^line);
+ prerr_endline ("Line and the beginning of the next word :"^Bytes.to_string line);
prerr_endline ("x ="^string_of_int flags.x);
prerr_endline ("x_start ="^string_of_int flags.x_start);
prerr_endline ("x_end ="^string_of_int flags.x_end);
prerr_endline ("hsize ="^string_of_int flags.hsize);
prerr_endline ("last_space ="^string_of_int flags.last_space);
- prerr_endline ("line size ="^string_of_int (String.length line));
+ prerr_endline ("line size ="^string_of_int (Bytes.length line));
end;
(* On repart du dernier espace *)
let reste =
let len = flags.x - flags.last_space -1 in
if len = 0 then ""
else
- String.sub line (flags.last_space +1) len
+ Bytes.sub_string line (flags.last_space +1) len
in
(* La ligne est prete et incomplete*)
- line.[flags.last_space]<-'\n';
- do_put_line (String.sub line 0 (flags.last_space+1));
+ Bytes.set line flags.last_space '\n';
+ do_put_line (Bytes.sub_string line 0 (flags.last_space+1));
- for i = 0 to flags.x_start-1 do line.[i]<-' ' done;
+ for i = 0 to flags.x_start-1 do Bytes.set line i ' ' done;
for i = flags.x_start to (flags.x_start+ String.length reste -1) do
- line.[i]<- reste.[i-flags.x_start];
+ Bytes.set line i reste.[i-flags.x_start];
done;
flags.x<- flags.x_start + (String.length reste);
flags.last_space <- flags.x_start-1;
@@ -592,13 +591,13 @@ let do_unskip () =
if !cur_out.temp || (Out.is_null !cur_out.out) then
Out.unskip !cur_out.out
else begin
- while flags.x > flags.x_start && line.[flags.x-1] = ' ' do
+ while flags.x > flags.x_start && Bytes.get line (flags.x-1) = ' ' do
flags.x <- flags.x - 1
done ;
flags.last_space <- flags.x ;
while
flags.last_space >= flags.x_start &&
- line.[flags.last_space] <> ' '
+ Bytes.get line flags.last_space <> ' '
do
flags.last_space <- flags.last_space - 1
done;
@@ -1179,8 +1178,8 @@ let table = ref {
cols = 0;
width = 0;
taille = Table.create 0;
- tailles = Array.create 0 0;
- table = Table.create {haut = 0; cells = Arr (Array.create 0 !cell)};
+ tailles = Array.make 0 0;
+ table = Table.create {haut = 0; cells = Arr (Array.make 0 !cell)};
line = 0;
col = 0;
in_cell = false;
@@ -1215,8 +1214,8 @@ let open_table _ _ =
cols = 0;
width = 0;
taille = Table.create 0;
- tailles = Array.create 0 0;
- table = Table.create {haut = 0; cells = Arr (Array.create 0 !cell)};
+ tailles = Array.make 0 0;
+ table = Table.create {haut = 0; cells = Arr (Array.make 0 !cell)};
line = -1;
col = -1;
in_cell = false;
@@ -1252,7 +1251,7 @@ let register_taille table =
and cur_len = Array.length cur in
let dest =
if cur_len > old_len then begin
- let t = Array.create cur_len 0 in
+ let t = Array.make cur_len 0 in
Array.blit old 0 t 0 old_len ;
t
end else
@@ -1338,7 +1337,7 @@ let open_cell format span insides _border =
!cell.post <- "";
!cell.post_inside <- [];
open_block "" "";
- if !cell.w > String.length line then raise ( Error "Column too wide");
+ if !cell.w > Bytes.length line then raise ( Error "Column too wide");
if (!cell.wrap=Wtrue) then begin (* preparation de l'alignement *)
!cur_out.temp <- false;
flags.x_start <- 0;
@@ -1644,7 +1643,7 @@ let close_table () =
(* affichage de la ligne *)
(* il faut envoyer ligne apres ligne dans chaque cellule, en tenant compte de l'alignement vertical et horizontal..*)
if !verbose> 2 then prerr_endline ("line "^string_of_int i^", columns:"^string_of_int (Array.length ligne)^", height:"^string_of_int tab.(i).haut);
- let pos = Array.create (Array.length ligne) 0 in
+ let pos = Array.make (Array.length ligne) 0 in
!row.haut <-0;
for j = 0 to tab.(i).haut -1 do
if not ( i=0 && j=0) then do_put_char '\n';
diff --git a/ultra.ml b/ultra.ml
index 546a5c4..3abb0d7 100644
--- a/ultra.ml
+++ b/ultra.ml
@@ -278,24 +278,22 @@ let slen f =
else
0) + String.length f.txt + String.length f.ctxt
-let order_factors (((_i1,_j1),f1),c1) (((_i2,_j2),f2),c2) =
- if c1 < c2 then true
- else if c1=c2 then
- slen f1 >= slen f2
- else
- false
+let order_factors (((_i1,_j1),f1),(c1:int)) (((_i2,_j2),f2),c2) =
+ match compare c1 c2 with
+ | 0 -> compare (slen f2) (slen f1) (* NB comparison reversed *)
+ | r -> r
let select_factors fs =
let fs1 = put_conflicts fs in
let fs2 = biggest fs1 in
- let fs3 = Sort.list order_factors fs2 in
+ let fs3 = List.sort order_factors fs2 in
if !Emisc.verbose > 1 then begin
prerr_string "fs1:" ; pfactorc stderr fs1 ;
prerr_string "fs2:" ; pfactorc stderr fs2 ;
prerr_string "fs3:" ; pfactorc stderr fs3
end ;
- Sort.list
- (fun ((_,j1),_) ((i2,_),_) -> j1 <= i2)
+ List.sort
+ (fun ((_,j1),_) ((i2,_),_) -> Pervasives.compare (j1:int) i2)
(get_them fs3)
diff --git a/verb.mll b/verb.mll
index 7b5f165..7ef90e5 100644
--- a/verb.mll
+++ b/verb.mll
@@ -51,7 +51,7 @@ let wrap_eat_fst_nl process =
let lst_process_error _ lxm =
warning ("listings, unknown character: '"^Char.escaped lxm^"'")
-let lst_char_table = Array.create 256 lst_process_error
+let lst_char_table = Array.make 256 lst_process_error
;;
let lst_init_char c f =
@@ -1749,7 +1749,7 @@ let init_listings () =
def_code "\\lst at see@frame"
(fun lexbuf ->
let arg = get_prim_arg lexbuf in
- let bs = Array.create 4 None in
+ let bs = Array.make 4 None in
for i = 0 to String.length arg-1 do
match arg.[i] with
| 't' -> bs.(0) <- Solid
diff --git a/version.ml b/version.ml
index 79827ea..adca66e 100644
--- a/version.ml
+++ b/version.ml
@@ -9,8 +9,8 @@
(* *)
(***********************************************************************)
-let real_version = "2.16"
-let release_date = "2014-06-09"
+let real_version = "2.18"
+let release_date = "2014-09-09"
let version =
diff --git a/videoc.mll b/videoc.mll
index 8e6ffa1..00ee0a5 100644
--- a/videoc.mll
+++ b/videoc.mll
@@ -86,6 +86,7 @@ let snipRunHook parsing name =
let compute_hint_id number filename _notename =
let result = number ^ "_" ^ filename in
+(*DEPRECATED
let rec convert i = begin
if i<String.length(result)
then let c = String.get result i in
@@ -97,6 +98,7 @@ let compute_hint_id number filename _notename =
convert (i+1);
end in
convert 0;
+*)
result;;
let increment_internal_counter =
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/hevea.git
More information about the Pkg-ocaml-maint-commits
mailing list