This commit is contained in:
Vitor Santos Costa 2019-01-22 01:47:07 +00:00
parent 86decdddde
commit 17a75d79ff
7 changed files with 408 additions and 433 deletions

View File

@ -1,19 +1,19 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: non backtrackable term support *
* Last rev: 2/8/06 *
* mods: *
* comments: non-backtrackable term support *
* *
*************************************************************************/
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: non backtrackable term support *
* Last rev: 2/8/06 *
* mods: *
* comments: non-backtrackable term support *
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
@ -31,81 +31,81 @@ static char SccsId[] = "%W% %G%";
/**
@defgroup Global_Variables Global Variables
@ingroup builtins
@{
@ingroup builtins
@{
Global variables are associations between names (atoms) and
terms. They differ in various ways from storing information using
assert/1 or recorda/3.
Global variables are associations between names (atoms) and
terms. They differ in various ways from storing information using
assert/1 or recorda/3.
+ The value lives on the Prolog (global) stack. This implies that
lookup time is independent from the size of the term. This is
particularly interesting for large data structures such as parsed XML
documents or the CHR global constraint store.
+ The value lives on the Prolog (global) stack. This implies that
lookup time is independent from the size of the term. This is
particularly interesting for large data structures such as parsed XML
documents or the CHR global constraint store.
+ They support both global assignment using nb_setval/2 and
backtrackable assignment using b_setval/2.
+ They support both global assignment using nb_setval/2 and
backtrackable assignment using b_setval/2.
+ Only one value (which can be an arbitrary complex Prolog term)
can be associated to a variable at a time.
+ Only one value (which can be an arbitrary complex Prolog term)
can be associated to a variable at a time.
+ Their value cannot be shared among threads. Each thread has its own
namespace and values for global variables.
+ Their value cannot be shared among threads. Each thread has its own
namespace and values for global variables.
Currently global variables are scoped globally. We may consider module
scoping in future versions. Both b_setval/2 and
nb_setval/2 implicitly create a variable if the referenced name
does not already refer to a variable.
Currently global variables are scoped globally. We may consider module
scoping in future versions. Both b_setval/2 and
nb_setval/2 implicitly create a variable if the referenced name
does not already refer to a variable.
Global variables may be initialized from directives to make them
available during the program lifetime, but some considerations are
necessary for saved-states and threads. Saved-states to not store
global variables, which implies they have to be declared with
initialization/1 to recreate them after loading the saved
state. Each thread has its own set of global variables, starting with
an empty set. Using `thread_initialization/1` to define a global
variable it will be defined, restored after reloading a saved state
and created in all threads that are created after the
registration. Finally, global variables can be initialized using the
exception hook called exception/3. The latter technique is used
by CHR.
Global variables may be initialized from directives to make them
available during the program lifetime, but some considerations are
necessary for saved-states and threads. Saved-states to not store
global variables, which implies they have to be declared with
initialization/1 to recreate them after loading the saved
state. Each thread has its own set of global variables, starting with
an empty set. Using `thread_initialization/1` to define a global
variable it will be defined, restored after reloading a saved state
and created in all threads that are created after the
registration. Finally, global variables can be initialized using the
exception hook called exception/3. The latter technique is used
by CHR.
SWI-Prolog global variables are associations between names (atoms) and
terms. They differ in various ways from storing information using
assert/1 or recorda/3.
SWI-Prolog global variables are associations between names (atoms) and
terms. They differ in various ways from storing information using
assert/1 or recorda/3.
+ The value lives on the Prolog (global) stack. This implies
that lookup time is independent from the size of the term.
This is particulary interesting for large data structures
such as parsed XML documents or the CHR global constraint
store.
+ The value lives on the Prolog (global) stack. This implies
that lookup time is independent from the size of the term.
This is particulary interesting for large data structures
such as parsed XML documents or the CHR global constraint
store.
They support both global assignment using nb_setval/2 and
backtrackable assignment using b_setval/2.
They support both global assignment using nb_setval/2 and
backtrackable assignment using b_setval/2.
+ Only one value (which can be an arbitrary complex Prolog
term) can be associated to a variable at a time.
+ Only one value (which can be an arbitrary complex Prolog
term) can be associated to a variable at a time.
+ Their value cannot be shared among threads. Each thread
has its own namespace and values for global variables.
+ Their value cannot be shared among threads. Each thread
has its own namespace and values for global variables.
+ Currently global variables are scoped globally. We may
consider module scoping in future versions.
+ Currently global variables are scoped globally. We may
consider module scoping in future versions.
Both b_setval/2 and nb_setval/2 implicitly create a variable if the
referenced name does not already refer to a variable.
Both b_setval/2 and nb_setval/2 implicitly create a variable if the
referenced name does not already refer to a variable.
Global variables may be initialized from directives to make them
available during the program lifetime, but some considerations are
necessary for saved-states and threads. Saved-states to not store global
variables, which implies they have to be declared with initialization/1
to recreate them after loading the saved state. Each thread has
its own set of global variables, starting with an empty set. Using
`thread_inititialization/1` to define a global variable it will be
defined, restored after reloading a saved state and created in all
threads that are created <em>after</em> the registration.
Global variables may be initialized from directives to make them
available during the program lifetime, but some considerations are
necessary for saved-states and threads. Saved-states to not store global
variables, which implies they have to be declared with initialization/1
to recreate them after loading the saved state. Each thread has
its own set of global variables, starting with an empty set. Using
`thread_inititialization/1` to define a global variable it will be
defined, restored after reloading a saved state and created in all
threads that are created <em>after</em> the registration.
*/
@ -123,7 +123,7 @@ threads that are created <em>after</em> the registration.
special term on the heap. Arenas automatically contract as we add terms to
the front.
*/
*/
#define QUEUE_FUNCTOR_ARITY 4
@ -292,7 +292,7 @@ static int GrowArena(Term arena, CELL *pt, size_t old_size, size_t size,
CELL *Yap_GetFromArena(Term *arenap, size_t cells, UInt arity) {
CACHE_REGS
restart : {
restart : {
Term arena = *arenap;
CELL *max = ArenaLimit(arena);
CELL *base = ArenaPt(arena);
@ -315,7 +315,7 @@ restart : {
new_size = old_sz - cells;
*arenap = CreateNewArena(newH, new_size);
return base;
}
}
}
static void CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP,
@ -340,6 +340,7 @@ static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
if (IsVarTerm(p)) {
RESET_VARIABLE(p);
} else {
/* copy downwards */
TrailTerm(TR0 + 1) = TrailTerm(pt);
TrailTerm(TR0) = TrailTerm(TR0 + 2) = p;
@ -361,7 +362,8 @@ static int copy_complex_term(register CELL *pt0, register CELL *pt0_end,
CELL *HLow USES_REGS) {
int lvl = push_text_stack();
struct cp_frame *to_visit0, *to_visit = Malloc(1024*sizeof(struct cp_frame));
struct cp_frame *to_visit0,
*to_visit = Malloc(1024*sizeof(struct cp_frame));
struct cp_frame *to_visit_max;
CELL *HB0 = HB;
@ -371,63 +373,52 @@ static int copy_complex_term(register CELL *pt0, register CELL *pt0_end,
HB = HLow;
to_visit0 = to_visit;
to_visit_max = to_visit+1024;
loop:
loop:
while (pt0 < pt0_end) {
register CELL d0;
register CELL *ptd0;
++pt0;
ptd0 = pt0;
d0 = *ptd0;
ptd0 = ++pt0;
d0 = *pt0;
if (d0 != TermNil)
Yap_DebugPlWriteln(d0);
deref:
deref_head(d0, copy_term_unk);
copy_term_nvar : {
if (IsPairTerm(d0)) {
CELL *ap2 = RepPair(d0);
if ((share && ap2 < HB) || (ap2 >= HB && ap2 < HR)) {
if (//(share && ap2 < HB) ||
(ap2 >= HB && ap2 < HR)) {
/* If this is newer than the current term, just reuse */
*ptf++ = d0;
continue;
}
*ptf = AbsPair(HR);
ptf++;
#ifdef RATIONAL_TREES
if (to_visit >= to_visit_max-32) {
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
}
pt0 = ap2;
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
to_visit->end_cp = pt0_end = pt0+2;
to_visit->to = ptf;
to_visit->oldv = *pt0;
d0 = *pt0;
to_visit->ground = ground;
/* fool the system into thinking we had a variable there */
*pt0 = AbsPair(HR);
MaBind(pt0,AbsPair(HR));
to_visit++;
#else
if (pt0 < pt0_end) {
if (to_visit + 32 >= to_visit_max - 32) {
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
}
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
to_visit->to = ptf;
to_visit->ground = ground;
to_visit++;
}
#endif
ground = TRUE;
pt0 = ap2 - 1;
pt0_end = ap2 + 1;
ptf = HR;
ground = true;
HR += 2;
if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow;
}
ptd0 = pt0;
goto deref;
} else if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2;
/* store the terms to visit */
ap2 = RepAppl(d0);
if ((share && ap2 < HB) || (ap2 >= HB && ap2 < HR)) {
if (//(share && ap2 < HB) ||
(ap2 >= HB && ap2 < HR)) {
/* If this is newer than the current term, just reuse */
*ptf++ = d0;
continue;
@ -498,44 +489,28 @@ loop:
}
continue;
}
*ptf = AbsAppl(HR);
ptf++;
/* store the terms to visit */
#ifdef RATIONAL_TREES
if (to_visit + 32 >= to_visit_max) {
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
}
/* store the terms to visit */
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
to_visit->to = ptf;
to_visit->oldv = *pt0;
to_visit->ground = ground;
if (++to_visit >= to_visit_max-32) {
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
}
/* fool the system into thinking we had a variable there */
*pt0 = AbsAppl(HR);
ptf = HR;
*ptf++ = d0 = *ap2;
MaBind(ap2++,AbsAppl(HR));
to_visit++;
#else
if (pt0 < pt0_end) {
if (to_visit++ >= (CELL **)AuxSp) {
expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
}
to_visit->start_cp = pt0;
to_visit->end_cp = pt0_end;
to_visit->to = ptf;
to_visit->ground = ground;
to_visit++;
}
#endif
ground = (f != FunctorMutable);
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
/* store the functor for the new term */
HR[0] = (CELL)f;
ptf = HR + 1;
HR += 1 + d0;
ground = true;
arity_t a = ArityOfFunctor((Functor)d0);
HR = ptf+a;
if (HR > ASP - MIN_ARENA_SIZE) {
goto overflow;
}
pt0 = ap2;
pt0_end = ap2+a;
ground = (f != FunctorMutable);
} else {
/* just copy atoms or integers */
*ptf++ = d0;
@ -544,13 +519,13 @@ loop:
}
derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar);
ground = FALSE;
ground = false;
/* don't need to copy variables if we want to share the global term */
if ((share && ptd0 < HB && ptd0 > H0) || (ptd0 >= HLow && ptd0 < HR)) {
if (//(share && ptd0 < HB && ptd0 > H0) ||
(ptd0 >= HLow && ptd0 < HR)) {
/* we have already found this cell */
*ptf++ = (CELL)ptd0;
} else {
#if COROUTINING
if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) {
/* if unbound, call the standard copy term routine */
struct cp_frame *bp;
@ -572,16 +547,13 @@ loop:
Bind_and_Trail(ptd0, new);
ptf++;
} else {
#endif
/* first time we met this term */
RESET_VARIABLE(ptf);
if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE)
goto trail_overflow;
Bind_and_Trail(ptd0, (CELL)ptf);
MaBind(ptd0, (CELL)ptf);
ptf++;
#ifdef COROUTINING
}
#endif
}
}
@ -591,9 +563,6 @@ loop:
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
ptf = to_visit->to;
#ifdef RATIONAL_TREES
*pt0 = to_visit->oldv;
#endif
ground = (ground && to_visit->ground);
goto loop;
}
@ -605,13 +574,12 @@ loop:
pop_text_stack(lvl);
return 0;
overflow:
overflow:
/* oops, we're in trouble */
HR = HLow;
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit--;
pt0 = to_visit->start_cp;
@ -619,18 +587,16 @@ overflow:
ptf = to_visit->to;
*pt0 = to_visit->oldv;
}
#endif
reset_trail(TR0);
pop_text_stack(lvl);
return -1;
trail_overflow:
trail_overflow:
/* oops, we're in trouble */
HR = HLow;
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit--;
pt0 = to_visit->start_cp;
@ -638,7 +604,6 @@ trail_overflow:
ptf = to_visit->to;
*pt0 = to_visit->oldv;
}
#endif
reset_trail(TR0);
pop_text_stack(lvl);
return -4;
@ -654,7 +619,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
int res = 0;
Term tn;
restart:
restart:
t = Deref(t);
if (IsVarTerm(t)) {
ASP = ArenaLimit(arena);
@ -787,7 +752,7 @@ restart:
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
return tf;
}
error_handler:
error_handler:
HR = HB;
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
XREGS[arity + 1] = t;
@ -835,7 +800,7 @@ static Term CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity,
Functor f = Yap_MkFunctor(Na, Nar);
UInt i;
restart:
restart:
HR = HB = ArenaPt(arena);
ASP = ArenaLimit(arena);
HB0 = HR;
@ -1959,7 +1924,7 @@ static Int p_nb_heap_add_to_heap(USES_REGS1) {
if (!qd)
return FALSE;
restart:
restart:
hsize = IntegerOfTerm(qd[HEAP_SIZE]);
hmsize = IntegerOfTerm(qd[HEAP_MAX]);
if (hsize == hmsize) {
@ -2497,7 +2462,7 @@ static Int p_nb_beam_keys(USES_REGS1) {
CELL *pt, *ho;
UInt i;
restart:
restart:
qd = GetHeap(ARG1, "beam_keys");
if (!qd)
return FALSE;
@ -2817,5 +2782,5 @@ void Yap_InitGlobals(void) {
}
/**
@}
@}
*/

View File

@ -24,7 +24,7 @@ static char SccsId[] = "%W% %G%";
#include "YapHeap.h"
#include "Yatom.h"
static Int currgent_module(USES_REGS1);
static Int current_module(USES_REGS1);
static Int current_module1(USES_REGS1);
static ModEntry *LookupModule(Term a);
static ModEntry *LookupSystemModule(Term a);

View File

@ -52,6 +52,7 @@ typedef struct non_single_struct_t {
}\
LIST0;\
ptd0 = RepPair(d0);\
if (*ptd0 == TermFreeTerm) continue;\
to_visit->pt0 = pt0;\
to_visit->pt0_end = pt0_end;\
to_visit->ptd0 = ptd0;\
@ -59,7 +60,7 @@ typedef struct non_single_struct_t {
to_visit ++;\
d0 = ptd0[0];\
pt0 = ptd0;\
*ptd0 = TermNil;\
*ptd0 = TermFreeTerm;\
pt0_end = pt0 + 1;\
goto list_loop;\
} else if (IsApplTerm(d0)) {\
@ -2269,9 +2270,8 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
*to_visit = Malloc(1024*sizeof( struct non_single_struct_t)),
*to_visit0 = to_visit,
*to_visit_max = to_visit+1024;
Term o = TermNil;
CELL *InitialH = HR;
*HR++ = MkAtomTerm(AtomDollar);
to_visit0 = to_visit;
restart:
while (pt0 < pt0_end) {
@ -2284,7 +2284,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
deref_head(d0, vars_within_term_unk);
vars_within_term_nvar:
{
WALK_COMPLEX_TERM()
WALK_COMPLEX_TERM();
continue;
}
@ -2293,10 +2293,13 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
*ptd0 = TermNil;
/* leave an empty slot to fill in later */
if (HR+1024 > ASP) {
o = TermNil;
goto global_overflow;
}
HR[0] = (CELL)ptd0;
HR ++;
HR[1] = o;
o = AbsPair(HR);
HR += 2;
/* next make sure noone will see this as a variable again */
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */
@ -2318,13 +2321,8 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end
}
clean_tr(TR0 PASS_REGS);
pop_text_stack(lvl);
if (HR > InitialH+1) {
InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (HR-InitialH)-1);
return AbsAppl(InitialH);
} else {
return MkAtomTerm(AtomDollar);
}
pop_text_stack(lvl);
return o;
def_trail_overflow();

View File

@ -62,7 +62,7 @@
[
class_drop/2
]).

do_checks(Y,Ty,St,Li,Or,Cl,No,Later) :-
numbers_only(Y),
verify_nonzero(No,Y),
@ -76,7 +76,7 @@ numbers_only(Y) :-
; throw(type_error(_X = Y,2,'a rational number',Y))
),
!.
ø
% verify_nonzero(Nonzero,Y)
%
% if Nonzero = nonzero, then verify that Y is not zero

View File

@ -43,6 +43,10 @@
project_nonlin/3,
collect_nonlin/3
]).
:- use_module(library(maplist),
[
maplist/2
]).
% l2conj(List,Conj)
%

View File

@ -47,6 +47,10 @@
dump_nonzero/3,
clp_type/2
]).
:- use_module(library(maplist),
[
maplist/2
]).
clp_type(Var,Type) :-

View File

@ -63,6 +63,10 @@
[
class_drop/2
]).
:- use_module(library(maplist),
[
maplist/2
]).
do_checks(Y,Ty,St,Li,Or,Cl,No,Later) :-
numbers_only(Y),