File: misc.ml

package info (click to toggle)
hevea 2.32-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 3,692 kB
  • sloc: ml: 19,109; sh: 493; makefile: 301; ansic: 132
file content (141 lines) | stat: -rw-r--r-- 3,584 bytes parent folder | download | duplicates (2)
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