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 <trei...@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@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 _______________________________________________ Pkg-ocaml-maint-commits mailing list Pkg-ocaml-maint-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-ocaml-maint-commits