1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141
|
(***********************************************************************)
(* *)
(* HEVEA *)
(* *)
(* Luc Maranget, projet PARA, INRIA Rocquencourt *)
(* *)
(* Copyright 1999 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
exception Fatal of string
exception NoSupport of string
exception Purposly of string
exception ScanError of string
exception UserError of string
exception EndInput
exception EndDocument
exception Close of string
exception CannotPut
exception EndOfLispComment of int (* QNC *)
let verbose = ref 0
and readverb = ref 0
and displayverb = ref false
let silent = ref false
let column_to_command s = "\\@"^s^"@"
let warning s =
if not !silent || !verbose > 0 then begin
Location.print_pos () ;
prerr_string "Warning: " ;
prerr_endline s
end
let print_verb level s =
if !verbose > level then begin
Location.print_pos () ;
prerr_endline s
end
let message s =
if not !silent || !verbose > 0 then prerr_endline s
let fatal s = raise (Fatal s)
let not_supported s = raise (NoSupport s)
let rec rev_iter f = function
| [] -> ()
| x::rem -> rev_iter f rem ; f x
let copy_hashtbl from_table to_table =
Hashtbl.clear to_table ;
let module OString =
struct
type t = string
let compare = Pervasives.compare
end in
let module Strings = Set.Make (OString) in
let keys = ref Strings.empty in
Hashtbl.iter
(fun key _ -> keys := Strings.add key !keys)
from_table ;
Strings.iter
(fun key ->
let vals = Hashtbl.find_all from_table key in
rev_iter (Hashtbl.add to_table key) vals)
!keys
let copy_int_hashtbl from_table to_table =
Hashtbl.clear to_table ;
let module OInt =
struct
type t = int
let compare x y = x-y
end in
let module Ints = Set.Make (OInt) in
let keys = ref Ints.empty in
Hashtbl.iter
(fun key _ -> keys := Ints.add key !keys)
from_table ;
Ints.iter
(fun key ->
let vals = Hashtbl.find_all from_table key in
rev_iter (Hashtbl.add to_table key) vals)
!keys
let start_env env = "\\"^ env
and end_env env = "\\end"^env
type limits = Limits | NoLimits | IntLimits
let image_opt = ref None
let set_image_opt s = image_opt := Some s
let get_image_opt () = match !image_opt with
| None -> ""
| Some s -> s
let dump_index = ref false
type saved = string option
let checkpoint () = !image_opt
and hot_start so = image_opt := so
let next_of_string s =
let len = String.length s
and k = ref 0 in
(fun () ->
let i = !k in
if i >= len then -1
else begin
incr k ;
Char.code (String.unsafe_get s i)
end)
let hexa c = match c with
| '0'..'9' -> Char.code c - Char.code '0'
| 'a'..'f' -> 10 + Char.code c - Char.code 'a'
| 'A'..'F' -> 10 + Char.code c - Char.code 'A'
| _ -> assert false
let hexa_code c1 c2 = 16 * hexa c1 + hexa c2
(* String utilities *)
let string_map f s =
let len = String.length s in
let out = Buffer.create len in
for k = 0 to len-1 do
Buffer.add_char out (f (String.get s k))
done ;
Buffer.contents out
|