1
\$\begingroup\$

I am trying to learn Prolog, and wrote a bibtex reader using GNU Prolog.

I would like some feedback on my code in terms of: the way I write Prolog, and how it can be improved.

Gist

% CLI for interacting with a bibtex db.
% Enter your bibtex file to .bib.db
% i.e cat wang.bib > .db.bib
% --------------------------------------------

i(K,V, bibentry(Type, Key, Entries)):-
  bibentry(Type, Key, Entries),
  member(i(K,V), Entries).

read_txt(FName, Txt) :-
  open(FName, read, File),
  read_file(File, Txt),
  close(File).

read_file(Stream, []) :- at_end_of_stream(Stream).
read_file(Stream, [X|L]) :-
  \+ at_end_of_stream(Stream),
  get_code(Stream, X),
  read_file(Stream, L).

% ============================================================
% DCG support.
% ============================================================
isalpha(Ch) :-
  Ch >= 0'a, Ch =< 0'z -> true ; Ch >= 0'A, Ch =< 0'Z -> true.
isdigit(Ch) :-
  0'0 =< Ch, Ch =< 0'9.
ispunct(Ch) :-
  Ch >= 0'!, Ch =< 0'@ -> true ; Ch >= 0'{, Ch =< 0'~ -> true.
islchar(Ch) :-
  Ch = 0'_ ; Ch = 0'. ; Ch = 0'- ; Ch = 0'+ .

not_brace(Ch) :-
  Ch =\= 0'{, Ch =\= 0'}.
not_quote(Ch) :-
  Ch =\= 0'".

tilleol(L) --> tilleol([], L).
tilleol(L0, L) -->
  [Char], { Char =\= 13 ; Char =\= 10 },
  { L1 = [Char|L0] },
  (tilleol(L1, L) ; {reverse(L1, L)}).

