/* -*- Mode: Prolog -*- */
/** @copyright

  
  This file is part of PrologDoc (http://prologdoc.sourceforge.net/).

  Copyright (C) 2004 by Salvador Fandino (sfandino@@yahoo.com)

  PrologDoc 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.

  PrologDoc 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 General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with PrologDoc; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

  @/copyright */

:- module(pd_comments_reader, [read_comments/2]).

:- use_module(library('prologdoc/util')).
:- consult(library(readutil)).

/** @pred read_comments(+File, -Comments)
  extract all comments inside /** ... */ from a prolog source file
  */
read_comments(File, Comments) :-
	read_file_to_codes(File, T, []),
	catch( comments(Comments, T, []),
	       syntax_error(Msg, Remains),
	       report_syntax_error(File, Comments, Remains, [Msg]) ).

comments([]) --> [], !.
comments(C) --> comment(C1), !, { append(C1, M, C) }, comments(M).
comments(L) --> no_comments(L1), { L1 = [] -> L = M ; append(L1, M, L) }, comments(M).

comment(C) --> c_comment(C1, Start, _), !, { append("/**", _, Start) -> C=C1 ; line_feeds(C, C1, []) }.
comment(C) --> line_comment(C).

c_comment(M, [0'/, 0'* | A], End) --> "/*", !, ( asterisks(A), more_c_comment(M, End), !; syntax_error('end of file in C style comment') ).

more_c_comment(M, End) --> nested_c_comment(C), !, { append(C, M1, M) }, more_c_comment(M1, End).
more_c_comment([], [0'*|End]) --> "*", asterisks(A), "/", !, { append(A, "/", End) }.
more_c_comment([M1|M], End) --> [M1], more_c_comment(M, End).

nested_c_comment(C) --> c_comment(In, Start, End), { append(In, End, In1), append(Start, In1, C) }.

asterisks([0'*|A]) --> "*", !, asterisks(A).
asterisks([]) --> [].

line_comment(M) --> "%", !, ( more_line_comment(M), ! ; syntax_error('CR missed at end of file') ).

more_line_comment("\n") --> "\n", !, [].
more_line_comment(M) --> [_], more_line_comment(M).

no_comments(L) --> "\"", !, ( more_double_quoted(L), ! ; syntax_error('end of file in double quoted string') ).
no_comments(L) --> "'", !, ( more_single_quoted(L), ! ; syntax_error('end of file in single quoted string') ).
no_comments(L) --> "0'", !, ( quoted_char(L), ! ; syntax_error('end of file in 0\'<char> sequence')).
no_comments(L) --> any_char(L).

more_double_quoted([]) --> "\"", !, [].
more_double_quoted(L) --> quoted_char(L1), more_double_quoted(M), { append(L1, M, L) }.

more_single_quoted([]) --> "'", !, [].
more_single_quoted(L) --> quoted_char(L1), more_single_quoted(M), { append(L1, M, L) }.

quoted_char([]) --> "\\", octal, (octal, (octal; []); []), ("\\"; []), !, [].

quoted_char([]) --> "\\x", ( hex, (hex; []), ("\\"; []), !; syntax_error('invalid hex escape sequence') ).
quoted_char(L) --> "\\", !, any_char(L).
quoted_char(L) --> any_char(L).

octal([O|M], M) :- member(O, "01234567").

hex([H|M], M) :- member(H, "0123456789abcdefABCDEF").

any_char("\n") --> "\n", !, [].
any_char([]) --> [_].

syntax_error(E, L, _) :- throw(syntax_error(E, L)).