caml2html.mll

  1: 
  2: (* caml2html *)
  3: 
  4: {
  5:   (* on vérifie la ligne de commande *)
  6:   let () =
  7:     if Array.length Sys.argv <> 2
  8:     || not (Sys.file_exists Sys.argv.(1)) then begin
  9:       Printf.eprintf "usage: caml2html file\n";
 10:       exit 1
 11:     end
 12: 
 13:   (* on ouvre le fichier de sortie en écriture *)
 14:   let file = Sys.argv.(1)
 15:   let cout = open_out (file ^ ".html")
 16:   let print s = Printf.fprintf cout s
 17: 
 18:   (* on écrit le début du fichier HTML avec comme titre le nom du fichier *)
 19:   let () =
 20:     print "<!DOCTYPE html>";
 21:     print "<html><head><title>%s</title><style>" file;
 22:     print ".keyword { color: green; } .comment { color: #990000; } .number { color: black; }";
 23:     print "</style></head><body><pre>"
 24: 
 25:   (* décompte des lignes *)
 26:   let count = ref 0
 27:   let newline () = incr count; print "\n<span class=\"number\">%3d</span>: " !count
 28:   let () = newline ()
 29: 
 30:   (* la fonction `is_keyword` détermine si un identificateur est un mot clé *)
 31:   let is_keyword =
 32:     let ht = Hashtbl.create 97 in
 33:     List.iter
 34:       (fun s -> Hashtbl.add ht s ())
 35:       [ "and"; "as"; "assert"; "asr"; "begin"; "class";
 36:         "closed"; "constraint"; "do"; "done"; "downto"; "else";
 37:         "end"; "exception"; "external"; "false"; "for"; "fun";
 38:         "function"; "functor"; "if"; "in"; "include"; "inherit";
 39:         "land"; "lazy"; "let"; "lor"; "lsl"; "lsr";
 40:         "lxor"; "match"; "method"; "mod"; "module"; "mutable";
 41:         "new"; "of"; "open"; "or"; "parser"; "private";
 42:         "rec"; "sig"; "struct"; "then"; "to"; "true";
 43:         "try"; "type"; "val"; "virtual"; "when"; "while";
 44:         "with" ];
 45:     fun s -> Hashtbl.mem ht s
 46: 
 47: }
 48: 
 49: (* expression régulière reconnaissant les identificateurs OCaml *)
 50: 
 51: let ident = ['A'-'Z' 'a'-'z' '_'] ['A'-'Z' 'a'-'z' '0'-'9' '_']*
 52: 
 53: (* fonction s'appliquant dans le code *)
 54: 
 55: rule scan = parse
 56:   | "(*"   { print "<span class=\"comment\">(*";
 57:              comment lexbuf;
 58:              print "</span>";
 59:              scan lexbuf }
 60:   | eof    { () }
 61:   | ident as s
 62:            { if is_keyword s then begin
 63:                print "<span class=\"keyword\">%s</span>" s
 64:              end else
 65:                print "%s" s;
 66:              scan lexbuf }
 67:   | "<"    { print "&lt;"; scan lexbuf }
 68:   | "&"    { print "&amp;"; scan lexbuf }
 69:   | "\n"   { newline (); scan lexbuf }
 70:   | '"'    { print "\""; string lexbuf; scan lexbuf }
 71:   | "'\"'"
 72:   | _ as s { print "%s" s; scan lexbuf }
 73: 
 74: (* fonction s'appliquant dans les commentaires *)
 75: 
 76: and comment = parse
 77:   | "(*"   { print "(*"; comment lexbuf; comment lexbuf }
 78:   | "*)"   { print "*)" }
 79:   | eof    { () }
 80:   | "\n"   { newline (); comment lexbuf }
 81:   | '"'    { print "\""; string lexbuf; comment lexbuf }
 82:   | "<"    { print "&lt;"; comment lexbuf }
 83:   | "&"    { print "&amp;"; comment lexbuf }
 84:   | "'\"'"
 85:   | _ as s { print "%s" s; comment lexbuf }
 86: 
 87: and string = parse
 88:   | '"'    { print "\"" }
 89:   | "<"    { print "&lt;"; string lexbuf }
 90:   | "&"    { print "&amp;"; string lexbuf }
 91:   | "\\" _
 92:   | _ as s { print "%s" s; string lexbuf }
 93: 
 94: {
 95: 
 96:   (* on crée le buffer d'analyse lexicale, on lui applique scan, puis
 97:      on écrit la fin du fichier HTML et on ferme les canaux. *)
 98:   let () =
 99:     scan (Lexing.from_channel (open_in file));
100:     print "</pre>\n</body></html>\n";
101:     close_out cout
102: 
103: }
104: