3:- module(dot_dcg, [dot/3]).    4
    5:- use_module(library(dcg/basics)).    6
    7% Subset of the dot language grammar. See www.graphviz.org/doc/info/lang.html
    8% Comments prefixed "DOT Spec" are taken verbatim from the specification.
    9
   10% TODO: Allow logical lines to be separated by backslash and  newline
   11% TODO: Allow double-quoted strings to be concatenated using a '+' operator
   12% TODO: Support comments
   13% TODO: Semi-colons are generally optional, but need to handle exlusion (see spec)
   14% TODO: Keywords should be case-insensitive
   15% TODO: Unify representation of quote and unquoted IDs
   16% TODO: Enforcement of quoted keyword IDs
   17
   18% DOT Spec: graph : [ strict ] (graph | digraph) [ ID ] '{' stmt_list '}'
   19% TODO: Support strict
   20% TODO: Support un-directed graph
   21dot(digraph(Name, StmtList)) -->
   22        w_spc_opt, "digraph", w_spc,
   23        id(Name),
   24        w_spc,
   25        "{", w_spc_opt, stmt_list(StmtList), w_spc_opt, "}",
   26        w_spc_opt.
   27
   28% DOT Spec: stmt_list : [ stmt [ ';' ] [ stmt_list ] ]
   29stmt_list([]) --> [].
   30stmt_list([Stmt]) --> stmt(Stmt).
   31stmt_list([Stmt]) --> stmt(Stmt), w_spc_opt, ";".
   32stmt_list([Stmt|Rest]) --> stmt(Stmt), w_spc_opt, ";", w_spc_opt, stmt_list(Rest).
   33% stmt_list([Stmt|Rest]) --> stmt(Stmt), w_spc_opt, stmt_list(Rest).
   34
   35
   36% DOT Spec: stmt : node_stmt | edge_stmt | attr_stmt | ID '=' ID | subgraph
   37% TODO: attr_stmt
   38                                % TODO: ID '=' ID
   39stmt(EdgeStmt) --> edge_stmt(EdgeStmt).
   40% stmt(EdgeStmt) --> edge_stmt(EdgeStmt), w_spc_opt, ";".
   41stmt(NodeStmt) --> node_stmt(NodeStmt).
   42% stmt(NodeStmt) --> node_stmt(NodeStmt), w_spc_opt, ";".
   43stmt(SubGraph) --> subgraph(SubGraph).
   44% stmt(SubGraph) --> subgraph(SubGraph), w_spc_opt, ";".
   45
   46% DOT Spec: attr_stmt :	(graph | node | edge) attr_list
   47% TODO
   48        
   49% DOT Spec: attr_list : '[' [ a_list ] ']' [ attr_list ]
   50attr_list(AList) -->
   51        "[", w_spc_opt, a_list(AList), w_spc_opt, "]",
   52        !.
   53attr_list(Merged) -->
   54        "[", w_spc_opt, 
   55        { merge(AList, Rest, Merged) }, 
   56        a_list(AList),
   57        w_spc_opt, "]",
   58        w_spc_opt,
   59        attr_list(Rest).
   60
   61
   62% DOT Spec:  a_list : ID '=' ID [ (';' | ',') ] [ a_list ]
   63a_list([]) --> [].
   64a_list([Attr]) -->
   65        attr(Attr), !.
   66a_list([Attr|Rest]) -->
   67        attr(Attr),
   68        w_spc_opt,
   69        ("," ; ";"),
   70        w_spc_opt,
   71        a_list(Rest), !.
   72
   73
   74attr(attr(Name, Value)) --> id(Name), w_spc_opt, "=", w_spc_opt, id(Value), !.
   75attr(attr(Name)) --> id(Name).            
   76
   77% DOT Spec: edge_stmt : (node_id | subgraph) edgeRHS [ attr_list ]
   78% TODO: Subgraph
   79edge_stmt(edge_stmt(Nodes)) --> edge(Nodes).
   80edge_stmt(edge_stmt(Nodes, AttrList)) --> edge(Nodes), w_spc_opt, attr_list(AttrList), !.
   81
   82
   83edge([First|Rest]) --> node_id(First), w_spc_opt, edge_rhs(Rest).
   84
   85% DOT Spec: edgeRHS : edgeop (node_id | subgraph) [ edgeRHS ]
   86% TODO: Subgraph
   87                                % TODO: Edge type
   88
   89edge_rhs([Node]) -->
   90        edge_op,
   91        w_spc_opt,
   92        node_id(Node).
   93edge_rhs([Node|Rest]) -->
   94        edge_op,
   95        w_spc_opt,
   96        node_id(Node),
   97        w_spc_opt,
   98        edge_rhs(Rest).
   99% edge_rhs([Node]) --> edge_op, w_spc_opt, node_id(Node).
  100
  101
  102% DOT Spec: node_stmt : node_id [ attr_list ]
  103node_stmt(node_stmt(NodeId, AttrList)) --> node_id(NodeId), w_spc, attr_list(AttrList).
  104node_stmt(node_stmt(NodeId)) --> node_id(NodeId).
  105
  106
  107% DOT Spec: node_id : ID [ port ]
  108% TODO: Port
  109node_id(NodeId) --> id(NodeId).
  110
  111% DOT Spec: port: ':' ID [ ':' compass_pt ] | ':' compass_pt
  112% DOT Spec: subgraph : [ subgraph [ ID ] ] '{' stmt_list '}'
  113subgraph(subgraph(SubGraphId, StmtList)) -->
  114        id(SubGraphId),
  115        w_spc,
  116        "{", stmt_list(StmtList), "}".
  117
  118% DOT Spec: compass_pt : (n | ne | e | se | s | sw | w | nw | c | _)
  119% TODO
  120
  121id_elem(C) -->
  122        [C],
  123        {code_type(C, alnum)
  124        ;
  125         atom_codes('_', [C])
  126        }.
  127
  128% DOT Spec: An ID is one of the following:
  129% DOT Spec: Any string of alphabetic ([a-zA-Z\200-\377]) characters, underscores
  130                                % ('_') or digits ([0-9]), not beginning with a digit;
  131                                % DOT Spec: a numeral [-]?(.[0-9]+ | [0-9]+(.[0-9]*)? );
  132% DOT Spec: any double-quoted string ("...") possibly containing escaped quotes (\");
  133
  134id(Number) -->
  135        {number(Number)},
  136        !,
  137        number(Number).
  138id(AId) -->
  139        % if atomic, then translate to codes and recurse
  140        {atomic(AId), atom_codes(AId, Id)},
  141        !,
  142        id(Id).
  143
  144id([C|Cs]) -->
  145        id_elem(C),
  146        {\+ digit(C, [C], [])},
  147        id_(Cs).
  148
  149id(Cs) -->
  150       quoted_string_body(Cs, false, false).
  151
  152
  153
  154id_([C]) --> id_elem(C).
  155id_([C|Cs]) --> id_elem(C), id_(Cs).
  156
  157
  158
  159
  160% id(Id) --> quoted_string(Id).
  161
  162% DOT Spec: an HTML string (<...>).
  163% TODO
  164
  165
  166
  167% Quoted string
  168quoted_string(AString) -->
  169        { atom(AString), atom_codes(AString, String) },
  170        quoted_string_body(String, false, false).
  171
  172quoted_string_body([34|String], false, false, [34|Codes], Rest):-
  173    % First character is a quote
  174    quoted_string_body(String, true, false, Codes, Rest).
  175
  176quoted_string_body([92|String], true, false, [92|Codes], Rest):-
  177    % First character is a backslash (i.e., escape symbol)
  178    quoted_string_body(String, true, true, Codes, Rest).
  179
  180quoted_string_body([C|String], true, true, [C|Codes], Rest):-
  181    % Escaped is true, so just (blindly, for now) append whatever was escaped
  182    quoted_string_body(String, true, false, Codes, Rest).
  183
  184quoted_string_body([C|String], true, false, [C|Codes], Rest):-
  185    % Character not a quote
  186    C \= 34,
  187    quoted_string_body(String, true, false, Codes, Rest).
  188
  189quoted_string_body([34], true, false, [34|Codes], Rest) :-
  190    % Closing quote - unify Rest with remainder of input
  191    Rest = Codes, !.
  192
  193% Misc
  194% TODO: Un-directed graph (--)
  195edge_op --> "-", ">".
  196
  197% Mandatory white space
  198w_spc --> w_spc_char.
  199w_spc --> w_spc_char, w_spc.
  200
  201w_spc_char --> [32]; [10]; [11]; [12]; [13].
  202
  203% Optional white space
  204w_spc_opt --> [].
  205w_spc_opt --> w_spc.
  206
  207% Utility predicate for merging one list into another
  208merge([], Ys, Ys).
  209merge([X|Xs], Ys, [X|Zs]) :- merge(Xs, Ys,  Zs)