This commit is contained in:
Vitor Santos Costa 2019-02-08 09:33:07 +00:00
parent 933db5bc7e
commit 4678b2baee
5 changed files with 194 additions and 288 deletions

267
C/terms.c
View File

@ -105,7 +105,7 @@ typedef struct non_single_struct_t {
*to_visit0 = to_visit, \
*to_visit_max = to_visit + 1024; \
\
do{ \
while (to_visit >= to_visit0) { \
CELL d0; \
CELL *ptd0; \
restart:\
@ -114,7 +114,7 @@ while (pt0 < pt0_end) { \
ptd0 = pt0; \
d0 = *ptd0; \
list_loop: \
fprintf(stderr, "%ld at %s\n", to_visit - to_visit0, __FUNCTION__); \
/*fprintf(stderr, "%ld at %s\n", to_visit - to_visit0, __FUNCTION__);*/ \
deref_head(d0, var_in_term_unk); \
var_in_term_nvar : { \
if (IsPairTerm(d0)) { \
@ -172,14 +172,13 @@ while (pt0 < pt0_end) { \
}\
}\
/* Do we still have compound terms to visit */ \
if (to_visit > to_visit0) {\
to_visit--;\
\
pt0 = to_visit->pt0;\
to_visit--; \
if (to_visit >= to_visit0) {\
pt0 = to_visit->pt0; \
pt0_end = to_visit->pt0_end;\
*to_visit->ptd0 = to_visit->d0;\
} \
} while (to_visit>to_visit0); \
*to_visit->ptd0 = to_visit->d0; \
}\
}\
pop_text_stack(lvl);
#define def_aux_overflow() \
@ -221,13 +220,13 @@ while (pt0 < pt0_end) { \
#define CYC_LIST \
if (d0 == TermFreeTerm) { \
fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);\
/*fprintf(stderr,"+%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \
while (to_visit > to_visit0) { \
to_visit--; \
to_visit->ptd0[0] = \
to_visit->d0; \
} \
pop_text_stack(lvl); fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__);\
pop_text_stack(lvl); /*fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \
return true; \
}
@ -238,7 +237,7 @@ while (to_visit > to_visit0) { \
to_visit->ptd0[0] = \
to_visit->d0; \
} \
fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__);\
/*fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__);*/ \
return true; \
}
@ -645,7 +644,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
}
}
fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__);
/*fprintf(stderr,"<%ld at %s\n", to_visit-to_visit0, __FUNCTION__)*/;
return (output);
def_aux_overflow();
@ -1189,8 +1188,9 @@ static Int largest_numbervar(USES_REGS1) {
}
static Term BREAK_LOOP(Int ddep) {
Term t0 = MkIntegerTerm(ddep);
return Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("@^"), 1), 1, &t0);
char buf[64];
snprintf(buf, 63, "@^[" Int_FORMAT "]", ddep);
return MkAtomTerm(Yap_LookupAtom(buf));
}
static Term UNFOLD_LOOP(Term t, Term *b) {
@ -1203,161 +1203,106 @@ static Term UNFOLD_LOOP(Term t, Term *b) {
return o;
}
static Term *loops_in_complex_term(CELL *pt0, CELL *pt0_end,
Term *listp USES_REGS) {
int lvl = push_text_stack();
CELL *ptf0 = HR;
tr_fr_ptr TR0 = TR;
struct non_single_struct_t *to_visit = Malloc(
1024 * sizeof(struct non_single_struct_t)),
*to_visit0 = to_visit,
*to_visit_max = to_visit + 1024;
do{
CELL *ptd0,
*ptf = HR;
CELL d0;
restart:
while (pt0 < pt0_end) {
++pt0;
ptd0 = pt0;
d0 = *ptd0;
list_loop:
{
fprintf(stderr,"%ld at %s\n", to_visit-to_visit0, __FUNCTION__);
deref_head(d0, vars_in_term_unk);
vars_in_term_nvar:
if (IsPairTerm(d0)) {
if (to_visit + 32 >= to_visit_max) {
goto aux_overflow;
}
ptd0 = RepPair(d0);
d0 = ptd0[0];
if (listp) {
CELL *pt = VarOfTerm(d0);
if (pt &&pt >= ptf &&
pt < HR) {
// LIST0;
*ptf++ = UNFOLD_LOOP(AbsPair(pt), listp);
continue;
} else {
*ptf++ = AbsPair(HR);
MaBind( ptd0, AbsPair(ptf - 1));
}
} else {
struct non_single_struct_t *v0 =
(struct non_single_struct_t *)AtomOfTerm(d0);
if (IsAtomTerm(d0) && v0 >= to_visit0 &&
(CELL *)AtomOfTerm(d0) < (CELL *)to_visit) {
// LIST0;
*ptf++ = BREAK_LOOP(to_visit - v0);
continue;
} else {
*ptf++ = AbsPair(HR);
to_visit->ptd0 = ptd0;
to_visit->d0 = d0 = *ptd0;
*ptd0 = MkAtomTerm((AtomEntry *)to_visit);
}
}
to_visit->pt0 = pt0;
to_visit->pt0_end = pt0_end;
to_visit->ptf = ptf;
to_visit++;
pt0 = ptd0;
pt0_end = pt0 + 1;
ptd0 = pt0;
ptf = HR;
HR+=2;
goto list_loop;
} else if (IsApplTerm(d0)) {
register Functor f;
typedef struct block_connector {
Int id; //> index in the array;
Term source; //> source;
CELL *copy; //> copy;
CELL header; //> backup of first word of the source data;
CELL reference; //> term used to refer the copy.
} cl_connector;
/* store the terms to visit */
ptd0 = RepAppl(d0);
f = (Functor)(*ptd0);
if (IsExtensionFunctor(f) || f == FunctorDollarVar) {
*ptf++ = d0;
continue;
}
if (listp) {
CELL *pt = (CELL *)f;
if (IsVarTerm(d0) && pt >= ptf0 &&
pt < HR) {
// LIST0;
*ptf++ = UNFOLD_LOOP(AbsAppl(pt), listp);
continue;
} else {
*ptf++ = AbsAppl(HR);
MaBind( pt, AbsAppl(ptf - 1));
}
} else {
struct non_single_struct_t *v0 =
(struct non_single_struct_t *)AtomOfTerm(d0);
if (IsAtomTerm(d0) && v0 >= to_visit0 &&
v0 < to_visit) {
// LIST0;
*ptf++ = BREAK_LOOP(to_visit - v0);
continue;
} else {
*ptf++ = AbsAppl(HR);
to_visit->ptd0 = ptd0;
to_visit->d0 = d0;
*ptd0 = MkAtomTerm((AtomEntry *)to_visit);
}
}
// STRUCT0;
if (to_visit + 32 >= to_visit_max) {
goto aux_overflow;
}
to_visit->pt0 = pt0;
to_visit->pt0_end = pt0_end;
to_visit->ptf = ptf;
to_visit++;
pt0 = ptd0;
pt0_end = ptd0 + (ArityOfFunctor(f));
HR[0] = (CELL)f;
ptf = HR+1;
HR = ptf +ArityOfFunctor(f);
} else {
*ptf++ = d0;
}
continue;
}
derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
*ptf++ = *ptd0;
continue;
}
/* Do we still have compound terms to visit */
while (to_visit > to_visit0) {
to_visit--;
pt0 = to_visit->pt0;
ptf = to_visit->ptf;
pt0_end = to_visit->pt0_end;
to_visit->ptd0[0] = to_visit->d0;
}
} while (to_visit > to_visit0) ;
fprintf(stderr,"exit %ld at %s\n", to_visit-to_visit0, __FUNCTION__);
if (listp) {
clean_tr(TR0);
}
pop_text_stack(lvl);
return ptf0;
Int cp_link(Term t,Int i, Int j, cl_connector *q, Int max, CELL *tailp)
{
Term ref, h, *s, *ostart;
bool pair = false;
ssize_t n;
def_aux_overflow();
if (IsVarTerm(t) || IsPrimitiveTerm(t)) {
q[i].copy[j] = t;
return max;
}
ostart = HR;
if (IsPairTerm(t)) {
h = HeadOfTerm(t);
s = RepPair(t);
n = 2;
pair = true;
ref = AbsPair(ostart);
} else {
h = (CELL)FunctorOfTerm(t);
s = RepAppl(t);
n = ArityOfFunctor(FunctorOfTerm(t));
ref = AbsAppl(ostart);
*ostart++ = s[0];
}
if (HR > s && H0 < s) {
// first time, create a new term
q[max].id = max;
q[max].source = t;
q[max].copy = ostart;
q[max].header = s[0];
q[max].reference = ref;
s[0] = max*sizeof(CELL);
HR += n;
max++;
} else {
Int id = h/sizeof(CELL);
if (q[id].reference == ref) {
q[id].reference = UNFOLD_LOOP(t, tailp);
}
q[i].copy[j] = q[id].reference;
}
return max;
}
Term Yap_BreakCycles(Term inp, UInt arity, Term *listp USES_REGS) {
Term t = Deref(inp);
Term Yap_BreakCycles(Term inp, UInt arity, Term *listp USES_REGS) {
int lvl = push_text_stack();
Term t = Deref(inp);
ssize_t qsize = 2048, qlen=0;
cl_connector *q = Malloc(qsize * sizeof(cl_connector)), *q0 = q;
Term *s;
if (IsVarTerm(t) || IsPrimitiveTerm(t)) {
return t;
} else if (IsPairTerm(t)) {
return AbsPair(loops_in_complex_term((&t) - 1, &t, listp PASS_REGS));
} else {
Int i=0;
qlen = cp_link(t, 0, 0, q, qlen, listp);
while (i < qlen) {
arity_t n, j;
if (IsPairTerm( q[i].source )) {
s = RepPair( q[i].source );
n = 2;
qlen = cp_link(q[i].header, i, 0, q, qlen, listp);
qlen = cp_link(s[1], i, 1, q, qlen, listp);
} else {
s = RepAppl( q[i].source )+1;
n = ArityOfFunctor((Functor)q[i].header);
for (j = 0; j<n; j++) {
qlen = cp_link(s[j], i, j, q, qlen, listp);
}
}
i++;
}
}
return AbsAppl(loops_in_complex_term((&t) - 1, &t, listp PASS_REGS));
Int i;
for (i =0; i < qlen; i++) {
if (IsPairTerm(t)) {
RepPair(q[i].source)[0] = q[i].header;
} else {
RepAppl(q[i].source)[0] = q[i].header;
}
}
pop_text_stack(lvl);
return q[0].reference;
}
/** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms)
@ -1372,7 +1317,7 @@ Term Yap_BreakCycles(Term inp, UInt arity, Term *listp USES_REGS) {
*/
static Int p_break_rational(USES_REGS1) {
Term t = (ARG1);
Term t = Deref(ARG1);
Term l = Deref(ARG4);
if (IsVarTerm(l))
Yap_unify(l, MkVarTerm());

View File

@ -1098,8 +1098,8 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
wglb.Write_strings = false;
wglb.Quote_illegal = false;
wglb.Ignore_ops = false;
wglb.MaxDepth = false;
wglb.MaxArgs = false;
wglb.MaxDepth = 0;
wglb.MaxArgs = 0;
wglb.lw = separator;
if ((flags & Handle_cyclics_f) && Yap_IsCyclicTerm(t) ){

View File

@ -559,7 +559,7 @@ static Int doformat(volatile Term otail, volatile Term oargs,
goto do_type_atom_error;
yhandle_t sl = Yap_StartSlots();
// stream is already locked.
Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f,
Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f | Handle_cyclics_f,
GLOBAL_MaxPriority);
Yap_CloseSlots(sl);
break;
@ -809,7 +809,7 @@ static Int doformat(volatile Term otail, volatile Term oargs,
t = targs[targ++];
yhandle_t sl = Yap_StartSlots();
Yap_plwrite(t, GLOBAL_Stream + sno, 0,
Quote_illegal_f | Ignore_ops_f | To_heap_f,
Quote_illegal_f | Ignore_ops_f | To_heap_f | Handle_cyclics_f,
GLOBAL_MaxPriority);
Yap_CloseSlots(sl);
break;
@ -845,7 +845,7 @@ static Int doformat(volatile Term otail, volatile Term oargs,
{
Int sl = Yap_InitSlot(args);
Yap_plwrite(t, GLOBAL_Stream + sno, 0,
Handle_vars_f | Use_portray_f | To_heap_f,
Handle_vars_f | Use_portray_f | To_heap_f | Handle_cyclics_f,
GLOBAL_MaxPriority);
args = Yap_GetFromSlot(sl);
Yap_CloseSlots(sl);
@ -879,7 +879,7 @@ static Int doformat(volatile Term otail, volatile Term oargs,
{
yhandle_t sl0 = Yap_StartSlots();
Yap_plwrite(t, GLOBAL_Stream + sno, 0,
Handle_vars_f | Quote_illegal_f | To_heap_f,
Handle_vars_f | Quote_illegal_f | To_heap_f | Handle_cyclics_f,
GLOBAL_MaxPriority);
Yap_CloseSlots(sl0);
}
@ -890,7 +890,7 @@ static Int doformat(volatile Term otail, volatile Term oargs,
t = targs[targ++];
{
yhandle_t slf = Yap_StartSlots();
Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f,
Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f | Handle_cyclics_f,
GLOBAL_MaxPriority);
Yap_CloseSlots(slf);
}

View File

@ -102,9 +102,9 @@ undefined_query(G0, M0, Cut) :-
true
;
'$undef_error'(Current, M0:G0, MGI, MG)
,
),
'$undef_cleanup'(Action,Debug,Current)
).
.
'$undef_error'(_, M0:G0, _, MG) :-
'$pred_exists'(unknown_predicate_handler(_,_,_,_), user),

View File

@ -1,125 +1,86 @@
%, copy_term(X,Y), writeln('....'), writeln(X), writeln(Y).
:- linitialization(main).
:- use_module(library(terms)).
:- initialization(main).
:- op(700, xfx, :=: ).
main :-
main( cyclic_term(X), X).
main :-
writeln('--- cyclic_term/1 --------------------'),
fail.
main :-
main( ground(X), X).
main :-
writeln('--- ground/1 ------------------'),
fail.
main :-
main2( (terms:variables_in_term(X, O), writeln(X=O) ), X, L, O).
main :-
writeln('--------variables_in_term/2, writeln/1 ---------------'),
fail.
main :-
main2( (terms:new_variables_in_term(L,X, O), writeln(X+L=O) ), X, L, O).
main :-
writeln('-----------------------'),
fail.
main :-
main2( (terms:variables_within_term(L,X, O), writeln(X+L=O) ), X, L, O).
main :-
writeln('-----------------------'),
fail.
main :-
main( writeln(X), X).
main :-
writeln('------rational_term_to_tree(X,A,B,[]),\
writeln((A->B) -----------------'),
fail.
main :-
main((rational_term_to_tree(X,A,B,[]),
writeln((A->B))), X).
main :-
writeln('------ numbervars(A+B,1,_),\
writeln((A->B) -----------------'),
fail.
main :-
main(( numbervars(A+B,1,_),
writeln((A->B))), X).
main :-
writeln('------rational_term_to_tree(X,A,B,[]), numbervars(A+B,1,_),\
writeln((A->B) -----------------'),
fail.
main :-
main((rational_term_to_tree(X,A,B,[]), numbervars(A+B,1,_),
writeln((A->B))), X).
main.
main(G, X) :-
d(X),
m(G).
main2(G, X, L, O) :-
e(X,L),
m(G).
m( G ) :-
G,
!,
writeln(yes),
end.
m( G ) :-
writeln(no),
end.
d(X) :- X :=: [_A].
d(X) :- X :=: [a,_A].
d(X) :- X :=: [X].
d(X) :- X :=: [_|X].
d(X) :- X :=: [_,X].
d(X) :- X :=: [_,x].
d(X) :- X :=: [_,x(X)].
d(X) :- X:=: f(X).
d(X) :- X:=: f(X,X).
d(X) :- X:=: f(_,X).
d(X) :- X:=: f(A,A,X).
d(X) :- X:=: f(A,A,g(A)).
d(X) :- X:=: f(A,g(X,[A|A]),X).
d(X) :- X:=: f(X,[X,X]).
d(X) :- X:=: f(X,[X,g(X)]).
d(X) :- X:=: f(_,X/[X]).
d(X) :- X:=: f(_,A/[A]), A:=: f(X,[X,g(X)]).
d(X) :- X:=: f(_,A/[A]), A:=: f(X,[A,g(X)]).
d(X) :- X:=: f(_,A/[A]), A:=: f(B,[X,g(A)]), B:=:[C|B], C:=:[X].
end :- writeln('....'), fail.
e(X,Y) :- X :=: t(_A,B,_C,D), Y :=: [B,E].
e(X,Y) :- X :=: t(_A,_B,_C,_D), Y :=: [_,_E].
e(X,Y) :- X :=: t(A,_B,C,_D), Y :=: [ A,C].
e(X,Y) :- X :=: t(A,[X,_D]), Y :=: [A,_C,_E].
e(X,Y) :- X :=: t(A,[X,C]), Y :=: [A,C,_E].
e(X,Y) :- X :=: t(A,X,_B,[X,C,_D]), Y :=: [A,C,_E].
a(no, no).
a(no, no).
a(yes, yes).
a(yes, no).
a(yes, no).
a( no, no).
a(yes, no).
a(yes, yes).
a(yes, yes).
a(yes, no).
a(yes, no).
a( no, no).
a(yes, no).
a(yes, yes).
a(yes, yes).
a(yes, no).
a(yes, no).
X :-: Y :- writeln(X), fail.
X :=: X.
main :-
exec.
test( cyclic_term(X), [X]).
test( ground(X), [X]).
test( (variables_in_term(X, O), writeln(X=O) ), [X, [], O]).
test( (new_variables_in_term(L,X, O), writeln(X+L=O) ), [X, L, O]).
test( (variables_within_term(L,X, O), writeln(X+L=O) ), [X, L, O]).
test( writeln(X), [X]).
test((rational_term_to_tree(X,A,B,[]),
writeln((A->B))), [X, A, B]).
test(( numbervars(A+B,1,_)), [A, B]).
test((rational_term_to_tree(X,A,B,[]), numbervars(A+B,1,_),
writeln((A->B))), [X,A,B]).
:- dynamic i/1.
i(0).
id(I) :-
retract(i(I)),
I1 is I+1,
assert(i(I1)).
exec :-
test( G, [X|Ps] ),
functors(G, Fs),
format('**** ~w:~n',[Fs]),
d(X, GX),
id(I),
m(I, GX, G, [X|Ps]),
fail.
exec.
functors((X,Y),(GX -> GY)) :-
!,
functors(X, GX),
functors(Y, GY).
functors(X, GX) :-
functor(X, GX, _).
m( I, GX, G, Ps ) :-
%trace,
GX,
G,
!,
format( '~d. ~w: ~a.~n', [I, G,yes]).
m( I, GX, G, _Ps ) :-
GX,
format( '~d. ~w: ~a.~n',[I,G,no]).
d(X, X = [_A] ).
d(X, ( X = [a,_A]) ).
d(X, ( X = [X]) ).
d(X, ( X = [_|X]) ).
d(X, ( X = [_,X]) ).
d(X, ( X = [_,x]) ).
d(X, ( X = [_,x(X)]) ).
d(X, ( X= f(X)) ).
d(X, ( X= f(X,X)) ).
d(X, ( X= f(_,X)) ).
d(X, ( X= f(A,A,X)) ).
d(X, ( X= f(A,A,g(A))) ).
d(X, ( X= f(A,g(X,[A|A]),X)) ).
d(X, ( X= f(X,[X,X])) ).
d(X, ( X= f(X,[X,g(X)])) ).
d(X, ( X= f(_,X/[X])) ).
d(X, ( X= f(_,A/[A]), A= f(X,[X,g(X)])) ).
d(X, ( X= f(_,A/[A]), A= f(X,[A,g(X)])) ).
d(X, ( X= f(_,A/[A]), A= f(B,[X,g(A)]), B=[C|B], C=[X]) ).
e(X,Y, ( X = t(_A,B,_C,D), Y = [B,E]) ).
e(X,Y, ( X = t(_A,_B,_C,_D), Y = [_,_E]) ).
e(X,Y, ( X = t(A,_B,C,_D), Y = [ A,C]) ).
e(X,Y, ( X = t(A,[X,_D]), Y = [A,_C,_E]) ).
e(X,Y, ( X = t(A,[X,C]), Y = [A,C,_E]) ).
e(X,Y, ( X = t(A,X,_B,[X,C,_D]), Y = [A,C,_E]) ).