[Xsb-commits] CVS: XSB/syslib assert.H, 1.30, 1.31 assert.P, 1.48, 1.49 assert.xwam, 1.55, 1.56 basics.xwam, 1.49, 1.50 curr_sym.xwam, 1.75, 1.76 setof.P, 1.6, 1.7 setof.xwam, 1.33, 1.34

[David S. W. <dw...@us...>]

Update of /cvsroot/xsb/XSB/syslib
In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv21623

Modified Files:
	assert.H assert.P assert.xwam basics.xwam curr_sym.xwam 
	setof.P setof.xwam 
Log Message:
Made excess_vars a builtin, and 
added low-level hack in assert.P to allow direct updating.  Experimental only.  Not to be generally used!!!


Index: assert.H
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/assert.H,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- assert.H	19 Sep 2008 14:28:01 -0000	1.30
+++ assert.H	10 Feb 2010 19:13:00 -0000	1.31
@@ -33,8 +33,9 @@
 :- export clause0/2, clause/2.
 :- export (dynamic)/1.
 :- export t_assert/2.
-   :- export code_to_buff/2. % for message queues
+:- export code_to_buff/2. % for message queues
 :- export exchange_definitions/2.
+:- export update/4, get_fact_clref/2, update_clref/4.  %% hackery...
 
 :- import append/3, memberchk/2 from basics.
 
@@ -73,3 +74,6 @@
 :- import call_xsb_hook/3, xsb_assert_hook/1, xsb_retract_hook/1 from xsb_hook.
  
 :- import obsolete/2 from obsolete.
+
+:- import buff_set_word/3, term_psc/2 from machine.
+:- import call_c/1 from standard.

Index: assert.P
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/assert.P,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -r1.48 -r1.49
--- assert.P	19 Sep 2008 14:28:02 -0000	1.48
+++ assert.P	10 Feb 2010 19:13:00 -0000	1.49
@@ -741,3 +741,32 @@
 %	writeln(clause(Clause) +psc(PSC) +arity(Arity) +prref(Prref)),
 	trie_assert_builtin(Clause,PSC,Arity,Prref,Flag).
 
+/* experimental predicates, to allow an update of an integer field in a
+simple fact predicate: Fields must be integer or atom before updated
+argument, and indexed argument cannot be updated.
+E.g. update(p(a,X,_),[2],[NX],(NX is X+1)) updates the second field of the
+p(a,_,_) fact by adding 1 to it.  */
+
+update(Fact,Args,Vals,Exp) :-
+	get_fact_clref(Fact,ClRef),
+	call_c(Exp),
+	update_fields(Args,Vals,ClRef).
+
+get_fact_clref(Fact,ClRef) :-
+	term_psc(Fact,PSC),
+	psc_type(PSC,Type),
+	Type =:= 1,		% T_DYNA
+	psc_ep(PSC,PredEP),
+	PredEP =\= 0,
+	db_clause(Fact,true,PredEP,ClRef).
+
+%% if have the ClRef
+update_clref(ClRef,Args,Vals,Exp) :-
+	call_c(Exp),
+	update_fields(Args,Vals,ClRef).
+
+update_fields([],[],_).
+update_fields([Arg|Args],[Val|Vals],ClRef) :-
+	Disp is (7+2*Arg)*4,
+	buff_set_word(ClRef,Disp,Val),
+	update_fields(Args,Vals,ClRef).

Index: assert.xwam
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/assert.xwam,v
retrieving revision 1.55
retrieving revision 1.56
diff -u -r1.55 -r1.56
Binary files /tmp/cvsGbGR29 and /tmp/cvsNRO5Nf differ

Index: basics.xwam
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/basics.xwam,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -r1.49 -r1.50
Binary files /tmp/cvsQl8957 and /tmp/cvsfF58Rd differ

Index: curr_sym.xwam
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/curr_sym.xwam,v
retrieving revision 1.75
retrieving revision 1.76
diff -u -r1.75 -r1.76
Binary files /tmp/cvs59kwb8 and /tmp/cvs46tlYd differ

Index: setof.P
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/setof.P,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- setof.P	6 Feb 2006 20:09:08 -0000	1.6
+++ setof.P	10 Feb 2010 19:13:00 -0000	1.7
@@ -23,8 +23,9 @@
 */
 
 
-:- compiler_options([sysmod]).
+:- compiler_options([sysmod,xpp_on]).
 
+#include "builtin.h"
 
 /*======================================================================*/
 /* setof(?Template, +Call, ?Set)					*/
@@ -102,17 +103,21 @@
 decide(_, Bag, Key, Key, Bag).
 decide(Bags, _, _, Key, Bag) :- pick(Bags, Key, Bag).
 
-excess_vars(T,X,L0,L) :- var(T), !,
+%% now use builtin
+excess_vars(_Term,_Tmpl,_PVars,_Vars) :- '_$builtin'(EXCESS_VARS).
+
+
+old_excess_vars(T,X,L0,L) :- var(T), !,
    ( no_occurrence(T,X), !, introduce(T,L0,L)
    ; L = L0 ).
-excess_vars(X^P,Y,L0,L) :- !, excess_vars(P,(X,Y),L0,L).
-excess_vars(setof(X,P,S),Y,L0,L) :- !, excess_vars((P,S),(X,Y),L0,L).
-excess_vars(bagof(X,P,S),Y,L0,L) :- !, excess_vars((P,S),(X,Y),L0,L).
-excess_vars(T,X,L0,L) :- functor(T,_,N), rem_excess_vars(N,T,X,L0,L).
+old_excess_vars(X^P,Y,L0,L) :- !, old_excess_vars(P,(X,Y),L0,L).
+old_excess_vars(setof(X,P,S),Y,L0,L) :- !, old_excess_vars((P,S),(X,Y),L0,L).
+old_excess_vars(bagof(X,P,S),Y,L0,L) :- !, old_excess_vars((P,S),(X,Y),L0,L).
+old_excess_vars(T,X,L0,L) :- functor(T,_,N), rem_excess_vars(N,T,X,L0,L).
 
 rem_excess_vars(N,T,X,L0,L) :-
 	( N =:= 0 -> L0 = L
-	; arg(N,T,T1), excess_vars(T1,X,L0,L1),
+	; arg(N,T,T1), old_excess_vars(T1,X,L0,L1),
 	  N1 is N-1, rem_excess_vars(N1,T,X,L1,L)
 	).
 

Index: setof.xwam
===================================================================
RCS file: /cvsroot/xsb/XSB/syslib/setof.xwam,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -r1.33 -r1.34
Binary files /tmp/cvsCIIQAb and /tmp/cvsf8vaph differ