[Xsb-commits] CVS: XSB/syslib error_handler.H,NONE,1.1.2.1 error_handler.P,NONE,1.1.2.1 error_handle

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 454-5900

Update of /cvsroot/xsb/XSB/syslib
In directory usw-pr-cvs1:/tmp/cvs-serv25033

Modified Files:
      Tag: demand_branch
	Makefile eval.H eval.P eval.xwam machine.H machine.P 
	machine.xwam standard.H standard.P standard.xwam std_xsb.P 
	std_xsb.xwam x_interp.H x_interp.P x_interp.xwam xcallxsb.H 
	xcallxsb.P xcallxsb.xwam 
Added Files:
      Tag: demand_branch
	error_handler.H error_handler.P error_handler.xwam 
Log Message:
* APPLIED several patches from HEAD
* BACKED OUT circular lists in nlcp_prevlookup, in favor of tagging
  the next_clause pointer to mark undemanded choicepoints

--- NEW FILE: error_handler.H ---
/* File:      error_handler.H
** Author(s): Swift
** Contact:   xsb...@cs...
** 
** Copyright (C) The Research Foundation of SUNY, 1986, 1993-1998
** Copyright (C) ECRC, Germany, 1990
** 
** XSB is free software; you can redistribute it and/or modify it under the
** terms of the GNU Library General Public License as published by the Free
** Software Foundation; either version 2 of the License, or (at your option)
** any later version.
** 
** XSB 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 Library General Public License for
** more details.
** 
** You should have received a copy of the GNU Library General Public License
** along with XSB; if not, write to the Free Software Foundation,
** Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
**
** $Id: error_handler.H,v 1.1.2.1 2002/08/29 14:17:24 lfcastro Exp $
** 
*/


:- export default_error_handler/1.

:- import abort/0, messageln/2 from standard.
:- import (dynamic)/1 from assert.





--- NEW FILE: error_handler.P ---
/* File:      error_handler.P
** Author(s): Swift
** Contact:   xsb...@cs...
** 
** Copyright (C) The Research Foundation of SUNY, 1986, 1993-1998
** Copyright (C) ECRC, Germany, 1990
** 
** XSB is free software; you can redistribute it and/or modify it under the
** terms of the GNU Library General Public License as published by the Free
** Software Foundation; either version 2 of the License, or (at your option)
** any later version.
** 
** XSB 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 Library General Public License for
** more details.
** 
** You should have received a copy of the GNU Library General Public License
** along with XSB; if not, write to the Free Software Foundation,
** Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
**
** $Id: error_handler.P,v 1.1.2.1 2002/08/29 14:17:24 lfcastro Exp $
** 
*/


:- compiler_options([xpp_on,sysmod,optimize]).

#include "sig_xsb.h"
#include "flag_defs_xsb.h"
#include "heap_defs_xsb.h"
#include "standard.h"
#include "char_defs.h"

:- dynamic default_user_error_handler/1.

/* Types of errors are taken from Section 7.12 of the ISO Standard */

default_error_handler(Error):- 
	default_user_error_handler(Error),
	!.

default_error_handler(error(instantiation_error,Msg)):- 
	messageln(('++Error[XSB/Runtime/P]: [Instantiation] ', Msg), 
	           STDERR),
        messageln('Aborting...', STDFDBK),
	abort.
default_error_handler(error(type_error(Valid_type,Culprit),Msg)):- 
	messageln(('++Error[XSB/Runtime/P]: [Type (',
		    Culprit,' in place of ',Valid_type,')] ', Msg),STDERR),
        messageln('Aborting...', STDFDBK),
	abort.
default_error_handler(error(domain_error(Valid_type,Culprit),Msg)):- 
	messageln(('++Error[XSB/Runtime/P]: [Domain (',
		Culprit,' in place of ',Valid_type,')] ', Msg), STDERR),
        messageln('Aborting...', STDFDBK),
	abort.
default_error_handler(error(existence_error(Object_type,Culprit),Msg)):- 
	messageln(('++Error[XSB/Runtime/P]: [Existence (',
	           Object_type,Culprit,' does not exist)] ', Msg), STDERR),
        messageln('Aborting...', STDFDBK),
	abort.
default_error_handler(error(permission_error(Op,Obj_type,Culprit),Msg)):- 
	messageln(('++Error[XSB/Runtime/P]: [Permission (Operation',Culprit,
	           ' of type ',Op,' on ',Obj_type,')] ', Msg), STDERR),
        messageln('Aborting...', STDFDBK),
	abort.
