File: counter.ml

package info (click to toggle)
hevea 1.10-12
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 2,128 kB
  • ctags: 2,379
  • sloc: ml: 19,637; sh: 264; makefile: 197
file content (171 lines) | stat: -rw-r--r-- 4,615 bytes parent folder | download | duplicates (3)
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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
(***********************************************************************)
(*                                                                     *)
(*                          HEVEA                                      *)
(*                                                                     *)
(*  Luc Maranget, projet PARA, INRIA Rocquencourt                      *)
(*                                                                     *)
(*  Copyright 1998 Institut National de Recherche en Informatique et   *)
(*  Automatique.  Distributed only by permission.                      *)
(*                                                                     *)
(***********************************************************************)

let header = "$Id: counter.ml,v 1.11 2006/04/24 14:01:16 maranget Exp $" 
type t_counter =
    {mutable count : int ;
    mutable related : t_counter list}

let mk_bidon () = {count = 0 ; related = []}

type t_checked =
    {cname : string ;
    cvalue : int ;
    crelated : int list} 

let cbidon = {cname = "" ; cvalue = (-1) ; crelated = []}

let ctable = (Hashtbl.create 19 : (string,t_counter) Hashtbl.t);;

type saved =  t_checked array


let prerr_cc check_ctable cc =
  prerr_endline ("counter: "^cc.cname) ;
  prerr_endline ("\tvalue = "^string_of_int cc.cvalue) ;
  prerr_string "\trelated =" ;
  List.iter
    (fun j ->
      prerr_string " " ;
      prerr_string (check_ctable).(j).cname)
    cc.crelated ;
  prerr_endline ""

let checkpoint () =
  let module H = struct
    type t = t_counter 
    let equal = (==) 
    let hash = Hashtbl.hash
  end in
  let module RevHash = Hashtbl.Make (H) in
  let rev_table = RevHash.create 19
  and count = ref 0 in
  Hashtbl.iter
    (fun key value ->
      RevHash.add rev_table value (key, !count) ;
      incr count)
    ctable ;
  let to_int c =
    try
      let _,j = RevHash.find rev_table c in
      j
    with
    | Not_found -> Misc.fatal "Counter.checkpoint" in

  let t = Array.create !count cbidon in

  RevHash.iter
    (fun {count = value ; related = related} (name, i) ->
      t.(i) <-
         {cname = name ;
         cvalue = value ;
        crelated = List.map to_int related})
    rev_table ;
  t

and hot_start check_ctable =
  
  Hashtbl.clear ctable ;
  let rec create_rec i =
    let cc = (check_ctable).(i) in
    try
      Hashtbl.find ctable cc.cname
    with
    | Not_found ->
        let c =
          {count = cc.cvalue ; related = []} in
        Hashtbl.add ctable cc.cname c;
        c.related <- List.map create_rec cc.crelated ;
        if !Misc.verbose > 1 then begin 
          prerr_string "Restored " ;
          prerr_cc check_ctable cc
        end ;
        c in
  for i = 0 to Array.length check_ctable - 1 do
    let _ = create_rec i in ()
  done
;;

let unkown name where =
  Misc.warning ("Unknown counter: "^name^" in "^where)

let find_counter name = Hashtbl.find ctable name


let value_counter name =
  try
    let {count=c} = find_counter name in
    c
  with Not_found -> begin
    unkown name "\\value" ; 0
  end
;;

let def_counter name within =
  try
    let _ = Hashtbl.find ctable name in
    Misc.warning ("Counter "^name^" is already defined, not defining it") ;
    raise Latexmacros.Failed
  with
  | Not_found -> begin
      let within_c =
        try match within with "" -> None | _ -> Some (find_counter within)
        with Not_found -> begin
          unkown within ("\\newcounter{"^name^"}["^within^"]") ;
          None end in
      let c = {count=0 ; related = []} in
      Hashtbl.add ctable name c ;
      match within_c with
      | Some d -> d.related <- c :: d.related
      | _ -> ()
  end

let add_counter name i =
  try
   let c = find_counter name in
   c.count <- c.count + i
  with Not_found -> unkown name "\\addtocounter"
    
let set_counter name x =
  try
    let c = find_counter name in
    c.count <- x
  with Not_found -> unkown name "\\setcounter"
;;

let step_counter name =
  try
  let c = find_counter name in
  c.count <- c.count + 1;
  List.iter (fun c -> c.count <- 0) c.related
  with Not_found ->
    unkown name ("\\stepcounter")
;;

let addtoreset name within =
  try
    let c = find_counter name in
    let d = find_counter within in
    d.related <- c :: d.related
  with Not_found ->
    unkown (name^" or "^within) "\\@addtoreset"
  
and removefromreset name within =
  try
    let c = find_counter name in
    let d = find_counter within in
    d.related <-
       List.fold_right
	 (fun e r -> if e == c then r else  e::r)
	 d.related []
  with Not_found ->
    unkown (name^" or "^within) "\\@removefromreset"