1(***********************************************************************) 2(* *) 3(* HEVEA *) 4(* *) 5(* Luc Maranget, projet PARA, INRIA Rocquencourt *) 6(* *) 7(* Copyright 1998 Institut National de Recherche en Informatique et *) 8(* Automatique. Distributed only by permission. *) 9(* *) 10(***********************************************************************) 11 12type t_counter = 13 {mutable count : int ; 14 mutable related : t_counter list} 15 16type t_checked = 17 {cname : string ; 18 cvalue : int ; 19 crelated : int list} 20 21let cbidon = {cname = "" ; cvalue = (-1) ; crelated = []} 22 23let ctable = (Hashtbl.create 19 : (string,t_counter) Hashtbl.t);; 24 25type saved = t_checked array 26 27 28let prerr_cc check_ctable cc = 29 prerr_endline ("counter: "^cc.cname) ; 30 prerr_endline ("\tvalue = "^string_of_int cc.cvalue) ; 31 prerr_string "\trelated =" ; 32 List.iter 33 (fun j -> 34 prerr_string " " ; 35 prerr_string (check_ctable).(j).cname) 36 cc.crelated ; 37 prerr_endline "" 38 39let checkpoint () = 40 let module H = struct 41 type t = t_counter 42 let equal = (==) 43 let hash = Hashtbl.hash 44 end in 45 let module RevHash = Hashtbl.Make (H) in 46 let rev_table = RevHash.create 19 47 and count = ref 0 in 48 Hashtbl.iter 49 (fun key value -> 50 RevHash.add rev_table value (key, !count) ; 51 incr count) 52 ctable ; 53 let to_int c = 54 try 55 let _,j = RevHash.find rev_table c in 56 j 57 with 58 | Not_found -> Misc.fatal "Counter.checkpoint" in 59 60 let t = Array.make !count cbidon in 61 62 RevHash.iter 63 (fun {count = value ; related = related} (name, i) -> 64 t.(i) <- 65 {cname = name ; 66 cvalue = value ; 67 crelated = List.map to_int related}) 68 rev_table ; 69 t 70 71and hot_start check_ctable = 72 73 Hashtbl.clear ctable ; 74 let rec create_rec i = 75 let cc = (check_ctable).(i) in 76 try 77 Hashtbl.find ctable cc.cname 78 with 79 | Not_found -> 80 let c = 81 {count = cc.cvalue ; related = []} in 82 Hashtbl.add ctable cc.cname c; 83 c.related <- List.map create_rec cc.crelated ; 84 if !Misc.verbose > 1 then begin 85 prerr_string "Restored " ; 86 prerr_cc check_ctable cc 87 end ; 88 c in 89 for i = 0 to Array.length check_ctable - 1 do 90 let _ = create_rec i in () 91 done 92;; 93 94let unkown name where = 95 Misc.warning ("Unknown counter: "^name^" in "^where) 96 97let find_counter name = Hashtbl.find ctable name 98 99 100let value_counter name = 101 try 102 let {count=c} = find_counter name in 103 c 104 with Not_found -> begin 105 unkown name "\\value" ; 0 106 end 107;; 108 109let def_counter name within = 110 try 111 let _ = Hashtbl.find ctable name in 112 Misc.warning ("Counter "^name^" is already defined, not defining it") ; 113 raise Latexmacros.Failed 114 with 115 | Not_found -> begin 116 let within_c = 117 try match within with "" -> None | _ -> Some (find_counter within) 118 with Not_found -> begin 119 unkown within ("\\newcounter{"^name^"}["^within^"]") ; 120 None end in 121 let c = {count=0 ; related = []} in 122 Hashtbl.add ctable name c ; 123 match within_c with 124 | Some d -> d.related <- c :: d.related 125 | _ -> () 126 end 127 128let add_counter name i = 129 try 130 let c = find_counter name in 131 c.count <- c.count + i 132 with Not_found -> unkown name "\\addtocounter" 133 134let set_counter name x = 135 try 136 let c = find_counter name in 137 c.count <- x 138 with Not_found -> unkown name "\\setcounter" 139;; 140 141let step_counter name = 142 try 143 let c = find_counter name in 144 c.count <- c.count + 1; 145 List.iter (fun c -> c.count <- 0) c.related 146 with Not_found -> 147 unkown name ("\\stepcounter") 148;; 149 150let addtoreset name within = 151 try 152 let c = find_counter name in 153 let d = find_counter within in 154 d.related <- c :: d.related 155 with Not_found -> 156 unkown (name^" or "^within) "\\@addtoreset" 157 158and removefromreset name within = 159 try 160 let c = find_counter name in 161 let d = find_counter within in 162 d.related <- 163 List.fold_right 164 (fun e r -> if e == c then r else e::r) 165 d.related [] 166 with Not_found -> 167 unkown (name^" or "^within) "\\@removefromreset" 168 169