default_error_handler(error(representation_error(Flag),Msg)):- 
	messageln(('++Error[XSB/Runtime/P]: [Representation (',Flag,
	            ')] ', Msg), STDERR),
        messageln('Aborting...', STDFDBK),
	abort.
default_error_handler(error(calculation_error(Flag),Msg)):- 
	messageln(('++Error[XSB/Runtime/P]: [Calculation (',Flag,
	            ')] ', Msg), STDERR),
        messageln('Aborting...', STDFDBK),
	abort.

default_error_handler(Msg):- 
	messageln(('++Error[XSB/Runtime/P] uncaught exception: ', Msg), 
	           STDERR),
        messageln('Aborting...', STDFDBK),
	abort.



--- NEW FILE: error_handler.xwam ---

error_handler
type_error





















































Index: Makefile
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/Makefile,v
retrieving revision 1.43
retrieving revision 1.43.2.1
diff -u -r1.43 -r1.43.2.1
--- Makefile	13 Apr 2002 05:01:59 -0000	1.43
+++ Makefile	29 Aug 2002 14:17:24 -0000	1.43.2.1
@@ -27,7 +27,8 @@
 
 ALL =	assert${OBJEXT} atts${OBJEXT} basics${OBJEXT} consult${OBJEXT} \
 	curr_sym${OBJEXT} dbclause${OBJEXT} \
-	dcg${OBJEXT} debugger${OBJEXT} domain${OBJEXT} eval${OBJEXT}  \
+	dcg${OBJEXT} debugger${OBJEXT} domain${OBJEXT}\
+	error_handler${OBJEXT}  eval${OBJEXT}  \
 	file_io${OBJEXT} \
 	file_op${OBJEXT} gensym${OBJEXT} hilogsym${OBJEXT} loader${OBJEXT}  \
 	machine${OBJEXT} num_vars${OBJEXT} \

Index: eval.H
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/eval.H,v
retrieving revision 1.2
retrieving revision 1.2.8.1
diff -u -r1.2 -r1.2.8.1
--- eval.H	18 Aug 1999 16:45:59 -0000	1.2
+++ eval.H	29 Aug 2002 14:17:24 -0000	1.2.8.1
@@ -29,7 +29,7 @@
 :- import load/1 from loader.
 :- import functor/3, arg/3, abort/1 from standard.
 :- import term_type/2, term_psc/2, psc_type/2, 
-	  psc_prop/2, psc_name/2
+          psc_prop/2, psc_name/2, pow/3
      from machine.
 
 

Index: eval.P
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/eval.P,v
retrieving revision 1.12
retrieving revision 1.12.2.1
diff -u -r1.12 -r1.12.2.1
--- eval.P	2 Jul 2002 14:31:06 -0000	1.12
+++ eval.P	29 Aug 2002 14:17:24 -0000	1.12.2.1
@@ -1,5 +1,5 @@
 /* File:      eval.P
-** Author(s): David S. Warren, Kostis F. Sagonas
+** Author(s): Warren, Xu, Sagonas, Swift
 ** Contact:   xsb...@cs...
 ** *
 ** Copyright (C) The Research Foundation of SUNY, 1993-1998
@@ -26,25 +26,37 @@
 
 #include "celltags_xsb.h"
 
-%-------------------------------------------------------------------------
-% NOTE:	Predicate eval/2 is the one who is responsible for error checking
-%	of arithmetic comparisons and evaluations. According to the Prolog
-%	standard, arithmetic comparisons and evaluations can cause overflow
-%       and
-%	instantiation errors ONLY. Everything else should simply fail as
-%	far as evaluation is concerned.
-%-------------------------------------------------------------------------
-% NOTE: According to the Prolog standard, predicate eval/2 should perform 
-%	type conversion between integers and reals when necessary. 
-%	Our eval/2, does NOT. (mainly because at the moment when this is
-%	written it is not clear whether we will support reals in the first
-%	XSB version).
-%-------------------------------------------------------------------------
-% TLS: 7/02: added min/2 and max/2 as evaluable functions to support the 
-% clpr package.  I have not yet added these functions to the compiler
-% or engine. 
-%-------------------------------------------------------------------------
+/*-------------------------------------------------------------------------
 
+NOTE: In XSB, evaluable functions within is/2 or arithmetic comparison
+literals (e.g. =<) are handled in one of two ways.  First, they may be
+compiled (via tp_eval.P in cmplib); if so, no functions from this file
+are used.  eval/2 and associated predicates are only used when
+"dynamic" arithmetic expressions are to be evaluated -- from the
+command line or from dynamic code.  In addition, eval/2 is called when
+a constraint such as {X = 2+3} in static or dynamic code to evaluated
+via the clpqr library package.
+
+With the exception of min/2, max/2 and exp/2 below, all functions here
+are also compiled as evaluable functions.  These exceptional functions
+are not (as I recall) part of the ISO standard, but are used by clpqr.
+Thus if min/2, max/2 and exp/2 are in an arithmetic expression in is/2
+or an arithmetic comparison operator within static code, they will be
+treated as terms and not evaluable functions.  If they occur within a
+constraint, they will be evaluated via a call by clpqr to eval/2, and
+all will work out.  You'll also be able to use them from the command
+line.
+
+Currently, min/2 and max/2 are written directly in prolog, while exp/2
+calls a builtin.  One fine day, we might make them compilable into
+instructions, but this doesnt seem a high priority in 08/02.
+
+According to the Prolog standard, arithmetic comparisons and
+evaluations can cause overflow and instantiation errors
+ONLY. Everything else should simply fail as far as evaluation is
+concerned.
+
+-------------------------------------------------------------------------*/
 
 eval(Expr, Res) :- 
 	eval(Expr,Res,Expr).
