/*  This is a parser for Prolog program schemes as described in
    the August Expert Toolbox column in AI Expert.

DEEP STRUCTURE OF SCHEMA INPUT

     % a schema definition is a list of items (clauses or comments)
scheme_def --> item | scheme_def | []

     % an item is a clause or comment
item --> clause | comment

     % an clause is a fact or rule
clause --> fact | rule
          %%%%%%%%%

     % a fact is a term followed by a period
fact --> term .

     % a rule is a term (the head) followed by the neck symbol
     % followed by a (rule) body followed by a period
rule --> term :- body .

     % a body is a comment followed by body
     % or a term followed by a comma followed by a body
     % or a term
body --> comment body | term , body | term  | comment

     % a term is a functor symbol followed by an argument list
     % or a set or a constant or a variable
term --> functor_symbol arg_list | set | constant | variable

     % an arg_list is a term_list in parens
arg_list --> ( termlist )

     % a term_list is a term followed by a ter_list or a term
term_list --> term term_list | term

     % a functor symbol is an atom or variable
functor_symbol --> atom | variable

     % a set is a list of terms or the empty list
set  --> [ set_termlist  | []

     % a termlist is a term followed by a comma followed by a termlist
     % or a term followed by a right bracket
set_termlist --> term, set_termlist | term  ]


     % a comment is a comment starter followed by a (comment)
     % word list
comment        --> start_comment word_list

     % a word_list is a word followed by a word_list
     % or an end of comment
word_list      --> word word_list | end_comment

     % a word is a variable or a token
word           --> variable | token

*/

%      def. of comment start marker
% start_comment  --> /*

%      def. of comment end marker
% end_comment    --> */

%%%%%%%%%%%%%%%%%%%%% traces %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

     % to turn off trace, comment out the next line.
p_trace.
p_trace(X) :- p_trace, trace_message(X),!.
p_trace(_).
p_trace(X,Y) :- p_trace, trace_message(X,Y),!.
p_trace(_,_).


trace_message(X):-  leadoff, write_message(X).
trace_message(X,Y):-  leadoff, write_message(X), write_message(Y).

leadoff :-    nl,
               write('**TRACE***: ').

write_message(X) :- string(X),!, write(X).
write_message(X) :- writeq(X).

%%%%%%%%%%%%%%%%%%%%% scheme_def %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

scheme_def(Scheme) --> item(H), scheme_def( T),
                         {Scheme= [ H | T],
                          p_trace($Scheme : $, Scheme)},!.
scheme_def([],[],[]) :- p_trace($Scheme = [] $),!.

%%%%%%%%%%%%%%%%%%%%% item %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

item(X) --> fact(X) , !,{p_trace($item : $, X)}.
item(X) --> rule(X) , !,{p_trace($item : $, X)}.
item(X) --> comment(X) , !,{p_trace($item : $, X)}.


%%%%%%%%%%%%%%%%%%%%% fact %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

fact(fact(Fact)) --> term( Fact), [$.$],
                     {p_trace($Fact : $,Fact)}.

%%%%%%%%%%%%%%%%%%%%% rule %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

rule(Rule) --> term(Head), [$:-$],
               {p_trace($starting rule body$)},
               body(Body),
               {Rule = rule((Head :- Body)),
                p_trace($Rule : $,Rule)}.

%%%%%%%%%%%%%%%%%%%%% body %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

body( Body ) -->   comment(H), body(T),!,
                   { Body = [H | T],
                     p_trace($Body : $,Body)}.
body( Body ) -->   term(H), [$,$], body(T),!,
                   { Body = [H | T],
                     p_trace($Body : $,Body)}.
body( [Term]) -->  term( Term), [$.$],!,
                   {p_trace($Body : $, Term)}.
body( [Comment]) -->  comment(Comment), [$.$],!,
                      {p_trace($Body : $, Comment)}.

%%%%%%%%%%%%%%%%%%%%% term %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

     % a term is a functor symbol followed by an argument list
     % or a set or a constant or a variable or a set
