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