home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / AI_AUG88.ZIP / PROLCODE.ASC < prev   
Encoding:
Text File  |  1988-05-04  |  9.9 KB  |  292 lines
  1. /*  This is a parser for Prolog program schemes as described in
  2.     the August Expert Toolbox column in AI Expert.
  3.  
  4. DEEP STRUCTURE OF SCHEMA INPUT
  5.  
  6.      % a schema definition is a list of items (clauses or comments)
  7. scheme_def --> item | scheme_def | []
  8.  
  9.      % an item is a clause or comment
  10. item --> clause | comment
  11.  
  12.      % an clause is a fact or rule
  13. clause --> fact | rule
  14.           %%%%%%%%%
  15.  
  16.      % a fact is a term followed by a period
  17. fact --> term .
  18.  
  19.      % a rule is a term (the head) followed by the neck symbol
  20.      % followed by a (rule) body followed by a period
  21. rule --> term :- body .
  22.  
  23.      % a body is a comment followed by body
  24.      % or a term followed by a comma followed by a body
  25.      % or a term
  26. body --> comment body | term , body | term  | comment
  27.  
  28.      % a term is a functor symbol followed by an argument list
  29.      % or a set or a constant or a variable
  30. term --> functor_symbol arg_list | set | constant | variable
  31.  
  32.      % an arg_list is a term_list in parens
  33. arg_list --> ( termlist )
  34.  
  35.      % a term_list is a term followed by a ter_list or a term
  36. term_list --> term term_list | term
  37.  
  38.      % a functor symbol is an atom or variable
  39. functor_symbol --> atom | variable
  40.  
  41.      % a set is a list of terms or the empty list
  42. set  --> [ set_termlist  | []
  43.  
  44.      % a termlist is a term followed by a comma followed by a termlist
  45.      % or a term followed by a right bracket
  46. set_termlist --> term, set_termlist | term  ]
  47.  
  48.  
  49.      % a comment is a comment starter followed by a (comment)
  50.      % word list
  51. comment        --> start_comment word_list
  52.  
  53.      % a word_list is a word followed by a word_list
  54.      % or an end of comment
  55. word_list      --> word word_list | end_comment
  56.  
  57.      % a word is a variable or a token
  58. word           --> variable | token
  59.  
  60. */
  61.  
  62. %      def. of comment start marker
  63. % start_comment  --> /*
  64.  
  65. %      def. of comment end marker
  66. % end_comment    --> */
  67.  
  68. %%%%%%%%%%%%%%%%%%%%% traces %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  69.  
  70.      % to turn off trace, comment out the next line.
  71. p_trace.
  72. p_trace(X) :- p_trace, trace_message(X),!.
  73. p_trace(_).
  74. p_trace(X,Y) :- p_trace, trace_message(X,Y),!.
  75. p_trace(_,_).
  76.  
  77.  
  78. trace_message(X):-  leadoff, write_message(X).
  79. trace_message(X,Y):-  leadoff, write_message(X), write_message(Y).
  80.  
  81. leadoff :-    nl,
  82.                write('**TRACE***: ').
  83.  
  84. write_message(X) :- string(X),!, write(X).
  85. write_message(X) :- writeq(X).
  86.  
  87. %%%%%%%%%%%%%%%%%%%%% scheme_def %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  88.  
  89. scheme_def(Scheme) --> item(H), scheme_def( T),
  90.                          {Scheme= [ H | T],
  91.                           p_trace($Scheme : $, Scheme)},!.
  92. scheme_def([],[],[]) :- p_trace($Scheme = [] $),!.
  93.  
  94. %%%%%%%%%%%%%%%%%%%%% item %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  95.  
  96. item(X) --> fact(X) , !,{p_trace($item : $, X)}.
  97. item(X) --> rule(X) , !,{p_trace($item : $, X)}.
  98. item(X) --> comment(X) , !,{p_trace($item : $, X)}.
  99.  
  100.  
  101. %%%%%%%%%%%%%%%%%%%%% fact %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  102.  
  103. fact(fact(Fact)) --> term( Fact), [$.$],
  104.                      {p_trace($Fact : $,Fact)}.
  105.  
  106. %%%%%%%%%%%%%%%%%%%%% rule %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  107.  
  108. rule(Rule) --> term(Head), [$:-$],
  109.                {p_trace($starting rule body$)},
  110.                body(Body),
  111.                {Rule = rule((Head :- Body)),
  112.                 p_trace($Rule : $,Rule)}.
  113.  
  114. %%%%%%%%%%%%%%%%%%%%% body %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  115.  
  116. body( Body ) -->   comment(H), body(T),!,
  117.                    { Body = [H | T],
  118.                      p_trace($Body : $,Body)}.
  119. body( Body ) -->   term(H), [$,$], body(T),!,
  120.                    { Body = [H | T],
  121.                      p_trace($Body : $,Body)}.
  122. body( [Term]) -->  term( Term), [$.$],!,
  123.                    {p_trace($Body : $, Term)}.
  124. body( [Comment]) -->  comment(Comment), [$.$],!,
  125.                       {p_trace($Body : $, Comment)}.
  126.  
  127. %%%%%%%%%%%%%%%%%%%%% term %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  128.  
  129.      % a term is a functor symbol followed by an argument list
  130.      % or a set or a constant or a variable or a set
  131. term(Term) --> variable(Variable), [$($],
  132.                {p_trace($entering arg_list $)},
  133.                arg_list(Arg_list), !,
  134.                {Term = var_functor_term( Variable, Arg_list),
  135.                 p_trace($term: $,Term)}.
  136.  
  137. term(Term) --> is_atom(X), [$($], arg_list(Arg_list), !,
  138.                {Term = const_functor_term( X, Arg_list),
  139.                 p_trace($term: $,Term)}.
  140.  
  141. term(X) --> set(X), ! , { p_trace($term: $,X)}.
  142.  
  143. term(X) --> is_atomic(X), ! , { p_trace($term: $,X)}.
  144.  
  145. term(X) --> variable(X), ! , { p_trace($term: $,X)}.
  146.  
  147. %%%%%%%%%%%%%%%%%%%%% arg_list %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  148.  
  149. arg_list(Arglist = [Term | Termlist]) --> term(Term) ,
  150.                                 arg_list_hlpr(Termlist),!,
  151.                                 { Arglist = [Term | Termlist],
  152.                                   p_trace($arg_list: $,Arglist)}.
  153.  
  154. arg_list_hlpr([]) -->  [$)$] , !,
  155.                        { p_trace($arg_list_hlpr: []$)}.
  156. arg_list_hlpr(Termlist) --> [$,$] , arg_list( Termlist) , !,
  157.                        { p_trace($arg_list_hlpr: $,
  158.                                  Termlist )}.
  159.  
  160. %%%%%%%%%%%%%%%%%%%%% set %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  161.  
  162.      % set  --> [ termlist
  163. set( Set ) --> [$[$], termlist(Set),!,{p_trace($Set : $,Set)}.
  164.      % set  --> [ ]
  165. set( Set ) --> [$[$,$]$],{Set = [], p_trace($Set : $,Set)}.
  166.  
  167. %%%%%%%%%%%%%%%%%%%%% termlist %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  168.  
  169.      % termlist --> term, termlist   | term
  170. termlist(Termlist) --> term(H), termlist_hlpr(T),
  171.                        { Termlist = [H | T],
  172.                         p_trace($termlist : $, Termlist)}.
  173. termlist_hlpr([]) --> [$]$],!,{p_trace($termlist : []$)}.
  174. termlist_hlpr(T) --> [$|$], term(T),[$]$],!,
  175.                      {p_trace($termlist : $, T)}.
  176. termlist_hlpr(T) --> comma($,$), termlist(T), !,
  177.                      {p_trace($termlist : $, T)}.
  178.  
  179. %%%%%%%%%%%%%%%%%%%%% comment %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  180.  
  181. comment( Comment ) --> start_comment( H), word_list(T),
  182.                                 { Comment = comment([H | T]),
  183.                                   p_trace($Comment : $,Comment) }.
  184.  
  185. %%%%%%%%%%%%%%%%%%%%% end_comment %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  186.  
  187.         % the straightforward implementation, like that of
  188.         % start_comment, did not work properly
  189. end_comment($*/$) --> [$*/$].
  190.  
  191. %%%%%%%%%%%%%%%%%%% start_comment %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  192.  
  193. start_comment($/*$) --> [$/*$].
  194.  
  195. %%%%%%%%%%%%%%%%%%%%% word_list %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  196.  
  197.           % word_list --> word word_list | end_comment
  198. word_list( [H | T] ) --> word(H), word_list( T ), !.
  199. word_list( [H] ) --> end_comment( H ).
  200.  
  201. %%%%%%%%%%%%%%%%%%%%% word %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  202.  
  203.           % word --> variable | token
  204. word(X) --> variable(X),!.
  205.           % don't let an end of comment be a word
  206. word(X) --> end_comment(X), !, {fail}.
  207. word(X) --> token(X).
  208.  
  209. %%%%%%%%%%%%%%%%%%%%% variable %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  210.  
  211.           % returns a variable inside a var(*) marker
  212. variable(var(X)) --> [X], % get the next token
  213.                      % get its first character
  214.                 {nth_char(0,X,Char),
  215.                      % see if it's upper case
  216.                  is_uc(Char)}.
  217.  
  218. %%%%%%%%%%%%%%%%%%%%% is_atom %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  219.  
  220.            % get an atom from input stream
  221. is_atom(X)  --> [X], % get the next token
  222.                    % get its first character
  223.                {nth_char(0,X,Char),
  224.                    % see if it's lower case
  225.                is_lc(Char)}.
  226.  
  227.  
  228. %%%%%%%%%%%%%%%%%%%%% is_atomic %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  229.  
  230.            % get an atomic structure from input stream
  231. is_atomic(X)  --> [X], % get the next token
  232.                    % see if it's atomic
  233.                   {atomic(X)},!.
  234.  
  235.  
  236. %%%%%%%%%%%%%%%%%%%%% comma %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  237.  
  238. comma(X) --> [$,$],!.
  239.  
  240. %%%%%%%%%%%%%%%%%%%%% token %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  241.  
  242.      % returns an arbitrary token as itself
  243. token(X) --> [X],!.
  244.  
  245. %%%%%%%%%%%%%%%%%%%%% test %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  246.  
  247. test :-
  248.         % Input is a tokenized user-supplied scheme
  249.          Input =
  250. [$/*$, $Predicate_name$, $User_defined_purpose$, $*/$,
  251.  $/*$, $Predicate_name$, $maps$, $null$, $set$, $into$, $null$, $set$, $*/$,
  252.  $Predicate_name$, $($, $[$, $]$, $,$, $[$, $]$, $)$, $:-$, $!$, $.$,
  253.  $/*$, $recursive$, $rule$, $for$, $Predicate_name$, $*/$,
  254.  $Predicate_name$, $($, $[$, $H$, $|$, $T$, $]$, $,$,
  255.                         $[$, $H1$, $|$, $T1$, $]$, $)$,
  256.     $:-$,
  257.       $/*$, $apply$, $Element_predicate$, $to$, $head$, $of$, $list$, $*/$,
  258.   $Element_predicate$, $($, $H$, $,$, $H1$, $)$, $,$,
  259.       $/*$, $recurse$, $with$, $Predicate_name$, $on$,
  260.             $tail$, $of$, $list$, $*/$,
  261.        $Predicate_name$, $($, $T$, $,$, $T1$, $)$, $.$],
  262.         % which is parsed using the top level grammar rules
  263.     scheme_def(Structure, Input, []),
  264.         % and the result is written out
  265.     nl, write($scheme_def = $),  writeq(Structure), nl.
  266.  
  267. e :-
  268.    shell($pe2 proparse.ari$),
  269.    nl,write($reconsulting proparse.ari$),
  270.    reconsult($proparse.ari$).
  271.  
  272. /*
  273. test0 :-
  274.     Input = [ $/*$, $recursive$, $rule$, $for$, $Predicate_name$, $*/$],
  275.     comment( Structure, Input, []),
  276.     nl, write($comment  = $),  writeq(Structure), nl.
  277.  
  278. test3 :-
  279.     Input =
  280. [$Predicate_name$, $($, $[$, $]$, $,$, $[$, $]$, $)$, $:-$, $!$, $.$],
  281.     rule( Structure, Input, []),
  282.     nl, write($rule  = $),  writeq(Structure), nl.
  283.  
  284. test4 :-
  285.     Input = [$[$, $H$, $|$, $T$, $]$],
  286.     set( Structure, Input, []),
  287.     nl, write($set = $ ),  writeq(Structure), nl.
  288.  
  289. test :- test0,  test3, test4.
  290. */
  291. ]$],
  292.     set( Structure, In