% TODO : Collapse all the three into a single function
digits(N) --> digits(0, N).
digits(N0, N) --> % N0 is number already read
  [Char], {isdigit(Char)},
  { N1 is N0 * 10 + (Char - 0'0) },
  ( digits(N1, N) ; { N = N1 }).

letters(L) --> letters([], L).
letters(L0, L) -->
  [Char], { isalpha(Char) },
  {L1 = [Char|L0] },
  (letters(L1, L) ; {reverse(L1, L)}).

alphanum(L) --> alphanum([], L).
alphanum(L0, L) -->
  [Char], {isalpha(Char) ; isdigit(Char)},
  {L1 = [Char|L0] },
  (alphanum(L1, L) ; {reverse(L1, L) }).

alphanum_a(L) --> alphanum(LC),{atom_codes(L, LC)}.

punctanum(L) --> punctanum([], L).
punctanum(L0, L) -->
  [Char], {isalpha(Char) ; isdigit(Char) ; ispunct(Char)},
  {L1 = [Char|L0] },
  (punctanum(L1, L) ; {reverse(L1, L) }).

wordanum(L) --> wordanum([], L).
wordanum(L0, L) -->
  [Char], {isalpha(Char) ; isdigit(Char) ; islchar(Char)},
  {L1 = [Char|L0] },
  (wordanum(L1, L) ; {reverse(L1, L) }).

% Just consume spaces
s1_ --> (" ";"\n" ; "\t"), s_.
s_ --> s1_ ; "".

any_case(XX) --> [X], { char_code(C, X), lower_upper(CC, C), char_code(CC, XX)}.

i_([]) --> [].
i_([C|Cs]) --> any_case(C), i_(Cs).

% ============================================================
% Now the bibtex parser.
% ============================================================

parse_txt([]).
parse_txt(Txt) :- phrase(bibs(Bibs), Txt), apply(Bibs).

apply([Bib|Bibs]) :- asserta(Bib), apply(Bibs).
apply([]).

bibs([Bib | Bibs]) --> s_, bib(Bib), s_, bibs(Bibs).
bibs([]) --> [].

bib(Bib) --> ( bib_comment(Bib) ; bib_preamble(Bib) ; bib_string(Bib) ; bib_entry(Bib) ).

bib_entry(bibentry(Type, Name, Keys)) -->
  "@", bib_type(Type),
  "{", s_, bib_name(Name), s_, ",", {!}, s_, bib_keys(Keys), s_, "}", s_.

bib_comment(bibentry(comment,comment, [i(key,Val)])) -->
  "@", i_("comment"), bib_braces(Val), s_.

bib_preamble(bibentry(preamble,preamble, [i(key,Val)])) -->
  "@", i_("preamble"), bib_braces(Val), s_.

bib_string(bibentry(string, K, [i(key,K),i(val,V)])) -->
  "@", i_("string"),
  ("{", s_, bib_keys([i(K,V)]), s_, "}" ; "(", s_, bib_keys([i(K,V)]), s_, ")"), s_.

bib_type(Type) -->
  wordanum(TypeC), {atom_codes(Type, TypeC)}.

bib_name(Name) -->
  wordanum(NameC), {atom_codes(Name, NameC)}.
bib_keys([Pair | Rest]) --> bib_kv(Pair), s_, bib_keys(Rest).
bib_keys([]) --> [].

bib_kv(i(Key,Val)) -->
  bib_key(Key), s_, "=", s_, bib_value(Val), s_, ((",",{!}) ; "").
  % we have a !cut here so that once a pair is parsed, we should not go back
  % there are no possible circumstances in bibtex which would require it.

bib_key(Key) --> wordanum(KeyC), {atom_codes(Key, KeyC)}.

bib_value(Val) -->(bib_braces(V1) ; bib_quotes(V1) ; bib_word(V1)),
  s_, "#", s_, bib_value(V2),
  {list(V2) -> Val = [V1|V2] ; [V1,V2] = Val}. % TODO, fetch from string db
bib_value(Val) --> bib_word(Val).
bib_value(Val) --> bib_braces(Val).
bib_value(Val) --> bib_quotes(Val).

bib_word(word(Val)) --> wordanum(ValC), {atom_codes(Val, ValC)}.
bib_braces(Val) --> parse_brace(ValC), {atom_codes(Val, ValC)}.
bib_quotes(Val) --> parse_quote(ValC), {atom_codes(Val, ValC)}.

% Use the below if the string parens are required (to know what kind of string it was)
% parse_brace(Val) --> "{", parse_bstring(ValS), "}", {append( [0'{| ValS], "}", Val)}.

parse_brace(Val) --> "{", parse_bstring(Val), "}".

parse_bstring([0'\\| [Char|Val]] ) --> "\\", [Char], parse_bstring(Val).
parse_bstring([Char|Val]) --> [Char], {not_brace(Char)}, parse_bstring(Val).
parse_bstring(Val) --> parse_brace(ValA), parse_bstring(ValB), {append(ValA, ValB, Val)}.
parse_bstring([]) --> [].

% Use the below if the string parens are required (to know what kind of string it was)
% parse_quote(Val) --> "\"", parse_qstring(ValS), "\"", {append( [0'"| ValS], "\"", Val)}.

parse_quote(Val) --> "\"", parse_qstring(Val), "\"".

% Warning escaped Quote
parse_qstring([0'\\| [Char|Val]] ) --> "\\", [Char], parse_qstring(Val).
parse_qstring(Val) --> parse_brace(V), parse_qstring(U), {append(V, U, Val)}.
parse_qstring([Char|Val]) --> [Char], {not_quote(Char)}, parse_qstring(Val).
parse_qstring([]) --> [].


%--------------------------------------------------------
% Some colour
%--------------------------------------------------------
c_red(Str) :- write('[0;31m'), write(Str),write('[0m').
c_green(Str) :- write('[0;32m'), write(Str),write('[0m').
c_yellow(Str) :- write('[0;33m'), write(Str),write('[0m').
c_byellow(Str):- write('[1;33m'), write(Str),write('[0m').
c_blue(Str) :- write('[0;34m'), write(Str),write('[0m').
c_magenta(Str):- write('[0;35m'), write(Str),write('[0m').
c_cyan(Str) :- write('[0;36m'), write(Str),write('[0m').
c_white(Str) :- write('[0;37m'), write(Str),write('[0m').

c_start(red) :- write('[0;31m').
c_start(green) :- write('[0;32m').
c_start(yellow):- write('[0;33m').
c_start(byellow):- write('[1;33m').
c_start(blue):- write('[0;34m').
c_start(magenta):- write('[0;35m').
c_start(cyan):- write('[0;36m').
c_start(_):- write('[0;37m').
c_end :- write('[0m').


%--------------------------------------------------------
% Load bibtex files
%--------------------------------------------------------

load_bib(File) :-
  read_txt(File, Txt),
  parse_txt(Txt).

%--------------------------------------------------------
read_line(Codes) :-
  get0(Code),
  ( Code < 0 /* end of file */ -> Codes = "exit"
  ; Code =:= 10 /* end of line */ -> Codes = []
  ; Codes = [Code|Codes1],
  read_line(Codes1)
  ).

%--------------------------------------------------------
% Read User Commands
%--------------------------------------------------------

parse_line(Line, Cmd) :-
phrase(read_command(Cmd), Line) ; Cmd = unknown.

read_kv(pair(Key, Value)) -->
  alphanum_a(Key), s_, ":", s_, alphanum_a(Value).

read_kv(pair(Key, Value)) -->
  alphanum_a(Key), s_, ":", s_, {atom_codes(Value,"")}.

read_kv(has(Key, Value)) -->
  alphanum_a(Key), s_, "~", s_, alphanum_a(Value).

read_kv(has(Key, Value)) -->
  alphanum_a(Key), s_, "~", s_, {atom_codes(Value,"")}.

read_kv(ne(Key, Value)) -->
  alphanum_a(Key), s_, "!", s_, alphanum_a(Value).

read_kv(gt(Key, Value)) -->
  alphanum_a(Key), s_, ">", s_, alphanum_a(Value).

read_kv(lt(Key, Value)) -->
  alphanum_a(Key), s_, "<", s_, alphanum_a(Value).

read_kv(ge(Key, Value)) -->
  alphanum_a(Key), s_, ">=", s_, alphanum_a(Value).

read_kv(le(Key, Value)) -->
  alphanum_a(Key), s_, "<=", s_, alphanum_a(Value).


read_command(exit) --> "exit".
read_command(help) --> "help".
read_command(show(V)) --> "show", s_, alphanum_a(V), s_.
read_command(colour(K,V)) --> ("colour" ; "color"), s_, alphanum_a(K), s_, alphanum_a(V), s_.
read_command(no) --> s_.

read_command(or(P1, P2)) -->
  s_, read_expr(P1), s_, ";", s_, read_command(P2), s_.

read_command(and(P1, P2)) -->
  s_, read_expr(P1), s_, ",", s_, read_command(P2), s_.

read_command(P) --> s_, read_expr(P), s_.


read_command(no) --> [].

read_expr(Pair) --> read_kv(Pair).
read_expr(E) --> "(", read_command(E), ")".
read_expr(all(V)) --> s_, "*", alphanum_a(V), s_.
read_expr(all('')) --> s_, "*", s_.

%--------------------------------------------------------
% Some libraries
%--------------------------------------------------------
awrite([L|Ls]) :- print(L), nl, awrite(Ls).
awrite([]).

portray(bibentry(comment,Key,[i(key, Entry)])) :-
  c_green('>'), write(' '), c_green(Entry).

portray(bibentry(preamble,Key,[i(key,Key),i(val,Entry)])):-
  c_blue('*>'), write(' '), c_yellow(Entry).

portray(bibentry(string,Key,[i(key,Key), i(val,Entry)])):-
  c_yellow(Key), write(' = '), print(Entry).

portray(bibentry(Type,Key,Entries)) :- opt(show,prolog),
  write('bibentry('), c_blue(Type), write(', '), c_yellow(Key),write(','), nl,
  write('['),nl,
  awrite(Entries),
  write(']'),nl,
  write(')'),
  nl.

portray(bibentry(Type,Key,Entries)) :- opt(show,bib),
  write('@'),c_blue(Type), write('{'), c_yellow(Key),write(','), nl,
  awrite(Entries),
  write('}'),
  nl.

portray(bibentry(Type,Key,Entries)) :-
  c_blue(Type), write(' '), c_yellow(Key), nl,
  awrite(Entries), nl.

portray(i(K,V)) :- opt(show,prolog),
  write(' '),write('i('), print(key(K)), write(', '), wvals(V), write('),').

portray(i(K,V)) :- opt(show,bib),
  write(' '), print(key(K)), c_blue('= '), write('{'), wvals(V), write('},').

portray(i(K,V)) :-
  write(' '), print(key(K)), c_blue(': '), wvals(V).

portray(key(K)) :-
  mycolour(K,V), c_start(V), (opt(show,prolog) -> write(K) ; format('~15a', [K])), c_end.
portray(key(K)) :-
  (opt(show,prolog) -> write(K) ; format('~15a', [K])).

portray(word(K)) :- opt(show,prolog), write('word('),print(K),write(')').

% String substitution happens here.
portray(word(K)) :-
  bibentry(string, K, [_,i(val,V)]), print(V).

wvals([V|Vs]) :- print(V), wvals(Vs).
wvals([]).
wvals(V) :- opt(show,prolog),write('\''), print(V), write('\'').
wvals(V) :- print(V).

ulcaseatom(L, U) :-
  atom_chars(L, Ls),
  ulcase(Ls, Us),
  atom_chars(U, Us). % !!!! this is dependent on sequence.

ulcase([L|Ls], [U|Us]) :-
  lower_upper(L, U),
  ulcase(Ls, Us).
  ulcase([], []).

%--------------------------------------------------------
find_num(K,V, N, V1, N1, Res) :-
  atom_codes(V, V1),
  phrase(digits(N), V1),
  i(K,Vi, Res),
  atom_codes(Vi, Vi1),
  phrase(digits(N1), Vi1).

process_cmd(unknown) :-
  write('*'), nl.

process_cmd(help) :-
  write('COMMANDS'),nl,
  tab(1),write('help'),nl,
  tab(1),write('colour <key> <value>'),nl,
  tab(2),write(' e.g: colour title red'),nl,
  tab(1),write('*'),nl,
  tab(1),write('*<type>'),nl,
  tab(2),write(' e.g: *article'),nl,
  tab(1),write('*show <bib|prolog|format>'),nl,
  tab(2),write(' e.g: show bib'),nl.

process_cmd(show(V)) :-
  retractall(opt(show,_)),
  assertz(opt(show,V)).

process_cmd(colour(K,V)) :-
  assertz(mycolour(K,V)).


process_cmd(E) :-
  setof(Res, process_expr(E, Res), ResL),
  awrite(ResL), nl.

process_expr(all(V), Res) :-
  (V = '' ->
  (bibentry(X,Key,R), Res = bibentry(X, Key, R)) ;
  (bibentry(V,Key,R), Res = bibentry(V, Key, R)) ).

process_expr(pair(K,V), Res) :-
  i(K,V, Res).

process_expr(gt(K,V), Res) :-
  find_num(K,V,N,V1,N1, Res),
  N1 #># N, fd_domain([N,N1],1,10000).

process_expr(lt(K,V), Res) :-
  find_num(K,V,N,V1,N1, Res),
  N1 #<# N, fd_domain([N,N1],1,10000).

process_expr(ge(K,V), Res) :-
  find_num(K,V,N,V1,N1, Res),
  N1 #>=# N, fd_domain([N,N1],1,10000).

process_expr(le(K,V), Res) :-
  find_num(K,V,N,V1,N1, Res),
  N1 #=<# N, fd_domain([N,N1],1,10000).

process_expr(ne(K,V), Res) :-
  i(K,V1, Res), V \= V1.

process_expr(has(K,V), Res) :-
  i(K,V1, Res), ulcaseatom(V1, V2), ulcaseatom(V, Vi), sub_atom(V2, _, _, _, Vi).

process_expr(or(E1,E2), Res) :-
process_expr(E1, Res) ; process_expr(E2, Res).

process_expr(and(E1,E2), Res) :-
process_expr(E1, Res), process_expr(E2, Res).

%--------------------------------------------------------
% Standard Incantation for a REPL
%--------------------------------------------------------

do_command :-
  write('bib> '),
  read_line(Line),!,
  parse_line(Line, Cmd),
  ( Cmd = exit; %halt ;
  Cmd = no, do_command ;
  process_cmd(Cmd),
  do_command
  ).


main :-
  load_bib('.db.bib'),
  do_command.

:- dynamic([bibentry/3, opt/2, mycolour/2]).
:- initialization(main).
\$\endgroup\$
2
\$\begingroup\$

Quite nice! A few comments: First of all, consider using SWI-Prolog because it has more extensive libraries that you can use. In particular, consider using SWI's library(pio) to process files. Pure input lets you write DCGs and then transparently apply them to files, which leads to more declarative and more convenient solutions. Instead of isalpha/1 etc., consider using SWI's code_type/2. Also consider using format/2 for output. For example, instead of:

c_red(Str) :- write('[0;31m'), write(Str), write('[0m').

You can write:

c_red(Str) :- format("[0;31m~w[0m", [Str]).

Finite domain constraints are available in SWI-Prolog with library(clpfd).

Edit:

In addition, consider using DCGs also for string generation. This could be useful for your portray/1 predicate: You could describe the output string with a DCG, and use a single format/2 or write/1 call to print the resulting string instead of using several intermixed write calls. The advantage is that it is much easier to test pure predicates than predicates involving low-level output. You can easily write test cases for them etc. The code would also be shorter. In general, it is good practice to separate pure code from impure code. DCGs are often a good fit when describing lists also in other cases.

\$\endgroup\$
  • \$\begingroup\$ I was able to use your suggestion and reduce the duplication in coloring code. color(red, '[0;31m'). c_show(C,Str) :- color(C,Col), color(end,End), format("~w~w~w", [Col,Str,End]). c_start(C) :- color(C,Col), write(Col). I will check out SWI Prolog (Help, my markdown is not working as I expected.) \$\endgroup\$ – rahul Apr 17 '12 at 18:34

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.