From d8e5f2c89519b506c7dc30d51545dd0906bc52b8 Mon Sep 17 00:00:00 2001 From: vsc Date: Fri, 11 Jul 2008 17:02:10 +0000 Subject: [PATCH] fixes by Bart and Tom: mostly libraries but nasty one in indexing compilation. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2286 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/amasm.c | 6 +- C/c_interface.c | 18 ++++- C/index.c | 7 +- C/iopreds.c | 7 +- H/yapio.h | 1 + changes-5.1.html | 9 +++ docs/yap.tex | 14 +++- include/YapInterface.h | 6 +- library/apply_macros.yap | 1 - library/dgraphs.yap | 3 +- library/lists.yap | 3 - library/rbtrees.yap | 163 ++++++++++++++++++++++----------------- library/splay.yap | 2 +- library/system/sys.c | 6 +- library/trees.yap | 7 +- misc/yap.def | 1 + pl/boot.yap | 5 +- pl/consult.yap | 51 +++++------- pl/messages.yap | 4 +- 19 files changed, 185 insertions(+), 129 deletions(-) diff --git a/C/amasm.c b/C/amasm.c index 455efde0f..3d004a19e 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -11,8 +11,11 @@ * File: amasm.c * * comments: abstract machine assembler * * * -* Last rev: $Date: 2008-04-01 22:28:41 $ * +* Last rev: $Date: 2008-07-11 17:02:07 $ * * $Log: not supported by cvs2svn $ +* Revision 1.101 2008/04/01 22:28:41 vsc +* put YAPOR back to life. +* * Revision 1.100 2008/03/25 16:45:52 vsc * make or-parallelism compile again * @@ -3570,7 +3573,6 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates DBTerm *x; StaticClause *cl; UInt osize; - if(!(x = fetch_clause_space(&t,size,cip,&osize))) { return NULL; } diff --git a/C/c_interface.c b/C/c_interface.c index 08e15ae8b..786e8c25a 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -10,8 +10,13 @@ * File: c_interface.c * * comments: c_interface primitives definition * * * -* Last rev: $Date: 2008-06-17 13:37:48 $,$Author: vsc $ * +* Last rev: $Date: 2008-07-11 17:02:07 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.119 2008/06/17 13:37:48 vsc +* fix c_interface not to crash when people try to recover slots that are +* not there. +* fix try_logical and friends to handle case where predicate has arity 0. +* * Revision 1.118 2008/06/04 14:47:18 vsc * make sure we do trim_trail whenever we mess with B! * @@ -434,6 +439,7 @@ X_API void STD_PROTO(YAP_InitSocks, (char *, long)); X_API void STD_PROTO(YAP_SetOutputMessage, (void)); X_API int STD_PROTO(YAP_StreamToFileNo, (Term)); X_API void STD_PROTO(YAP_CloseAllOpenStreams,(void)); +X_API void STD_PROTO(YAP_FlushAllStreams,(void)); X_API Term STD_PROTO(YAP_OpenStream,(void *, char *, Term, int)); X_API long STD_PROTO(YAP_CurrentSlot,(void)); X_API long STD_PROTO(YAP_NewSlots,(int)); @@ -2005,6 +2011,16 @@ YAP_CloseAllOpenStreams(void) RECOVER_H(); } +X_API void +YAP_FlushAllStreams(void) +{ + BACKUP_H(); + + Yap_FlushStreams(); + + RECOVER_H(); +} + X_API Term YAP_OpenStream(void *fh, char *name, Term nm, int flags) { diff --git a/C/index.c b/C/index.c index 099797bdc..47ce82c6b 100644 --- a/C/index.c +++ b/C/index.c @@ -11,8 +11,11 @@ * File: index.c * * comments: Indexing a Prolog predicate * * * -* Last rev: $Date: 2008-05-10 23:24:11 $,$Author: vsc $ * +* Last rev: $Date: 2008-07-11 17:02:07 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.201 2008/05/10 23:24:11 vsc +* fix threads and LU +* * Revision 1.200 2008/04/16 17:16:47 vsc * make static_clause only commit to a lause if it is sure that is the true * clause. Otherwise, search for the clause. @@ -1487,7 +1490,7 @@ add_info(ClauseDef *clause, UInt regno) case _write_x_val: case _write_x_loc: case _write_x_var: - cl = NEXTOP(cl,e); + cl = NEXTOP(cl,x); break; case _save_b_x: case _put_list: diff --git a/C/iopreds.c b/C/iopreds.c index a9b26c5c0..04a5d8637 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -5395,7 +5395,12 @@ p_flush_all_streams (void) fflush (NULL); #endif - return (TRUE); + return TRUE; +} + +void Yap_FlushStreams(void) +{ + (void)p_flush_all_streams(); } #if HAVE_SELECT diff --git a/H/yapio.h b/H/yapio.h index 6e9556a92..e60bb039c 100644 --- a/H/yapio.h +++ b/H/yapio.h @@ -300,6 +300,7 @@ void STD_PROTO(Yap_UnLockStream,(int)); #endif int STD_PROTO(Yap_GetStreamFd,(int)); void STD_PROTO(Yap_CloseStreams,(int)); +void STD_PROTO(Yap_FlushStreams,(void)); void STD_PROTO(Yap_CloseStream,(int)); int STD_PROTO(Yap_PlGetchar,(void)); int STD_PROTO(Yap_PlGetWchar,(void)); diff --git a/changes-5.1.html b/changes-5.1.html index e751de984..e3b6760a0 100644 --- a/changes-5.1.html +++ b/changes-5.1.html @@ -17,6 +17,15 @@

Yap-5.1.4:

diff --git a/docs/yap.tex b/docs/yap.tex index fe053cd4d..db16a5048 100644 --- a/docs/yap.tex +++ b/docs/yap.tex @@ -1663,8 +1663,9 @@ supported encodings. @item compilation_mode(+@var{Mode}) This extension controls how procedures are compiled. If @var{Mode} - is @code{compile} clauses are compiled and no source code is stored; - is @code{assert_all} clauses are asserted into the data-base. + is @code{compact} clauses are compiled and no source code is stored; + if it is @code{source} clauses are compiled and source code is stored; + if it is @code{assert_all} clauses are asserted into the data-base. @end table @item ensure_loaded(@var{+F}) [ISO] @@ -14148,6 +14149,15 @@ This routine closes the YAP Input/Output system except for the first three streams, that are always associated with the three standard Unix streams. It is most useful if you are doing @code{fork()}. +@findex YAP_FlushAllStreams (C-Interface function) +Last, one may sometimes need to flush all streams: +@example + void YAP_CloseAllOpenStreams(void) +@end example +@noindent +It is also useful before you do a @code{fork()}, or otherwise you may +have trouble with unflushed output. + @findex YAP_OpenStream (C-Interface function) The next routine allows a currently open file to become a stream. The routine receives as arguments a file descriptor, the true file name as a diff --git a/include/YapInterface.h b/include/YapInterface.h index a69febf16..a517a483b 100644 --- a/include/YapInterface.h +++ b/include/YapInterface.h @@ -341,15 +341,15 @@ extern X_API YAP_Term MkSFTerm(); #endif /* SFUNC */ -/* YAP_Term YAP_SetOutputMessage() */ + extern X_API void PROTO(YAP_SetOutputMessage,(void)); -/* YAP_Term YAP_SetOutputMessage() */ extern X_API int PROTO(YAP_StreamToFileNo,(YAP_Term)); -/* YAP_Term YAP_SetOutputMessage() */ extern X_API void PROTO(YAP_CloseAllOpenStreams,(void)); +extern X_API void PROTO(YAP_FlushAllStreams,(void)); + #define YAP_INPUT_STREAM 0x01 #define YAP_OUTPUT_STREAM 0x02 #define YAP_APPEND_STREAM 0x04 diff --git a/library/apply_macros.yap b/library/apply_macros.yap index 5395263d3..464a20409 100644 --- a/library/apply_macros.yap +++ b/library/apply_macros.yap @@ -243,7 +243,6 @@ user:goal_expansion(maplist(Meta, ListIn, ListOut), Mod, Goal) :- append_args(HeadPrefix, [[In|Ins], [Out|Outs]], RecursionHead), append_args(Pred, [In, Out], Apply), append_args(HeadPrefix, [Ins, Outs], RecursiveCall), - write(Goal),nl, compile_aux([ Base, (RecursionHead :- Apply, RecursiveCall) diff --git a/library/dgraphs.yap b/library/dgraphs.yap index 2491a8b34..73e9e7da6 100644 --- a/library/dgraphs.yap +++ b/library/dgraphs.yap @@ -32,7 +32,8 @@ dgraph_min_paths/3, dgraph_isomorphic/4, dgraph_path/3, - dgraph_reachable/3]). + dgraph_reachable/3 + ]). :- reexport(library(rbtrees), [rb_new/1 as dgraph_new]). diff --git a/library/lists.yap b/library/lists.yap index 4e539019a..bc1e2c990 100644 --- a/library/lists.yap +++ b/library/lists.yap @@ -299,9 +299,6 @@ sumlist([Head|Tail], Sofar, Total) :- % is true when Lists is a list of lists, and List is the % concatenation of these lists. -list_concat(Lists, List) :- - list_concat(Lists, [], List). - list_concat([], []). list_concat([H|T], L) :- list_concat(H, L, Li), diff --git a/library/rbtrees.yap b/library/rbtrees.yap index 34c2c0f94..e0c47829b 100644 --- a/library/rbtrees.yap +++ b/library/rbtrees.yap @@ -63,6 +63,29 @@ form colour(Left, Key, Value, Right), where _colour_ is one of =red= or :- meta_predicate rb_map(+,:,-), rb_partial_map(+,+,:,-), rb_apply(+,+,:,-). +/* +:- use_module(library(type_check)). + +:- type rbtree(K,V) ---> t(tree(K,V),tree(K,V)). +:- type tree(K,V) ---> black(tree(K,V),K,V,tree(K,V)) + ; red(tree(K,V),K,V,tree(K,V)) + ; ''. +:- type cmp ---> (=) ; (<) ; (>). + + +:- pred rb_new(rbtree(_K,_V)). +:- pred rb_empty(rbtree(_K,_V)). +:- pred rb_lookup(K,V,rbtree(K,V)). +:- pred lookup(K,V, tree(K,V)). +:- pred lookup(cmp, K, V, tree(K,V)). +:- pred rb_min(rbtree(K,V),K,V). +:- pred min(tree(K,V),K,V). +:- pred rb_max(rbtree(K,V),K,V). +:- pred max(tree(K,V),K,V). +:- pred rb_next(rbtree(K,V),K,pair(K,V),V). +:- pred next(tree(K,V),K,pair(K,V),V,tree(K,V)). +*/ + % create an empty tree. %% rb_new(-T) is det. % @@ -70,15 +93,15 @@ form colour(Left, Key, Value, Right), where _colour_ is one of =red= or % % @deprecated Use rb_empty/1. -rb_new(t(Nil,Nil)) :- Nil = black([],[],[],[]). +rb_new(t(Nil,Nil)) :- Nil = black('',_,_,''). + +rb_new(K,V,t(Nil,black(Nil,K,V,Nil))) :- Nil = black('',_,_,''). %% rb_empty(?T) is semidet. % % Succeeds if T is an empty Red-Black tree. -rb_empty(t(Nil,Nil)) :- Nil = black([],[],[],[]). - -rb_new(K,V,t(Nil,black(Nil,K,V,Nil))) :- Nil = black([],[],[],[]). +rb_empty(t(Nil,Nil)) :- Nil = black('',_,_,''). %% rb_lookup(+Key, -Value, +T) is semidet. % @@ -88,7 +111,7 @@ rb_new(K,V,t(Nil,black(Nil,K,V,Nil))) :- Nil = black([],[],[],[]). rb_lookup(Key, Val, t(_,Tree)) :- lookup(Key, Val, Tree). -lookup(_, _, black([],_,_,[])) :- !, fail. +lookup(_, _, black('',_,_,'')) :- !, fail. lookup(Key, Val, Tree) :- arg(2,Tree,KA), compare(Cmp,KA,Key), @@ -110,8 +133,8 @@ lookup(=, _, V, Tree) :- rb_min(t(_,Tree), Key, Val) :- min(Tree, Key, Val). -min(red(black([],_,_,_),Key,Val,_), Key, Val) :- !. -min(black(black([],_,_,_),Key,Val,_), Key, Val) :- !. +min(red(black('',_,_,_),Key,Val,_), Key, Val) :- !. +min(black(black('',_,_,_),Key,Val,_), Key, Val) :- !. min(red(Right,_,_,_), Key, Val) :- min(Right,Key,Val). min(black(Right,_,_,_), Key, Val) :- @@ -124,8 +147,8 @@ min(black(Right,_,_,_), Key, Val) :- rb_max(t(_,Tree), Key, Val) :- max(Tree, Key, Val). -max(red(_,Key,Val,black([],_,_,_)), Key, Val) :- !. -max(black(_,Key,Val,black([],_,_,_)), Key, Val) :- !. +max(red(_,Key,Val,black('',_,_,_)), Key, Val) :- !. +max(black(_,Key,Val,black('',_,_,_)), Key, Val) :- !. max(red(_,_,_,Left), Key, Val) :- max(Left,Key,Val). max(black(_,_,_,Left), Key, Val) :- @@ -139,7 +162,7 @@ max(black(_,_,_,Left), Key, Val) :- rb_next(t(_,Tree), Key, Next, Val) :- next(Tree, Key, Next, Val, []). -next(black([],_,_,[]), _, _, _, _) :- !, fail. +next(black('',_,_,''), _, _, _, _) :- !, fail. next(Tree, Key, Next, Val, Candidate) :- arg(2,Tree,KA), arg(3,Tree,VA), @@ -169,7 +192,7 @@ next(=, _, _, _, NK, Val, Tree, Candidate) :- rb_previous(t(_,Tree), Key, Previous, Val) :- previous(Tree, Key, Previous, Val, []). -previous(black([],_,_,[]), _, _, _, _) :- !, fail. +previous(black('',_,_,''), _, _, _, _) :- !, fail. previous(Tree, Key, Previous, Val, Candidate) :- arg(2,Tree,KA), arg(3,Tree,VA), @@ -241,7 +264,7 @@ update(red(Left,Key0,Val0,Right), Key, OldVal, Val, NewTree) :- rb_apply(t(Nil,OldTree), Key, Goal, t(Nil,NewTree)) :- apply(OldTree, Key, Goal, NewTree). -%apply(black([],_,_,[]), _, _, _) :- !, fail. +%apply(black('',_,_,''), _, _, _) :- !, fail. apply(black(Left,Key0,Val0,Right), Key, Goal, black(NewLeft,Key0,Val,NewRight)) :- Left \= [], @@ -288,7 +311,7 @@ rb_in(Key, Val, t(_,T)) :- enum(Key, Val, black(L,K,V,R)) :- - L \= [], + L \= '', enum_cases(Key, Val, L, K, V, R). enum(Key, Val, red(L,K,V,R)) :- enum_cases(Key, Val, L, K, V, R). @@ -309,7 +332,7 @@ rb_lookupall(Key, Val, t(_,Tree)) :- lookupall(Key, Val, Tree). -lookupall(_, _, black([],_,_,[])) :- !, fail. +lookupall(_, _, black('',_,_,'')) :- !, fail. lookupall(Key, Val, Tree) :- arg(2,Tree,KA), compare(Cmp,KA,Key), @@ -369,7 +392,7 @@ insert(Tree0,Key,Val,Nil,Tree) :- % % actual insertion % -insert2(black([],[],[],[]), K, V, Nil, T, Status) :- !, +insert2(black('',_,_,''), K, V, Nil, T, Status) :- !, T = red(Nil,K,V,Nil), Status = not_done. insert2(red(L,K0,V0,R), K, V, Nil, NT, Flag) :- @@ -414,7 +437,7 @@ insert_new(Tree0,Key,Val,Nil,Tree) :- % % actual insertion, copied from insert2 % -insert_new_2(black([],[],[],[]), K, V, Nil, T, Status) :- !, +insert_new_2(black('',_,_,''), K, V, Nil, T, Status) :- !, T = red(Nil,K,V,Nil), Status = not_done. insert_new_2(red(L,K0,V0,R), K, V, Nil, NT, Flag) :- @@ -520,7 +543,7 @@ fix_right(T,T,done). pretty_print(t(_,T)) :- pretty_print(T,6). -pretty_print(black([],[],[],[]),_) :- !. +pretty_print(black('',_,_,''),_) :- !. pretty_print(red(L,K,_,R),D) :- DN is D+6, pretty_print(L,DN), @@ -580,12 +603,12 @@ delete(black(L,_,V,R), _, V, OUT, Flag) :- rb_del_min(t(Nil,T), K, Val, t(Nil,NT)) :- del_min(T, K, Val, Nil, NT, _). -del_min(red(black([],_,_,_),K,V,R), K, V, Nil, OUT, Flag) :- !, +del_min(red(black('',_,_,_),K,V,R), K, V, Nil, OUT, Flag) :- !, delete_red_node(Nil,R,OUT,Flag). del_min(red(L,K0,V0,R), K, V, Nil, NT, Flag) :- del_min(L, K, V, Nil, NL, Flag0), fixup_left(Flag0,red(NL,K0,V0,R), NT, Flag). -del_min(black(black([],_,_,_),K,V,R), K, V, Nil, OUT, Flag) :- !, +del_min(black(black('',_,_,_),K,V,R), K, V, Nil, OUT, Flag) :- !, delete_black_node(Nil,R,OUT,Flag). del_min(black(L,K0,V0,R), K, V, Nil, NT, Flag) :- del_min(L, K, V, Nil, NL, Flag0), @@ -600,12 +623,12 @@ del_min(black(L,K0,V0,R), K, V, Nil, NT, Flag) :- rb_del_max(t(Nil,T), K, Val, t(Nil,NT)) :- del_max(T, K, Val, Nil, NT, _). -del_max(red(L,K,V,black([],_,_,_)), K, V, Nil, OUT, Flag) :- !, +del_max(red(L,K,V,black('',_,_,_)), K, V, Nil, OUT, Flag) :- !, delete_red_node(L,Nil,OUT,Flag). del_max(red(L,K0,V0,R), K, V, Nil, NT, Flag) :- del_max(R, K, V, Nil, NR, Flag0), fixup_right(Flag0,red(L,K0,V0,NR),NT, Flag). -del_max(black(L,K,V,black([],_,_,_)), K, V, Nil, OUT, Flag) :- !, +del_max(black(L,K,V,black('',_,_,_)), K, V, Nil, OUT, Flag) :- !, delete_black_node(L,Nil,OUT,Flag). del_max(black(L,K0,V0,R), K, V, Nil, NT, Flag) :- del_max(R, K, V, Nil, NR, Flag0), @@ -614,27 +637,27 @@ del_max(black(L,K0,V0,R), K, V, Nil, NT, Flag) :- delete_red_node(L1,L2,L1,done) :- L1 == L2, !. -delete_red_node(black([],[],[],[]),R,R,done) :- !. -delete_red_node(L,black([],[],[],[]),L,done) :- !. +delete_red_node(black('',_,_,''),R,R,done) :- !. +delete_red_node(L,black('',_,_,''),L,done) :- !. delete_red_node(L,R,OUT,Done) :- delete_next(R,NK,NV,NR,Done0), fixup_right(Done0,red(L,NK,NV,NR),OUT,Done). delete_black_node(L1,L2,L1,not_done) :- L1 == L2, !. -delete_black_node(black([],[],[],[]),red(L,K,V,R),black(L,K,V,R),done) :- !. -delete_black_node(black([],[],[],[]),R,R,not_done) :- !. -delete_black_node(red(L,K,V,R),black([],[],[],[]),black(L,K,V,R),done) :- !. -delete_black_node(L,black([],[],[],[]),L,not_done) :- !. +delete_black_node(black('',_,_,''),red(L,K,V,R),black(L,K,V,R),done) :- !. +delete_black_node(black('',_,_,''),R,R,not_done) :- !. +delete_black_node(red(L,K,V,R),black('',_,_,''),black(L,K,V,R),done) :- !. +delete_black_node(L,black('',_,_,''),L,not_done) :- !. delete_black_node(L,R,OUT,Done) :- delete_next(R,NK,NV,NR,Done0), fixup_right(Done0,black(L,NK,NV,NR),OUT,Done). -delete_next(red(black([],[],[],[]),K,V,R),K,V,R,done) :- !. -delete_next(black(black([],[],[],[]),K,V,red(L1,K1,V1,R1)), +delete_next(red(black('',_,_,''),K,V,R),K,V,R,done) :- !. +delete_next(black(black('',_,_,''),K,V,red(L1,K1,V1,R1)), K,V,black(L1,K1,V1,R1),done) :- !. -delete_next(black(black([],[],[],[]),K,V,R),K,V,R,not_done) :- !. +delete_next(black(black('',_,_,''),K,V,R),K,V,R,not_done) :- !. delete_next(red(L,K,V,R),K0,V0,OUT,Done) :- delete_next(L,K0,V0,NL,Done0), fixup_left(Done0,red(NL,K,V,R),OUT,Done). @@ -742,7 +765,7 @@ rb_visit(t(_,T),Lf) :- rb_visit(t(_,T),L0,Lf) :- visit(T,L0,Lf). -visit(black([],_,_,_),L,L) :- !. +visit(black('',_,_,_),L,L) :- !. visit(red(L,K,V,R),L0,Lf) :- visit(L,[K-V|L1],Lf), visit(R,L0,L1). @@ -755,9 +778,19 @@ visit(black(L,K,V,R),L0,Lf) :- % True if call(Goal, Value) is true for all nodes in T. rb_map(t(Nil,Tree),Goal,t(Nil,NewTree)) :- - map(Tree,Goal,NewTree). + map(Tree,Goal,NewTree,Nil). +map(black('',_,_,''),_,Nil,Nil) :- !. +map(red(L,K,V,R),Goal,red(NL,K,NV,NR),Nil) :- + call(Goal,V,NV), !, + map(L,Goal,NL,Nil), + map(R,Goal,NR,Nil). +map(black(L,K,V,R),Goal,black(NL,K,NV,NR),Nil) :- + call(Goal,V,NV), !, + map(L,Goal,NL,Nil), + map(R,Goal,NR,Nil). + %% rb_map(+T, :G, -TN) is semidet. % % For all nodes Key in the tree T, if the value associated with @@ -765,21 +798,11 @@ rb_map(t(Nil,Tree),Goal,t(Nil,NewTree)) :- % the value associated with Key in TN is ValF. Fails if % call(G,Val0,ValF) is not satisfiable for all Var0. -map(black([],[],[],[]),_,black([],[],[],[])) :- !. -map(red(L,K,V,R),Goal,red(NL,K,NV,NR)) :- - call(Goal,V,NV), !, - map(L,Goal,NL), - map(R,Goal,NR). -map(black(L,K,V,R),Goal,black(NL,K,NV,NR)) :- - call(Goal,V,NV), !, - map(L,Goal,NL), - map(R,Goal,NR). - rb_map(t(_,Tree),Goal) :- map(Tree,Goal). -map(black([],[],[],[]),_) :- !. +map(black('',_,_,''),_) :- !. map(red(L,_,V,R),Goal) :- call(Goal,V), !, map(L,Goal), @@ -796,26 +819,26 @@ map(black(L,_,V,R),Goal) :- % a list containing all new nodes as pairs K-V. rb_clone(t(Nil,T),t(Nil,NT),Ns) :- - clone(T,NT,Ns,[]). + clone(T,Nil,NT,Ns,[]). -clone(black([],[],[],[]),black([],[],[],[]),Ns,Ns) :- !. -clone(red(L,K,_,R),red(NL,K,NV,NR),NsF,Ns0) :- - clone(L,NL,NsF,[K-NV|Ns1]), - clone(R,NR,Ns1,Ns0). -clone(black(L,K,_,R),black(NL,K,NV,NR),NsF,Ns0) :- - clone(L,NL,NsF,[K-NV|Ns1]), - clone(R,NR,Ns1,Ns0). +clone(black('',_,_,''),Nil,Nil,Ns,Ns) :- !. +clone(red(L,K,_,R),Nil,red(NL,K,NV,NR),NsF,Ns0) :- + clone(L,Nil,NL,NsF,[K-NV|Ns1]), + clone(R,Nil,NR,Ns1,Ns0). +clone(black(L,K,_,R),Nil,black(NL,K,NV,NR),NsF,Ns0) :- + clone(L,Nil,NL,NsF,[K-NV|Ns1]), + clone(R,Nil,NR,Ns1,Ns0). rb_clone(t(Nil,T),ONs,t(Nil,NT),Ns) :- - clone(T,ONs,[],NT,Ns,[]). + clone(T,Nil,ONs,[],NT,Ns,[]). -clone(black([],[],[],[]),ONs,ONs,black([],[],[],[]),Ns,Ns) :- !. -clone(red(L,K,V,R),ONsF,ONs0,red(NL,K,NV,NR),NsF,Ns0) :- - clone(L,ONsF,[K-V|ONs1],NL,NsF,[K-NV|Ns1]), - clone(R,ONs1,ONs0,NR,Ns1,Ns0). -clone(black(L,K,V,R),ONsF,ONs0,black(NL,K,NV,NR),NsF,Ns0) :- - clone(L,ONsF,[K-V|ONs1],NL,NsF,[K-NV|Ns1]), - clone(R,ONs1,ONs0,NR,Ns1,Ns0). +clone(black('',_,_,''),Nil,ONs,ONs,Nil,Ns,Ns) :- !. +clone(red(L,K,V,R),Nil,ONsF,ONs0,red(NL,K,NV,NR),NsF,Ns0) :- + clone(L,Nil,ONsF,[K-V|ONs1],NL,NsF,[K-NV|Ns1]), + clone(R,Nil,ONs1,ONs0,NR,Ns1,Ns0). +clone(black(L,K,V,R),Nil,ONsF,ONs0,black(NL,K,NV,NR),NsF,Ns0) :- + clone(L,Nil,ONsF,[K-V|ONs1],NL,NsF,[K-NV|Ns1]), + clone(R,Nil,ONs1,ONs0,NR,Ns1,Ns0). %% rb_partial_map(+T, +Keys, :G, -TN) % @@ -832,7 +855,7 @@ rb_partial_map(t(Nil,T0), Map, Map0, Goal, t(Nil,TF)) :- rb_partial_map(T0, Map, Map0, Nil, Goal, TF). partial_map(T,[],[],_,_,T) :- !. -partial_map(black([],_,_,_),Map,Map,Nil,_,Nil) :- !. +partial_map(black('',_,_,_),Map,Map,Nil,_,Nil) :- !. partial_map(red(L,K,V,R),Map,MapF,Nil,Goal,red(NL,K,NV,NR)) :- partial_map(L,Map,MapI,Nil,Goal,NL), ( @@ -885,7 +908,7 @@ rb_keys(t(_,T),Lf) :- rb_keys(t(_,T),L0,Lf) :- keys(T,L0,Lf). -keys(black([],[],[],[]),L,L) :- !. +keys(black('',_,_,''),L,L) :- !. keys(red(L,K,_,R),L0,Lf) :- keys(L,[K|L1],Lf), keys(R,L0,L1). @@ -908,11 +931,11 @@ list_to_rbtree(List, T) :- % list L. ord_list_to_rbtree([], t(Nil,Nil)) :- !, - Nil = black([], [], [], []). + Nil = black('', _, _, ''). ord_list_to_rbtree([K-V], t(Nil,black(Nil,K,V,Nil))) :- !, - Nil = black([], [], [], []). + Nil = black('', _, _, ''). ord_list_to_rbtree(List, t(Nil,Tree)) :- - Nil = black([], [], [], []), + Nil = black('', _, _, ''), Ar =.. [seq|List], functor(Ar,_,L), Height is integer(log(L)/log(2)), @@ -943,7 +966,7 @@ build_node( _, Left, K, Val, Right, black(Left, K, Val, Right)). rb_size(t(_,T),Size) :- size(T,0,Size). -size(black([],_,_,_),Sz,Sz) :- !. +size(black('',_,_,_),Sz,Sz) :- !. size(red(L,_,_,R),Sz0,Szf) :- Sz1 is Sz0+1, size(L,Sz1,Sz2), @@ -974,7 +997,7 @@ is_rbtree(T,Goal) :- % This code checks if a tree is ordered and a rbtree % % -rbtree(t(_,black([],[],[],[]))) :- !. +rbtree(t(_,black('',_,_,''))) :- !. rbtree(t(_,T)) :- catch(rbtree1(T),msg(S,Args),format(S,Args)). @@ -986,14 +1009,14 @@ rbtree1(red(_,_,_,_)) :- throw(msg("root should be black",[])). -find_path_blacks(black([],[],[],[]), Bls, Bls) :- !. +find_path_blacks(black('',_,_,''), Bls, Bls) :- !. find_path_blacks(black(L,_,_,_), Bls0, Bls) :- Bls1 is Bls0+1, find_path_blacks(L, Bls1, Bls). find_path_blacks(red(L,_,_,_), Bls0, Bls) :- find_path_blacks(L, Bls0, Bls). -check_rbtree(black([],[],[],[]),Min,Max,Bls0) :- !, +check_rbtree(black('',_,_,''),Min,Max,Bls0) :- !, check_height(Bls0,Min,Max). check_rbtree(red(L,K,_,R),Min,Max,Bls) :- check_val(K,Min,Max), @@ -1061,11 +1084,11 @@ clean_tree(X1,X,T0,TF) :- clean_tree(X2,X,TI,TF). bclean_tree(X,X,T0,TF) :- !, -% format("cleaning ~d~n", [X]), + format("cleaning ~d~n", [X]), rb_delete(T0,X,TF), ( rbtree(TF) -> true ; abort). bclean_tree(X1,X,T0,TF) :- -% format("cleaning ~d~n", [X1]), + format("cleaning ~d~n", [X1]), rb_delete(T0,X1,TI), X2 is X1-1, ( rbtree(TI) -> true ; abort), diff --git a/library/splay.yap b/library/splay.yap index 841c0e198..f0ad187d5 100644 --- a/library/splay.yap +++ b/library/splay.yap @@ -104,7 +104,7 @@ splay_insert(Item, Val,Tree, NewTree):- bst(insert, Item, Val, Tree, NewTree). splay_del(Item, Tree, NewTree):- bst(access(true), Item, Val, Tree, n(Item, Val, Left, Right)), - join(Left, Right, NewTree). + splay_join(Left, Right, NewTree). splay_join(Left, Right, New):- join(L-L, Left, Right, New). splay_split(Item, Val, Tree, Left, Right):- diff --git a/library/system/sys.c b/library/system/sys.c index 7f2f4db6d..5499614c0 100644 --- a/library/system/sys.c +++ b/library/system/sys.c @@ -8,8 +8,11 @@ * * ************************************************************************** * * -* $Id: sys.c,v 1.35 2008-05-23 13:16:13 vsc Exp $ * +* $Id: sys.c,v 1.36 2008-07-11 17:02:09 vsc Exp $ * * mods: $Log: not supported by cvs2svn $ +* mods: Revision 1.35 2008/05/23 13:16:13 vsc +* mods: fix sys.c for win32 +* mods: * mods: Revision 1.34 2008/05/22 23:25:21 vsc * mods: add tmp_file/2 * mods: @@ -710,6 +713,7 @@ execute_command(void) close(outf); return(YAP_Unify(YAP_ARG6, YAP_MkIntTerm(errno))); } + YAP_FlushAllStreams(); /* we are now ready to fork */ if ((res = fork()) < 0) { /* close streams we don't need */ diff --git a/library/trees.yap b/library/trees.yap index f80fc7c3c..080815938 100644 --- a/library/trees.yap +++ b/library/trees.yap @@ -104,16 +104,11 @@ list_to_tree(List, Tree) :- % a tool for everyday use. map_tree(Pred, t(Old,OLeft,ORight), t(New,NLeft,NRight)) :- - tree_apply(Pred, [Old,New]), + once(call(Pred, Old, New)), map_tree(Pred, OLeft, NLeft), map_tree(Pred, ORight, NRight). map_tree(_, t, t). -tree_apply(Pred,Args) :- - G =.. [Pred,Args], - call(G), !. - - % put_label(Index, OldTree, Label, NewTree) % constructs a new tree the same shape as the old which moreover has the % same elements except that the Index-th one is Label. Unlike the diff --git a/misc/yap.def b/misc/yap.def index 858060579..fcf433214 100644 --- a/misc/yap.def +++ b/misc/yap.def @@ -69,6 +69,7 @@ YAP_InitSocks YAP_SetOutputMessage YAP_StreamToFileNo YAP_CloseAllOpenStreams +YAP_FlushAllStreams YAP_OpenStream YAP_NewSlots YAP_InitSlot diff --git a/pl/boot.yap b/pl/boot.yap index 4b25dbb28..a4c666da5 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -300,7 +300,8 @@ true :- true. '$execute_commands'([],_,_,_) :- !, fail. '$execute_commands'([C|Cs],VL,Con,Source) :- !, ( - '$execute_command'(C,VL,Con,Source) + '$execute_command'(C,VL,Con,Source), + fail ; '$execute_commands'(Cs,VL,Con,Source) ), @@ -1064,7 +1065,7 @@ access_file(F,Mode) :- expand_term(Term,Expanded) :- ( \+ '$undefined'(term_expansion(_,_), user), - user:term_expansion(Term,Expanded) + once(user:term_expansion(Term,Expanded)) ; '$expand_term_grammar'(Term,Expanded) ), diff --git a/pl/consult.yap b/pl/consult.yap index b94af56ef..0e395d706 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -27,7 +27,7 @@ % silent(true,false) => implemented % stream(Stream) => implemented % consult(consult,reconsult) => implemented -% compilation_mode(compile,source,assert_all) => implemented +% compilation_mode(compact,source,assert_all) => implemented % load_files(Files,Opts) :- '$load_files'(Files,Opts,load_files(Files,Opts)). @@ -92,7 +92,7 @@ load_files(Files,Opts) :- nb_setval('$lf_verbose',silent). '$process_lf_opt'(skip_unix_comments,_,_,_,_,_,_,_,_,skip_unix_comments,_,_,_,_). '$process_lf_opt'(compilation_mode(source),_,_,_,_,_,_,_,_,_,source,_,_,_). -'$process_lf_opt'(compilation_mode(compile),_,_,_,_,_,_,_,_,_,compile,_,_,_). +'$process_lf_opt'(compilation_mode(compact),_,_,_,_,_,_,_,_,_,compact,_,_,_). '$process_lf_opt'(compilation_mode(assert_all),_,_,_,_,_,_,_,_,_,assert_all,_,_,_). '$process_lf_opt'(silent(false),_,_,_,_,_,_,_,_,_,_,_,_,_). '$process_lf_opt'(consult(reconsult),_,_,_,_,_,_,_,_,_,_,reconsult,_,_). @@ -253,7 +253,7 @@ use_module(M,F,Is) :- ), '$change_alias_to_stream'('$loop_stream',OldStream), '$set_yap_flags'(18,GenerateDebug), - '$comp_mode'(_, OldCompMode), + '$comp_mode'(CompMode, OldCompMode), nb_setval('$consulting',Old), nb_setval('$consulting_file',OldF), cd(OldD), @@ -872,33 +872,22 @@ absolute_file_name(File,Opts,TrueFileName) :- '$if_directive'((:- elif(_))). '$if_directive'((:- endif)). -'$comp_mode'(OldCompMode, CompMode) :- - ( - nb_getval('$assert_all',on) - -> - OldCompMode = assert_all - ; - '$access_yap_flags'(11,1) - -> - OldCompMode = source - ; - OldCompMode = compile - ), - ( - var(CompMode) -> - true - ; - CompMode == assert_all - -> - nb_setval('$assert_all',on) - ; - CompMode == source - -> - nb_setval('$assert_all',off), - '$set_yap_flags'(11,1) - ; - nb_setval('$assert_all',off), - '$set_yap_flags'(11,0) - ). +'$comp_mode'(_OldCompMode, CompMode) :- + var(CompMode), !. % just do nothing. +'$comp_mode'(OldCompMode, assert_all) :- + '$fetch_comp_status'(OldCompMode), + nb_setval('$assert_all',on). +'$comp_mode'(OldCompMode, source) :- + '$fetch_comp_status'(OldCompMode), + '$set_yap_flags'(11,1). +'$comp_mode'(OldCompMode, compact) :- + '$fetch_comp_status'(OldCompMode), + '$set_yap_flags'(11,0). + +'$fetch_comp_status'(assert_all) :- + nb_getval('$assert_all',on), !. +'$fetch_comp_status'(source) :- + '$get_yap_flags'(11,1). +'$fetch_comp_status'(compact). diff --git a/pl/messages.yap b/pl/messages.yap index 56a63815f..a69a07445 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -11,7 +11,7 @@ * File: utilities for displaying messages in YAP. * * comments: error messages for YAP * * * -* Last rev: $Date: 2008-06-16 21:22:15 $,$Author: vsc $ * +* Last rev: $Date: 2008-07-11 17:02:10 $,$Author: vsc $ * * * * * *************************************************************************/ @@ -106,7 +106,7 @@ system_message(debug(off)) --> system_message(debug(trace)) --> [ 'Trace mode on.' ]. system_message(declaration(Args,Action)) --> - [ 'declaration ~w ~w.', [Args,Action] ]. + [ 'declaration ~w ~w.' - [Args,Action] ]. system_message(defined_elsewhere(P,F)) --> [ 'predicate ~q previously defined in file ~w' - [P,F] ]. system_message(import(Pred,To,From,private)) -->