(* Graph viewer * Copyright (C) 2010 Jérôme Vouillon * Laboratoire PPS - CNRS Université Paris Diderot * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) { type graph_type = Graph | Digraph | Unknown let graph_type = ref Unknown let set_graph_type v = if !graph_type = Unknown then graph_type := v let buffer = Buffer.create 256 let html_nest = ref 1 let reset () = graph_type := Unknown } let letter = ['A'-'Z' 'a'-'z' '_' '\128'-'\255'] let digit = ['0'-'9'] let name = letter (letter | digit) * let number = '-'? ((digit+ ('.' digit*)?) | ('.' digit+)) let id = name | number rule token = parse "/*" { comment lexbuf } | "//" [^ '\n']* | "#" [^ '\n']* | [' ' '\t' '\r' '\n']+ { token lexbuf } | "->" { if !graph_type = Digraph then Dot_parser.EDGEOP else exit 1 (*XXX*) } | "--" { if !graph_type = Graph then Dot_parser.EDGEOP else exit 1 (*XXX*) } | name { let s = Lexing.lexeme lexbuf in match String.lowercase s with "node" -> Dot_parser.NODE | "edge" -> Dot_parser.EDGE | "graph" -> set_graph_type Graph; Dot_parser.GRAPH | "digraph" -> set_graph_type Digraph; Dot_parser.DIGRAPH | "strict" -> Dot_parser.STRICT | "subgraph" -> Dot_parser.SUBGRAPH | _ -> Dot_parser.ATOM s } | number { Dot_parser.ATOM (Lexing.lexeme lexbuf) } | '"' { qstring lexbuf } | '<' { Buffer.add_char buffer '<'; html_nest := 1; hstring lexbuf } | '{' { Dot_parser.LBRACE } | '}' { Dot_parser.RBRACE } | '[' { Dot_parser.LBRACKET } | ']' { Dot_parser.RBRACKET } | '=' { Dot_parser.EQUAL } | ':' { Dot_parser.COLON } | ';' { Dot_parser.SEMI } | ',' { Dot_parser.COMMA } | '+' { Dot_parser.PLUS } | _ { Format.eprintf "%s@." (Lexing.lexeme lexbuf); exit 1 (*XXX*) } | eof { Dot_parser.EOF } and comment = parse [^'*']* { comment lexbuf } | '*'+ [^ '*' '/']* { comment lexbuf } | '*'+ '/' { token lexbuf } (* | eof *) and qstring = parse '"' { let s = Buffer.contents buffer in Buffer.clear buffer; Dot_parser.QATOM s } | "\\\"" { Buffer.add_string buffer "\\\""; qstring lexbuf } | "\\\n" { qstring lexbuf } | '\n' { Buffer.add_char buffer '\n'; qstring lexbuf } | [^ '"' '\\']+ | '\\' [^'\n'] { Buffer.add_string buffer (Lexing.lexeme lexbuf); qstring lexbuf } (* | _ | eof *) and hstring = parse '>' { decr html_nest; if !html_nest > 0 then hstring lexbuf else begin Buffer.add_char buffer '>'; let s = Buffer.contents buffer in Buffer.clear buffer; Dot_parser.QATOM s end } | '<' { incr html_nest; Buffer.add_char buffer '<'; hstring lexbuf } | [^ '<' '>'] + { Buffer.add_string buffer (Lexing.lexeme lexbuf); hstring lexbuf }