~ubuntu-branches/ubuntu/wily/coq-doc/wily

« back to all changes in this revision

Viewing changes to tools/coqdoc/output.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu, Stéphane Glondu, Samuel Mimram
  • Date: 2010-01-07 22:50:39 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20100107225039-n3cq82589u0qt0s2
Tags: 8.2pl1-1
[ Stéphane Glondu ]
* New upstream release (Closes: #563669)
  - remove patches
* Packaging overhaul:
  - use git, advertise it in Vcs-* fields of debian/control
  - use debhelper 7 and dh with override
  - use source format 3.0 (quilt)
* debian/control:
  - set Maintainer to d-o-m, set Uploaders to Sam and myself
  - add Homepage field
  - bump Standards-Version to 3.8.3
* Register PDF documentation into doc-base
* Add debian/watch
* Update debian/copyright

[ Samuel Mimram ]
* Change coq-doc's description to mention that it provides documentation in
  pdf format, not postscript, closes: #543545.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
(* -*- compile-command: "make -C ../.. bin/coqdoc" -*- *)
 
2
(************************************************************************)
 
3
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
 
4
(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
 
5
(*   \VV/  **************************************************************)
 
6
(*    //   *      This file is distributed under the terms of the       *)
 
7
(*         *       GNU Lesser General Public License Version 2.1        *)
 
8
(************************************************************************)
 
9
 
 
10
(*i $Id: output.ml 12187 2009-06-13 19:36:59Z msozeau $ i*)
 
11
 
 
12
open Cdglobals
 
13
open Index
 
14
 
 
15
(*s Low level output *)
 
16
 
 
17
let output_char c = Pervasives.output_char !out_channel c
 
18
 
 
19
let output_string s = Pervasives.output_string !out_channel s
 
20
 
 
21
let printf s = Printf.fprintf !out_channel s
 
22
 
 
23
let sprintf = Printf.sprintf
 
24
 
 
25
 
 
26
(*s Coq keywords *)
 
27
 
 
28
let build_table l = 
 
29
  let h = Hashtbl.create 101 in
 
30
  List.iter (fun key ->Hashtbl.add h  key ()) l;
 
31
  function s -> try Hashtbl.find h s; true with Not_found -> false
 
32
 
 
33
let is_keyword = 
 
34
  build_table
 
35
    [ "AddPath"; "Axiom"; "Abort"; "Boxed"; "Chapter"; "Check"; "Coercion"; "CoFixpoint";
 
36
      "CoInductive"; "Corollary"; "Defined"; "Definition"; "End"; "Eval"; "Example"; 
 
37
      "Export"; "Fact"; "Fix"; "Fixpoint"; "Global"; "Grammar"; "Goal"; "Hint";
 
38
      "Hypothesis"; "Hypotheses"; 
 
39
      "Resolve"; "Unfold"; "Immediate"; "Extern"; "Implicit"; "Import"; "Inductive"; 
 
40
      "Infix"; "Lemma"; "Let"; "Load"; "Local"; "Ltac"; 
 
41
      "Module"; "Module Type"; "Declare Module"; "Include";
 
42
      "Mutual"; "Parameter"; "Parameters"; "Print"; "Proof"; "Proof with"; "Qed";
 
43
      "Record"; "Recursive"; "Remark"; "Require"; "Save"; "Scheme";
 
44
      "Induction"; "for"; "Sort"; "Section"; "Show"; "Structure"; "Syntactic"; "Syntax"; "Tactic"; "Theorem"; 
 
45
      "Set"; "Types"; "Undo"; "Unset"; "Variable"; "Variables"; "Context";
 
46
      "Notation"; "Reserved Notation"; "Tactic Notation";
 
47
      "Delimit"; "Bind"; "Open"; "Scope"; 
 
48
      "Boxed"; "Unboxed"; "Inline";
 
49
      "Implicit Arguments"; "Add"; "Strict";
 
50
      "Typeclasses"; "Instance"; "Global Instance"; "Class"; "Instantiation";
 
51
      "subgoal";
 
52
      (* Program *)
 
53
      "Program Definition"; "Program Example"; "Program Fixpoint"; "Program Lemma";
 
54
      "Obligation"; "Obligations"; "Solve"; "using"; "Next Obligation"; "Next";
 
55
      "Program Instance"; "Equations"; "Equations_nocomp";
 
56
      (*i (* coq terms *) *)
 
57
      "forall"; "match"; "as"; "in"; "return"; "with"; "end"; "let"; "dest"; "fun"; 
 
58
      "if"; "then"; "else"; "Prop"; "Set"; "Type"; ":="; "where"; "struct"; "wf"; "measure";
 
59
      (* Ltac *)
 
60
      "before"; "after"
 
61
       ]
 
62
 
 
63
let is_tactic = 
 
64
  build_table
 
65
    [ "intro"; "intros"; "apply"; "rewrite"; "refine"; "case"; "clear"; "injection";
 
66
      "elimtype"; "progress"; "setoid_rewrite";
 
67
      "destruct"; "destruction"; "destruct_call"; "dependent"; "elim"; "extensionality";
 
68
      "f_equal"; "generalize"; "generalize_eqs"; "generalize_eqs_vars"; "induction"; "rename"; "move"; "omega";
 
69
      "set"; "assert"; "do"; "repeat";
 
70
      "cut"; "assumption"; "exact"; "split"; "subst"; "try"; "discriminate";
 
71
      "simpl"; "unfold"; "red"; "compute"; "at"; "in"; "by";
 
72
      "reflexivity"; "symmetry"; "transitivity";
 
73
      "replace"; "setoid_replace"; "inversion"; "inversion_clear";
 
74
      "pattern"; "intuition"; "congruence"; "fail"; "fresh";
 
75
      "trivial"; "exact"; "tauto"; "firstorder"; "ring";
 
76
      "clapply"; "program_simpl"; "program_simplify"; "eapply"; "auto"; "eauto" ]
 
77
 
 
78
(*s Current Coq module *)
 
79
 
 
80
let current_module = ref ""
 
81
 
 
82
let set_module m = current_module := m; page_title := m
 
83
 
 
84
(*s Common to both LaTeX and HTML *)
 
85
 
 
86
let item_level = ref 0
 
87
 
 
88
(*s Customized pretty-print *)
 
89
 
 
90
let token_pp = Hashtbl.create 97
 
91
 
 
92
let add_printing_token = Hashtbl.replace token_pp
 
93
 
 
94
let find_printing_token tok = 
 
95
  try Hashtbl.find token_pp tok with Not_found -> None, None
 
96
 
 
97
let remove_printing_token = Hashtbl.remove token_pp
 
98
 
 
99
(* predefined pretty-prints *)
 
100
let initialize () = 
 
101
  let if_utf8 = if !Cdglobals.utf8 then fun x -> Some x else fun _ -> None in
 
102
    List.iter 
 
103
      (fun (s,l,l') -> Hashtbl.add token_pp s (Some l, l'))
 
104
      [ "*" ,  "\\ensuremath{\\times}", if_utf8 "×";
 
105
        "|", "\\ensuremath{|}", None;
 
106
        "->",  "\\ensuremath{\\rightarrow}", if_utf8 "→";
 
107
        "->~",  "\\ensuremath{\\rightarrow\\lnot}", None;
 
108
        "->~~",  "\\ensuremath{\\rightarrow\\lnot\\lnot}", None;
 
109
        "<-",  "\\ensuremath{\\leftarrow}", None;
 
110
        "<->", "\\ensuremath{\\leftrightarrow}", if_utf8 "↔";
 
111
        "=>",  "\\ensuremath{\\Rightarrow}", if_utf8 "⇒";
 
112
        "<=",  "\\ensuremath{\\le}", if_utf8 "≤";
 
113
        ">=",  "\\ensuremath{\\ge}", if_utf8 "≥";
 
114
        "<>",  "\\ensuremath{\\not=}", if_utf8 "≠";
 
115
        "~",   "\\ensuremath{\\lnot}", if_utf8 "¬";
 
116
        "/\\", "\\ensuremath{\\land}", if_utf8 "∧";
 
117
        "\\/", "\\ensuremath{\\lor}", if_utf8 "∨";
 
118
        "|-",  "\\ensuremath{\\vdash}", None;
 
119
        "forall", "\\ensuremath{\\forall}", if_utf8 "∀";
 
120
        "exists", "\\ensuremath{\\exists}", if_utf8 "∃";
 
121
        "Π", "\\ensuremath{\\Pi}", if_utf8 "Π";
 
122
        "λ", "\\ensuremath{\\lambda}", if_utf8 "λ"
 
123
        (* "fun", "\\ensuremath{\\lambda}" ? *)
 
124
      ]
 
125
 
 
126
(*s Table of contents *)
 
127
 
 
128
type toc_entry = 
 
129
  | Toc_library of string
 
130
  | Toc_section of int * (unit -> unit) * string
 
131
 
 
132
let (toc_q : toc_entry Queue.t) = Queue.create ()
 
133
 
 
134
let add_toc_entry e = Queue.add e toc_q
 
135
 
 
136
let new_label = let r = ref 0 in fun () -> incr r; "lab" ^ string_of_int !r
 
137
 
 
138
(*s LaTeX output *)
 
139
 
 
140
module Latex = struct
 
141
 
 
142
  let in_title = ref false
 
143
  let in_doc = ref false
 
144
 
 
145
  (*s Latex preamble *)
 
146
 
 
147
  let (preamble : string Queue.t) = Queue.create ()
 
148
 
 
149
  let push_in_preamble s = Queue.add s preamble
 
150
 
 
151
  let header () =
 
152
    if !header_trailer then begin
 
153
      printf "\\documentclass[12pt]{report}\n";
 
154
      if !inputenc != "" then printf "\\usepackage[%s]{inputenc}\n" !inputenc;
 
155
      printf "\\usepackage[T1]{fontenc}\n";
 
156
      printf "\\usepackage{fullpage}\n";
 
157
      printf "\\usepackage{coqdoc}\n";
 
158
      Queue.iter (fun s -> printf "%s\n" s) preamble;
 
159
      printf "\\begin{document}\n"
 
160
    end;
 
161
    output_string 
 
162
      "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n";
 
163
    output_string
 
164
      "%% This file has been automatically generated with the command\n";
 
165
    output_string "%% ";
 
166
    Array.iter (fun s -> printf "%s " s) Sys.argv;
 
167
    printf "\n";
 
168
    output_string
 
169
      "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n"
 
170
 
 
171
  let trailer () =
 
172
    if !header_trailer then begin
 
173
      printf "\\end{document}\n"
 
174
    end
 
175
 
 
176
  let char c = match c with
 
177
    | '\\' -> 
 
178
        printf "\\symbol{92}"
 
179
    | '$' | '#' | '%' | '&' | '{' | '}' | '_' -> 
 
180
        output_char '\\'; output_char c
 
181
    | '^' | '~' -> 
 
182
        output_char '\\'; output_char c; printf "{}"
 
183
    | _ -> 
 
184
        output_char c
 
185
 
 
186
  let label_char c = match c with
 
187
    | '\\' | '$' | '#' | '%' | '&' | '{' | '}' | '_'
 
188
    | '^' | '~' -> ()
 
189
    | _ -> 
 
190
        output_char c
 
191
 
 
192
  let latex_char = output_char
 
193
  let latex_string = output_string
 
194
 
 
195
  let html_char _ = ()
 
196
  let html_string _ = ()
 
197
 
 
198
  let raw_ident s =
 
199
    for i = 0 to String.length s - 1 do char s.[i] done
 
200
 
 
201
  let label_ident s =
 
202
    for i = 0 to String.length s - 1 do label_char s.[i] done
 
203
 
 
204
  let start_module () = 
 
205
    if not !short then begin
 
206
      printf "\\coqlibrary{"; 
 
207
      label_ident !current_module; 
 
208
      printf "}{";
 
209
      raw_ident !current_module; 
 
210
      printf "}\n\n"
 
211
    end
 
212
 
 
213
  let start_latex_math () = output_char '$'
 
214
 
 
215
  let stop_latex_math () = output_char '$'
 
216
 
 
217
  let start_verbatim () = printf "\\begin{verbatim}"
 
218
 
 
219
  let stop_verbatim () = printf "\\end{verbatim}\n"
 
220
 
 
221
  let indentation n = 
 
222
    if n == 0 then 
 
223
      printf "\\coqdocnoindent\n"
 
224
    else
 
225
      let space = 0.5 *. (float n) in
 
226
      printf "\\coqdocindent{%2.2fem}\n" space
 
227
 
 
228
  let with_latex_printing f tok =
 
229
    try 
 
230
      (match Hashtbl.find token_pp tok with
 
231
         | Some s, _ -> output_string s
 
232
         | _ -> f tok)
 
233
    with Not_found -> 
 
234
      f tok
 
235
 
 
236
  let module_ref m s = 
 
237
    printf "\\moduleid{%s}{" m; raw_ident s; printf "}"
 
238
      (*i
 
239
    match find_module m with
 
240
    | Local ->
 
241
        printf "<a href=\"%s.html\">" m; raw_ident s; printf "</a>"
 
242
    | Coqlib when !externals ->
 
243
        let m = Filename.concat !coqlib m in
 
244
        printf "<a href=\"%s.html\">" m; raw_ident s; printf "</a>"
 
245
    | Coqlib | Unknown ->
 
246
        raw_ident s
 
247
    i*)
 
248
 
 
249
  let ident_ref m fid typ s =
 
250
    let id = if fid <> "" then (m ^ "." ^ fid) else m in
 
251
    match find_module m with
 
252
      | Local ->
 
253
          printf "\\coq%sref{" (type_name typ); label_ident id; printf "}{"; raw_ident s; printf "}"
 
254
      | Coqlib when !externals ->
 
255
          let _m = Filename.concat !coqlib m in
 
256
            printf "\\coq%sref{" (type_name typ); label_ident id; printf "}{"; raw_ident s; printf "}"
 
257
      | Coqlib | Unknown ->
 
258
          printf "\\coq%sref{" (type_name typ); label_ident id; printf "}{"; raw_ident s; printf "}"
 
259
 
 
260
  let defref m id ty s =
 
261
    printf "\\coq%s{" (type_name ty); label_ident (m ^ "." ^ id); printf "}{"; raw_ident s; printf "}"
 
262
 
 
263
  let reference s = function
 
264
    | Def (fullid,typ) -> 
 
265
        defref !current_module fullid typ s
 
266
    | Mod (m,s') when s = s' ->
 
267
        module_ref m s
 
268
    | Ref (m,fullid,typ) -> 
 
269
        ident_ref m fullid typ s
 
270
    | Mod _ ->
 
271
        printf "\\coqdocvar{"; raw_ident s; printf "}"
 
272
          
 
273
  let ident s loc = 
 
274
    if is_keyword s then begin
 
275
      printf "\\coqdockw{"; raw_ident s; printf "}"
 
276
    end else begin
 
277
      begin
 
278
        try
 
279
          reference s (Index.find !current_module loc)
 
280
        with Not_found ->
 
281
          if is_tactic s then begin
 
282
            printf "\\coqdoctac{"; raw_ident s; printf "}"
 
283
          end else begin
 
284
            if !Cdglobals.interpolate && !in_doc (* always a var otherwise *) 
 
285
            then
 
286
              try reference s (Index.find_string !current_module s)
 
287
              with _ -> (printf "\\coqdocvar{"; raw_ident s; printf "}")
 
288
            else (printf "\\coqdocvar{"; raw_ident s; printf "}")
 
289
          end
 
290
      end
 
291
    end
 
292
 
 
293
  let ident s l = 
 
294
    if !in_title then (
 
295
      printf "\\texorpdfstring{\\protect";
 
296
      with_latex_printing (fun s -> ident s l) s;
 
297
      printf "}{"; raw_ident s; printf "}")
 
298
    else
 
299
      with_latex_printing (fun s -> ident s l) s
 
300
    
 
301
  let symbol s = with_latex_printing raw_ident s
 
302
 
 
303
  let rec reach_item_level n = 
 
304
    if !item_level < n then begin
 
305
      printf "\n\\begin{itemize}\n\\item "; incr item_level;
 
306
      reach_item_level n
 
307
    end else if !item_level > n then begin
 
308
      printf "\n\\end{itemize}\n"; decr item_level;
 
309
      reach_item_level n
 
310
    end
 
311
 
 
312
  let item n =
 
313
    let old_level = !item_level in
 
314
    reach_item_level n;
 
315
    if n <= old_level then printf "\n\\item "
 
316
 
 
317
  let stop_item () = reach_item_level 0
 
318
 
 
319
  let start_doc () = in_doc := true
 
320
 
 
321
  let end_doc () = in_doc := false; stop_item ()
 
322
 
 
323
  let comment c = char c
 
324
 
 
325
  let start_comment () = printf "\\begin{coqdoccomment}\n"
 
326
 
 
327
  let end_comment () = printf "\\end{coqdoccomment}\n"
 
328
 
 
329
  let start_coq () = printf "\\begin{coqdoccode}\n"
 
330
 
 
331
  let end_coq () = printf "\\end{coqdoccode}\n"
 
332
 
 
333
  let start_code () = end_doc (); start_coq ()
 
334
 
 
335
  let end_code () = end_coq (); start_doc ()
 
336
 
 
337
  let section_kind = function
 
338
    | 1 -> "\\section{"
 
339
    | 2 -> "\\subsection{"
 
340
    | 3 -> "\\subsubsection{"
 
341
    | 4 -> "\\paragraph{"
 
342
    | _ -> assert false
 
343
 
 
344
  let section lev f =
 
345
    stop_item ();
 
346
    output_string (section_kind lev);
 
347
    in_title := true; f (); in_title := false;
 
348
    printf "}\n\n"
 
349
 
 
350
  let rule () =
 
351
    printf "\\par\n\\noindent\\hrulefill\\par\n\\noindent{}"
 
352
 
 
353
  let paragraph () = stop_item (); printf "\n\n"
 
354
 
 
355
  let line_break () = printf "\\coqdoceol\n"
 
356
 
 
357
  let empty_line_of_code () = printf "\\coqdocemptyline\n"
 
358
 
 
359
  let start_inline_coq () = ()
 
360
 
 
361
  let end_inline_coq () = ()
 
362
 
 
363
  let make_multi_index () = ()
 
364
 
 
365
  let make_index () = ()
 
366
 
 
367
  let make_toc () = printf "\\tableofcontents\n"
 
368
 
 
369
end
 
370
 
 
371
 
 
372
(*s HTML output *)
 
373
 
 
374
module Html = struct
 
375
 
 
376
  let header () =
 
377
    if !header_trailer then
 
378
      if !header_file_spec then
 
379
        let cin = Pervasives.open_in !header_file in
 
380
          try 
 
381
            while true do 
 
382
              let s = Pervasives.input_line cin in 
 
383
                printf "%s\n" s
 
384
            done
 
385
          with End_of_file -> Pervasives.close_in cin
 
386
      else
 
387
        begin
 
388
          printf "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n";
 
389
          printf "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n";
 
390
          printf "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n<head>\n";
 
391
          printf "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=%s\"/>\n" !charset;
 
392
          printf "<link href=\"coqdoc.css\" rel=\"stylesheet\" type=\"text/css\"/>\n";
 
393
          printf "<title>%s</title>\n</head>\n\n" !page_title;
 
394
          printf "<body>\n\n<div id=\"page\">\n\n<div id=\"header\">\n</div>\n\n";
 
395
          printf "<div id=\"main\">\n\n"
 
396
        end
 
397
 
 
398
  let trailer () =
 
399
    if !index && !current_module <> "Index" then 
 
400
      printf "</div>\n\n<div id=\"footer\">\n<hr/><a href=\"index.html\">Index</a>";
 
401
    if !header_trailer then 
 
402
      if !footer_file_spec then
 
403
        let cin = Pervasives.open_in !footer_file in
 
404
          try 
 
405
            while true do 
 
406
              let s = Pervasives.input_line cin in 
 
407
                printf "%s\n" s
 
408
            done
 
409
          with End_of_file -> Pervasives.close_in cin
 
410
      else
 
411
        begin
 
412
          printf "<hr/>This page has been generated by ";
 
413
          printf "<a href=\"%s\">coqdoc</a>\n" Coq_config.wwwcoq;
 
414
          printf "</div>\n\n</div>\n\n</body>\n</html>"
 
415
        end
 
416
 
 
417
  let start_module () = 
 
418
    if not !short then begin
 
419
      add_toc_entry (Toc_library !current_module);
 
420
      printf "<h1 class=\"libtitle\">Library %s</h1>\n\n" !current_module
 
421
    end
 
422
 
 
423
  let indentation n = for i = 1 to n do printf "&nbsp;" done
 
424
 
 
425
  let line_break () = printf "<br/>\n"
 
426
 
 
427
  let empty_line_of_code () = 
 
428
    printf "\n<br/>\n"
 
429
 
 
430
  let char = function
 
431
    | '<' -> printf "&lt;"
 
432
    | '>' -> printf "&gt;"
 
433
    | '&' -> printf "&amp;"
 
434
    | c -> output_char c
 
435
 
 
436
  let raw_ident s = for i = 0 to String.length s - 1 do char s.[i] done
 
437
 
 
438
  let latex_char _ = ()
 
439
  let latex_string _ = ()
 
440
 
 
441
  let html_char = output_char
 
442
  let html_string = output_string
 
443
 
 
444
  let start_latex_math () = ()
 
445
  let stop_latex_math () = ()
 
446
 
 
447
  let start_verbatim () = printf "<pre>"
 
448
  let stop_verbatim () = printf "</pre>\n"
 
449
 
 
450
  let module_ref m s = 
 
451
    match find_module m with
 
452
      | Local ->
 
453
          printf "<a class=\"modref\" href=\"%s.html\">" m; raw_ident s; printf "</a>"
 
454
      | Coqlib when !externals ->
 
455
          let m = Filename.concat !coqlib m in
 
456
            printf "<a class=\"modref\" href=\"%s.html\">" m; raw_ident s; printf "</a>"
 
457
      | Coqlib | Unknown ->
 
458
          raw_ident s
 
459
 
 
460
  let ident_ref m fid typ s =
 
461
    match find_module m with
 
462
    | Local ->
 
463
        printf "<a class=\"idref\" href=\"%s.html#%s\">" m fid;
 
464
        printf "<span class=\"id\" type=\"%s\">" typ; 
 
465
        raw_ident s;
 
466
        printf "</span></a>"
 
467
    | Coqlib when !externals ->
 
468
        let m = Filename.concat !coqlib m in
 
469
          printf "<a class=\"idref\" href=\"%s.html#%s\">" m fid;
 
470
          printf "<span class=\"id\" type=\"%s\">" typ; 
 
471
          raw_ident s; printf "</span></a>"
 
472
    | Coqlib | Unknown ->
 
473
        printf "<span class=\"id\" type=\"%s\">" typ; raw_ident s; printf "</span>"
 
474
          
 
475
  let ident s loc = 
 
476
    if is_keyword s then begin
 
477
      printf "<span class=\"id\" type=\"keyword\">"; 
 
478
      raw_ident s; 
 
479
      printf "</span>"
 
480
    end else 
 
481
      begin
 
482
        try
 
483
          (match Index.find !current_module loc with
 
484
             | Def (fullid,ty) -> 
 
485
                 printf "<a name=\"%s\">" fullid; 
 
486
                 printf "<span class=\"id\" type=\"%s\">" (type_name ty); 
 
487
                 raw_ident s; printf "</span></a>"
 
488
             | Mod (m,s') when s = s' ->
 
489
                 module_ref m s
 
490
             | Ref (m,fullid,ty) -> 
 
491
                 ident_ref m fullid (type_name ty) s
 
492
             | Mod _ ->
 
493
                 printf "<span class=\"id\" type=\"mod\">"; raw_ident s ; printf "</span>")
 
494
        with Not_found ->
 
495
          if is_tactic s then
 
496
            (printf "<span class=\"id\" type=\"tactic\">"; raw_ident s; printf "</span>")
 
497
          else
 
498
            (printf "<span class=\"id\" type=\"var\">"; raw_ident s ; printf "</span>")
 
499
      end
 
500
 
 
501
  let with_html_printing f tok =
 
502
    try 
 
503
      (match Hashtbl.find token_pp tok with
 
504
         | _, Some s -> output_string s
 
505
         | _ -> f tok)
 
506
    with Not_found -> 
 
507
      f tok
 
508
 
 
509
  let ident s l =
 
510
    with_html_printing (fun s -> ident s l) s
 
511
 
 
512
  let symbol s =
 
513
    with_html_printing raw_ident s
 
514
 
 
515
  let rec reach_item_level n = 
 
516
    if !item_level < n then begin
 
517
      printf "\n<ul>\n<li>"; incr item_level;
 
518
      reach_item_level n
 
519
    end else if !item_level > n then begin
 
520
      printf "\n</li>\n</ul>\n"; decr item_level;
 
521
      reach_item_level n
 
522
    end
 
523
 
 
524
  let item n =
 
525
    let old_level = !item_level in
 
526
    reach_item_level n;
 
527
    if n <= old_level then printf "\n</li>\n<li>"
 
528
 
 
529
  let stop_item () = reach_item_level 0
 
530
 
 
531
  let start_coq () = if not !raw_comments then printf "<div class=\"code\">\n"
 
532
 
 
533
  let end_coq () = if not !raw_comments then printf "</div>\n"
 
534
 
 
535
  let start_doc () = 
 
536
    if not !raw_comments then
 
537
      printf "\n<div class=\"doc\">\n"
 
538
 
 
539
  let end_doc () =
 
540
    stop_item (); 
 
541
    if not !raw_comments then printf "\n</div>\n"
 
542
 
 
543
  let start_comment () = printf "<span class=\"comment\">(*"
 
544
 
 
545
  let end_comment () = printf "*)</span>"
 
546
 
 
547
  let start_code () = end_doc (); start_coq ()
 
548
 
 
549
  let end_code () = end_coq (); start_doc ()
 
550
 
 
551
  let start_inline_coq () = printf "<span class=\"inlinecode\">"
 
552
 
 
553
  let end_inline_coq () = printf "</span>"
 
554
 
 
555
  let paragraph () = 
 
556
    let i = !item_level in
 
557
      stop_item ();
 
558
      if i > 0 then printf "\n"
 
559
      else printf "\n<br/> <br/>\n"
 
560
 
 
561
  let section lev f =
 
562
    let lab = new_label () in
 
563
    let r = sprintf "%s.html#%s" !current_module lab in
 
564
    add_toc_entry (Toc_section (lev, f, r));
 
565
    stop_item ();
 
566
    printf "<a name=\"%s\"></a><h%d class=\"section\">" lab lev;
 
567
    f ();
 
568
    printf "</h%d>\n" lev
 
569
 
 
570
  let rule () = printf "<hr/>\n"
 
571
 
 
572
  (* make a HTML index from a list of triples (name,text,link) *)
 
573
  let index_ref i c =
 
574
    let idxc = sprintf "%s_%c" i.idx_name c in
 
575
    if !multi_index then "index_" ^ idxc ^ ".html" else "index.html#" ^ idxc
 
576
 
 
577
  let letter_index category idx (c,l) =
 
578
    if l <> [] then begin
 
579
      let cat = if category && idx <> "global" then "(" ^ idx ^ ")" else "" in
 
580
      printf "<a name=\"%s_%c\"></a><h2>%c %s</h2>\n" idx c c cat;
 
581
      List.iter 
 
582
        (fun (id,(text,link)) -> 
 
583
           printf "<a href=\"%s\">%s</a> %s<br/>\n" link id text) l;
 
584
      printf "<br/><br/>"
 
585
    end
 
586
                
 
587
  let all_letters i = List.iter (letter_index false i.idx_name) i.idx_entries
 
588
 
 
589
  (* Construction d'une liste des index (1 index global, puis 1
 
590
     index par catégorie) *)
 
591
  let format_global_index =
 
592
    Index.map 
 
593
      (fun s (m,t) -> 
 
594
         if t = Library then 
 
595
           "[library]", m ^ ".html"
 
596
         else
 
597
           sprintf "[%s, in <a href=\"%s.html\">%s</a>]" (type_name t) m m ,
 
598
         sprintf "%s.html#%s" m s)
 
599
 
 
600
  let format_bytype_index = function
 
601
    | Library, idx ->
 
602
        Index.map (fun id m -> "", m ^ ".html") idx
 
603
    | (t,idx) ->
 
604
        Index.map 
 
605
          (fun s m -> 
 
606
             let text = sprintf "[in <a href=\"%s.html\">%s</a>]" m m in
 
607
               (text, sprintf "%s.html#%s" m s)) idx
 
608
 
 
609
  (* Impression de la table d'index *)
 
610
  let print_index_table_item i =
 
611
    printf "<tr>\n<td>%s Index</td>\n" (String.capitalize i.idx_name);
 
612
    List.iter 
 
613
      (fun (c,l) -> 
 
614
         if l <> [] then
 
615
           printf "<td><a href=\"%s\">%c</a></td>\n" (index_ref i c) c
 
616
         else
 
617
           printf "<td>%c</td>\n" c)
 
618
      i.idx_entries;
 
619
    let n = i.idx_size in
 
620
      printf "<td>(%d %s)</td>\n" n (if n > 1 then "entries" else "entry");
 
621
      printf "</tr>\n"
 
622
 
 
623
  let print_index_table idxl = 
 
624
    printf "<table>\n";
 
625
    List.iter print_index_table_item idxl;
 
626
    printf "</table>\n"
 
627
        
 
628
  let make_one_multi_index prt_tbl i =
 
629
    (* Attn: make_one_multi_index créé un nouveau fichier... *)
 
630
    let idx = i.idx_name in
 
631
    let one_letter ((c,l) as cl) =
 
632
      open_out_file (sprintf "index_%s_%c.html" idx c);
 
633
      if (!header_trailer) then header ();
 
634
      prt_tbl (); printf "<hr/>";
 
635
      letter_index true idx cl;
 
636
      if List.length l > 30 then begin printf "<hr/>"; prt_tbl () end;
 
637
      if (!header_trailer) then trailer ();
 
638
      close_out_file ()
 
639
    in
 
640
      List.iter one_letter i.idx_entries
 
641
 
 
642
  let make_multi_index () = 
 
643
    let all_index = 
 
644
      let glob,bt = Index.all_entries () in
 
645
        (format_global_index glob) ::
 
646
          (List.map format_bytype_index bt) in
 
647
    let print_table () = print_index_table all_index in
 
648
      List.iter (make_one_multi_index print_table) all_index
 
649
        
 
650
  let make_index () =
 
651
    let all_index = 
 
652
      let glob,bt = Index.all_entries () in
 
653
        (format_global_index glob) ::
 
654
          (List.map format_bytype_index bt) in
 
655
    let print_table () = print_index_table all_index in
 
656
    let print_one_index i =
 
657
      if i.idx_size > 0 then begin
 
658
        printf "<hr/>\n<h1>%s Index</h1>\n" (String.capitalize i.idx_name);
 
659
        all_letters i
 
660
      end
 
661
    in
 
662
      current_module := "Index";
 
663
      if !title <> "" then printf "<h1>%s</h1>\n" !title;
 
664
      print_table ();
 
665
      if not (!multi_index) then 
 
666
        begin
 
667
          List.iter print_one_index all_index;
 
668
          printf "<hr/>"; print_table ()
 
669
        end
 
670
            
 
671
  let make_toc () = 
 
672
    let make_toc_entry = function
 
673
      | Toc_library m -> 
 
674
          stop_item ();
 
675
          printf "<a href=\"%s.html\"><h2>Library %s</h2></a>\n" m m
 
676
      | Toc_section (n, f, r) ->
 
677
          item n; 
 
678
          printf "<a href=\"%s\">" r; f (); printf "</a>\n"
 
679
    in
 
680
      Queue.iter make_toc_entry toc_q;
 
681
      stop_item ();
 
682
 
 
683
end
 
684
 
 
685
 
 
686
(*s TeXmacs-aware output *)
 
687
 
 
688
module TeXmacs = struct
 
689
 
 
690
  (*s Latex preamble *)
 
691
 
 
692
  let in_doc = ref false
 
693
 
 
694
  let (preamble : string Queue.t) = 
 
695
    in_doc := false; Queue.create ()
 
696
 
 
697
  let push_in_preamble s = Queue.add s preamble
 
698
 
 
699
  let header () =
 
700
    output_string 
 
701
      "(*i This file has been automatically generated with the command  \n";
 
702
    output_string 
 
703
      "    "; Array.iter (fun s -> printf "%s " s) Sys.argv; printf " *)\n"
 
704
 
 
705
  let trailer () = ()
 
706
 
 
707
  let char_true c = match c with
 
708
    | '\\' -> printf "\\\\"
 
709
    | '<' -> printf "\\<"
 
710
    | '|' -> printf "\\|"
 
711
    | '>' -> printf "\\>"
 
712
    | _ -> output_char c
 
713
 
 
714
  let char c = if !in_doc then char_true c else output_char c
 
715
 
 
716
  let latex_char = char_true
 
717
  let latex_string = String.iter latex_char
 
718
 
 
719
  let html_char _ = ()
 
720
  let html_string _ = ()
 
721
 
 
722
  let raw_ident s =
 
723
    for i = 0 to String.length s - 1 do char s.[i] done
 
724
 
 
725
  let start_module () = ()
 
726
 
 
727
  let start_latex_math () = printf "<with|mode|math|"
 
728
 
 
729
  let stop_latex_math () = output_char '>'
 
730
 
 
731
  let start_verbatim () = in_doc := true; printf "<\\verbatim>"
 
732
 
 
733
  let stop_verbatim () = in_doc := false; printf "</verbatim>"
 
734
 
 
735
  let indentation n = ()
 
736
 
 
737
  let ident_true s = 
 
738
    if is_keyword s then begin
 
739
      printf "<kw|"; raw_ident s; printf ">"
 
740
    end else begin
 
741
      raw_ident s
 
742
    end
 
743
 
 
744
  let ident s _ = if !in_doc then ident_true s else raw_ident s
 
745
 
 
746
  let symbol_true s = 
 
747
    let ensuremath x = printf "<with|mode|math|\\<%s\\>>" x in
 
748
      match s with
 
749
        | "*"  -> ensuremath "times"
 
750
        | "->" -> ensuremath "rightarrow"
 
751
        | "<-" -> ensuremath "leftarrow"
 
752
        | "<->" ->ensuremath "leftrightarrow"
 
753
        | "=>" -> ensuremath "Rightarrow"
 
754
        | "<=" -> ensuremath "le"
 
755
        | ">=" -> ensuremath "ge"
 
756
        | "<>" -> ensuremath "noteq"
 
757
        | "~" ->  ensuremath "lnot"
 
758
        | "/\\" -> ensuremath "land"
 
759
        | "\\/" -> ensuremath "lor"
 
760
        | "|-" -> ensuremath "vdash"
 
761
        | s    -> raw_ident s
 
762
 
 
763
  let symbol s = if !in_doc then symbol_true s else raw_ident s
 
764
 
 
765
  let rec reach_item_level n = 
 
766
    if !item_level < n then begin
 
767
      printf "\n<\\itemize>\n<item>"; incr item_level;
 
768
      reach_item_level n
 
769
    end else if !item_level > n then begin
 
770
      printf "\n</itemize>"; decr item_level;
 
771
      reach_item_level n
 
772
    end
 
773
 
 
774
  let item n =
 
775
    let old_level = !item_level in
 
776
    reach_item_level n;
 
777
    if n <= old_level then printf "\n\n<item>"
 
778
 
 
779
  let stop_item () = reach_item_level 0
 
780
 
 
781
  let start_doc () = in_doc := true; printf "(** texmacs: "
 
782
 
 
783
  let end_doc () = stop_item (); in_doc := false; printf " *)"
 
784
 
 
785
  let start_coq () = ()
 
786
 
 
787
  let end_coq () = ()
 
788
 
 
789
  let start_comment () = ()
 
790
  let end_comment () = ()
 
791
 
 
792
  let start_code () = in_doc := true; printf "<\\code>\n"
 
793
  let end_code () = in_doc := false; printf "\n</code>"
 
794
 
 
795
  let section_kind = function
 
796
    | 1 -> "section"
 
797
    | 2 -> "subsection"
 
798
    | 3 -> "subsubsection"
 
799
    | 4 -> "paragraph"
 
800
    | _ -> assert false
 
801
 
 
802
  let section lev f =
 
803
    stop_item ();
 
804
    printf "<"; output_string (section_kind lev); printf "|"; 
 
805
    f (); printf ">\n\n"
 
806
 
 
807
  let rule () =
 
808
    printf "\n<hrule>\n"
 
809
 
 
810
  let paragraph () = stop_item (); printf "\n\n"
 
811
 
 
812
  let line_break_true () = printf "<format|line break>"
 
813
 
 
814
  let line_break () = printf "\n"
 
815
 
 
816
  let empty_line_of_code () = printf "\n"
 
817
 
 
818
  let start_inline_coq () = printf "<verbatim|["
 
819
 
 
820
  let end_inline_coq () = printf "]>"
 
821
 
 
822
  let make_multi_index () = ()
 
823
 
 
824
  let make_index () = ()
 
825
 
 
826
  let make_toc () = ()
 
827
 
 
828
end
 
829
 
 
830
 
 
831
(*s LaTeX output *)
 
832
 
 
833
module Raw = struct
 
834
 
 
835
  let header () = ()
 
836
 
 
837
  let trailer () = ()
 
838
 
 
839
  let char = output_char
 
840
 
 
841
  let label_char c = match c with
 
842
    | '\\' | '$' | '#' | '%' | '&' | '{' | '}' | '_'
 
843
    | '^' | '~' -> ()
 
844
    | _ -> 
 
845
        output_char c
 
846
 
 
847
  let latex_char = output_char
 
848
  let latex_string = output_string
 
849
 
 
850
  let html_char _ = ()
 
851
  let html_string _ = ()
 
852
 
 
853
  let raw_ident s =
 
854
    for i = 0 to String.length s - 1 do char s.[i] done
 
855
 
 
856
  let start_module () = ()
 
857
  let end_module () = ()
 
858
 
 
859
  let start_latex_math () = ()
 
860
  let stop_latex_math () = ()
 
861
 
 
862
  let start_verbatim () = ()
 
863
 
 
864
  let stop_verbatim () = ()
 
865
 
 
866
  let indentation n = 
 
867
      for i = 1 to n do printf " " done
 
868
 
 
869
  let ident s loc = raw_ident s
 
870
 
 
871
  let symbol s = raw_ident s
 
872
 
 
873
  let item n = printf "- "
 
874
 
 
875
  let stop_item () = ()
 
876
 
 
877
  let start_doc () = printf "(** "
 
878
  let end_doc () = printf " *)\n"
 
879
 
 
880
  let start_comment () = ()
 
881
  let end_comment () = ()
 
882
 
 
883
  let start_coq () = ()
 
884
  let end_coq () = ()
 
885
 
 
886
  let start_code () = end_doc (); start_coq ()
 
887
  let end_code () = end_coq (); start_doc ()
 
888
 
 
889
  let section_kind = 
 
890
    function
 
891
      | 1 -> "*"
 
892
      | 2 -> "**"
 
893
      | 3 -> "***"
 
894
      | 4 -> "****"
 
895
      | _ -> assert false    
 
896
 
 
897
  let section lev f = 
 
898
    output_string (section_kind lev);
 
899
    f ()
 
900
 
 
901
  let rule () = ()
 
902
 
 
903
  let paragraph () = printf "\n\n"
 
904
 
 
905
  let line_break () = printf "\n"
 
906
 
 
907
  let empty_line_of_code () = printf "\n"
 
908
 
 
909
  let start_inline_coq () = ()
 
910
  let end_inline_coq () = ()
 
911
 
 
912
  let make_multi_index () = ()
 
913
  let make_index () = ()
 
914
  let make_toc () = () 
 
915
 
 
916
end
 
917
 
 
918
 
 
919
 
 
920
(*s Generic output *)
 
921
 
 
922
let select f1 f2 f3 f4 x = 
 
923
  match !target_language with LaTeX -> f1 x | HTML -> f2 x | TeXmacs -> f3 x | Raw -> f4 x
 
924
 
 
925
let push_in_preamble = Latex.push_in_preamble
 
926
 
 
927
let header = select Latex.header Html.header TeXmacs.header Raw.header
 
928
let trailer = select Latex.trailer Html.trailer TeXmacs.trailer Raw.trailer
 
929
 
 
930
let start_module = 
 
931
  select Latex.start_module Html.start_module TeXmacs.start_module Raw.start_module
 
932
 
 
933
let start_doc = select Latex.start_doc Html.start_doc TeXmacs.start_doc Raw.start_doc
 
934
let end_doc = select Latex.end_doc Html.end_doc TeXmacs.end_doc Raw.end_doc
 
935
 
 
936
let start_comment = select Latex.start_comment Html.start_comment TeXmacs.start_comment Raw.start_comment
 
937
let end_comment = select Latex.end_comment Html.end_comment TeXmacs.end_comment Raw.end_comment
 
938
 
 
939
let start_coq = select Latex.start_coq Html.start_coq TeXmacs.start_coq Raw.start_coq
 
940
let end_coq = select Latex.end_coq Html.end_coq TeXmacs.end_coq Raw.end_coq
 
941
 
 
942
let start_code = select Latex.start_code Html.start_code TeXmacs.start_code Raw.start_code
 
943
let end_code = select Latex.end_code Html.end_code TeXmacs.end_code Raw.end_code 
 
944
 
 
945
let start_inline_coq = 
 
946
  select Latex.start_inline_coq Html.start_inline_coq TeXmacs.start_inline_coq Raw.start_inline_coq
 
947
let end_inline_coq = 
 
948
  select Latex.end_inline_coq Html.end_inline_coq TeXmacs.end_inline_coq Raw.end_inline_coq
 
949
 
 
950
let indentation = select Latex.indentation Html.indentation TeXmacs.indentation Raw.indentation
 
951
let paragraph = select Latex.paragraph Html.paragraph TeXmacs.paragraph Raw.paragraph
 
952
let line_break = select Latex.line_break Html.line_break TeXmacs.line_break Raw.line_break
 
953
let empty_line_of_code = select 
 
954
  Latex.empty_line_of_code Html.empty_line_of_code TeXmacs.empty_line_of_code Raw.empty_line_of_code
 
955
 
 
956
let section = select Latex.section Html.section TeXmacs.section Raw.section
 
957
let item = select Latex.item Html.item TeXmacs.item Raw.item
 
958
let stop_item = select Latex.stop_item Html.stop_item TeXmacs.stop_item Raw.stop_item
 
959
let rule = select Latex.rule Html.rule TeXmacs.rule Raw.rule
 
960
 
 
961
let char = select Latex.char Html.char TeXmacs.char Raw.char
 
962
let ident = select Latex.ident Html.ident TeXmacs.ident Raw.ident
 
963
let symbol = select Latex.symbol Html.symbol TeXmacs.symbol Raw.symbol
 
964
 
 
965
let latex_char = select Latex.latex_char Html.latex_char TeXmacs.latex_char Raw.latex_char
 
966
let latex_string = 
 
967
  select Latex.latex_string Html.latex_string TeXmacs.latex_string Raw.latex_string
 
968
let html_char = select Latex.html_char Html.html_char TeXmacs.html_char Raw.html_char
 
969
let html_string = 
 
970
  select Latex.html_string Html.html_string TeXmacs.html_string Raw.html_string
 
971
 
 
972
let start_latex_math = 
 
973
  select Latex.start_latex_math Html.start_latex_math TeXmacs.start_latex_math Raw.start_latex_math
 
974
let stop_latex_math = 
 
975
  select Latex.stop_latex_math Html.stop_latex_math TeXmacs.stop_latex_math Raw.stop_latex_math
 
976
 
 
977
let start_verbatim = 
 
978
  select Latex.start_verbatim Html.start_verbatim TeXmacs.start_verbatim Raw.start_verbatim
 
979
let stop_verbatim = 
 
980
  select Latex.stop_verbatim Html.stop_verbatim TeXmacs.stop_verbatim Raw.stop_verbatim
 
981
let verbatim_char = 
 
982
  select output_char Html.char TeXmacs.char Raw.char
 
983
let hard_verbatim_char = output_char
 
984
 
 
985
let make_multi_index = select Latex.make_multi_index Html.make_multi_index TeXmacs.make_multi_index Raw.make_multi_index
 
986
let make_index = select Latex.make_index Html.make_index TeXmacs.make_index Raw.make_index
 
987
let make_toc = select Latex.make_toc Html.make_toc TeXmacs.make_toc Raw.make_toc