1:- module(tidylog_dcg, [ read_prolog//1, write_prolog//1 ]).    2
    3:- use_module(library(tidylog/atom/name), [name//1]).    4:- use_module(library(tidylog/atom/punc), [punctuation//1]).    5
    6:- use_module(library(tidylog/comment/aol), [aol_comment//1]).    7:- use_module(library(tidylog/comment/ml), [ml_comment//1]).    8
    9:- use_module(library(tidylog/number/decimal), [decimal//1]).   10:- use_module(library(tidylog/number/hex), [hex//1]).   11:- use_module(library(tidylog/number/octal), [octal//1]).   12:- use_module(library(tidylog/number/binary), [binary//1]).   13:- use_module(library(tidylog/number/float), [float//1]).   14
   15:- use_module(library(tidylog/text), [text//2]).   16
   17:- use_module(library(dcg/basics), [eos//0]).   18:- use_module(library(lists), [proper_length/2]).   19:- use_module(library(portray_text), []).   20
   21% Thank you to P. Deransart, A. Ed-Dbali, L. Cervoni whose
   22% "Prolog: The Standard" provided guidance for the initial
   23% DCG that parsed Prolog code.
   24
   25read_prolog(T) -->
   26    comment(T),
   27    eos.
   28read_prolog(T) -->
   29    term(T,1200),
   30    end.
   31
   32
   33write_prolog(T) -->
   34    term_out(T),
   35    ( { is_comment(T) } -> []; end ).
   36
   37
   38% parse terms from a list of codes
   39term(T,P) -->
   40    number_term(T,P).
   41term(T,P) -->
   42    variable_term(T,P).
   43term(T,P) -->
   44    compound_term(T,P).
   45term(T,P) -->
   46    atom_term(T,P).
   47term(T,P) -->
   48    paren_term(T,P).
   49term(T,P) -->
   50    string_term(T,P).
   51term(T,P) -->
   52    prefix_operator_term(T,P).
   53
   54
   55% generate list of codes from a term
   56term_out(Var) -->
   57    { var(Var), ! },
   58    { name_the_vars(Var, Names) },
   59    write_term(Var,[variable_names(Names)]).
   60term_out(AolComment) -->
   61    aol_comment(AolComment).
   62term_out(MlComment) -->
   63    ml_comment(MlComment).
   64term_out(Integer) -->
   65    decimal(Integer).
   66term_out(Op) -->
   67    { is_operator(Op) },
   68    format("(~w)",[Op]).
   69term_out(Atom) -->
   70    { atom(Atom) },
   71    name(Atom).
   72term_out(Punctuation) -->
   73    { atom(Punctuation) },
   74    punctuation(Punctuation).
   75term_out(Text) -->
   76    text(_,Text).
   77term_out(Head :- Body) -->
   78    term_out(Head),
   79    " :-",
   80    nl,
   81    indent,
   82    term_out(Body).
   83term_out(F) -->
   84    float(F).
   85term_out(T) -->
   86    format("~q",[T]).
   87
   88
   89number_term(T,P) -->
   90    float_number(F),
   91    rest_term(F,T,0,P).
   92number_term(T,P) -->
   93    decimal(I),
   94    rest_term(I,T,0,P).
   95number_term(T,P) -->
   96    hex(I),
   97    rest_term(I,T,0,P).
   98number_term(T,P) -->
   99    octal(I),
  100    rest_term(I,T,0,P).
  101number_term(T,P) -->
  102    binary(I),
  103    rest_term(I,T,0,P).
  104
  105
  106variable_term(T,P) -->
  107    variable(V),
  108    rest_term(V,T,0,P).
  109
  110name_the_vars(Term,Names) :-
  111    term_variables(Term, Vars),
  112    maplist(variable_name,Vars,Names).
  113
  114variable_name(Var,Name=Var) :-
  115    get_attr(Var, tidylog, name(Name)).
  116
  117atom_term(T,P) -->
  118    atom(A),
  119    { \+ is_operator(A) },
  120    rest_term(A,T,0,P).
  121atom_term(Op,_P) -->
  122    atom(Op),
  123    { is_operator(Op) }.
  124
  125atom(A) -->
  126    optional_layout_text,
  127    name_token(A).
  128
  129
  130compound_term(T,P) -->
  131    % standard notation
  132    atom(F),
  133    open_paren,
  134    term(Arg,999),
  135    arg_list(L),
  136    { Term =.. [F, Arg | L ] },
  137    rest_term(Term,T,0,P).
  138compound_term(T,P) -->
  139    % list notation
  140    open_bracket,
  141    term(Arg,999),
  142    items(List),
  143    rest_term('[|]'(Arg,List),T,0,P).
  144compound_term(T,P) -->
  145    % curly notation
  146    open_curly,
  147    term(Term,1200),
  148    close_curly,
  149    rest_term('{}'(Term),T,0,P).
  150
  151arg_list([]) -->
  152    close_paren.
  153arg_list([H|T]) -->
  154    comma,
  155    term(H,999),
  156    arg_list(T).
  157
  158items('[|]'(H,T)) -->
  159    comma,
  160    term(H,999),
  161    items(T).
  162items(T) -->
  163    head_tail_separator,
  164    term(T,999),
  165    close_bracket.
  166items('[]') -->
  167    close_bracket.
  168
  169
  170paren_term(T,P) -->
  171    open_paren,
  172    term(Term,1200),
  173    close_paren,
  174    rest_term(Term,T,0,P).
  175paren_term(T,P) -->
  176    "(",
  177    term(Term,1200),
  178    close,
  179    rest_term(Term,T,0,P).
  180
  181
  182string_term(T,P) -->
  183    text(string,S),
  184    rest_term(S,T,0,P).
  185string_term(T,P) -->
  186    text(codes,S),
  187    rest_term(S,T,0,P).
  188
  189
  190prefix_operator_term(T,P) -->
  191    atom(Op),
  192    term(Arg,ArgP),
  193    { prefix_operator(Op,OpP,ArgP) },
  194    { P >= OpP },
  195    { Term =.. [Op, Arg] },
  196    rest_term(Term,T,OpP,P).
  197
  198
  199rest_term(LeftArg,T,LeftP,P) -->
  200    atom(Op),
  201    { infix_operator(Op,OpP,LAP,RAP) },
  202    { P >= OpP },
  203    { LeftP =< LAP },
  204    term(RightArg,RAP),
  205    { Term =.. [Op,LeftArg,RightArg] },
  206    rest_term(Term,T,OpP,P).
  207rest_term(LeftArg,T,LeftP,P) -->
  208    atom(Op),
  209    { postfix_operator(Op,OpP,LAP) },
  210    { P >= OpP },
  211    { LeftP =< LAP },
  212    { Term =.. [Op, LeftArg] },
  213    rest_term(Term,T,OpP,P).
  214rest_term(Left,T,LeftP,P) -->
  215    comma,
  216    { P >= 1000 },
  217    { LeftP < 1000 },
  218    term(Right,1000),
  219    rest_term(','(Left,Right),T,1000,P).
  220rest_term(Term,Term,_,_) -->
  221    [].
  222
  223
  224variable(Var) -->
  225    optional_layout_text,
  226    variable_token(X),
  227    { atom_codes(Name,X) },
  228    { set_variable_name(Var,Name) }.
  229
  230set_variable_name(Var,Name) :-
  231    put_attr(Var,tidylog,name(Name)).
  232
  233
  234float_number(F) -->
  235    optional_layout_text,
  236    float(F).
  237
  238
  239open_paren -->
  240    optional_layout_text,
  241    "(".
  242
  243
  244close_paren -->
  245    optional_layout_text,
  246    ")".
  247
  248
  249open_bracket -->
  250    optional_layout_text,
  251    "[".
  252
  253
  254close_bracket -->
  255    optional_layout_text,
  256    "]".
  257
  258
  259open_curly -->
  260    optional_layout_text,
  261    "{".
  262
  263
  264close_curly -->
  265    optional_layout_text,
  266    "}".
  267
  268
  269head_tail_separator -->
  270    optional_layout_text,
  271    "|".
  272
  273
  274comma -->
  275    optional_layout_text,
  276    ",".
  277
  278
  279end -->
  280    optional_layout_text,
  281    ".".
  282
  283
  284% true if DCG is operating as a parser
  285parsing(H,H) :-
  286    nonvar(H).
  287
  288% matches Rule 0 or more times, consuming as many as possible
  289:- meta_predicate greedy(//,?,?).  290greedy(Rule) -->
  291    call(Rule),
  292    greedy(Rule).
  293greedy(_) -->
  294    [].
  295
  296format(Pattern,Args,H,T) :-
  297    format(codes(H,T),Pattern,Args).
  298
  299write_term(Term,Options,H,T) :-
  300    with_output_to(codes(H,T),write_term(Term,Options)).
  301
  302
  303optional_layout_text -->
  304    ( parsing -> greedy(layout_text) ; [] ).
  305
  306
  307layout_text -->
  308    comment(_).
  309layout_text -->
  310    layout_char(_).
  311
  312
  313is_comment(Var) :-
  314    var(Var),
  315    !,
  316    fail.
  317is_comment('tidylog %full'(_)).
  318is_comment('tidylog %multi'(_)).
  319
  320
  321comment(Comment) -->
  322    aol_comment(Comment).
  323comment(Comment) -->
  324    ml_comment(Comment).
  325
  326
  327name_token(A) -->
  328    name(A).
  329name_token(A) -->
  330    text(atom, A).
  331name_token(A) -->
  332    punctuation(A).
  333
  334
  335alpha_num_seq_char([A|L]) -->
  336    alpha_num_char(A),
  337    alpha_num_seq_char(L).
  338alpha_num_seq_char([]) -->
  339    [].
  340
  341
  342variable_token(V) -->
  343    anonymous_variable(V).
  344variable_token(V) -->
  345    named_variable(V).
  346
  347anonymous_variable(`_`) -->
  348    "_".
  349
  350named_variable([0'_,A|S]) -->
  351    "_",
  352    alpha_num_char(A),
  353    alpha_num_seq_char(S).
  354named_variable([C|S]) -->
  355    capital_letter_char(C),
  356    alpha_num_seq_char(S).
  357
  358
  359type_char(Type,C) -->
  360    [C],
  361    { code_type(C,Type) }.
  362
  363alpha_num_char(C) -->
  364    type_char(alnum,C).
  365alpha_num_char(0'_) -->
  366    "_".
  367
  368
  369layout_char(C) -->
  370    type_char(space,C).
  371
  372
  373capital_letter_char(C) -->
  374    type_char(upper,C).
  375
  376
  377is_operator(Op) :-
  378    atom(Op),
  379    current_op(_,_,Op).
  380
  381infix_operator(Op,P,LeftP,RightP) :-
  382    current_op(P,Spec,Op),
  383    Op \= '.',
  384    ( Spec = xfx ->
  385        LeftP is P-1,
  386        RightP is P-1
  387    ; Spec = xfy ->
  388        LeftP is P-1,
  389        RightP is P
  390    ; Spec = yfx ->
  391        LeftP is P,
  392        RightP is P-1
  393    ).
  394
  395postfix_operator(Op,P,LeftP) :-
  396    current_op(P,Spec,Op),
  397    ( Spec = xf ->
  398        LeftP is P-1
  399    ; Spec = yf ->
  400        LeftP is P
  401    ).
  402
  403prefix_operator(Op,P,RightP) :-
  404    current_op(P,Spec,Op),
  405    ( Spec = fx ->
  406        RightP is P-1
  407    ; Spec = fy ->
  408        RightP is P
  409    ).
  410
  411
  412nl -->
  413    "\n".
  414
  415indent -->
  416    "    ".  % 4 spaces