Whiteline: Alpha

home *** CD-ROM | disk | FTP | other *** search

/ Whiteline: Alpha / Whiteline Alpha.iso / progtool / prolog / source / monitor.pro < prev next >

Wrap

Text File | 1994-09-22 | 43.8 KB | 1,126 lines

% TOY - the Prolog part. % (c) Copyright 1983 - Feliks Kluzniak, Stanislaw Spakowicz % Institute of Informatics, Warsaw University. % % ATARI ST Implementation (c) Jens J. Kilian, THD % % :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % - - - - - - INTERACTIVE DRIVER - TOP LEVEL - - - - - - % :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ear :- nl, display('TOY Prolog listening:'), nl, tag(loop). ear :- grf_mode, halt('TOY Prolog --- end of session.'). loop :- repeat, display(?-), read(Term, Sym_tab), exec(Term, Sym_tab), fail. stop :- tagfail(loop). sysload(File) :- see(File), tagexit(loop). exec('e r r', _) :- !. % this covers variables, too exec(:-(Goals), _) :- !, once(Goals). exec(N, _) :- integer(N), !, num_clause. % assert non-unit clauses or grammar rules entered OUTSIDE 'consult' mode exec(:-(Head, Body), _) :- !, assimilate(:-(Head, Body)), % cf. consult display(ok), nl. exec(-->(Left, Right), _) :- !, assimilate(-->(Left, Right)), display(ok), nl. % process a list of file names exec([H | T], _) :- !, consultall([H | T]). % normal execution exec(Goals, Sym_tab) :- call(Goals), numbervars(Goals, 0, _), printvars(Sym_tab), enough(Sym_tab), !. exec(_, _) :- display(no), nl. % if call(Goals) fails enough(Sym_tab) :- var(Sym_tab), !. enough(_) :- rch, skipbl, lastch(Ch), rch, not(=(Ch, ';')). printvars(Sym_tab) :- var(Sym_tab), display(yes), nl, !. printvars(Sym_tab) :- prvars(Sym_tab). prvars(Sym_tab) :- var(Sym_tab), !. prvars([var(NameString, Instance) | Sym_tab_tail]) :- nl, writetext(NameString), display(' = '), side_effects(outt(Instance, fd(_, _), q)), wch(' '), % this is equivalent to writeq(Instance), but we avoid % superfluous calls to numbervars - cf. write prvars(Sym_tab_tail). num_clause :- display('A number can''t be a clause.'), nl. % read a program terminated by 'end.' (NOT the only way to define user % procedures, cf. exec); consult/reconsult must be issued from the terminal, % and it returns there ( consult(user) is correct, too) consultall([]) :- !. consultall([-(Name) | OtherNames]) :- !, reconsult(Name), consultall(OtherNames). consultall([Name | OtherNames]) :- !, consult(Name), consultall(OtherNames). consult(File) :- seeing(OldF), readprog(File), see(OldF). reconsult(File) :- redefine, seeing(OldF), readprog(File), see(OldF), redefine. readprog(user) :- !, getprog. readprog(File) :- see(File), echo, getprog, noecho, seen. % the actual job is done by this procedure : getprog :- repeat, read(T), assimilate(T), =(T, end), !. assimilate('e r r') :- !. % a variable is erroneous, too assimilate( -->(Left, Right) ) :- !, tag(transl_rule(Left, Right, Clause)), assertz(Clause). assimilate( :-(Goal) ) :- !, once(Goal). assimilate(end) :- nl, !. assimilate(N) :- integer(N), !, num_clause. % otherwise store the Clause : assimilate(Clause) :- assertz(Clause). % :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % - - - - - - READ A TERM - - - - - - % :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: read(T) :- read(T, Sym_tab). read(T, Sym_tab) :- gettr(T_internal, Sym_tab), !, maketerm(T_internal, T). % if gettr fails, then ... read('e r r', _) :- nl, display('+++ Bad term on input. Text skipped: '), skip, nl. % skip to the nearest full stop not in quotes or in comment skip :- lastch(Ch), wch(Ch), skip(Ch). skip(.) :- rch, lastch(Ch), e_skip(Ch), !. skip('%') :- skip_comment, !, rch, skip. skip(Q) :- isquote(Q), skip_s(Q), !, rch, skip. skip(_) :- rch, skip. % stop on a "layout" character e_skip(Ch) :- @=<(Ch, ' '). e_skip(Ch) :- wch(Ch), rch, skip. skip_comment :- repeat, rch, lastch(Ch), wch(Ch), iseoln(Ch), !. isquote(''''). isquote('"'). % skip a string skip_s(Quote) :- repeat, rch, lastch(Ch), wch(Ch), =(Ch, Quote), !. % :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % - - - - - - P A R S E R - - - - - - % :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % This is an operator precedence parser for Prolog-10. g e t t r % constructs the internal representation of a term. next, m a k e t e r m % constructs the term proper - see r e a d. Here is an informal % description of the underlying operator precedence grammar (each "rule" % corrensponds to one clause of r e d u c e). Sides are separated by ==> % and multiple righthand sides - by OR. % t ==> variable OR integer OR string % t ==> identifier % t ==> identifier ( t ) % t ==> [] OR {} % t ==> ( t ) OR [ t ] OR { t } % t ==> [ t | t ] % t ==> t postfix_functor % t ==> t infix_functor t % t ==> prefix_functor t % Sequences of terms separated by commas - in rules 3, 5, 6 - will be recognised % as comma-terms (commas are infix functors, covered by rule 8). % There are five types of operators: vns(_), id(_), ff(_, _, _), % br(_, _), bar - see the scanner. The terminal symbol dot never gets onto % the stack. The terminal symbol bottom is never returned by the scanner; % it is only used to initiate and terminate the main loop (p a r s e). The % only nonterminal symbol is t(_). % There are fives types of internal representations (Args denotes the represen- % tation of arguments - usually a comma-term): % tr(Name, Args) - for functor-terms, % arg0(X) - for X a variable, an atom, a number, or a string, % bar(X, Y) - for a list with front X and tail Y, % tr1(Name, X) - for prefix and postfix functors, % tr2(Name, X, Y) - for infix functors. % A Name in tr may be a bracket type. See r e d u c e (clauses 5, 6) % and m a k e t e r m for details. % - - - get the internal representation of a term gettr(X, Sym_tab) :- gettoken(T, Sym_tab), parse([bottom], T, X, Sym_tab). % p a r s e takes four parameters: the current stack, the current token % from input, the variable that drifts down and brings the internal repre- % sentation to the surface, and the symbol table (used by g e t t o k e n). parse([t(X), bottom], dot, X, _) :- !. parse(Stack, Input, X, Sym_tab) :- topterminal(Stack, Top, Pos), establish_precedence(Top, Input, Pos, Rel, RTop, RInput), exch_top(Top, RTop, Stack, RStack), step(Rel, RInput, RStack, NewStack, NewInput, Sym_tab), parse(NewStack, NewInput, X, Sym_tab). % the topmost terminal will be covered by at most one nonterminal % (the third parameter gives Top's position: 1 on the top, 2 covered) topterminal([t(_), Top | _], Top, 2) :- !. topterminal([Top | _], Top, 1). % exchange the topmost terminal (applies only to disambiguated mixed functors) exch_top(Top, Top, Stack, Stack) :- !. exch_top(_, RTop, [t(X), _ | S], [t(X), RTop | S]) :- !. exch_top(_, RTop, [_ | S], [RTop | S]). % - - - perform one step: shift (stack the current token) or reduce step(lseq, RInput, Stack, [RInput | Stack], NewInput, Sym_tab) :- !, gettoken(NewInput, Sym_tab). step(gt, RInput, Stack, NewStack, RInput, _) :- reduce(Stack, NewStack). % fail if reduction impossible (parse and gettr will fail, too - % this failure will be intercepted by gettr's caller) %reduce top segment of the stack according to the underlying grammar reduce([ vns(X) | S], [t(arg0(X)) | S]). reduce([ id(I) | S], [t(arg0(I)) | S]). reduce([ br(r, '()'), t(X), br(l, '()'), id(I) | S], [t(tr(I, X)) | S]). reduce([br(r, Type), br(l, Type) | S], [t(arg0(Type)) | S]) :- not(=(Type, '()')). % '[]' or '{}', see p, 2nd clause reduce([br(r, Type), t(X), br(l, Type) | S], [t(tr(Type, X)) | S]). reduce([br(r, '[]'), t(Y), bar, t(X), br(l, '[]') | S], [t(bar(X, Y)) | S]). reduce([ff(I, Type, _), t(X) | S], [t(tr1(I, X)) | S]) :- ismpostf(Type). reduce([t(Y), ff(I, Type, _), t(X) | S], [t(tr2(I, X, Y)) | S]) :- isminf(Type). reduce([t(X), ff(I, Type, _) | S], [t(tr1(I, X)) | S]) :- ismpref(Type). % otherwise fail (cf. step) % - - - auxiliary tests for the parser ispref(fy). ispref(fx). ispostf(yf). ispostf(xf). ismpref([TUn]) :- ispref(TUn). ismpref([_, TUn]) :- ispref(TUn). isminf([TBin]) :- member(TBin, [yfy, xfy, yfx, xfx]). isminf([_, _]). ismpostf([TUn]) :- ispostf(TUn). ismpostf([_, TUn]) :- ispostf(TUn). % - - - establish precedence relation between the topmost % terminal on the stack and the current input terminal establish_precedence(Top, Input, Pos, Rel, RTop, RInput) :- p(Top, Input, Pos, Rel0), finalize(Rel0, Top, Input, Rel, RTop, RInput), !. finalize(lseq, Top, Input, lseq, Top, Input). finalize(gt, Top, Input, gt, Top, Input). finalize(lseq(RTop, RInput), _, _, lseq, RTop, RInput). finalize(gt(RTop, RInput), _, _, gt, RTop, RInput). p(id(_), br(l, '()'), 1, lseq). p(br(l, Type), br(r, Type), _, lseq). p(br(l, '[]'), bar, 2, lseq). p(bar, br(r, '[]'), 2, lseq). p(Top, Input, 1, gt) :- vns_id_br(Top, r), br_bar(Input, r). p(Top, ff(N, Types, P), 1, gt(Top, ff(N, RTypes, P))) :- vns_id_br(Top, r), restrict(Types, [fx, fy], RTypes). p(Top, Input, 1, lseq) :- br_bar(Top, l), vns_id_br(Input, l). p(Top, ff(N, Types, P), Pos, lseq(Top, ff(N, RTypes, P))) :- br_bar(Top, l), pre_inpost(Pos, Types, RTypes). p(ff(N, Types, P), Input, Pos, gt(ff(N, RTypes, P), Input)) :- br_bar(Input, r), post_inpre(Pos, Types, RTypes). p(ff(N, Types, P), Input, 1, lseq(ff(N, RTypes, P), Input)) :- vns_id_br(Input, l), restrict(Types, [xf, yf], RTypes). % functors with equal priorities p(ff(NTop, TsTop, P), ff(NInp, TsInp, P), Pos, Rel) :- res_confl(TsTop, TsInp, Pos, RTsTop, RTsInp, Rel0), !, do_rel(Rel0, ff(NTop, RTsTop, P), ff(NInp, RTsInp, P), Rel). % different priorities p(ff(NTop, TsTop, PTop), ff(NInp, TsInp, PInp), Pos, gt(ff(NTop, RTsTop, PTop), ff(NInp, RTsInp, PInp))) :- stronger(PTop, PInp), !, restrict(TsInp, [fx, fy], RTsInp), post_inpre(Pos, TsTop, RTsTop). p(ff(NTop, TsTop, PTop), ff(NInp, TsInp, PInp), Pos, lseq(ff(NTop, RTsTop, PTop), ff(NInp, RTsInp, PInp))) :- stronger(PInp, PTop), !, restrict(TsTop, [xf, yf], RTsTop), pre_inpost(Pos, TsInp, RTsInp). p(_, dot, _, gt). p(bottom, _, _, lseq). % otherwise fail (p a r s e fails, too) vns_id_br(vns(_), _). vns_id_br(id(_), _). vns_id_br(br(LeftRight, _), LeftRight). br_bar(br(LeftRight, _), LeftRight). br_bar(bar, _). stronger(Prior1, Prior2) :- less(Prior1, Prior2). pre_inpost(1, Types, RTypes) :- % the functor must be prefix restrict(Types, [xf, yf], A), restrict(A, [xfy, yfx, xfx], RTypes). pre_inpost(2, Types, RTypes) :- % the functor must not be prefix restrict(Types, [fx, fy], RTypes). post_inpre(1, Types, RTypes) :- % the functor must be postfix restrict(Types, [fx, fy], A), restrict(A, [xfy, yfx, xfx], RTypes). post_inpre(2, Types, RTypes) :- % the functor must not be postfix restrict(Types, [xf, yf], RTypes). % leave only those types that do not belong to RSet, % fail if this would leave no types at all (RSet contains % only binary types, or only unary types) restrict([T], RSet, [T]) :- !, not(member(T, RSet)). restrict([TBin, TUn], RSet, [TBin]) :- member(TUn, RSet), !. restrict([TBin, TUn], RSet, [TUn]) :- member(TBin, RSet), !. restrict(Types, _, Types). % compute relation for two functors with equal priorities; four cases: % both normal, Top mixed, Input mixed, both mixed res_confl([TTop], [TInp], Pos, [TTop], [TInp], Rel0) :- !, ff_p(TTop, TInp, Pos, Rel0). res_confl([TTopBin, TTopUn], [TInp], Pos, RTsTop, [TInp], Rel0) :- !, ff_p(TTopBin, TInp, Pos, RelB), ff_p(TTopUn, TInp, Pos, RelU), match_rels(RelB, RelU, Rel0, TTopBin, TTopUn, RTsTop). res_confl([TTop], [TInpBin, TInpUn], Pos, [TTop], RTsInp, Rel0) :- !, ff_p(TTop, TInpBin, Pos, RelB), ff_p(TTop, TInpUn, Pos, RelU), match_rels(RelB, RelU, Rel0, TInpBin, TInpUn, RTsInp). res_confl([TTopBin, TTopUn], [TInpBin, TInpUn], Pos, RTsTop, RTsInp, Rel0) :- ff_p(TTopBin, TInpBin, Pos, RelBB), ff_p(TTopBin, TInpUn, Pos, RelBU), ff_p(TTopUn, TInpBin, Pos, RelUB), ff_p(TTopUn, TInpUn, Pos, RelUU), res_mixed(RelBB, RelBU, RelUB, RelUU, Rel0, TTopBin, TTopUn, TInpBin, TInpUn, RTsTop, RTsInp), !. do_rel(lseq, TopF, InpF, lseq(TopF, InpF)). do_rel(gt, TopF, InpF, gt(TopF, InpF)). % fail if Rel0 = err match_rels(Rel, Rel, Rel, TBin, TUn, [TBin, TUn]) :- !. % err included match_rels(err, Rel, Rel, _, TUn, [TUn]) :- !. match_rels(Rel, err, Rel, TBin, _, [TBin]) :- !. match_rels(_, _, err, TBin, TUn, [TBin, TUn]). res_mixed(Rel0, Rel0, Rel0, Rel0, Rel0, TTopBin, TTopUn, TInpBin, TInpUn, [TTopBin, TTopUn], [TInpBin, TInpUn]). res_mixed(err, err, RelUB, RelUU, Rel0, _, TTopUn, TInpBin, TInpUn, [TTopUn], RTsInp) :- match_rels(RelUB, RelUU, Rel0, TInpBin, TInpUn, RTsInp). res_mixed(RelBB, RelBU, err, err, Rel0, TTopBin, _, TInpBin, TInpUn, [TTopBin], RTsInp) :- match_rels(RelBB, RelBU, Rel0, TInpBin, TInpUn, RTsInp). res_mixed(err, RelBU, err, RelUU, Rel0, TTopBin, TTopUn, _, TInpUn, RTsTop, [TInpUn]) :- match_rels(RelBU, RelUU, Rel0, TTopBin, TTopUn, RTsTop). res_mixed(RelBB, err, RelUB, err, Rel0, TTopBin, TTopUn, TInpBin, _, RTsTop, [TInpBin]) :- match_rels(RelBB, RelUB, Rel0, TTopBin, TTopUn, RTsTop). res_mixed(_, _, _, _, err, _, _, _, _, _, _). % establish precedence relation for two (basic) types ff_p(TTop, TInp, Pos, lseq) :- member(TTop, [xfy, fy]), % right associative ff_p_aux1(Pos, TInp), !. ff_p(TTop, TInp, Pos, gt) :- member(TInp, [yfx, yf]), % left associative ff_p_aux2(Pos, TTop), !. ff_p(_, _, _, err). ff_p_aux1(1, TInp) :- ispref(TInp). ff_p_aux1(2, TInp) :- member(TInp, [xfy, xf, xfx]). ff_p_aux2(1, TTop) :- ispostf(TTop). ff_p_aux2(2, TTop) :- member(TTop, [yfx, fx, xfx]). % :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % - - - - - - internal representation --> term - - - - - - % :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: maketerm(arg0(X), X) :- !. % variable, atom, number, string maketerm(tr('()', RawTerm), T) :- !, maketerm(RawTerm, T). maketerm(bar(RawList, RawTail), T) :- !, maketerm(RawTail, Tail), makelist(RawList, Tail, T). maketerm(tr('[]', RawList), T) :- !, makelist(RawList, '[]', T). maketerm(tr('{}', RawArg), '{}'(Arg)) :- !, maketerm(RawArg, Arg). maketerm(tr(Name, RawArgs), T) :- !, makelist(RawArgs, '[]', Args), =..(T, [Name | Args]). maketerm(tr2(Name, RawArg1, RawArg2), T) :- !, maketerm(RawArg1, Arg1), maketerm(RawArg2, Arg2), =..(T, [Name, Arg1, Arg2]). maketerm(tr1(Name, RawArg), T) :- maketerm(RawArg, Arg), =..(T, [Name, Arg]). % comma-term to dot-list-with-Tail makelist(tr2(',', RawArg, RawArgs), Tail, [Arg | Args]) :- !, maketerm(RawArg, Arg), makelist(RawArgs, Tail, Args). makelist(RawArg, Tail, [Arg | Tail]) :- maketerm(RawArg, Arg). % :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % - - - - - - S C A N N E R - - - - - - % :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % This scanner returns six kinds of tokens: % vns(_) variables, numbers, strings % id(Name) atoms % ff(Name, Types, Prior) "fix" functors % br(Which, Type) brackets (left/right, '()' / '[]' / '{}') % bar | (in lists) % dot . followed by a layout character % - - - read a token and construct its internal form % the input is supposed to be positioned % over the first character of a token (or preceding "white space") gettoken(Token, Sym_tab) :- skipbl, lastch(Startch), absorbtoken(Startch, Rawtoken), !, maketoken(Rawtoken, Token, Sym_tab), !. % - - - read in a suitable sequence of characters % a word, i.e. a regular alphanumeric identifier absorbtoken(Ch, id([Ch | Wordtail])) :- wordstart(Ch), getword(Wordtail). % a variable absorbtoken(Ch, var([Ch | Tail])) :- varstart(Ch), getword(Tail). % a solo character is a comma, a semicolon or an exclamation mark absorbtoken(Ch, id([Ch])) :- solochar(Ch), rch. % a bracket, i.e. ( ) [ ] { } absorbtoken(Ch, br(Wh, Type)) :- bracket(Ch), bracket(Ch, Wh, Type), rch. absorbtoken('|', bar) :- rch. % a string in quotes or in double quotes absorbtoken('''', qid(Qname)) :- rdch(Nextch), getstring('''', Nextch, Qname). absorbtoken('"', str(String)) :- rdch(Nextch), getstring('"', Nextch, String). % a positive number absorbtoken(Ch, num([Ch | Digits])) :- digit(Ch), getdigits(Digits). % a negative number or a dash (possibly starting a symbol, see below) absorbtoken(-, Rawtoken) :- rdch(Ch), num_or_sym(Ch, Rawtoken). absorbtoken(., Rawtoken) :- rdch(Ch), dot_or_sym(Ch, Rawtoken). % a symbol, built of . : - < = > + / * ? & $ @ # ^ \ absorbtoken(Ch, id([Ch | Symbs])) :- symch(Ch), getsym(Symbs). % an embedded comment absorbtoken('%', Rawtoken) :- skipcomment, lastch(Ch), absorbtoken(Ch, Rawtoken). % this shouldn't happen: absorbtoken(Ch, _) :- display(errinscan(Ch)), nl, fail. num_or_sym(Ch, num([-, Ch | Digits])) :- digit(Ch), getdigits(Digits). num_or_sym(Ch, id([-, Ch | Symbs])) :- symch(Ch), getsym(Symbs). num_or_sym(_, id([-])). % layout characters precede ' ' in ASCII dot_or_sym(Ch, dot) :- @=<(Ch, ' '). % no advance dot_or_sym(Ch, id([., Ch | Symbs])) :- symch(Ch), getsym(Symbs). dot_or_sym(_, id([.])). skipcomment :- lastch(Ch), iseoln(Ch), skipbl, !. skipcomment :- rch, skipcomment. % - - - auxiliary input procedures % read an alphanumeric identifier getword([Ch | Word]) :- rdch(Ch), alphanum(Ch), !, getword(Word). getword([]). % read a sequence of digits getdigits([Ch | Digits]) :- rdch(Ch), digit(Ch), !, getdigits(Digits). getdigits([]). % read a symbol getsym([Ch | Symbs]) :- rdch(Ch), symch(Ch), !, getsym(Symbs). getsym([]). % read a quoted id or string (Delim is either ' or ") getstring(Delim, Delim, Str) :- !, rdch(Nextch), twodelims(Delim, Nextch, Str). getstring(Delim, Ch, [Ch | Str]) :- rdch(Nextch), getstring(Delim, Nextch, Str). twodelims(Delim, Delim, [Delim | Str]) :- !, rdch(Nextch), getstring(Delim, Nextch, Str). twodelims(_, _, []). % close the list % auxiliary tests wordstart(Ch) :- smalletter(Ch). varstart(Ch) :- bigletter(Ch). varstart('_'). bracket('(', l, '()'). bracket(')', r, '()'). bracket('[', l, '[]'). bracket(']', r, '[]'). bracket('{', l, '{}'). bracket('}', r, '{}'). % transform a raw token into its final form maketoken(var(Namestring), vns(Ptr), Sym_tab) :- makeptr(Namestring, Ptr, Sym_tab). maketoken(id(Namestring), Token, _) :- pname(Name, Namestring), make_ff_or_id(Name, Token). maketoken(qid(Namestring), id(Name), _) :- pname(Name, Namestring). maketoken(num([- | Digits]), vns(N), _) :- pnamei(N1, Digits), sum(N, N1, 0). maketoken(num(Digits), vns(N), _) :- pnamei(N, Digits). maketoken(str(Chars), vns(Chars), _). maketoken(Token, Token, _). % br(_,_) and bar and dot % variables are kept in a symbol table (an open list) makeptr(['_'], _, _). % no search - an anonymous variable makeptr(Nmstr, Ptr, Sym_tab) :- look_var(var(Nmstr, Ptr), Sym_tab). % look-up look_var(Item, [Item | Sym_tab]). look_var(Item, [_ | Sym_tab]) :- look_var(Item, Sym_tab). make_ff_or_id(Name, ff(Name, Types, Prior)) :- 'FF'(Name, Types, Prior). make_ff_or_id(Name, id(Name)). % ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % - - - - - - GRAMMAR RULE PREPROCESSOR - - - - - - % ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: transl_rule(Left, Right, Clause) :- two_ok(Left, Right), isolate_lhs_t(Left, Nont, Lhs_t), connect(Lhs_t, Outpar, Finalvar), expand(Nont, Initvar, Outpar, Head), makebody(Right, Initvar, Finalvar, Body, Alt_flag), do_clause(Body, Head, Clause). do_clause(true, Head, Head) :- !. do_clause(Body, Head, :-(Head, Body)). % Lhs_t is a list (possibly empty) of lefthand side terminals isolate_lhs_t(','(Nont, Lhs_t), Nont, Lhs_t) :- ';'(nonvarint(Nont), rulerror(varint)), ';'(isclosedlist(Lhs_t), rulerror(ter)), !. isolate_lhs_t(Nont, Nont, []). % fail if not a closed list isclosedlist(L) :- check(iscll(L)). iscll(L) :- var(L), !, fail. iscll([]). iscll([_ | L]) :- iscll(L). % connect terminals to the nearest nonterminal's input parameter % (actually, "open" a closed list) connect([], Nextvar, Nextvar). connect([Tsym | Tsyms], [Tsym | Outpar], Nextvar) :- connect(Tsyms, Outpar, Nextvar). % - - - translate the righthand side (loop over alternatives) % in alternatives, each righthand side is preceded by a dummy % nonterminal, as defined by ' dummy' --> []. (since terminals % are appended to input parameters, the input parameter of a common % lefthand side must be a variable) makebody(';'(Alt, Alts), Initvar, Finalvar, ';'(','(' dummy'(Initvar, Nextvar), Alt_b), Alt_bs), _) :- !, two_ok(Alt, Alts), makeright(Alt, Nextvar, Finalvar, Alt_b), makebody(Alts, Initvar, Finalvar, Alt_bs, alt). makebody(Right, Initvar, Finalvar, Body, Alt_flag) :- var(Alt_flag), !, % only one alternative makeright(Right, Initvar, Finalvar, Body). makebody(Right, Initvar, Finalvar, ','(' dummy'(Initvar, Nextvar), Body), alt) :- makeright(Right, Nextvar, Finalvar, Body). % - - - translate one alternative makeright(','(Item, Items), Thispar, Finalvar, T_item_items) :- !, two_ok(Item, Items), transl_item(Item, Thispar, Nextvar, T_item), makeright(Items, Nextvar, Finalvar, T_items), combine(T_item, T_items, T_item_items). makeright(Item, Thispar, Finalvar, T_item) :- transl_item(Item, Thispar, Finalvar, T_item). combine(true, T_items, T_items) :- !. combine(T_item, true, T_item) :- !. combine(T_item, T_items, ','(T_item, T_items)). % - - - translate one item (sure to be a functor-term) transl_item(Terminals, Thispar, Nextvar, true) :- isclosedlist(Terminals), !, connect(Terminals, Thispar, Nextvar). % conditions (the cut and others) transl_item(!, Thispar, Thispar, !) :- !. transl_item('{}'(Cond), Thispar, Thispar, call(Cond)) :- !. % bad list of terminals (missed the first clause) transl_item([_ | _], _, _, _) :- rulerror(ter). % a nested alternative transl_item(';'(X, Y), Thispar, Nextvar, Transl) :- !, makebody(';'(X, Y), Thispar, Nextvar, Transl, _). % finally, a regular nonterminal transl_item(Nont, Thispar, Nextvar, Transl) :- expand(Nont, Thispar, Nextvar, Transl). % add input parameter and output parameter expand(Nont, In_par, Out_par, Call) :- =..(Nont, [Fun | Args]), =..(Call, [Fun, In_par, Out_par | Args]). % - - - error handling two_ok(X, Y) :- nonvarint(X), nonvarint(Y), !. two_ok(_, _) :- rulerror(varint). rulerror(Message) :- nl, display('+++ Error in this rule: '), mes(Message), nl, tagfail(transl_rule(_, _, _)). % diagnostics are only very brief (and not too informative ...) mes(varint) :- display('variable or integer item.'). mes(ter) :- display('terminals not in a closed list.'). % - - - initiate grammar processing phrase(Nont, Terminals) :- nonvarint(Nont), !, expand(Nont, Terminals, [], Init_call), call(Init_call). phrase(N, T) :- error(phrase(N, T)). ' dummy'(X, X). % *************************** % *************************** % *** L I B R A R Y *** % *************************** % *************************** % ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % - - - - - - =.. (read as "univ") - - - - - - % ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: =..(X, Y) :- var(X), var(Y), !, error(=..(X, Y)). =..(Num, [Num]) :- integer(Num), !. =..(Term, [Fun | Args]) :- setarity(Term, Args, N), functor(Term, Fun, N), % this works both ways not(integer(Fun)), % we dont't want e.g. 17(X) setargs(Term, Args, 0, N). % this works both ways, too setarity(Term, Args, N) :- var(Term), !, length(Args, N). % notice that bad Args give an error in l e n g t h setarity(_, _, _). % Arity will be set by f u n c t o r in =.. % both numeric parameters are given, % the loop stops when the third reaches the fourth % (works both ways because a r g does) setargs(_, [], N, N) :- !. setargs(Term, [Arg | Args], K, N) :- sum(K, 1, K1), arg(K1, Term, Arg), setargs(Term, Args, K1, N). % find the length of a closed list; error if not closed length(List, N) :- length(List, 0, N). % this is a tail-recursive formulation of length length(L, _, _) :- var(L), !, error(length(L, _)). length([], N, N) :- !. length([_ | List], K, N) :- !, sum(K, 1, K1), length(List, K1, N). length(Bizarre, _, _) :- error(length(Bizarre, _)). % bind every variable to a distinct 'V'(N) numbervars('V'(N), N, NextN) :- !, sum(N, 1, NextN). numbervars('V'(_), N, N) :- !. numbervars(X, N, N) :- integer(X), !. numbervars(X, N, NextN) :- numbervars(X, 1, N, NextN). numbervars(X, K, N, NextN) :- arg(K, X, A), !, numbervars(A, N, MidN), sum(K, 1, K1), numbervars(X, K1, MidN, NextN). numbervars(_, _, N, N). % ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % - - - - - - PREDEFINED "FIX" FUNCTORS ETC. - - - - - - % ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % op has been defined as a system routine, together with 'FF' and delop :- op(1000, xfy, ','). % ordered according to probable frequency :- op(1200, xfx, :- ). :- op(1200, fx, :- ). :- op(1100, xfy, ';'). :- op( 900, fy, not). :- op( 700, xfx, = ). :- op( 700, xfx, is ). :- op(1200, xfx, -->). :- op( 500, yfx, + ). :- op( 500, fx, + ). :- op( 500, yfx, - ). :- op( 500, fx, - ). :- op( 400, yfx, * ). :- op( 400, yfx, / ). :- op( 300, xfx, mod). :- op( 700, xfx, < ). :- op( 700, xfx, =< ). :- op( 700, xfx, > ). :- op( 700, xfx, >= ). :- op( 700, xfx, =:=). :- op( 700, xfx, =\=). :- op( 700, xfx, @< ). :- op( 700, xfx, @=<). :- op( 700, xfx, @> ). :- op( 700, xfx, @>=). :- op( 700, xfx, =..). :- op( 700, xfx, == ). :- op( 700, xfx, \==). % test for binary and instantiate Assoc binary(yfy, a(_)). % arbitrarily associative binary(xfy, a(r)). % right associative binary(yfx, a(l)). % left associative binary(xfx, na(_)). % non-associative % test for unary, instantiate Kind and Assoc unary(fy, pre, a(r)). % right associative unary(fx, pre, na(r)). % right non-associative unary(yf, post, a(l)). % left associative unary(xf, post, na(l)). % left non-associative % ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % - - - - - - EVALUATE AN ARITHMETIC EXPRESSION - - - - - - % ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: is(N, N) :- integer(N), !. is(Val, +(A, B)) :- !, is(Av, A), is(Bv, B), sum(Av, Bv, Val). is(Val, -(A, B)) :- !, is(Av, A), is(Bv, B), sum(Bv, Val, Av). is(Val, *(A, B)) :- !, is(Av, A), is(Bv, B), prod(Av, Bv, 0, Val). is(Val, /(A, B)) :- !, is(Av, A), is(Bv, B), prod(Bv, Val, _, Av). is(Val, mod(A, B)) :- !, is(Av, A), is(Bv, B), prod(Bv, _, Val, Av). is(Val, +(A)) :- !, is(Val, A). is(Val, -(A)) :- !, is(Av, A), sum(Val, Av, 0). is(N, [N]) :- integer(N). % otherwise f a i l % - - - - - - EVALUATE AN ARITHMETIC RELATION - - - - - - =:=(X, Y) :- is(Val, X), is(Val, Y). <(X, Y) :- is(Xv, X), is(Yv, Y), less(Xv, Yv). =<(X, Y) :- is(Xv, X), is(Yv, Y), not(less(Yv, Xv)). >(X, Y) :- is(Xv, X), is(Yv, Y), less(Yv, Xv). >=(X, Y) :- is(Xv, X), is(Yv, Y), not(less(Xv, Yv)). =\=(X, Y) :- not(=:=(X, Y)). % ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % - - - - - - PERFECT EQUALITY OF TERMS - - - - - - % ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ==(T1, T2) :- var(T1), var(T2), !, eqvar(T1, T2). ==(T1, T2) :- check(==?(T1, T2)). \==(T1, T2) :- not(==?(T1, T2)). ==?(T1, T2) :- integer(T1), integer(T2), !, =(T1, T2). ==?(T1, T2) :- nonvarint(T1), nonvarint(T2), functor(T1, Fun, Arity), functor(T2, Fun, Arity), equalargs(T1, T2, 1). equalargs(T1, T2, Argnumber) :- arg(Argnumber, T1, Arg1), arg(Argnumber, T2, Arg2), % arg fails given too large a number !, ==(Arg1, Arg2), sum(Argnumber, 1, Nextnumber), equalargs(T1, T2, Nextnumber). equalargs(_, _, _). % ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % - - - - - - assert, asserta, assertz, retract, clause - - - - - - % ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % - - - add a clause (using built-in assert/3) assert(Cl) :- asserta(Cl). asserta(Cl) :- nonvarint(Cl), convert(Cl, Head, Body), !, assert(Head, Body, 0). asserta(Cl) :- error(asserta(Cl)). assertz(Cl) :- nonvarint(Cl), convert(Cl, Head, Body), !, assert(Head, Body, 32767). % i.e. MAXINT in this implementation assertz(Cl) :- error(assertz(Cl)). % convert the external form of a Body into a dotted list convert(:-(Head, B), Head, Body) :- conv_body(B, Body). convert(Unit_cl, Unit_cl, []). % this procedure works both ways conv_body(B, [call(B)]) :- var(B), !. conv_body(true, []). conv_body(B, Body) :- conv_b(B, Body). conv_b(B, [Body]) :- var(B), !, conv_call(B, Body). conv_b(','(C, B), [Call | Body]) :- !, conv_call(C, Call), conv_b(B, Body). conv_b(Call, [Call]). % sure to be no variable % interpreter can process variable calls only within c a l l conv_call(C, call(C)) :- var(C), !. conv_call(C, C). % - - - remove a clause (this procedure is backtrackable) retract(Cl) :- nonvarint(Cl), convert(Cl, Head, Body), !, functor(Head, Fun, Arity), remcls(Fun, Arity, 1, Head, Body). retract(Cl) :- error(retract(Cl)). % ultimate failure if N too big (retract/3 fails) remcls(Fun, Arity, N, Head, Body) :- clause(Fun, Arity, N, N_head, N_body), remcls(Fun, Arity, N, N_head, Head, N_body, Body). remcls(Fun, Arity, N, Head, Head, Body, Body) :- retract(Fun, Arity, N). % user's backtracking resumes r e t r a c t here % (after removing the Nth clause the next becomes Nth) remcls(Fun, Arity, N, N_head, Head, N_body, Body) :- check(=(N_head, Head)), check(=(N_body, Body)), !, remcls(Fun, Arity, N, Head, Body). remcls(Fun, Arity, N, _, Head, _, Body) :- sum(N, 1, N1), remcls(Fun, Arity, N1, Head, Body). % - - - generate nondeterministically all clauses whose head % and body match the parameters of c l a u s e clause(Head, Body) :- nonvarint(Head), !, functor(Head, Fun, Arity), gencls(Fun, Arity, 1, Head, Body). clause(Head, Body) :- error(clause(Head, Body)). % generate: ultimate failure if N too big (clause/5 fails) gencls(Fun, Arity, N, Head, Body) :- clause(Fun, Arity, N, N_head, N_body), gencls(Fun, Arity, N, N_head, Head, N_body, Body). % fail if N_head does not match Head, % or if N_body converted does not match Body gencls(_, _, _, N_head, N_head, N_body, Body) :- conv_body(Body, N_body). % user's backtracking resumes c l a u s e here gencls(Fun, Arity, N, _, Head, _, Body) :- sum(N, 1, N1), gencls(Fun, Arity, N1, Head, Body). % ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % - - - - - - L I S T I N G - - - - - - % ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % list procedures determined by the parameter (listing/1) % or all user's procedures (listing/0) listing :- proc(Head), listproc(Head), nl, fail. listing. % catch the final fail from p r o c listing(Fun) :- atom(Fun), !, listbyname(Fun). listing(/(Fun, Arity)) :- atom(Fun), integer(Arity), =<(0, Arity), !, functor(Head, Fun, Arity), listproc(Head). listing(L) :- isclosedlist(L), listseveral(L), !. listing(X) :- error(listing(X)). % isclosedlist - cf. grammar rule preprocessor listseveral([]). listseveral([Item | Items]) :- listing(Item), listseveral(Items). % all procedures with this name listbyname(Fun) :- proc(Head), functor(Head, Fun, _), listproc(Head), nl, fail. listbyname(_). % succeed % one procedure listproc(Head) :- clause(Head, Body), writeclause(Head, Body), wch(.), nl, fail. listproc(_). % succeed writeclause(Head, Body) :- not(var(Body)), =(Body, true), !, writeq(Head). writeclause(Head, Body) :- writeq(:-(Head, Body)). % ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: % - - - - - - W R I T E - - - - - - % ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: write(Term) :- side_effects(outterm(Term, noq)). % writeq encloses in quotes all identifiers except words, % symbols and solochars (not coinciding with "fix" functors) writeq(Term) :- side_effects(outterm(Term, q)). writetext([Ch | Chs]) :- !, wch(Ch), writetext(Chs). writetext([]). outterm(T, Q) :- numbervars(T, 1, _), outt(T, fd(_,_), Q). % the real job is done here outt(X, _, _) :- var(X), !, wch('_'). % applies only to anonymous variables read in by % the "kernel" reader outt('V'(N), _, _) :- integer(N), !, wch('X'), display(N). % C A U T I O N : outt is unable to write 'V'(Integer) outt(Term, _, _) :- integer(Term), display(Term), !. % the second parameter specifies a context for "fix" functors: % the nearest external functor and Term's position % (to the left or to the right of the external functor) outt(Term, Context, Q) :- =..(Term, [Name | Args]), outfun(Name, Args, Context, Q). % - - - output a functor-term % - as a "fix" term outfun(Name, Args, Context, Q) :- isfix(Name, Args, This_ff, Kind), !, outff(Kind, This_ff, [Name | Args], Context, Q). % - as a list outfun(., [Larg, Rarg], _, Q) :- !, outlist([Larg | Rarg], Q). % - as a normal functor-term outfun(Name, Args, _, Q) :- outname(Name, Q), outargs(Args, Q). % isfix constructs a pair ff(Prior, Associativity), and % 'in' or 'pre' or 'post' (fails if not a "fix" functor) isfix(Name, [_, _], ff(Prior, Assoc), in) :- 'FF'(Name, Types, Prior), mk_bin(Types, Assoc). isfix(Name, [_], ff(Prior, Assoc), Kind) :- 'FF'(Name, Types, Prior), mk_un(Types, Kind, Assoc). % Bintype (if any) is before Untype (if any) mk_bin([Bintype | _], Assoc) :- binary(Bintype, Assoc). mk_un([Untype], Kind, Assoc) :- unary(Untype, Kind, Assoc). mk_un([_, Untype], Kind, Assoc) :- unary(Untype, Kind, Assoc). % tests - see o p % - - - output a "fix" term (this outff has 5 parameters) outff(Kind, This_ff, NameArgs, Context, Q) :- agree(This_ff, Context), !, outff(Kind, This_ff, NameArgs, Q). outff(Kind, This_ff, NameArgs, _, Q) :- wch('('), outff(Kind, This_ff, NameArgs, Q), wch(')'). % agree helps avoid (some) unnecessary brackets around the term agree(_, fd(Ext_ff, _)) :- var(Ext_ff). agree(ff(Prior1, _), fd(ff(Prior2, _), _)) :- stronger(Prior1, Prior2). % cf. the parser agree(ff(Prior, a(Dir)), fd(ff(Prior, a(Dir)), Dir)). % output the functor and the arguments (this outff has 4 parameters) outff(in, This_ff, [Name, Larg, Rarg], Q) :- outt(Larg, fd(This_ff, l), Q), outfn(Name, ' '), outt(Rarg, fd(This_ff, r), Q). outff(pre, This_ff, [Name, Arg], Q) :- outfn(Name, ' '), outt(Arg, fd(This_ff, r), Q). outff(post, This_ff, [Name, Arg], Q) :- outt(Arg, fd(This_ff, l), Q), outfn(Name, ' '). % output functor's name enclosed in Encl % if Encl is not a space, double ocurrences of Encl w i t h i n Name outfn(Name, ' ') :- !, wch(' '), display(Name), wch(' '). outfn(Name, Encl) :- wch(Encl), pname(Name, NmString), outfn1(NmString, Encl), wch(Encl). outfn1([], _) :- !. outfn1([E | T], E) :- !, wch(E), wch(E), outfn1(T, E). outfn1([C | T], E) :- wch(C), outfn1(T, E). % - - - print a name (in quotes, if necessary) outname(Name, noq) :- !, display(Name). outname(Name, q) :- 'FF'(Name, _, _), !, outfn(Name, ''''). outname(Name, q) :- pname(Name, Namestring), check(noq(Namestring)), !, display(Name). outname(Name, q) :- outfn(Name, ''''). noq([Ch | String]) :- wordstart(Ch), isword(String). noq([Ch]) :- solochar(Ch). noq(['[', ']']). noq([Ch | String]) :- symch(Ch), issym(String). isword([]). isword([Ch | String]) :- alphanum(Ch), isword(String). issym([]). issym([Ch | String]) :- symch(Ch), issym(String). % - - - output a list of arguments (cf. outfun) outargs([], _) :- !. outargs(Args, Q) :- fake(Context), wch('('), outargs(Args, Context, Q), wch(')'). outargs([Last], Context, Q) :- !, outt(Last, Context, Q). outargs([Arg | Args], Context, Q) :- outt(Arg, Context, Q), display(', '), outargs(Args, Context, Q). % commas are used to delimit list items, so we must bracket commas % w i t h i n items (it's a trick: we depend on ',' having % the priority 1000 and being associative) fake(fd(ff(1000, na(_)), _)). % - - - output a list in square brackets (cf. outfun - the main % functor is the dot, and the list cannot be empty) outlist([First | Tail], Q) :- fake(Context), wch('['), outt(First, Context, Q), outlist(Tail, Context, Q), wch(']'). outlist([], _, _) :- !. outlist([Item | Items], Context, Q) :- !, display(', '), outt(Item, Context, Q), outlist(Items, Context, Q). % the bar and the closing item (still bracketed if it contains commas) outlist(Closing, Context, Q) :- display(' | '), outt(Closing, Context, Q). % ********************************* % ********************************* % *** T R A N S L A T O R *** % ********************************* % ********************************* % read a program upto "end." and translate it into "kernel" form translate(Infile, Outfile) :- see(Infile), tell(Outfile), nl, repeat, read(Clause, OrgST), put(Clause, OrgST), nl, =(Clause, end), !, seen, told, see(user), tell(user). % - - - produce and output the translation of one clause put(:-(Head, Body), OrgST) :- !, puthead(Head, Sym_tab), putbody(Body, Sym_tab), put_varnames(OrgST, Sym_tab, 0). put(-->(Left, Right), OrgST) :- !, tag(transl_rule(Left, Right, :-(Head, Body))), puthead(Head, Sym_tab), putbody(Body, Sym_tab), put_varnames(OrgST, Sym_tab, 0). put(:-(Goal), OrgST) :- !, putbody(Goal, Sym_tab), wch(#), nl, put_varnames(OrgST, Sym_tab, 0), once(Goal). % a failure here wouldn't matter (cf. translate) put(end, _) :- !, putbody(seen, _), wch(#), nl. % this is for security put('e r r', _) :- !. put(Unitclause, OrgST) :- puthead(Unitclause, Sym_tab), putbody(true, _), put_varnames(OrgST, Sym_tab, 0). % - - - put a head call (it must be a functor-term) puthead(Head, Sym_tab) :- nonvarint(Head), !, putterm(Head, Sym_tab). puthead(Head, _) :- transl_err(Head). % - - - put a list of calls and [] at the end putbody(Body, Sym_tab) :- punct(:), conv_body(Body, B), !, putbody_c(B, Sym_tab). % see assert etc. for c o n v _ b o d y putbody_c([], _) :- !, display([]). putbody_c([Term | Terms], Sym_tab) :- not(integer(Term)), !, putterm(Term, Sym_tab), punct(.), putbody_c(Terms, Sym_tab). putbody_c([Term | _], _) :- transl_err(Term). punct(Ch) :- wch(' '), wch(Ch), nl, display(' '). % - - - put a term (with infix dots, and canonical otherwise) putterm(Term, Sym_tab) :- var(Term), !, lookup(Term, Sym_tab, -1, N), wch(:), display(N). putterm(Term, _) :- integer(Term), !, display(Term). putterm([Head | Tail], Sym_tab) :- !, putterm_inlist(Head, Sym_tab), display(' . '), putterm(Tail, Sym_tab). putterm(Term, Sym_tab) :- =..(Term, [Name | Args]), outfn(Name, ''''), % cf. w r i t e putargs(Args, Sym_tab). % Sym_tab is an open list of pairs vn(Variable, Number) % (this formulation helps avoid too many additions) lookup(V, S_t_end, PreviousN, N) :- var(S_t_end), !, sum(PreviousN, 1, N), =(S_t_end, [vn(V, N) | New_S_t_end]). lookup(V, [vn(CurrV, CurrN) | _], _, CurrN) :- eqvar(V, CurrV), !. lookup(V, [vn(_, CurrN) | S_t_tail], _, N) :- lookup(V, S_t_tail, CurrN, N). % arguments - nothing, or a list of terms in parentheses putargs([], _) :- !. putargs(Args, Sym_tab) :- wch('('), putarglist(Args, Sym_tab), wch(')'). putarglist([Arg], Sym_tab) :- !, putterm(Arg, Sym_tab). putarglist([Arg | Args], Sym_tab) :- putterm(Arg, Sym_tab), display(', '), putarglist(Args, Sym_tab). % - - - a list within a list must be enclosed in parentheses putterm_inlist(Term, Sym_tab) :- nonvarint(Term), =(Term, [_ | _]), !, wch('('), putterm(Term, Sym_tab), wch(')'). putterm_inlist(Term, Sym_tab) :- putterm(Term, Sym_tab). % - - - error handling (only one error is discovered by translate) transl_err(X) :- nl, display('+++ Bad head or call: '), display(X), nl, fail. % - - - output names of source variables paired with numbers put_varnames(_, EndOfST, _) :- var(EndOfST), !. put_varnames(OrgST, [vn(Inst, Num) | RestOfST], Count) :- find_varname(Inst, OrgST, Num, Name), nextline(Count), wch(' '), display(Num), wch(' '), writetext(Name), wch(','), sum(Count, 1, NextCount), put_varnames(OrgST, RestOfST, NextCount). find_varname(_, EndOrgST, Num, ['X' | Digits]) :- var(EndOrgST), !, pnamei(Num, Digits). find_varname(Inst, [var(Name, Inst1) | _ ], _, Name) :- eqvar(Inst, Inst1), !. find_varname(Inst, [_ | RestOrgST], Num, Name) :- find_varname(Inst, RestOrgST, Num, Name). nextline(N) :- prod(6, _, 0, N), !, nl, display(' %%'). nextline(_). %:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: %- - - - - - - - - protect / unprotect all of the library - - - - - - - - - - %:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: protect :- proc(Proc), functor(Proc, Name, Arity), protect(Name, Arity), fail. protect :- display('All predicates protected.'), nl. unprotect :- proc(Proc), functor(Proc, Name, Arity), unprotect(Name, Arity), fail. unprotect :- display('All predicates un-protected.'), nl. % ok, monitor loaded - protect it (the system will start up the 'ear' goal) :- grf_mse_hide, txt_mode, protect, seen.