diff --git a/C/errors.c b/C/errors.c index d8267d297..c4edc2033 100644 --- a/C/errors.c +++ b/C/errors.c @@ -1461,10 +1461,8 @@ Yap_Error(yap_error_number type, Term where, char *format,...) { int i; - Term ti[1]; i = strlen(tmpbuf); - ti[0] = where; - nt[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, ti); + nt[0] = where; tp = tmpbuf+i; psize -= i; fun = FunctorError; diff --git a/C/iopreds.c b/C/iopreds.c index cb58d6d51..9e66a18ab 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -388,6 +388,18 @@ syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp) return(Yap_MkApplTerm(FunctorSyntaxError,7,tf)); } +static void +GenerateSyntaxError(Term *tp, TokEntry *tokstart, IOSTREAM *sno) +{ + if (tp) { + Term et[2]; + Term t = MkVarTerm(); + et[0] = syntax_error(tokstart, sno, &t); + et[1] = MkAtomTerm(Yap_LookupAtom("Syntax error")); + *tp = Yap_MkApplTerm(FunctorError, 2, et); + } +} + Term Yap_StringToTerm(char *s,Term *tp) { @@ -418,11 +430,8 @@ Yap_StringToTerm(char *s,Term *tp) } t = Yap_Parse(); TR = TR_before_parse; - if (!t && !Yap_ErrorMessage) { - if (tp) { - t = MkVarTerm(); - *tp = syntax_error(tokstart, sno, &t); - } + if (!t || Yap_ErrorMessage) { + GenerateSyntaxError(tp, tokstart, sno); Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); Sclose(sno); return FALSE; @@ -521,11 +530,10 @@ Yap_readTerm(void *st0, Term *tp, Term *varnames, Term *terror, Term *tpos) return FALSE; } pt = Yap_Parse(); - if (Yap_ErrorMessage) { - Term t0 = MkVarTerm(); - *terror = syntax_error(tokstart, st, &t0); - Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); - return FALSE; + if (Yap_ErrorMessage || pt == (CELL)0) { + GenerateSyntaxError(terror, tokstart, st); + Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable); + return FALSE; } if (varnames) { *varnames = Yap_VarNames(Yap_VarTable, TermNil); @@ -535,6 +543,8 @@ Yap_readTerm(void *st0, Term *tp, Term *varnames, Term *terror, Term *tpos) } } *tp = pt; + if (!pt) + return FALSE; return TRUE; } diff --git a/LGPL/history.pl b/LGPL/history.pl new file mode 100644 index 000000000..e6e668d69 --- /dev/null +++ b/LGPL/history.pl @@ -0,0 +1,288 @@ +/* $Id$ + + Part of SWI-Prolog + + Author: Jan Wielemaker + E-mail: wielemak@science.uva.nl + WWW: http://www.swi-prolog.org + Copyright (C): 1985-2005, University of Amsterdam + + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License + as published by the Free Software Foundation; either version 2 + of the License, or (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + As a special exception, if you link this library with other files, + compiled with a Free Software compiler, to produce an executable, this + library does not by itself cause the resulting executable to be covered + by the GNU General Public License. This exception does not however + invalidate any other reasons why the executable file might be covered by + the GNU General Public License. +*/ + +:- module('$history', + [ % read_history/6, + '$clean_history'/0, + '$save_history'/1 + ]). + +%% read_history(+History, +Help, +DontStore, +Prompt, -Term, -Bindings) +% +% Give a prompt using Prompt. The sequence '%w' is substituted with the +% current event number. Then read a term from the input stream and perform +% the history expansion. Return the expanded term and the bindings of the +% variables as with read/2. +% entering the term History makes read_history/5 print the history. +% Help specifies the help command. +% DontStore is a list of events that need not be stored. + +% When read_history reads a term of the form $silent(Goal), it will +% call Goal and pretend it has not seen anything. This hook is used +% by the GNU-Emacs interface to for communication between GNU-EMACS +% and SWI-Prolog. + +prolog:read_history(History, Help, DontStore, Prompt, Term, Bindings) :- + repeat, + prompt_history(Prompt), + catch('$raw_read'(user_input, Raw), E, + (print_message(error, E), + ( E = error(syntax_error(_), _) + -> fail + ; throw(E) + ))), + read_history_(History, Help, DontStore, Raw, Term, Bindings), !. + +read_history_(History, _, _, History, _, _) :- + list_history, !, + fail. +read_history_(Show, Help, _, Help, _, _) :- + print_message(help, history(help(Show, Help))), !, + fail. +read_history_(History, Help, DontStore, Raw, Term, Bindings) :- + expand_history(Raw, Expanded, Changed), + save_history_line(Expanded), + catch(atom_to_term(Expanded, Term0, Bindings0), + E, + ( print_message(error, E), + fail + )), + ( var(Term0) + -> Term = Term0, + Bindings = Bindings0 + ; Term0 = '$silent'(Goal) + -> user:ignore(Goal), + read_history(History, Help, DontStore, '', Term, Bindings) + ; save_event(DontStore, Expanded), + ( Changed == true + -> print_message(query, history(expanded(Expanded))) + ; true + ), + Term = Term0, + Bindings = Bindings0 + ). + + +% list_history +% Write history events to the current output stream. + +list_history :- + ( '$history'(Last, _) + -> true + ; Last = 0 + ), + history_depth_(Depth), + plus(First, Depth, Last), + findall(Nr/Event, + ( between(First, Last, Nr), + '$history'(Nr, Event) + ), + Events), + print_message(query, history(history(Events))). + +'$clean_history' :- + retractall('$history'(_,_)). + +% prompt_history(+Prompt) +% Give prompt, substituting '%!' by the event number. + +prompt_history('') :- !, + ttyflush. +prompt_history(Prompt) :- + ( '$history'(Last, _) + -> This is Last + 1 + ; This = 1 + ), + atom_codes(Prompt, SP), + number_codes(This, ST), + ( substitute("%!", ST, SP, String) + -> prompt1(String) + ; prompt1(Prompt) + ), + ttyflush. + +% substitute(+Old, +New, +String, -Substituted) +% substitute first occurence of Old in String by New + +substitute(Old, New, String, Substituted) :- + '$append'(Head, OldAndTail, String), + '$append'(Old, Tail, OldAndTail), !, + '$append'(Head, New, HeadAndNew), + '$append'(HeadAndNew, Tail, Substituted), !. + +% save_event(+Event) +% Save Event in the history system. Remove possibly outdated events. + +save_history_line(end_of_file) :- !. +save_history_line(Line) :- + current_prolog_flag(readline, true), + format(atom(CompleteLine), '~W~W', + [ Line, [partial(true)], + '.', [partial(true)] + ]), + catch(user:rl_add_history(CompleteLine), _, fail), !. +save_history_line(_). + +save_event(Dont, Event) :- + lists:memberchk(Event, Dont), !. +save_event(_, Event) :- + '$save_history'(Event). + +:- thread_local + '$history'/2. + +'$save_history'(Event) :- + ( '$history'(Old, _) + -> New is Old + 1 + ; New is 1 + ), + asserta('$history'(New, Event)), + history_depth_(Depth), + remove_history(New, Depth). + +remove_history(New, Depth) :- + New - Depth =< 0, !. +remove_history(New, Depth) :- + Remove is New - Depth, + retract('$history'(Remove, _)), !. +remove_history(_, _). + +% history_depth_(-Depth) +% Define the depth to which to keep the history. + +history_depth_(N) :- + current_prolog_flag(history, N), + integer(N), + N > 0, !. +history_depth_(25). + +% expand_history(+Raw, -Expanded) +% Expand Raw using the available history list. Expandations performed +% are: +% +% !match % Last event starting +% !n % Event nr. +% !! % last event +% +% Note: the first character after a '!' should be a letter or number to +% avoid problems with the cut. + +expand_history(Raw, Expanded, Changed) :- + atom_chars(Raw, RawString), + expand_history2(RawString, ExpandedString, Changed), + atom_chars(Expanded, ExpandedString), !. + +expand_history2([!], [!], false) :- !. +expand_history2([!, C|Rest], [!|Expanded], Changed) :- + not_event_char(C), !, + expand_history2([C|Rest], Expanded, Changed). +expand_history2([!|Rest], Expanded, true) :- !, + match_event(Rest, Event, NewRest), + '$append'(Event, RestExpanded, Expanded), !, + expand_history2(NewRest, RestExpanded, _). +expand_history2(['\''|In], ['\''|Out], Changed) :- !, + skip_quoted(In, '\'', Out, Tin, Tout), + expand_history2(Tin, Tout, Changed). +expand_history2(['"'|In], ['"'|Out], Changed) :- !, + skip_quoted(In, '"', Out, Tin, Tout), + expand_history2(Tin, Tout, Changed). +expand_history2([H|T], [H|R], Changed) :- !, + expand_history2(T, R, Changed). +expand_history2([], [], false). + +skip_quoted([Q|T],Q,[Q|R], T, R) :- !. +skip_quoted([\,Q|T0],Q,[\,Q|T], In, Out) :- !, + skip_quoted(T0, Q, T, In, Out). +skip_quoted([Q,Q|T0],Q,[Q,Q|T], In, Out) :- !, + skip_quoted(T0, Q, T, In, Out). +skip_quoted([C|T0],Q,[C|T], In, Out) :- !, + skip_quoted(T0, Q, T, In, Out). +skip_quoted([], _, [], [], []). + +% get_last_event(-String) +% return last event typed as a string + +get_last_event(Event) :- + '$history'(_, Atom), + atom_chars(Atom, Event), !. +get_last_event(_) :- + print_message(query, history(no_event)), + fail. + +% match_event(+Spec, -Event, -Rest) +% Use Spec as a specification of and event and return the event as Event +% and what is left of Spec as Rest. + +match_event(Spec, Event, Rest) :- + find_event(Spec, Event, Rest), !. +match_event(_, _, _) :- + print_message(query, history(no_event)), + fail. + +not_event_char(C) :- code_type(C, csym), !, fail. +not_event_char(!) :- !, fail. +not_event_char(_). + +find_event([!|Left], Event, Left) :- !, + get_last_event(Event). +find_event([N|Rest], Event, Left) :- + code_type(N, digit), !, + take_number([N|Rest], String, Left), + number_codes(Number, String), + '$history'(Number, Atom), + atom_chars(Atom, Event). +find_event(Spec, Event, Left) :- + take_string(Spec, String, Left), + matching_event(String, Event). + +take_string([C|Rest], [C|String], Left) :- + code_type(C, csym), !, + take_string(Rest, String, Left). +take_string([C|Rest], [], [C|Rest]) :- !. +take_string([], [], []). + +take_number([C|Rest], [C|String], Left) :- + code_type(C, digit), !, + take_string(Rest, String, Left). +take_number([C|Rest], [], [C|Rest]) :- !. +take_number([], [], []). + +% matching_event(+String, -Event) +% +% Return first event with prefix String as a Prolog string. + +matching_event(String, Event) :- + '$history'(_, AtomEvent), + atom_chars(AtomEvent, Event), + '$append'(String, _, Event), !. + +'$append'(Head, OldAndTail, String) :- + lists:append(Head, OldAndTail, String). \ No newline at end of file diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 2acae2911..9e5a44358 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -2754,15 +2754,26 @@ Yap_swi_install(void) YAP_UserCPredicate("ctime", SWI_ctime, 2); } -int Yap_read_term(term_t t, IOSTREAM *st, term_t vs); +int Yap_read_term(term_t t, IOSTREAM *st, term_t *excep, term_t vs); int -Yap_read_term(term_t t, IOSTREAM *st, term_t vs) +Yap_read_term(term_t t, IOSTREAM *st, term_t *excep, term_t vs) { Term varnames, out, tpos; + Term error; - if (!Yap_readTerm(st, &out, &varnames, NULL, &tpos)) + if (!Yap_readTerm(st, &out, &varnames, &error, &tpos)) { + if (excep) { + *excep = Yap_InitSlot(error); + } return FALSE; + } + if (!out) { + if (excep) { + *excep = Yap_InitSlot(error); + } + return FALSE; + } if (!Yap_unify(out, Yap_GetFromSlot(t))) { return FALSE; } @@ -2794,6 +2805,9 @@ Atom Yap_FileName(IOSTREAM *s) { atom_t a = fileNameStream(s); + if (!a) { + return AtomEmptyAtom; + } return SWIAtomToAtom(a); } diff --git a/packages/PLStream/pl-read.c b/packages/PLStream/pl-read.c index ff25bfa93..7183fdcd6 100644 --- a/packages/PLStream/pl-read.c +++ b/packages/PLStream/pl-read.c @@ -83,7 +83,16 @@ free_read_data(ReadData _PL_rd) static int read_term(term_t t, ReadData _PL_rd ARG_LD) { - return Yap_read_term(t, rb.stream, _PL_rd->varnames); + int rval; + term_t except; + + if (!(rval = Yap_read_term(t, rb.stream, &except, _PL_rd->varnames))) { + if (except) { + _PL_rd->has_exception = TRUE; + _PL_rd->exception = except; + } + } + return rval; } diff --git a/packages/PLStream/pl-yap.h b/packages/PLStream/pl-yap.h index 93f643450..f23a8d456 100644 --- a/packages/PLStream/pl-yap.h +++ b/packages/PLStream/pl-yap.h @@ -31,7 +31,7 @@ typedef YAP_Term (*Func)(term_t); /* foreign functions */ extern const char *Yap_GetCurrentPredName(void); extern YAP_Int Yap_GetCurrentPredArity(void); -extern int Yap_read_term(term_t t, IOSTREAM *st, term_t vs); +extern int Yap_read_term(term_t t, IOSTREAM *st, term_t *exc, term_t vs); extern int Yap_LookupSWIStream(void *swi_s); extern term_t Yap_fetch_module_for_format(term_t args, YAP_Term *modp); extern IOENC Yap_DefaultEncoding(void); diff --git a/pl/boot.yap b/pl/boot.yap index 554b9a93e..58fb97f11 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -66,7 +66,7 @@ true :- true. set_value(fileerrors,1), set_value('$gc',on), ('$exit_undefp' -> true ; true), - prompt1(' ?- '), + prompt1(' ?- '), '$debug_on'(false), % simple trick to find out if this is we are booting from Prolog. get_value('$user_module',V), @@ -144,10 +144,11 @@ true :- true. */ /* main execution loop */ -'$read_vars'(user_input, Goal, Mod, Pos, Binding) :- +'$read_vars'(user_input, Goal, Mod, Pos, Bindings) :- + get_value('$readline',true), !, read_history(h, '!h', [trace, end_of_file], - Prompt, Goal, Bindings), + ' ?- ', Goal, Bindings), (nonvar(Err) -> print_message(error,Err), fail ; @@ -191,8 +192,8 @@ true :- true. set_value('$live','$false'). '$enter_top_level' :- '$disable_docreep', - prompt(_,' | '), - prompt1(' ?- '), + prompt(_,'| '), + prompt1(' ?- '), '$run_toplevel_hooks', '$read_vars'(user_input,Command,_,Pos,Varnames), nb_setval('$spy_gn',1), @@ -200,7 +201,7 @@ true :- true. nb_setval('$debug_run',off), nb_setval('$debug_jump',off), - prompt(_,' |: '), + prompt(_,'|: '), '$command'(Command,Varnames,Pos,top), '$sync_mmapped_arrays', set_value('$live','$false'). @@ -223,7 +224,7 @@ true :- true. '$startup_saved_state' :- recorded('$restore_goal',G,R), erase(R), - prompt(_,' | '), + prompt(_,'| '), '$system_catch'('$do_yes_no'((G->true),user),user,Error,user:'$Error'(Error)), fail. '$startup_saved_state'. diff --git a/pl/flags.yap b/pl/flags.yap index 4f5254a4f..0194c32f2 100644 --- a/pl/flags.yap +++ b/pl/flags.yap @@ -207,12 +207,11 @@ yap_flag(home,X) :- yap_flag(readline,X) :- var(X), !, - get_value('$readline',X1). - '$transl_to_true_false'(X1,X). + get_value('$readline',X). +yap_flag(readline,X) :- + ( X = true ; X = false ), !, + set_value('$readline',X). yap_flag(readline,X) :- - '$transl_to_true_false'(X1,X), !, - set_value('$readline',X1). -yap_flag(bounded,X) :- '$do_error'(domain_error(flag_value,readline+X),yap_flag(bounded,X)). % tabling mode @@ -848,6 +847,7 @@ yap_flag(dialect,yap). '$yap_system_flag'(open_shared_object). '$yap_system_flag'(profiling). '$yap_system_flag'(prompt_alternatives_on). +'$yap_system_flag'(readline). '$yap_system_flag'(redefine_warnings). '$yap_system_flag'(shared_object_search_path). '$yap_system_flag'(single_var_warnings). diff --git a/pl/init.yap b/pl/init.yap index d1652a0d6..bb4bdd55a 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -113,9 +113,7 @@ system_mode(verbose,off) :- set_value('$verbose',off). :- use_module('attributes.yap'). :- use_module('corout.yap'). :- use_module('dialect.yap'). -%:- use_module('../LGPL/history.pl'). - -%:- set_prolog_flag(readline, true). +:- use_module('../LGPL/history.pl'). '$system_module'('$messages'). '$system_module'('$hacks'). @@ -211,3 +209,5 @@ file_search_path(foreign, yap('lib/Yap')). :- yap_flag(unknown,error). +:- set_prolog_flag(readline, true). + diff --git a/pl/messages.yap b/pl/messages.yap index acc7a5e47..1bf71d512 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -273,9 +273,10 @@ system_message(error(resource_error(trail), Where)) --> [ 'RESOURCE ERROR- not enough trail space' - [Where] ]. system_message(error(signal(SIG,_), _)) --> [ 'UNEXPECTED SIGNAL: ~a' - [SIG] ]. -system_message(error(syntax_error(syntax_error(G,0,Msg,[],0,0,File)), _)) --> +system_message(error(syntax_error(G,_,Msg,[],_,0,File), _)) --> [ 'SYNTAX ERROR at "~a", goal ~q: ~a' - [File,G,Msg] ]. -system_message(error(syntax_error(syntax_error(read(Term),_,_,Term,Pos,Start,File)), Where)) --> +system_message(error(syntax_error(read(_),_,_,Term,Pos,Start,File), Where)) --> + { Term = [_|_] }, ['~w' - [Where]], syntax_error_line(File, Start, Pos), syntax_error_term(10, Pos, Term), @@ -421,6 +422,8 @@ list_of_preds([P|L]) --> list_of_preds(L). +syntax_error_line('', _,_) --> !, + [':~n' ]. syntax_error_line(File, Position,_) --> [' at ~a, near line ~d:~n' - [File,Position]].