more robust support for attributed vars: all_attvars and stack

expansion.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1366 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-08-17 20:13:50 +00:00
parent 101abc67d0
commit b18224a460
4 changed files with 37 additions and 25 deletions

View File

@ -437,20 +437,31 @@ GetAllAtts(attvar_record *attv) {
static Term static Term
AllAttVars(Term t) { AllAttVars(Term t) {
if (t == TermNil) { CELL *h0 = H;
return t;
} else { while (t != TermNil) {
attvar_record *attv = (attvar_record *)VarOfTerm(t); attvar_record *attv;
if (!IsVarTerm(attv->Done) || !IsUnboundVar(&attv->Done))
return AllAttVars(attv->NS); if (ASP - H < 1024) {
else return MkPairTerm(t,AllAttVars(attv->NS)); H = h0;
return 0L;
}
attv = (attvar_record *)VarOfTerm(t);
if (IsVarTerm(attv->Done) && IsUnboundVar(&attv->Done)) {
if (H != h0) {
H[-1] = AbsPair(H);
}
H[0] = t;
H += 2;
}
t = attv->NS;
}
if (H != h0) {
H[-1] = TermNil;
return AbsPair(h0);
} else {
return TermNil;
} }
}
Term
Yap_CurrentAttVars(void) {
return(AllAttVars(Yap_ReadTimedVar(AttsMutableList)));
} }
static Int static Int
@ -650,8 +661,14 @@ p_n_atts(void)
static Int static Int
p_all_attvars(void) p_all_attvars(void)
{ {
Term t = Yap_ReadTimedVar(AttsMutableList); Term t = Yap_ReadTimedVar(AttsMutableList), out;
return Yap_unify(ARG1,AllAttVars(t)); while ((out = AllAttVars(t)) == 0L) {
if (!Yap_gc(1, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
}
return Yap_unify(ARG1,out);
} }
static Int static Int

View File

@ -22,6 +22,7 @@
#include "alloc.h" #include "alloc.h"
#include "sshift.h" #include "sshift.h"
#include "compile.h" #include "compile.h"
#include "attvar.h"
#if HAVE_STRING_H #if HAVE_STRING_H
#include <string.h> #include <string.h>
#endif #endif
@ -590,8 +591,11 @@ static_growglobal(long size, CELL **ptr)
{ {
UInt start_growth_time, growth_time; UInt start_growth_time, growth_time;
int gc_verbose; int gc_verbose;
char *omax = (ADDR)DelayTop();
/* adjust to a multiple of 256) */ /* adjust to a multiple of 256) */
if (size < (omax-Yap_GlobalBase)/8)
size = (omax-Yap_GlobalBase)/8;
size = AdjustPageSize(size); size = AdjustPageSize(size);
Yap_ErrorMessage = NULL; Yap_ErrorMessage = NULL;
if (!Yap_ExtendWorkSpace(size)) { if (!Yap_ExtendWorkSpace(size)) {

View File

@ -10,7 +10,7 @@
* File: Yap.proto * * File: Yap.proto *
* mods: * * mods: *
* comments: Function declarations for YAP * * comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.59 2005-08-04 15:45:53 ricroc Exp $ * * version: $Id: Yapproto.h,v 1.60 2005-08-17 20:13:49 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* prototype file for Yap */ /* prototype file for Yap */
@ -91,7 +91,6 @@ void STD_PROTO(Yap_InitAnalystPreds,(void));
void STD_PROTO(Yap_InitArrayPreds,(void)); void STD_PROTO(Yap_InitArrayPreds,(void));
/* attvar.c */ /* attvar.c */
Term STD_PROTO(Yap_CurrentAttVars,(void));
void STD_PROTO(Yap_InitAttVarPreds,(void)); void STD_PROTO(Yap_InitAttVarPreds,(void));
/* bb.c */ /* bb.c */

View File

@ -14,14 +14,6 @@
* comments: boot file for Prolog * * comments: boot file for Prolog *
* * * *
*************************************************************************/ *************************************************************************/
% process an input clause
'$test'(I,D,H,[Y|L]) :-
arg(I,D,X), ( X=':' ; integer(X)),
arg(I,H,Y), var(Y), !,
I1 is I-1,
'$module_u_vars'(I1,D,H,L).
% This one should come first so that disjunctions and long distance % This one should come first so that disjunctions and long distance
% cuts are compiled right with co-routining. % cuts are compiled right with co-routining.