fixes to use SWI version of readline.

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] = where;
-      nt[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, ti);
       tp = tmpbuf+i;
       psize -= i;
       fun = FunctorError;

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 (!t || Yap_ErrorMessage) {
-    if (tp) {
+    GenerateSyntaxError(tp, tokstart, sno);
-      t = MkVarTerm();
-      *tp = syntax_error(tokstart, sno, &t);
-    }
     Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
     Sclose(sno);
     return FALSE;
@@ -521,9 +530,8 @@ Yap_readTerm(void *st0, Term *tp, Term *varnames, Term *terror, Term *tpos)
       return FALSE;
     }
   pt = Yap_Parse();
-  if (Yap_ErrorMessage) {
+  if (Yap_ErrorMessage || pt == (CELL)0) {
-    Term t0 = MkVarTerm();
+    GenerateSyntaxError(terror, tokstart, st);
-    *terror = syntax_error(tokstart, st, &t0);
     Yap_clean_tokenizer(tokstart, Yap_VarTable, Yap_AnonVarTable);
     return FALSE;
   }
@@ -535,6 +543,8 @@ Yap_readTerm(void *st0, Term *tp, Term *varnames, Term *terror, Term *tpos)
     }
   }
   *tp = pt;
+  if (!pt)
+    return FALSE;
   return TRUE;
 }
 

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 <match>
+%	!n		% Event nr. <n>
+%	!!		% 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).

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);
 }
 

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;
 }
 
 

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);

pl/boot.yap

@@ -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
 	;

pl/flags.yap

@@ -207,12 +207,11 @@ yap_flag(home,X) :-
 
 yap_flag(readline,X) :-
 	var(X), !,
-	get_value('$readline',X1).
+	get_value('$readline',X).
-	'$transl_to_true_false'(X1,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).

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').
+:- use_module('../LGPL/history.pl').
-
-%:- set_prolog_flag(readline, true).
 
 '$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).
+

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]].