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
This commit is contained in:
vsc
parent
0dd1ed933e
commit
d8e5f2c895
@ -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;
|
||||
}
|
||||
|
||||
@ -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)
|
||||
{
|
||||
|
||||
@ -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:
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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));
|
||||
|
||||
@ -17,6 +17,15 @@
|
||||
|
||||
<h2>Yap-5.1.4:</h2>
|
||||
<ul>
|
||||
<li> FIXED: steps towards typed rbtrees plus some cases where one
|
||||
should not copy the null node (Tom Schrijvers and Bart Demoen).</li>
|
||||
<li> FIXED: map_tree in trees library (Bart Demoen).</li>
|
||||
<li> FIXED: bad call to splay_tree (Bart Demoen).</li>
|
||||
<li> FIXED: bad type for write_x_var in add_info (Bart Demoen).</li>
|
||||
<li> FIXED: exec/3 should flush streams.</li>
|
||||
<li> FIXED: load_files/2 compilation_mode to allow :- source and
|
||||
replace compile by compact.</li>
|
||||
<li> FIXED: list_concat/2 (fix from Bart Demoen).</li>
|
||||
<li> NEW: dgraph_reachable/3 and friends.</li>
|
||||
</ul>
|
||||
|
||||
|
||||
14
docs/yap.tex
14
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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]).
|
||||
|
||||
@ -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),
|
||||
|
||||
@ -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),
|
||||
|
||||
@ -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):-
|
||||
|
||||
@ -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 */
|
||||
|
||||
@ -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
|
||||
|
||||
@ -69,6 +69,7 @@ YAP_InitSocks
|
||||
YAP_SetOutputMessage
|
||||
YAP_StreamToFileNo
|
||||
YAP_CloseAllOpenStreams
|
||||
YAP_FlushAllStreams
|
||||
YAP_OpenStream
|
||||
YAP_NewSlots
|
||||
YAP_InitSlot
|
||||
|
||||
@ -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)
|
||||
),
|
||||
|
||||
@ -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).
|
||||
|
||||
|
||||
@ -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)) -->
|
||||
|
||||
Reference in New Issue
Block a user