some nice extra predicatesy
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2273 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
c1f9fc9bcf
commit
02565ae625
121
C/arrays.c
121
C/arrays.c
@ -692,6 +692,95 @@ ResizeStaticArray(StaticArrayEntry *pp, Int dim)
|
|||||||
WRITE_UNLOCK(pp->ArRWLock);
|
WRITE_UNLOCK(pp->ArRWLock);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static void
|
||||||
|
ClearStaticArray(StaticArrayEntry *pp)
|
||||||
|
{
|
||||||
|
statarray_elements old_v = pp->ValueOfVE;
|
||||||
|
static_array_types type = pp->ArrayType;
|
||||||
|
Int dim = - pp->ArrayEArity, i;
|
||||||
|
|
||||||
|
/* change official size */
|
||||||
|
if (pp->ArrayEArity >= 0){
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
WRITE_LOCK(pp->ArRWLock);
|
||||||
|
switch(type) {
|
||||||
|
case array_of_ints:
|
||||||
|
memset((void *)pp->ValueOfVE.ints,0,sizeof(int)*dim);
|
||||||
|
break;
|
||||||
|
case array_of_chars:
|
||||||
|
memset((void *)pp->ValueOfVE.chars,0,sizeof(char)*dim);
|
||||||
|
break;
|
||||||
|
case array_of_uchars:
|
||||||
|
memset((void *)pp->ValueOfVE.uchars,0,sizeof(unsigned char)*dim);
|
||||||
|
break;
|
||||||
|
case array_of_doubles:
|
||||||
|
memset((void *)pp->ValueOfVE.floats,0,sizeof(double)*dim);
|
||||||
|
break;
|
||||||
|
case array_of_ptrs:
|
||||||
|
memset((void *)pp->ValueOfVE.ptrs,0,sizeof(void *)*dim);
|
||||||
|
break;
|
||||||
|
case array_of_atoms:
|
||||||
|
for (i = 0; i< dim; i++)
|
||||||
|
pp->ValueOfVE.atoms[i] = TermNil;
|
||||||
|
break;
|
||||||
|
case array_of_dbrefs:
|
||||||
|
for (i = 0; i < dim; i++) {
|
||||||
|
Term t0 = pp->ValueOfVE.dbrefs[i];
|
||||||
|
if (t0 != 0L) {
|
||||||
|
DBRef ptr = DBRefOfTerm(t0);
|
||||||
|
|
||||||
|
if (ptr->Flags & LogUpdMask) {
|
||||||
|
LogUpdClause *lup = (LogUpdClause *)ptr;
|
||||||
|
LOCK(lup->ClLock);
|
||||||
|
lup->ClRefCount--;
|
||||||
|
if (lup->ClRefCount == 0 &&
|
||||||
|
(lup->ClFlags & ErasedMask) &&
|
||||||
|
!(lup->ClFlags & InUseMask)) {
|
||||||
|
UNLOCK(lup->ClLock);
|
||||||
|
Yap_ErLogUpdCl(lup);
|
||||||
|
} else {
|
||||||
|
UNLOCK(lup->ClLock);
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
ptr->NOfRefsTo--;
|
||||||
|
if (ptr->NOfRefsTo == 0 &&
|
||||||
|
(ptr->Flags & ErasedMask) &&
|
||||||
|
!(ptr->Flags & InUseMask)) {
|
||||||
|
Yap_ErDBE(ptr);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
pp->ValueOfVE.dbrefs[i] = 0L;
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
case array_of_terms:
|
||||||
|
for (i = 0; i < dim; i++) {
|
||||||
|
DBTerm *ref = pp->ValueOfVE.terms[i];
|
||||||
|
|
||||||
|
if (ref != NULL) {
|
||||||
|
Yap_ReleaseTermFromDB(ref);
|
||||||
|
}
|
||||||
|
pp->ValueOfVE.terms[i] = NULL;
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
case array_of_nb_terms:
|
||||||
|
for (i = 0; i < dim; i++) {
|
||||||
|
Term told = pp->ValueOfVE.lterms[i].tstore;
|
||||||
|
CELL *livep = &(pp->ValueOfVE.lterms[i].tlive);
|
||||||
|
|
||||||
|
RESET_VARIABLE(livep);
|
||||||
|
/* recover space */
|
||||||
|
if (IsApplTerm(told)) {
|
||||||
|
Yap_ReleaseTermFromDB((DBTerm *)RepAppl(told));
|
||||||
|
}
|
||||||
|
pp->ValueOfVE.lterms[i].tstore = old_v.lterms[i].tstore;
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
WRITE_UNLOCK(pp->ArRWLock);
|
||||||
|
}
|
||||||
|
|
||||||
/* create an array (?Name, + Size) */
|
/* create an array (?Name, + Size) */
|
||||||
static Int
|
static Int
|
||||||
p_create_array(void)
|
p_create_array(void)
|
||||||
@ -1008,6 +1097,37 @@ p_resize_static_array(void)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* resize a static array (+Name, + Size, +Props) */
|
||||||
|
/* does not work for mmap arrays yet */
|
||||||
|
static Int
|
||||||
|
p_clear_static_array(void)
|
||||||
|
{
|
||||||
|
Term t = Deref(ARG1);
|
||||||
|
|
||||||
|
if (IsVarTerm(t)) {
|
||||||
|
Yap_Error(INSTANTIATION_ERROR,t,"clear a static array");
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
|
else if (IsAtomTerm(t)) {
|
||||||
|
/* resize a named array */
|
||||||
|
Atom a = AtomOfTerm(t);
|
||||||
|
StaticArrayEntry *pp = RepStaticArrayProp(RepAtom(a)->PropsOfAE);
|
||||||
|
|
||||||
|
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
|
||||||
|
pp = RepStaticArrayProp(pp->NextOfPE);
|
||||||
|
if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
|
||||||
|
Yap_Error(PERMISSION_ERROR_RESIZE_ARRAY,t,"clear a static array");
|
||||||
|
return FALSE;
|
||||||
|
} else {
|
||||||
|
ClearStaticArray(pp);
|
||||||
|
return TRUE;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
Yap_Error(TYPE_ERROR_ATOM,t,"clear a static array");
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
/* Close a named array (+Name) */
|
/* Close a named array (+Name) */
|
||||||
static Int
|
static Int
|
||||||
p_close_static_array(void)
|
p_close_static_array(void)
|
||||||
@ -2368,6 +2488,7 @@ Yap_InitArrayPreds(void)
|
|||||||
Yap_InitCPred("dynamic_update_array", 3, p_assign_dynamic, SafePredFlag);
|
Yap_InitCPred("dynamic_update_array", 3, p_assign_dynamic, SafePredFlag);
|
||||||
Yap_InitCPred("add_to_array_element", 4, p_add_to_array_element, SafePredFlag);
|
Yap_InitCPred("add_to_array_element", 4, p_add_to_array_element, SafePredFlag);
|
||||||
Yap_InitCPred("array_element", 3, p_access_array, 0);
|
Yap_InitCPred("array_element", 3, p_access_array, 0);
|
||||||
|
Yap_InitCPred("reset_static_array", 1, p_clear_static_array, SafePredFlag);
|
||||||
Yap_InitCPred("close_static_array", 1, p_close_static_array, SafePredFlag);
|
Yap_InitCPred("close_static_array", 1, p_close_static_array, SafePredFlag);
|
||||||
Yap_InitCPred("$sync_mmapped_arrays", 0, p_sync_mmapped_arrays, SafePredFlag|HiddenPredFlag);
|
Yap_InitCPred("$sync_mmapped_arrays", 0, p_sync_mmapped_arrays, SafePredFlag|HiddenPredFlag);
|
||||||
Yap_InitCPred("$compile_array_refs", 0, p_compile_array_refs, SafePredFlag|HiddenPredFlag);
|
Yap_InitCPred("$compile_array_refs", 0, p_compile_array_refs, SafePredFlag|HiddenPredFlag);
|
||||||
|
@ -20,6 +20,7 @@
|
|||||||
rb_apply/4, % +T, +Key, :G, -TN
|
rb_apply/4, % +T, +Key, :G, -TN
|
||||||
rb_lookupall/3, % +Key, -Value, +T
|
rb_lookupall/3, % +Key, -Value, +T
|
||||||
rb_insert/4, % +T0, +Key, ?Value, -TN
|
rb_insert/4, % +T0, +Key, ?Value, -TN
|
||||||
|
rb_insert_new/4, % +T0, +Key, ?Value, -TN
|
||||||
rb_delete/3, % +T, +Key, -TN
|
rb_delete/3, % +T, +Key, -TN
|
||||||
rb_delete/4, % +T, +Key, -Val, -TN
|
rb_delete/4, % +T, +Key, -Val, -TN
|
||||||
rb_visit/2, % +T, -Pairs
|
rb_visit/2, % +T, -Pairs
|
||||||
@ -345,13 +346,6 @@ insert(Tree0,Key,Val,Nil,Tree) :-
|
|||||||
insert2(Tree0,Key,Val,Nil,TreeI,_),
|
insert2(Tree0,Key,Val,Nil,TreeI,_),
|
||||||
fix_root(TreeI,Tree).
|
fix_root(TreeI,Tree).
|
||||||
|
|
||||||
%
|
|
||||||
% make sure the root is always black.
|
|
||||||
%
|
|
||||||
fix_root(black(L,K,V,R),black(L,K,V,R)).
|
|
||||||
fix_root(red(L,K,V,R),black(L,K,V,R)).
|
|
||||||
|
|
||||||
|
|
||||||
%
|
%
|
||||||
% Cormen et al present the algorithm as
|
% Cormen et al present the algorithm as
|
||||||
% (1) standard tree insertion;
|
% (1) standard tree insertion;
|
||||||
@ -402,6 +396,53 @@ insert2(black(L,K0,V0,R), K, V, Nil, NT, Flag) :-
|
|||||||
fix_right(Flag0, black(L,K0,V0,IR), NT, Flag)
|
fix_right(Flag0, black(L,K0,V0,IR), NT, Flag)
|
||||||
).
|
).
|
||||||
|
|
||||||
|
% We don't use parent nodes, so we may have to fix the root.
|
||||||
|
|
||||||
|
%% rb_insert_new(+T0, +Key, ?Value, -TN)
|
||||||
|
%
|
||||||
|
% Add a new element with key Key and Value to the tree T0 creating a
|
||||||
|
% new red-black tree TN. Duplicated elements are not allowed.
|
||||||
|
|
||||||
|
insert_new(Tree0,Key,Val,Nil,Tree) :-
|
||||||
|
insert_new_2(Tree0,Key,Val,Nil,TreeI,_),
|
||||||
|
fix_root(TreeI,Tree).
|
||||||
|
|
||||||
|
%
|
||||||
|
% actual insertion, copied from insert2
|
||||||
|
%
|
||||||
|
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) :-
|
||||||
|
( K @< K0
|
||||||
|
-> NR = R,
|
||||||
|
NT = red(NL,K0,V0,R),
|
||||||
|
insert_new_2(L, K, V, Nil, NL, Flag)
|
||||||
|
; K == K0 ->
|
||||||
|
fail
|
||||||
|
;
|
||||||
|
NT = red(L,K0,V0,NR),
|
||||||
|
insert2(R, K, V, Nil, NR, Flag)
|
||||||
|
).
|
||||||
|
insert_new_2(black(L,K0,V0,R), K, V, Nil, NT, Flag) :-
|
||||||
|
( K @< K0
|
||||||
|
-> insert_new_2(L, K, V, Nil, IL, Flag0),
|
||||||
|
fix_left(Flag0, black(IL,K0,V0,R), NT, Flag)
|
||||||
|
; K == K0 ->
|
||||||
|
fail
|
||||||
|
;
|
||||||
|
insert_new_2(R, K, V, Nil, IR, Flag0),
|
||||||
|
fix_right(Flag0, black(L,K0,V0,IR), NT, Flag)
|
||||||
|
).
|
||||||
|
|
||||||
|
%
|
||||||
|
% make sure the root is always black.
|
||||||
|
%
|
||||||
|
fix_root(black(L,K,V,R),black(L,K,V,R)).
|
||||||
|
fix_root(red(L,K,V,R),black(L,K,V,R)).
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
%
|
%
|
||||||
% How to fix if we have inserted on the left
|
% How to fix if we have inserted on the left
|
||||||
%
|
%
|
||||||
|
Reference in New Issue
Block a user