compilo/gen_html.ml at master · ccompile/compilo · GitHub

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

open Ast

(* Lisp mode : generate lots of parentheses in the HTML output *)
let lisp_mode = ref false

(* Affiche une expression entre parenthèses si on est en lisp mode *)
let p_par printer f =
  if !lisp_mode then
    Format.fprintf f "(%a)" printer
  else printer f

(* Préfixes et suffixes de la sortie HTML *)
let html_prefix = "<!DOCTYPE html>\n<html>\n<head>\n"^
                "<title>Parsing output</title>" ^
  "<style>\n" ^
  ".c_type { color: red; }\n" ^
  ".c_type:hover { text-decoration: underline; }\n" ^
  ".c_ident { color: green; }\n" ^
  ".c_funname { color: blue; }\n" ^
  ".c_ident:hover { text-decoration: underline; }\n" ^
  ".c_keyword { font-weight: bold; }\n" ^
  ".c_cst { color: purple; }\n" ^
  ".c_cst:hover { text-decoration: underline; }\n" ^
  ".token:hover { text-decoration: underline; }\n" ^
  "</style>\n" ^
  "</head>\n<body>"
let h3_input_file_pre = "<h3>Input file:</h3>\n<pre>"
let html_infix =  "</pre>\n<h3>Output:</h3>\n"
let html_suffix = "</body>\n</html>"

(* Crée un printer pour le type 'a list
 * à partir d'un printer pour le type 'a
 * `sep` est le séparateur *)
let rec p_list sep printer f = function
  | [] -> ()
  | [a] -> printer f a
  | h::t -> Format.fprintf f "%a%s%a" printer h sep (p_list sep printer) t

(* Même chose, mais avec "@\n" comme séparateur.
 * On ne peut pas faire p_list "@\n" parce que le caractère
 * n'est plus interprété par Format (il passe dans un %s) *)
let rec p_list_nl printer f = function
  | [] -> ()
  | [a] -> printer f a
  | h::t -> Format.fprintf f "%a@\n%a" printer h (p_list_nl printer) t

let rec p_list_scnl printer f = function
  | [] -> ()
  | [a] -> printer f a
  | h::t -> Format.fprintf f "%a;@\n%a" printer h (p_list_scnl printer) t

let strop = function
  | AB_equal -> "=="
  | AB_diff -> "!="
  | AB_lt -> "<"
  | AB_leq -> "<="
  | AB_gt -> ">"
  | AB_geq -> ">="
  | AB_plus -> "+"
  | AB_minus -> "-"
  | AB_times -> "*"
  | AB_div -> "/"
  | AB_mod -> "%"
  | AB_and -> "&&"
  | AB_or -> "||"
  | AB_gets -> "="