1:- module(distfix). % SEPIA header 2 3:- lib(rdtok). 4:- import read_tokens/2 from rdtok. 5 6:- dynamic is_distprefix_op/5, is_distinfix_op/5. 7 8:- local display/1. 9display(X) :- write(error,X). 10ttyput(X) :- put(error, X). 11ttynl :- nl(error). 12 13% File : DISTFI.PL 14% Author : R.A.O'Keefe 15% Updated: 10 May 1984 16% Purpose: Read Prolog terms (with extended syntax). 17 18/* Modified by Alan Mycroft to regularise the functor modes. 19 This is both easier to understand (there are no more '?'s), 20 and also fixes bugs concerning the curious interaction of cut with 21 the state of parameter instantiation. 22 23 Since this file doesn't provide "metaread", it is considerably 24 simplified. The token list format has been changed somewhat, see 25 the comments in the RDTOK file. 26 27 I have added the rule X(...) -> apply(X,[...]) for Alan Mycroft. 28 29 Distfix operators have finally been added. They are declared by 30 distfixop(Priority, Type, Pattern, Term) 31 where Priority is as usual, Type is currently only fx or fy (if 32 the Pattern doesn't specify a right argument one of the types must 33 still be specified but it doesn't matter which), Term is what the 34 reader is to return when it sees something matching the pattern, 35 and the Pattern is a list of atoms and variables whose first 36 elements is an atom, and in which no two variables appear side by 37 side without an intervening atom. To avoid ambiguities, the first 38 atom following each variable should NOT be an infix or postfix 39 operator, but the code below does not check for that, as you could 40 declare such an operator after declaring the distfix form. 41 Examples: 42 distfixop(950, fy, [for,each,X,show,that,Y], forall(X,Y)) 43 distfixop(1105, fx, [try,Goal,reverting,to,Alternative,on,failure], 44 (Goal;Alternative)) 45 distfixop(999, fy, [there,is,a,clause,with,head,H,and,body,B], 46 clause(H,B)) 47 distfixop(999, fy, [there,is,a,clause,with,head,H], clause(H,_)) 48 Infix forms are also available. These have the side effect of 49 declaring the head keyword as an infix operator; anything that did 50 not do this would be significantly harder to patch into the old parser. 51 Examples: 52 distfixop(700, xfy, [S,is,the,set,of,X,such,that,P], setof(X,P,S)) 53 distfixop(700, xfy, [B,is,the,bag,of,X,such,that,P], bagof(X,P,S)), 54 distfixop(700, xfy, [X,is,to,Y,as,A,is,to,B], X*B =:= A*Y), 55 distfixop(700, xfx, [X,had,N,variables], numbervars(X,0,N)) 56*/ 57 58:- export 59 distfixop/4, 60 read/2. 61 62:- mode 63 after_prefix_op(+, +, +, +, +, -, -), 64 ambigop(+, -, -, -, -, -), 65 cant_follow_expr(+, -), 66 distfixop(?, ?, ?, ?), 67 distfix_head(+, +, +, -, -), 68 distfix_head(+, +, +, +, -, -), 69 distfix_keys(+, ?, ?), 70 distfix_pass(+, +, -), 71 distfix_pattern(+, +, -), 72 distfix_read(+, +, -), 73 expect(+, +, -), 74 exprtl(+, +, +, +, -, -), 75 exprtl0(+, +, +, -, -), 76 infixop(+, -, -, -), 77 postfixop(+, -, -), 78 prefixop(+, -, -), 79 prefix_is_atom(+, +), 80 read(?, ?), 81 read(+, +, -, -), 82 read(+, +, +, -, -), 83 read_args(+, -, -), 84 read_list(+, -, -), 85 syntax_error(+), 86 syntax_error(+, +). 87 88 89% read(?Answer, ?Variables) 90% reads a term from the current input stream and unifies it with 91% Answer. Variables is bound to a list of [Atom=Variable] pairs. 92 93read(Answer, Variables) :- 94 repeat, 95 read_tokens(Tokens, Variables), 96 ( read(Tokens, 1200, Term, Leftover), all_read(Leftover) 97 ; syntax_error(Tokens) 98 ), 99 !, 100 Answer = Term. 101 102 103% all_read(+Tokens) 104% checks that there are no unparsed tokens left over. 105 106all_read([]) :- !. 107all_read(S) :- 108 syntax_error([operator,expected,after,expression], S). 109 110 111% expect(Token, TokensIn, TokensOut) 112% reads the next token, checking that it is the one expected, and 113% giving an error message if it is not. It is used to look for 114% right brackets of various sorts, as they're all we can be sure of. 115 116expect(Token, [Token|Rest], Rest) :- !. 117expect(Token, S0, _) :- 118 syntax_error([Token,or,operator,expected], S0). 119 120 121% I want to experiment with having the operator information held as 122% ordinary Prolog facts. For the moment the following predicates 123% remain as interfaces to current_op. 124% prefixop(O -> Self, Rarg) 125% postfixop(O -> Larg, Self) 126% infixop(O -> Larg, Self, Rarg) 127 128 129prefixop(Op, Prec, Prec) :- 130 current_op(Prec, fy, Op), !. 131prefixop(Op, Prec, Less) :- 132 current_op(Prec, fx, Op), !, 133 Less is Prec-1. 134 135 136postfixop(Op, Prec, Prec) :- 137 current_op(Prec, yf, Op), !. 138postfixop(Op, Less, Prec) :- 139 current_op(Prec, xf, Op), !, Less is Prec-1. 140 141 142infixop(Op, Less, Prec, Less) :- 143 current_op(Prec, xfx, Op), !, Less is Prec-1. 144infixop(Op, Less, Prec, Prec) :- 145 current_op(Prec, xfy, Op), !, Less is Prec-1. 146infixop(Op, Prec, Prec, Less) :- 147 current_op(Prec, yfx, Op), !, Less is Prec-1. 148 149 150ambigop(F, L1, O1, R1, L2, O2) :- 151 postfixop(F, L2, O2), 152 infixop(F, L1, O1, R1), !. 153 154 155% read(+TokenList, +Precedence, -Term, -LeftOver) 156% parses a Token List in a context of given Precedence, 157% returning a Term and the unread Left Over tokens. 158 159read([Token|RestTokens], Precedence, Term, LeftOver) :- 160 read(Token, RestTokens, Precedence, Term, LeftOver). 161read([], _, _, _) :- 162 syntax_error([expression,expected], []). 163 164 165% read(+Token, +RestTokens, +Precedence, -Term, -LeftOver) 166 167read(var(Variable,_), ['('|S1], Precedence, Answer, S) :- !, 168 read(S1, 999, Arg1, S2), 169 read_args(S2, RestArgs, S3), !, 170 exprtl0(S3, apply(Variable,[Arg1|RestArgs]), Precedence, Answer, S). 171 172read(var(Variable,_), S0, Precedence, Answer, S) :- !, 173 exprtl0(S0, Variable, Precedence, Answer, S). 174 175read(atom(-), [integer(Integer)|S1], Precedence, Answer, S) :- 176 Negative is -Integer, !, 177 exprtl0(S1, Negative, Precedence, Answer, S). 178 179read(atom(Functor), ['('|S1], Precedence, Answer, S) :- !, 180 read(S1, 999, Arg1, S2), 181 read_args(S2, RestArgs, S3), 182 Term =.. [Functor,Arg1|RestArgs], !, 183 exprtl0(S3, Term, Precedence, Answer, S). 184 185read(atom(Keyword), S0, Precedence, Answer, S) :- 186 is_distprefix_op(Keyword, Prec, Keys, Pattern, Term), 187 Precedence >= Prec, 188 distfix_pass(Keys, S0, S1), 189 distfix_read(Pattern, S1, S2), 190 !, 191 exprtl(S2, Prec, Term, Precedence, Answer, S). 192 193read(atom(Functor), S0, Precedence, Answer, S) :- 194 prefixop(Functor, Prec, Right), !, 195 after_prefix_op(Functor, Prec, Right, S0, Precedence, Answer, S). 196 197read(atom(Atom), S0, Precedence, Answer, S) :- !, 198 exprtl0(S0, Atom, Precedence, Answer, S). 199 200read(integer(Integer), S0, Precedence, Answer, S) :- !, 201 exprtl0(S0, Integer, Precedence, Answer, S). 202 203read('[', [']'|S1], Precedence, Answer, S) :- !, 204 exprtl0(S1, [], Precedence, Answer, S). 205 206read('[', S1, Precedence, Answer, S) :- !, 207 read(S1, 999, Arg1, S2), 208 read_list(S2, RestArgs, S3), !, 209 exprtl0(S3, [Arg1|RestArgs], Precedence, Answer, S). 210 211read('(', S1, Precedence, Answer, S) :- !, 212 read(S1, 1200, Term, S2), 213 expect(')', S2, S3), !, 214 exprtl0(S3, Term, Precedence, Answer, S). 215 216read(' (', S1, Precedence, Answer, S) :- !, 217 read(S1, 1200, Term, S2), 218 expect(')', S2, S3), !, 219 exprtl0(S3, Term, Precedence, Answer, S). 220 221read('{', ['}'|S1], Precedence, Answer, S) :- !, 222 exprtl0(S1, '{}', Precedence, Answer, S). 223 224read('{', S1, Precedence, Answer, S) :- !, 225 read(S1, 1200, Term, S2), 226 expect('}', S2, S3), !, 227 exprtl0(S3, '{}'(Term), Precedence, Answer, S). 228 229read(string(List), S0, Precedence, Answer, S) :- !, 230 exprtl0(S0, List, Precedence, Answer, S). 231 232read(Token, S0, _, _, _) :- 233 syntax_error([Token,cannot,start,an,expression], S0). 234 235 236% read_args(+Tokens, -TermList, -LeftOver) 237% parses {',' expr(999)} ')' and returns a list of terms. 238 239read_args([','|S1], [Term|Rest], S) :- !, 240 read(S1, 999, Term, S2), !, 241 read_args(S2, Rest, S). 242read_args([')'|S], [], S) :- !. 243read_args(S, _, _) :- 244 syntax_error([', or )',expected,in,arguments], S). 245 246 247% read_list(+Tokens, -TermList, -LeftOver) 248% parses {',' expr(999)} ['|' expr(999)] ']' and returns a list of terms. 249 250read_list([','|S1], [Term|Rest], S) :- !, 251 read(S1, 999, Term, S2), !, 252 read_list(S2, Rest, S). 253read_list(['|'|S1], Rest, S) :- !, 254 read(S1, 999, Rest, S2), !, 255 expect(']', S2, S). 256read_list([']'|S], [], S) :- !. 257read_list(S, _, _) :- 258 syntax_error([', | or ]',expected,in,list], S). 259 260 261% after_prefix_op(+Op, +Prec, +ArgPrec, +Rest, +Precedence, -Ans, -LeftOver) 262 263after_prefix_op(Op, Oprec, _, S0, Precedence, _, _) :- 264 Precedence < Oprec, !, 265 syntax_error([prefix,operator,Op,in,context, 266 with,precedence,Precedence], S0). 267 268after_prefix_op(Op, Oprec, _, S0, Precedence, Answer, S) :- 269 peepop(S0, S1), 270 prefix_is_atom(S1, Oprec), % can't cut but would like to 271 exprtl(S1, Oprec, Op, Precedence, Answer, S). 272 273after_prefix_op(Op, Oprec, Aprec, S1, Precedence, Answer, S) :- 274 read(S1, Aprec, Arg, S2), 275 Term =.. [Op,Arg], !, 276 exprtl(S2, Oprec, Term, Precedence, Answer, S). 277 278 279% The next clause fixes a bug concerning "mop dop(1,2)" where 280% mop is monadic and dop dyadic with higher Prolog priority. 281 282peepop([atom(F),'('|S1], [atom(F),'('|S1]) :- !. 283peepop([atom(F)|S1], [infixop(F,L,P,R)|S1]) :- infixop(F, L, P, R). 284peepop([atom(F)|S1], [postfixop(F,L,P)|S1]) :- postfixop(F, L, P). 285peepop(S0, S0). 286 287 288% prefix_is_atom(+TokenList, +Precedence) 289% is true when the right context TokenList of a prefix operator 290% of result precedence Precedence forces it to be treated as an 291% atom, e.g. (- = X), p(-), [+], and so on. 292 293prefix_is_atom([Token|_], Precedence) :- 294 prefix_is_atom(Token, Precedence). 295 296prefix_is_atom(infixop(_,L,_,_), P) :- L >= P. 297prefix_is_atom(postfixop(_,L,_), P) :- L >= P. 298prefix_is_atom(')', _). 299prefix_is_atom(']', _). 300prefix_is_atom('}', _). 301prefix_is_atom('|', P) :- 1100 >= P. 302prefix_is_atom(',', P) :- 1000 >= P. 303prefix_is_atom([], _). 304 305 306% exprtl0(+Tokens, +Term, +Prec, -Answer, -LeftOver) 307% is called by read/4 after it has read a primary (the Term). 308% It checks for following postfix or infix operators. 309 310exprtl0([atom(F)|S1], Term, Precedence, Answer, S) :- 311 ambigop(F, L1, O1, R1, L2, O2), !, 312 ( exprtl([infixop(F,L1,O1,R1)|S1], 0, Term, Precedence, Answer, S) 313 ; exprtl([postfixop(F,L2,O2) |S1], 0, Term, Precedence, Answer, S) 314 ). 315exprtl0([atom(F)|S1], Term, Precedence, Answer, S) :- 316 infixop(F, L1, O1, R1), !, 317 exprtl([infixop(F,L1,O1,R1)|S1], 0, Term, Precedence, Answer, S). 318exprtl0([atom(F)|S1], Term, Precedence, Answer, S) :- 319 postfixop(F, L2, O2), !, 320 exprtl([postfixop(F,L2,O2) |S1], 0, Term, Precedence, Answer, S). 321 322exprtl0([','|S1], Term, Precedence, Answer, S) :- 323 Precedence >= 1000, !, 324 read(S1, 1000, Next, S2), !, 325 exprtl(S2, 1000, (Term,Next), Precedence, Answer, S). 326 327exprtl0(['|'|S1], Term, Precedence, Answer, S) :- 328 Precedence >= 1100, !, 329 read(S1, 1100, Next, S2), !, 330 exprtl(S2, 1100, (Term;Next), Precedence, Answer, S). 331 332exprtl0([Thing|S1], _, _, _, _) :- 333 cant_follow_expr(Thing, Culprit), !, 334 syntax_error([Culprit,follows,expression], [Thing|S1]). 335 336exprtl0(S, Term, _, Term, S). 337 338 339cant_follow_expr(atom(_), atom). 340cant_follow_expr(var(_,_), variable). 341cant_follow_expr(integer(_), integer). 342cant_follow_expr(string(_), string). 343cant_follow_expr(' (', bracket). 344cant_follow_expr('(', bracket). 345cant_follow_expr('[', bracket). 346cant_follow_expr('{', bracket). 347 348 349 350exprtl([infixop(F,L,O,_)|S1], C, Term, Precedence, Answer, S) :- 351 Precedence >= 0, C =< L, 352 is_distinfix_op(F, Keys, Term, Pattern, Expr), 353 distfix_pass(Keys, S1, S2), 354 distfix_read(Pattern, S2, S3), 355 !, % do we want this? 356 exprtl(S3, O, Expr, Precedence, Answer, S). 357 358exprtl([infixop(F,L,O,R)|S1], C, Term, Precedence, Answer, S) :- 359 Precedence >= O, C =< L, !, 360 read(S1, R, Other, S2), 361 Expr =.. [F,Term,Other], /*!,*/ 362 exprtl(S2, O, Expr, Precedence, Answer, S). 363 364exprtl([postfixop(F,L,O)|S1], C, Term, Precedence, Answer, S) :- 365 Precedence >= O, C =< L, !, 366 Expr =.. [F,Term], 367 peepop(S1, S2), 368 exprtl(S2, O, Expr, Precedence, Answer, S). 369 370exprtl([','|S1], C, Term, Precedence, Answer, S) :- 371 Precedence >= 1000, C < 1000, !, 372 read(S1, 1000, Next, S2), /*!,*/ 373 exprtl(S2, 1000, (Term,Next), Precedence, Answer, S). 374 375exprtl(['|'|S1], C, Term, Precedence, Answer, S) :- 376 Precedence >= 1100, C < 1100, !, 377 read(S1, 1100, Next, S2), /*!,*/ 378 exprtl(S2, 1100, (Term;Next), Precedence, Answer, S). 379 380exprtl(S, _, Term, _, Term, S). 381 382 383% This business of syntax errors is tricky. When an error is detected, 384% we have to write out a message. We also have to note how far it was 385% to the end of the input, and for this we are obliged to use the data- 386% base. Then we fail all the way back to read(), and that prints the 387% input list with a marker where the error was noticed. If subgoal_of 388% were available in compiled code we could use that to find the input 389% list without hacking the data base. The really hairy thing is that 390% the original code noted a possible error and backtracked on, so that 391% what looked at first sight like an error sometimes turned out to be 392% a wrong decision by the parser. This version of the parser makes 393% fewer wrong decisions, and my goal was to get it to do no backtracking 394% at all. This goal has not yet been met, and it will still occasionally 395% report an error message and then decide that it is happy with the input 396% after all. Sorry about that. 397 398 399syntax_error(Message, List) :- 400 ttynl, display('**'), 401 display_list(Message), 402 length(List, Length), 403 recorda(syntax_error, length(Length), _), !, 404 fail. 405 406display_list([Head|Tail]) :- 407 ttyput(32), 408 display_token(Head), !, 409 display_list(Tail). 410display_list([]) :- 411 ttynl. 412 413syntax_error(List) :- 414 recorded(syntax_error, length(AfterError), Ref), 415 erase(Ref), 416 length(List, Length), 417 BeforeError is Length-AfterError, 418 display_list(List, BeforeError), !, 419 fail. 420 421display_list(X, 0) :- 422 display('<<here>> '), !, 423 display_list(X, 99999). 424display_list([Head|Tail], BeforeError) :- 425 display_token(Head), 426 ttyput(32), 427 Left is BeforeError-1, !, 428 display_list(Tail, Left). 429display_list([], _) :- 430 ttynl. 431 432display_token(atom(X)) :- !, display(X). 433display_token(var(_,X)) :- !, display(X). 434display_token(integer(X)) :- !, display(X). 435display_token(string(X)) :- !, display(X). 436display_token(X) :- display(X). 437 438% From here down is new stuff to handle distfix operators. 439 440distfixop(Priority, Type, Pattern, Template) :- 441 integer(Priority), 442 Priority > 0, 443 Priority =< 1200, 444 atom(Type), 445 ( ( Type = fx, Right is Priority-1 446 ; Type = fy, Right = Priority 447 ), 448 distfix_keys(Pattern, [Atom|Keys], RestPattern), 449 distfix_pattern(RestPattern, Right, P_form), 450 !, 451 assert(is_distprefix_op(Atom, Priority, Keys, P_form, Template)) 452 ; ( Type = xfx, Right is Priority-1 453 ; Type = xfy, Right = Priority 454 ; Type = yfx, Right is Priority-1 455 ), 456 distfix_pattern(Pattern, Right, P_form_0), 457 P_form_0 = p(Lhs,[Atom|Keys],P_form), 458 !, 459 op(Priority, Type, Atom), 460 assert(is_distinfix_op(Atom, Keys, Lhs, P_form, Template)) 461 ). 462distfixop(P, T, Pn, Te) :- 463 nl(error), write(error, '! error: '), 464 write(error, distfixop(P,T,Pn,Te)), nl(error), 465 fail. 466 467/* A distfix pattern is one of 468 p -- standing for the end of the pattern 469 p(Var,Prio) -- standing for a right argument of that priority 470 p(Var,Keys,Rest) -- standing for Var Keyword... Restofpattern 471 e.g. p(X,[by],p(Y,[giving,quotient],p(Q,[and,remainder],p(R,99)))). 472 distfix_pattern(List, Prio, P_form) turns a human-readable list into 473 this compact form. 474*/ 475 476distfix_pattern([], _, p) :- !. 477distfix_pattern([Var], Prio, p(Var,Prio)) :- !, 478 var(Var). % 479distfix_pattern([Var|List], Prio, p(Var,Keys,Rest)) :- 480 var(Var), 481 distfix_keys(List, Keys, RestList), 482 Keys \== [], !, 483 distfix_pattern(RestList, Prio, Rest). 484 485/* distfix_keys picks off all the atoms at the front of the list. 486*/ 487distfix_keys([Key|List], [Key|Keys], RestList) :- 488 atom(Key), !, 489 distfix_keys(List, Keys, RestList). 490distfix_keys(List, [], List). 491 492 493distfix_read(p, S0, S) :- 494 peepop(S0, S). 495distfix_read(p(Variable,Priority), S0, S) :- 496 read(S0, Priority, Variable, S). 497distfix_read(p(Variable,Keywords,RestPattern), S0, S) :- 498 distfix_head(S0, [], Keywords, Tokens, S1), 499 % This may backtrack over ever longer Token lists 500 read(Tokens, 1200, Variable, T), 501 T = [], 502 !, % not sure if I want this cut or not 503 distfix_read(RestPattern, S1, S). 504 505 506/* Distfix_pass(Keys, S0, S) 507 is basically append(Keys, S, S0), but Keys is a list of atoms, 508 and the prefix of S0 must be atom(K1),...,atom(Kn) 509*/ 510distfix_pass([], S, S) :- !. 511distfix_pass([Key|Keys], [atom(Key)|S0], S) :- 512 distfix_pass(Keys, S0, S). 513 514/* Distfix_head(S0, Stack, Keys, Tokens, S) 515 matches S0 against Tokens & Keys & S, where Tokens is balanced 516 with respect to () [] {}. It uses the Stack to keep track of 517 what brackets need balancing. 518*/ 519 520distfix_head(S0, [], Keys, [], S) :- 521 distfix_pass(Keys, S0, S). 522distfix_head([Token|S0], Stack, Keys, [Token|Tokens], S) :- 523 distfix_head(Token, Stack, S0, Keys, Tokens, S). 524 525distfix_head('(', Stack, S0, Keys, Tokens, S) :- !, 526 distfix_head(S0, [')'|Stack], Keys, Tokens, S). 527distfix_head(' (',Stack, S0, Keys, Tokens, S) :- !, 528 distfix_head(S0, [')'|Stack], Keys, Tokens, S). 529distfix_head('[', Stack, S0, Keys, Tokens, S) :- !, 530 distfix_head(S0, [']'|Stack], Keys, Tokens, S). 531distfix_head('{', Stack, S0, Keys, Tokens, S) :- !, 532 distfix_head(S0, ['}'|Stack], Keys, Tokens, S). 533distfix_head(Token, [Token|Stack], S0, Keys, Tokens, S) :- !, 534 distfix_head(S0, Stack, Keys, Tokens, S). 535distfix_head(Token, _, _, _, _, _) :- 536 atom(Token), 537 (Token = ')' ; Token = ']' ; Token = '}'), 538 !, fail. 539distfix_head(_, Stack, S0, Keys, Tokens, S) :- 540 distfix_head(S0, Stack, Keys, Tokens, S). 541 542