term(Term) --> variable(Variable), [$($],
               {p_trace($entering arg_list $)},
               arg_list(Arg_list), !,
               {Term = var_functor_term( Variable, Arg_list),
                p_trace($term: $,Term)}.

term(Term) --> is_atom(X), [$($], arg_list(Arg_list), !,
               {Term = const_functor_term( X, Arg_list),
                p_trace($term: $,Term)}.

term(X) --> set(X), ! , { p_trace($term: $,X)}.

term(X) --> is_atomic(X), ! , { p_trace($term: $,X)}.

term(X) --> variable(X), ! , { p_trace($term: $,X)}.

%%%%%%%%%%%%%%%%%%%%% arg_list %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

arg_list(Arglist = [Term | Termlist]) --> term(Term) ,
                                arg_list_hlpr(Termlist),!,
                                { Arglist = [Term | Termlist],
                                  p_trace($arg_list: $,Arglist)}.

arg_list_hlpr([]) -->  [$)$] , !,
                       { p_trace($arg_list_hlpr: []$)}.
arg_list_hlpr(Termlist) --> [$,$] , arg_list( Termlist) , !,
                       { p_trace($arg_list_hlpr: $,
                                 Termlist )}.

%%%%%%%%%%%%%%%%%%%%% set %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

     % set  --> [ termlist
set( Set ) --> [$[$], termlist(Set),!,{p_trace($Set : $,Set)}.
     % set  --> [ ]
set( Set ) --> [$[$,$]$],{Set = [], p_trace($Set : $,Set)}.

%%%%%%%%%%%%%%%%%%%%% termlist %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

     % termlist --> term, termlist   | term
termlist(Termlist) --> term(H), termlist_hlpr(T),
                       { Termlist = [H | T],
                        p_trace($termlist : $, Termlist)}.
termlist_hlpr([]) --> [$]$],!,{p_trace($termlist : []$)}.
termlist_hlpr(T) --> [$|$], term(T),[$]$],!,
                     {p_trace($termlist : $, T)}.
termlist_hlpr(T) --> comma($,$), termlist(T), !,
                     {p_trace($termlist : $, T)}.

%%%%%%%%%%%%%%%%%%%%% comment %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

comment( Comment ) --> start_comment( H), word_list(T),
                                { Comment = comment([H | T]),
                                  p_trace($Comment : $,Comment) }.

%%%%%%%%%%%%%%%%%%%%% end_comment %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

        % the straightforward implementation, like that of
        % start_comment, did not work properly
end_comment($*/$) --> [$*/$].

%%%%%%%%%%%%%%%%%%% start_comment %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

start_comment($/*$) --> [$/*$].

%%%%%%%%%%%%%%%%%%%%% word_list %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

          % word_list --> word word_list | end_comment
word_list( [H | T] ) --> word(H), word_list( T ), !.
word_list( [H] ) --> end_comment( H ).

%%%%%%%%%%%%%%%%%%%%% word %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

          % word --> variable | token
word(X) --> variable(X),!.
          % don't let an end of comment be a word
word(X) --> end_comment(X), !, {fail}.
word(X) --> token(X).

%%%%%%%%%%%%%%%%%%%%% variable %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

          % returns a variable inside a var(*) marker
variable(var(X)) --> [X], % get the next token
                     % get its first character
                {nth_char(0,X,Char),
                     % see if it's upper case
                 is_uc(Char)}.

%%%%%%%%%%%%%%%%%%%%% is_atom %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

           % get an atom from input stream
is_atom(X)  --> [X], % get the next token
                   % get its first character
               {nth_char(0,X,Char),
                   % see if it's lower case
               is_lc(Char)}.


%%%%%%%%%%%%%%%%%%%%% is_atomic %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

           % get an atomic structure from input stream
is_atomic(X)  --> [X], % get the next token
                   % see if it's atomic
                  {atomic(X)},!.


%%%%%%%%%%%%%%%%%%%%% comma %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

comma(X) --> [$,$],!.

%%%%%%%%%%%%%%%%%%%%% token %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

     % returns an arbitrary token as itself
token(X) --> [X],!.

%%%%%%%%%%%%%%%%%%%%% test %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

test :-
        % Input is a tokenized user-supplied scheme
         Input =
[$/*$, $Predicate_name$, $User_defined_purpose$, $*/$,
 $/*$, $Predicate_name$, $maps$, $null$, $set$, $into$, $null$, $set$, $*/$,
 $Predicate_name$, $($, $[$, $]$, $,$, $[$, $]$, $)$, $:-$, $!$, $.$,
 $/*$, $recursive$, $rule$, $for$, $Predicate_name$, $*/$,
 $Predicate_name$, $($, $[$, $H$, $|$, $T$, $]$, $,$,
                        $[$, $H1$, $|$, $T1$, $]$, $)$,
    $:-$,
      $/*$, $apply$, $Element_predicate$, $to$, $head$, $of$, $list$, $*/$,
  $Element_predicate$, $($, $H$, $,$, $H1$, $)$, $,$,
      $/*$, $recurse$, $with$, $Predicate_name$, $on$,
            $tail$, $of$, $list$, $*/$,
       $Predicate_name$, $($, $T$, $,$, $T1$, $)$, $.$],
        % which is parsed using the top level grammar rules
    scheme_def(Structure, Input, []),
        % and the result is written out
    nl, write($scheme_def = $),  writeq(Structure), nl.

e :-
   shell($pe2 proparse.ari$),
   nl,write($reconsulting proparse.ari$),
   reconsult($proparse.ari$).

/*
test0 :-
    Input = [ $/*$, $recursive$, $rule$, $for$, $Predicate_name$, $*/$],
    comment( Structure, Input, []),
    nl, write($comment  = $),  writeq(Structure), nl.

test3 :-
    Input =
[$Predicate_name$, $($, $[$, $]$, $,$, $[$, $]$, $)$, $:-$, $!$, $.$],
    rule( Structure, Input, []),
    nl, write($rule  = $),  writeq(Structure), nl.

test4 :-
    Input = [$[$, $H$, $|$, $T$, $]$],
    set( Structure, Input, []),
    nl, write($set = $ ),  writeq(Structure), nl.

test :- test0,  test3, test4.
*/
]$],
    set( Structure, In