pereira@sri-unix.UUCP (08/15/83)
/* File: Read.Ppl Author: D.H.D.W. Updated: 16 December 82
Modified by Alan Mycroft to regularise the functor modes.
This is both easier to understand (there are no more '?'s),
and also fixes bugs concerning the curious interaction of cut with
the state of parameter instantiation.
I don't cite myself as author of this file yet because I don't
understand it yet. When I do understand it I will reorganise it and
rename things and maybe add things, and I shall then put my name on
it.
Since this file doesn't provide "metaread", it is considerably
simplified. The token list format has been changed somewhat, see
the comments in the RDTOK file.
I have added the rule X(...) -> apply(X,[...]) for Alan Mycroft.
*/
:- mode
after_prefix_op(+, +, +, +, +, -, -),
ambigop(+, -, -, -, -, -),
expect(+, +, -),
exprtl(+, +, +, +, -, -),
exprtl0(+, +, +, -, -),
infixop(+, -, -, -),
postfixop(+, -, -),
prefixop(+, -, -),
read(?, ?),
read(+, +, -, -),
read(+, +, +, -, -),
read_args(+, -, -),
read_list(+, -, -),
syntax_error(+),
syntax_error(+, +).
read(Answer, Variables) :-
repeat,
read_tokens(Tokens, Variables),
( read(Tokens, 1200, Term, Leftover), all_read(Leftover)
; syntax_error(Tokens)
),
!,
Answer = Term.
all_read([]) :- !.
all_read(S) :- syntax_error([operator,expected,after,expression], S).
% expect is part of providing a better syntax error scheme. At the
% moment it just says "X expected", but it should indicate the error
% using whatever method I develop for that.
expect(Token, [Token|Rest], Rest) :- !.
expect(Token, S0, _) :- !,
syntax_error([Token,or,operator,expected], S0).
% I want to experiment with having the operator information held in
% ordinary Prolog facts. For the moment the following predicates
% remain as interfaces to current_op.
% prefixop(O -> Self, Rarg)
% postfixop(O -> Larg, Self)
% infixop(O -> Larg, Self, Rarg)
prefixop(Op, Prec, Prec) :- current_op(Prec, fy, Op), !.
prefixop(Op, Prec, Less) :- current_op(Prec, fx, Op), !, Less is Prec-1.
postfixop(Op, Prec, Prec) :- current_op(Prec, yf, Op), !.
postfixop(Op, Less, Prec) :- current_op(Prec, xf, Op), !, Less is Prec-1.
infixop(Op, Less, Prec, Less) :-
current_op(Prec, xfx, Op), !, Less is Prec-1.
infixop(Op, Less, Prec, Prec) :-
current_op(Prec, xfy, Op), !, Less is Prec-1.
infixop(Op, Prec, Prec, Less) :-
current_op(Prec, yfx, Op), !, Less is Prec-1.
ambigop(F, L1, O1, R1, L2, O2) :-
postfixop(F, L2, O2),
infixop(F, L1, O1, R1), !.
% read(+TokenList, +Precedence, -Term, -LeftOver)
read([Token|RestTokens], Precedence, Term, LeftOver) :-
read(Token, RestTokens, Precedence, Term, LeftOver).
read([], _, _, _) :-
syntax_error(['<end of input>',cannot,start,an,expression], []).
% read(+Token, +RestTokens, +Precedence, -Term, -LeftOver)
read(var(Variable,_), ['('|S1], Precedence, Answer, S) :- !,
read(S1, 999, Arg1, S2),
read_args(S2, RestArgs, S3), !,
exprtl0(S3, apply(Variable,[Arg1|RestArgs]), Precedence, Answer, S).
read(var(Variable,_), S0, Precedence, Answer, S) :- !,
exprtl0(S0, Variable, Precedence, Answer, S).
read(atom(-), [integer(Integer)|S1], Precedence, Answer, S) :-
Negative is -Integer, !,
exprtl0(S1, Negative, Precedence, Answer, S).
read(atom(Functor), ['('|S1], Precedence, Answer, S) :- !,
read(S1, 999, Arg1, S2),
read_args(S2, RestArgs, S3),
Term =.. [Functor,Arg1|RestArgs], !,
exprtl0(S3, Term, Precedence, Answer, S).
read(atom(Functor), S0, Precedence, Answer, S) :-
prefixop(Functor, Prec, Right), !,
after_prefix_op(Functor, Prec, Right, S0, Precedence, Answer, S).
read(atom(Atom), S0, Precedence, Answer, S) :- !,
exprtl0(S0, Atom, Precedence, Answer, S).
read(integer(Integer), S0, Precedence, Answer, S) :- !,
exprtl0(S0, Integer, Precedence, Answer, S).
read('[', [']'|S1], Precedence, Answer, S) :- !,
exprtl0(S1, [], Precedence, Answer, S).
read('[', S1, Precedence, Answer, S) :- !,
read(S1, 999, Arg1, S2),
read_list(S2, RestArgs, S3), !,
exprtl0(S3, [Arg1|RestArgs], Precedence, Answer, S).
read('(', S1, Precedence, Answer, S) :- !,
read(S1, 1200, Term, S2),
expect(')', S2, S3), !,
exprtl0(S3, Term, Precedence, Answer, S).
read(' (', S1, Precedence, Answer, S) :- !,
read(S1, 1200, Term, S2),
expect(')', S2, S3), !,
exprtl0(S3, Term, Precedence, Answer, S).
read('{', ['}'|S1], Precedence, Answer, S) :- !,
exprtl0(S1, '{}', Precedence, Answer, S).
read('{', S1, Precedence, Answer, S) :- !,
read(S1, 1200, Term, S2),
expect('}', S2, S3), !,
exprtl0(S3, '{}'(Term), Precedence, Answer, S).
read(string(List), S0, Precedence, Answer, S) :- !,
exprtl0(S0, List, Precedence, Answer, S).
read(Token, S0, Precedence, Answer, S) :- !,
syntax_error([Token,cannot,start,an,expression], S0).
% read_args(+Tokens, -TermList, -LeftOver)
read_args([','|S1], [Term|Rest], S) :- !,
read(S1, 999, Term, S2), !,
read_args(S2, Rest, S).
read_args([')'|S], [], S) :- !.
read_args(S, _, _) :- !,
syntax_error([', or )',expected,in,arguments], S).
% read_list(+Tokens, -TermList, -LeftOver)
read_list([','|S1], [Term|Rest], S) :- !,
read(S1, 999, Term, S2), !,
read_list(S2, Rest, S).
read_list(['|'|S1], Rest, S) :- !,
read(S1, 999, Rest, S2), !,
expect(']', S2, S).
read_list([']'|S], [], S) :- !.
read_list(S, _, _) :- !,
syntax_error([', | or ]',expected,in,list], S).
% after_prefix_op(+Op, +Prec, +ArgPrec, +Rest, +Precedence, -Ans, -LeftOver)
after_prefix_op(Functor, Fprec, Aprec, S0, Precedence, _, _) :-
Precedence < Fprec, !,
syntax_error([prefix,operator,Functor,applied,in,context,
with,precedence,Precedence], S0).
after_prefix_op(Functor, Fprec, Aprec, S0, Precedence, Answer, S) :-
peepop(S0, S1),
exprtl(S1, Fprec, Functor, Precedence, Answer, S).
after_prefix_op(Functor, Fprec, Aprec, S1, Precedence, Answer, S) :-
read(S1, Aprec, Arg, S2),
Term =.. [Functor,Arg], /*!,*/
exprtl(S2, Fprec, Term, Precedence, Answer, S).
% the next line fixes a bug concerning "mop dop(1,2)" where mop is
% monadic and dop diadic with higher (PROLOG) prioity.
peepop([atom(F),'('|S1], [atom(F),'('|S1]) :- !.
peepop([atom(F)|S1], [infixop(F,L,P,R)|S1]) :- infixop(F, L, P, R).
peepop([atom(F)|S1], [postfixop(F,L,P)|S1]) :- postfixop(F, L, P).
peepop(S0, S0).
% exprtl0(+String, +Term, +Prec, -Answer, -LeftOver)
exprtl0(S1, Term, Precedence, Answer, S) :-
exprtl(S1, 0, Term, Precedence, Answer, S).
% exprtl(+String, +Context, +Term, +Prec, -Answer, -LeftOver)
exprtl([atom(F)|S1], C, Term, Precedence, Answer, S) :-
ambigop( F, L1, O1, R1, L2, O2), !,
( exprtl([infixop(F,L1,O1,R1)|S1], C, Term, Precedence, Answer, S)
; exprtl([postfixop(F,L2,O2)|S1], C, Term, Precedence, Answer, S)
).
exprtl([atom(F)|S1], C, Term, Precedence, Answer, S) :-
infixop(F, L, Op, R), !,
exprtl([infixop(F,L,Op,R)|S1], C, Term, Precedence, Answer, S).
exprtl([atom(F)|S1], C, Term, Precedence, Answer, S) :-
postfixop(F, L, Op), !,
exprtl([postfixop(F,L,Op)|S1], C, Term, Precedence, Answer, S).
exprtl([infixop(F,L,O,R)|S1], C, Term, Precedence, Answer, S) :-
Precedence >= O, C =< L, !,
read(S1, R, Other, S2),
Expr =.. [F,Term,Other], /*!,*/
exprtl(S2, O, Expr, Precedence, Answer, S).
exprtl([postfixop(F,L,O)|S1], C, Term, Precedence, Answer, S) :-
Precedence >= O, C =< L, !,
Expr =.. [F,Term],
peepop(S1, S2),
exprtl(S2, O, Expr, Precedence, Answer, S).
exprtl([','|S1], C, Term, Precedence, Answer, S) :-
Precedence >= 1000, C =< 999, !,
read(S1, 1000, Next, S2), /*!,*/
exprtl(S2, 1000, (Term,Next), Precedence, Answer, S).
exprtl(['|'|S1], C, Term, Precedence, Answer, S) :-
Precedence >= 1100, C =< 1099, !,
read(S1, 1100, Next, S2), /*!,*/
exprtl(S2, 1100, (Term;Next), Precedence, Answer, S).
exprtl(S, _, Term, _, Term, S) :- !.
/* This business of syntax errors is tricky. When an error is detected,
we have to write out a message. We also have to note how far it was
to the end of the input, and for this we are obliged to use the data-
base. Then we fail all the way back to read(), and that prints the
input list with a marker where the error was noticed. If subgoal_of
were available in compiled code we could use that to find the input
list without hacking the data base.
*/
syntax_error(Message, List) :-
ttynl, display('**'),
display_list(Message),
length(List, Length),
recorda(syntax_error, length(Length), Ref), !,
fail.
display_list([Head|Tail]) :-
ttyput(32),
display_token(Head), !,
display_list(Tail).
display_list([]) :-
ttynl.
syntax_error(List) :-
recorded(syntax_error, length(AfterError), Ref),
erase(Ref),
length(List, Length),
BeforeError is Length-AfterError,
display_list(List, BeforeError), !,
fail.
display_list(X, 0) :-
display(' <<here>> '), !,
display_list(X, 99999).
display_list([Head|Tail], BeforeError) :-
display_token(Head),
ttyput(32),
Left is BeforeError-1, !,
display_list(Tail, Left).
display_list([], _) :-
ttynl.
display_token(atom(X)) :- !, display(X).
display_token(var(V,X)) :- !, display(X).
display_token(integer(X)) :- !, display(X).
display_token(string(X)) :- !, display(X).
display_token(X) :- !, display(X).