@@ -90,6 +102,8 @@
 			     (Res1 =< Res2 -> Res = Res1 ; Res = Res2).
 eval0(max(X,Y), Res,Expr) :- eval(X, Res1,Expr),eval(Y, Res2,Expr),
 			     (Res1 >= Res2 -> Res = Res1 ; Res = Res2).
+eval0(exp(X,Y), Res,Expr) :- eval(X, Res1,Expr),eval(Y, Res2,Expr),
+			     pow(Res1,Res2,Res).
 
 eval0('-'(X), Res,Expr) :- eval(X, Res1,Expr), Res is -(Res1).
 eval0('\'(X), Res,Expr) :- eval(X, Res1,Expr), Res is '\'(Res1).  

Index: eval.xwam
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/eval.xwam,v
retrieving revision 1.6
retrieving revision 1.6.2.1
diff -u -r1.6 -r1.6.2.1
Binary files /tmp/cvsL8APjs and /tmp/cvs6OsLlK differ

Index: machine.H
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/machine.H,v
retrieving revision 1.46
retrieving revision 1.46.2.1
diff -u -r1.46 -r1.46.2.1
--- machine.H	13 Apr 2002 05:01:59 -0000	1.46
+++ machine.H	29 Aug 2002 14:17:24 -0000	1.46.2.1
@@ -129,6 +129,7 @@
         '$$set_scope_marker'/0,
         '$$unwind_stack'/0,
         '$$clean_up_block'/0,
+        pow/3,
 	print_ls/0, print_tr/0, print_heap/2, print_cp/0, print_regs/0,
 	print_all_stacks/0, expand_heap/0, mark_heap/1, gc_heap/0,
 	'$$findall_init'/2,

Index: machine.P
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/machine.P,v
retrieving revision 1.54
retrieving revision 1.54.2.1
diff -u -r1.54 -r1.54.2.1
--- machine.P	13 Apr 2002 05:01:59 -0000	1.54
+++ machine.P	29 Aug 2002 14:17:24 -0000	1.54.2.1
@@ -205,6 +205,8 @@
 '$$unwind_stack':- '$$unwind_stack'.
 '$$clean_up_block':- '$$clean_up_block'.
 
+pow(_X,_Y,_Z):- '_$builtin'(XSB_POW).
+
 print_ls :- print_ls.
 print_tr :- print_tr.
 print_heap(X,Y) :- print_heap(X,Y).

Index: machine.xwam
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/machine.xwam,v
retrieving revision 1.6
retrieving revision 1.6.2.1
diff -u -r1.6 -r1.6.2.1
Binary files /tmp/cvsMSzT7t and /tmp/cvsKiMHnQ differ

Index: standard.H
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/standard.H,v
retrieving revision 1.29
retrieving revision 1.29.2.1
diff -u -r1.29 -r1.29.2.1
--- standard.H	13 Apr 2002 05:01:59 -0000	1.29
+++ standard.H	29 Aug 2002 14:17:24 -0000	1.29.2.1
@@ -80,7 +80,7 @@
         catch/3,                throw/1,        '$$exception_ball'/1,
         goal_cut_trans/3,	goal_cut_untrans/2,
 	tcall/1,	arity_integer/1,	prolog_arglist/4,
-	message/1,      message/2,
+	message/1,      message/2, messageln/2,
         warning/1,	push_abort_cutpoint/0,  pop_abort_cutpoint/0,
         abort/1,	abort/0,
 	set_timer/1,

Index: standard.P
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/standard.P,v
retrieving revision 1.56.2.3
retrieving revision 1.56.2.4
diff -u -r1.56.2.3 -r1.56.2.4
--- standard.P	8 Aug 2002 12:53:29 -0000	1.56.2.3
+++ standard.P	29 Aug 2002 14:17:24 -0000	1.56.2.4
@@ -991,6 +991,7 @@
         close_open_tables, 
 	'_$cutto'(Cp), 
 	reset_undef_pred_handlers,
+	seen, told,
 	fail.
 
 
@@ -1018,20 +1019,15 @@
 %  message/1
 message(X) :- message(X, STDMSG).
 
+message(Message, File) :-
+	var(Message), !,
+	file_write0(File, Message).
 message((M1,M2), File) :-
 	!,
-	((var(M1); var(M2))
-	->  abort('Uninstantiated message variable')
-	;   true
-	),
 	message(M1, File),
 	message(M2, File).
 message(P/N, File) :-		% temp solution till we fix operators
 	!,
-	(var(P)
-	->  abort('Uninstantiated message variable')
-	;   true
-	),
 	message(P, File),
 	file_put(File, CH_SLASH),
 	file_write0(File, N).

Index: standard.xwam
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/standard.xwam,v
retrieving revision 1.5.2.3
retrieving revision 1.5.2.4
diff -u -r1.5.2.3 -r1.5.2.4
Binary files /tmp/cvsT3ldp8 and /tmp/cvs8LdPr6 differ

Index: std_xsb.P
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/std_xsb.P,v
retrieving revision 1.61.2.3
retrieving revision 1.61.2.4
diff -u -r1.61.2.3 -r1.61.2.4
--- std_xsb.P	8 Aug 2002 12:53:29 -0000	1.61.2.3
+++ std_xsb.P	29 Aug 2002 14:17:24 -0000	1.61.2.4
@@ -288,6 +288,9 @@
 standard_symbol(xsb_flag, 2, curr_sym).		% Not ISO
 standard_symbol((attribute), 1, atts).
 
+standard_symbol(default_error_handler, 1, error_handler).		
+% Not ISO
+
 standard_symbol(('_$cutto'), 1, standard).	% Not ISO
 standard_symbol(('_$savecp'), 1, standard).	% Not ISO
 

Index: std_xsb.xwam
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/std_xsb.xwam,v
retrieving revision 1.4.2.3
retrieving revision 1.4.2.4
diff -u -r1.4.2.3 -r1.4.2.4
Binary files /tmp/cvsIABOJa and /tmp/cvs29yf2a differ

Index: x_interp.H
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/x_interp.H,v
retrieving revision 1.28
retrieving revision 1.28.2.1
diff -u -r1.28 -r1.28.2.1
--- x_interp.H	13 Apr 2002 05:01:59 -0000	1.28
+++ x_interp.H	29 Aug 2002 14:17:24 -0000	1.28.2.1
@@ -36,8 +36,9 @@
 :- import file_read/3, vv/2 from xsb_read.
 %% These are explicitly imported because they are used early on, 
 %% before XSB is fully bootstrapped.
-:- import abort/0, call_c/1, call_expose/1, goal_cut_trans/3,
-          push_abort_cutpoint/0, pop_abort_cutpoint/0, atom_codes/2
+:- import abort/0, call_c/1, call_expose/1, catch/3, goal_cut_trans/3,
+          push_abort_cutpoint/0, pop_abort_cutpoint/0, atom_codes/2,
+          seeing/1, telling/1, see/1, tell/1, seen/0, told/0
      from standard.
 :- import '$$exception_ball'/1 from standard.
 :- import psc_set_type/2, psc_prop/2, psc_set_prop/2, term_psc/2,

Index: x_interp.P
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/x_interp.P,v
retrieving revision 1.42
retrieving revision 1.42.4.1
diff -u -r1.42 -r1.42.4.1
--- x_interp.P	7 Nov 2001 21:08:08 -0000	1.42
+++ x_interp.P	29 Aug 2002 14:17:25 -0000	1.42.4.1
@@ -24,7 +24,7 @@
 ** 
 */
 
-:- compiler_options([xpp_on]).
+:- compiler_options([xpp_on,sysmod,optimize]).
 
 #include "sig_xsb.h"
 #include "flag_defs_xsb.h"
@@ -134,13 +134,14 @@
 
 process_query1(X, []) :-	%% no printable variables appeared in the input
 	!,
-	call_query(X), close_open_tables,
+	call_with_default_catcher(X),
+	close_open_tables,
 	!,
 	file_nl(STDFDBK), file_write(STDFDBK, yes), file_nl(STDFDBK),
 	fail.
 process_query1(X, Vars) :- 
 	prompt(MorePrompt,MorePrompt,'_$more_prompt'(_)),
-	call_query(X),
+	call_with_default_catcher(X),
 	stat_flag(LETTER_VARS, LetterVars),
 	( LetterVars =:= 0 -> print_answer(Vars)
 	; ( numbervars(Vars), print_answer(Vars), fail ; true )
@@ -158,6 +159,9 @@
 	( X =:= CH_EOF_P /* end_of_file */ ; X =:= CH_NEWLINE ), !.
 no_more :- no_more, fail.
 
+call_with_default_catcher(X):- 
+	catch(call_query(X),Msg,default_error_handler(Msg)).
+
 call_query(X) :- 
 %%	'_$savecp'(C),			%% moved into call/1, affect trace?
 	( stat_set_flag(HIDE_STATE, 0)         %% expose tracing
@@ -193,14 +197,19 @@
 
 /* === break =========================================================== */
 
-break :- conget('_$break_level', Blevel),
+break :-
+	seeing(InpFile), telling(OutFile),
+	see(userin), tell(userout),
+	conget('_$break_level', Blevel),
 	Nblevel is Blevel+1, conset('_$break_level', Nblevel),
 	file_write(STDMSG, '[ Break (level '), file_write(STDMSG, Nblevel),
 	file_write(STDMSG, ') ]'), file_nl(STDMSG),
 	readl_brklp1,
 	conset('_$break_level', Blevel),
 	file_write(STDMSG, '[ End break (level '), file_write(STDMSG, Nblevel),
-	file_write(STDMSG, ') ]'), file_nl(STDMSG).
+	file_write(STDMSG, ') ]'), file_nl(STDMSG),
+	seen, told,
+	see(InpFile), tell(OutFile).
 
 readl_brklp1 :- 
 	x_interp_repeat, 
@@ -307,3 +316,4 @@
 	  ->	file_write(STDDBG,[debug]), file_nl(STDDBG)
 	; true
 	).
+

Index: x_interp.xwam
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/x_interp.xwam,v
retrieving revision 1.5
retrieving revision 1.5.2.1
diff -u -r1.5 -r1.5.2.1
Binary files /tmp/cvs3iS4Ie and /tmp/cvsEYNpdj differ

Index: xcallxsb.H
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/xcallxsb.H,v
retrieving revision 1.8
retrieving revision 1.8.2.1
diff -u -r1.8 -r1.8.2.1
--- xcallxsb.H	13 Apr 2002 05:01:59 -0000	1.8
+++ xcallxsb.H	29 Aug 2002 14:17:25 -0000	1.8.2.1
@@ -31,9 +31,8 @@
 :- import file_open/3, file_close/1
      from file_io.
 
-:- import
-       call_c/1, call_expose/1, goal_cut_trans/3, repeat/0, (=..)/2
-   from standard.
+:- import call_c/1, call_expose/1, catch/3,
+ 	  goal_cut_trans/3, repeat/0, (=..)/2  from standard.
 :- import set_inthandler/2 from loader.
 :- import file_write/2, file_nl/1 from xsb_writ.
 :- import file_read_foe/3, file_read/3 from xsb_read.

Index: xcallxsb.P
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/xcallxsb.P,v
retrieving revision 1.9
retrieving revision 1.9.4.1
diff -u -r1.9 -r1.9.4.1
--- xcallxsb.P	2 Nov 2001 22:20:58 -0000	1.9
+++ xcallxsb.P	29 Aug 2002 14:17:25 -0000	1.9.4.1
@@ -95,7 +95,7 @@
 eval_cmdline_goal(FileDes) :-
 	file_read(FileDes, Goal),
 	Goal \= end_of_file,
-	(call((Goal,!)) -> true ; true),
+	(catch(call((Goal,!)),Msg,default_error_handler(Msg)) -> true ; true),
 	eval_cmdline_goal(FileDes).
 eval_cmdline_goal(FileDes) :- file_close(FileDes).
 

Index: xcallxsb.xwam
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/xcallxsb.xwam,v
retrieving revision 1.5
retrieving revision 1.5.2.1
diff -u -r1.5 -r1.5.2.1
Binary files /tmp/cvs8OaNGi and /tmp/cvscnmY6q differ



