18static char SccsId[] =
"@(#)utilpreds.c 1.3";
45static CELL vars_in_complex_term(CELL *, CELL *, Term CACHE_TYPE);
46static Int p_non_singletons_in_term( USES_REGS1);
47static CELL non_singletons_in_complex_term(CELL *, CELL * CACHE_TYPE);
48static Int p_variables_in_term( USES_REGS1 );
49static Int p_ground( USES_REGS1 );
52static Int p_force_trail_expansion( USES_REGS1 );
56clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
61 Term p = TrailTerm(pt++);
70handle_cp_overflow(
int res, tr_fr_ptr TR0, UInt arity, Term t)
76 if (!Yap_dogc(PASS_REGS1)) {
77 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
80 return Deref(XREGS[arity+1]);
82 return Deref(XREGS[arity+1]);
85 UInt size = LOCAL_Error_Size;
86 LOCAL_Error_Size = 0L;
87 if (size > 4*1024*1024)
89 if (!Yap_ExpandPreAllocCodeSpace(size, NULL, TRUE)) {
90 Yap_ThrowError(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage);
94 return Deref(XREGS[arity+1]);
96 if (!Yap_growtrail((TR-TR0)*
sizeof(tr_fr_ptr *), FALSE)) {
97 Yap_ThrowError(RESOURCE_ERROR_TRAIL, TermNil, LOCAL_ErrorMessage);
100 return Deref(XREGS[arity+1]);
108copy_complex_term(CELL *pt0, CELL *pt0_end,
int share,
int newattvs, CELL *ptf, CELL *HLow USES_REGS)
111 struct cp_frame *tovisit0, *tovisit = (
struct cp_frame *)Yap_PreAllocCodeSpace();
119 while (pt0 < pt0_end) {
125 deref_head(d0, copy_term_unk);
128 if (IsPairTerm(d0)) {
129 CELL *ap2 = RepPair(d0);
130 if (ap2 >= HB && ap2 < HR) {
138 if (tovisit+1 >= (
struct cp_frame *)AuxSp) {
142 tovisit->pt0_end = pt0_end;
144 tovisit->oldv = *pt0;
145 tovisit->ground = ground;
151 if (tovisit+1 >= (
struct cp_frame *)AuxSp) {
155 tovisit->pt0_end = pt0_end;
157 tovisit->ground = ground;
166 if (HR > ASP - 2048) {
169 }
else if (IsApplTerm(d0)) {
174 if (ap2 >= HB && ap2 <= HR) {
181 if (IsExtensionFunctor(f)) {
183 if (f == FunctorDBRef) {
184 DBRef entryref = DBRefOfTerm(d0);
185 if (entryref->Flags & LogUpdMask) {
187 PELOCK(100,luclause->ClPred);
188 UNLOCK(luclause->ClPred->PELock);
190 LOCK(entryref->lock);
192 INC_DBREF_COUNT(entryref);
193 UNLOCK(entryref->lock);
201 *ptf++ = AbsAppl(HR);
203 if (f== FunctorDouble) {
204 sz =
sizeof(Float)/
sizeof(CELL)+2;
205 }
else if (f== FunctorLongInt) {
207 }
else if (f== FunctorString) {
211 sz = 2+
sizeof(
MP_INT)+(((
MP_INT *)(pt+1))->_mp_alloc*
sizeof(mp_limb_t));
213 if (HR+sz > ASP - 2048) {
216 memcpy((
void *)HR, (
void *)ap2, sz*
sizeof(CELL));
227 if (tovisit+1 >= (
struct cp_frame *)AuxSp) {
231 tovisit->pt0_end = pt0_end;
233 tovisit->oldv = *pt0;
234 tovisit->ground = ground;
240 if (tovisit+1 >= (
struct cp_frame *)AuxSp) {
244 tovisit->pt0_end = pt0_end;
246 tovisit->ground = ground;
250 ground = (f != FunctorMutable);
251 d0 = ArityOfFunctor(f);
258 if (HR > ASP - 2048) {
268 derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar);
270 if (ptd0 >= HLow && ptd0 < HR) {
272 *ptf++ = (CELL) ptd0;
275 if (newattvs && IsAttachedTerm((CELL)ptd0)) {
282 if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) {
287 Bind_NonAtt(ptd0,
new);
293 if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
295 if (!Yap_growtrail((TR-TR0)*
sizeof(tr_fr_ptr *), TRUE)) {
299 Bind_NonAtt(ptd0, (CELL)ptf);
306 if (tovisit > tovisit0) {
308 if (ground && share) {
309 CELL old = tovisit->oldv;
310 CELL *newp = tovisit->ptf-1;
320 pt0_end = tovisit->pt0_end;
323 *pt0 = tovisit->oldv;
325 ground = (ground && tovisit->ground);
330 clean_dirty_tr(TR0 PASS_REGS);
341 while (tovisit > tovisit0) {
344 pt0_end = tovisit->pt0_end;
346 *pt0 = tovisit->oldv;
360 while (tovisit > tovisit0) {
363 pt0_end = tovisit->pt0_end;
365 *pt0 = tovisit->oldv;
371 if (!Yap_growtrail((oTR-TR0)*
sizeof(tr_fr_ptr *), TRUE)) {
384 while (tovisit > tovisit0) {
387 pt0_end = tovisit->pt0_end;
389 *pt0 = tovisit->oldv;
393 LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)tovisit0;
399CopyTerm(Term inp, UInt arity,
int share,
int newattvs USES_REGS) {
405 if (newattvs && IsAttachedTerm(t)) {
413 if ((res = copy_complex_term(Hi-2, Hi-1, share, newattvs, Hi, Hi PASS_REGS)) < 0) {
415 if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
417 goto restart_attached;
423 }
else if (IsPrimitiveTerm(t)) {
425 }
else if (IsPairTerm(t)) {
437 if ((res = copy_complex_term(ap-1, ap+1, share, newattvs, Hi, Hi PASS_REGS)) < 0) {
439 if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
442 }
else if (res && share) {
455 f = FunctorOfTerm(t);
460 HR += 1+ArityOfFunctor(f);
463 if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L)
469 if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), share, newattvs, HB0+1, HB0 PASS_REGS)) < 0) {
471 if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
474 }
else if (res && share && FunctorOfTerm(t) != FunctorMutable) {
484p_copy_term( USES_REGS1 )
486 Term t = CopyTerm(ARG1, 2, TRUE, TRUE PASS_REGS);
490 return Yap_unify(ARG2,t);
494p_duplicate_term( USES_REGS1 )
496 Term t = CopyTerm(ARG1, 2, FALSE, TRUE PASS_REGS);
500 return Yap_unify(ARG2,t);
505p_copy_term_no_delays( USES_REGS1 )
507 Term t = CopyTerm(ARG1, 2, TRUE, FALSE PASS_REGS);
512 return(Yap_unify(ARG2,t));
524add_to_list( Term *out_e, Term v, Term t USES_REGS)
530 *out_e = tv = MkPairTerm(Yap_MkApplTerm( FunctorEq, 2, ta ), TermNil);
531 return RepPair(tv)+1;
535break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL *HLow USES_REGS)
546 while (pt0 < pt0_end) {
558 deref_head(d0, break_rationals_unk);
559 break_rationals_nvar:
563 if (IsPairTerm(d0)) {
564 CELL *ap2 = RepPair(d0);
566 if (IsVarTerm(first = *ap2) && (newp = (CELL*)first) && newp >= HB && newp < HR) {
569 if (!IsVarTerm(*newp)) {
570 Term v = (CELL)newp, t = *newp;
571 RESET_VARIABLE(newp);
572 of = add_to_list( of, v, t PASS_REGS);
578 *ptf++ = AbsPair(HR);
580 if (tovisit+1 >= (
struct copy_frame *)AuxSp) {
584 tovisit->pt0_end = pt0_end;
592 if (HR > ASP - 2048) {
595 }
else if (IsApplTerm(d0)) {
601 if (IsExtensionFunctor(f)) {
605 if (IsVarTerm(first = ap2[1]) && (newp = (CELL*)first) && newp >= HB && newp < HR) {
611 *ptf++ = AbsAppl(HR);
613 if (tovisit+1 >= (
struct copy_frame *)AuxSp) {
617 tovisit->pt0_end = pt0_end;
621 d0 = ArityOfFunctor(f);
628 if (HR > ASP - 2048) {
638 derefa_body(d0, ptd0, break_rationals_unk, break_rationals_nvar);
642 if (tovisit > tovisit0) {
645 pt0_end = tovisit->pt0_end;
654 Yap_unify((CELL)of, oi);
664 while (tovisit > tovisit0) {
667 pt0_end = tovisit->pt0_end;
682 while (tovisit > tovisit0) {
685 pt0_end = tovisit->pt0_end;
690 LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)tovisit0;
696BreakRational(Term inp, UInt arity, Term *of, Term oi USES_REGS) {
702 }
else if (IsPrimitiveTerm(t)) {
714 if ((res = break_rationals_complex_term(ap-1, ap, Hi, of, oi, Hi PASS_REGS)) < 0) {
716 if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
726p_break_rational( USES_REGS1 )
728 Term tf, t1=Deref(ARG1);
731 return Yap_unify(t1,ARG2) && Yap_unify(ARG3,ARG4);
732 return Yap_unify(ARG2, BreakRational(ARG1, 4, &tf, ARG4 PASS_REGS)) &&
738p_break_rational3( USES_REGS1 )
740 Term tf, t1=Deref(ARG1);
743 return Yap_unify(t1,ARG2) && Yap_unify(ARG3,TermNil);
744 return Yap_unify(ARG2, BreakRational(ARG1, 4, &tf, TermNil PASS_REGS)) &&
767CELL *CellDifH(CELL *hptr, CELL *hlow)
769 return (CELL *)((
char *)hptr-(
char *)hlow);
772#define AdjustSizeAtom(X) (((CELL)(X)+(8-1)) & ~(8-1))
775CELL *AtomAdjustSize(CELL *x,
char *buf)
777 UInt offset = (
char *)x-buf;
778 return (CELL*)(buf+AdjustSizeAtom(offset));
783Atom export_atom(
Atom at,
char **hpp,
char *buf,
size_t len)
789 ptr = (
char *)AtomAdjustSize((CELL*)ptr, buf);
793 sz = strlen(RepAtom(at)->StrOfAE);
796 strcpy(ptr, RepAtom(at)->StrOfAE);
798 return (
Atom)(p0-buf);
803Functor export_functor(
Functor f,
char **hpp,
char *buf,
size_t len)
805 CELL *hptr = AtomAdjustSize((CELL *)*hpp, buf);
806 UInt arity = ArityOfFunctor(f);
807 if (2*
sizeof(CELL) >= len)
810 *hpp = (
char *)(hptr+1);
811 if (!export_atom(NameOfFunctor(f), hpp, buf, len))
816 return (
Functor)(((
char *)hptr-buf)+1);
819#define export_derefa_body(D,A,LabelUnk,LabelNonVar) \
821 if ((CELL *)(D) < CellDifH(HR,HLow)) { (A) = (CELL *)(D); break; } \
823 (D) = *(CELL *)(D); \
824 if(!IsVarTerm(D)) goto LabelNonVar; \
826 } while (Unsigned(A) != (D))
830export_term_to_buffer(Term inpt,
char *buf,
char *bptr, CELL *t0 , CELL *tf,
size_t len)
833 CELL *bf = (CELL *)buf;
834 if (buf + len < (
char *)((CELL *)td + (tf-t0))) {
837 memcpy((
void *)td, (
void *)t0, (tf-t0)*
sizeof(CELL));
841 return bf[0]+
sizeof(CELL)*bf[1];
846export_complex_term(Term tf, CELL *pt0, CELL *pt0_end,
char * buf,
size_t len0,
int newattvs, CELL *ptf, CELL *HLow USES_REGS)
848 struct cp_frame *tovisit0, *tovisit = (
struct cp_frame *)Yap_PreAllocCodeSpace();
852 char *bptr = buf+ 3*
sizeof(CELL);
858 while (pt0 < pt0_end) {
864 deref_head(d0, export_term_unk);
867 if (IsPairTerm(d0)) {
868 CELL *ap2 = RepPair(d0);
869 if (ap2 < CellDifH(HR,HLow)) {
874 *ptf = AbsPair(CellDifH(HR,HLow));
877 if (tovisit+1 >= (
struct cp_frame *)AuxSp) {
881 tovisit->pt0_end = pt0_end;
883 tovisit->oldv = *pt0;
884 tovisit->ground = ground;
886 *pt0 = AbsPair(CellDifH(HR,HLow));
890 if (tovisit+1 >= (
struct cp_frame *)AuxSp) {
894 tovisit->pt0_end = pt0_end;
896 tovisit->ground = ground;
904 if (HR > ASP - 2048) {
907 }
else if (IsApplTerm(d0)) {
912 if (ap2 < CellDifH(HR,HLow)) {
919 *ptf++ = AbsAppl(CellDifH(HR,HLow));
920 if (IsExtensionFunctor(f)) {
924 if (f== FunctorDouble) {
925 sz =
sizeof(Float)/
sizeof(CELL)+2;
926 }
else if (f== FunctorLongInt) {
928 }
else if (f== FunctorString) {
932 sz = 2+
sizeof(
MP_INT)+(((
MP_INT *)(pt+1))->_mp_alloc*
sizeof(mp_limb_t));
934 if (HR+sz > ASP - 2048) {
937 memcpy((
void *)HR, (
void *)ap2, sz*
sizeof(CELL));
943 if (tovisit+1 >= (
struct cp_frame *)AuxSp) {
947 tovisit->pt0_end = pt0_end;
949 tovisit->oldv = *pt0;
950 tovisit->ground = ground;
956 if (tovisit+1 >= (
struct cp_frame *)AuxSp) {
960 tovisit->pt0_end = pt0_end;
962 tovisit->ground = ground;
966 ground = (f != FunctorMutable);
967 d0 = ArityOfFunctor(f);
973 if (HR > ASP - 2048) {
976 ptf[-1] = (CELL)export_functor(f, &bptr, buf, len);
977 len = len0 - (bptr-buf);
978 if (HR > ASP - 2048) {
982 if (IsAtomTerm(d0)) {
983 *ptf = MkAtomTerm(export_atom(AtomOfTerm(d0), &bptr, buf, len));
985 len = len0 - (bptr-buf);
993 export_derefa_body(d0, ptd0, export_term_unk, export_term_nvar);
995 if (ptd0 < CellDifH(HR,HLow)) {
997 *ptf++ = (CELL) ptd0;
1000 if (newattvs && IsAttachedTerm((CELL)ptd0) && FALSE) {
1007 if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) {
1012 Bind_NonAtt(ptd0,
new);
1017 *ptf = (CELL)CellDifH(ptf,HLow);
1018 if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
1020 if (!Yap_growtrail((TR-TR0)*
sizeof(tr_fr_ptr *), TRUE)) {
1021 goto trail_overflow;
1024 Bind_NonAtt(ptd0, (CELL)ptf);
1032 if (tovisit > tovisit0) {
1035 pt0_end = tovisit->pt0_end;
1037#ifdef RATIONAL_TREES
1038 *pt0 = tovisit->oldv;
1040 ground = (ground && tovisit->ground);
1045 clean_dirty_tr(TR0 PASS_REGS);
1047 return export_term_to_buffer(tf, buf, bptr, HLow, HR, len0);
1055#ifdef RATIONAL_TREES
1056 while (tovisit > tovisit0) {
1059 pt0_end = tovisit->pt0_end;
1061 *pt0 = tovisit->oldv;
1074#ifdef RATIONAL_TREES
1075 while (tovisit > tovisit0) {
1078 pt0_end = tovisit->pt0_end;
1080 *pt0 = tovisit->oldv;
1086 if (!Yap_growtrail((oTR-TR0)*
sizeof(tr_fr_ptr *), TRUE)) {
1098#ifdef RATIONAL_TREES
1099 while (tovisit > tovisit0) {
1102 pt0_end = tovisit->pt0_end;
1104 *pt0 = tovisit->oldv;
1108 LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)tovisit0;
1113ExportTerm(Term inp,
char * buf,
size_t len, UInt arity,
int newattvs USES_REGS) {
1114 Term t = Deref(inp);
1120 if (IsVarTerm(t) || IsIntTerm(t)) {
1121 return export_term_to_buffer(t, buf, buf+ 3*
sizeof(CELL), &inp, &inp, len);
1123 if (IsAtomTerm(t)) {
1124 Atom at = AtomOfTerm(t);
1125 char *b = buf+3*
sizeof(CELL);
1126 export_atom(at, &b, b, len-3*
sizeof(CELL));
1127 return export_term_to_buffer(t, buf, b, &inp, &inp, len);
1132 if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
1137 res = export_complex_term(inp, &t-1, &t, buf, len, newattvs, Hi, Hi PASS_REGS);
1138 }
while ((Int)res < 0);
1143Yap_ExportTerm(Term inp,
char * buf,
size_t len, UInt arity) {
1145 return ExportTerm(inp, buf, len, arity, TRUE PASS_REGS);
1150ShiftPtr(CELL t,
char *base)
1152 return (CELL *)(base+t);
1156addAtom(
Atom t,
char *buf)
1158 char *s = buf+(UInt)t;
1161 return Yap_LookupAtom(s+1);
1167FetchFunctor(CELL *pt,
char *buf)
1169 CELL *ptr = (CELL *)(buf+(*pt-1));
1171 UInt arity = *ptr++;
1174 ptr = AtomAdjustSize(ptr, buf);
1175 name = (
Atom)((
char *)ptr-buf);
1176 at = addAtom(name, buf);
1177 *pt = (CELL)Yap_MkFunctor(at, arity);
1182static CELL *import_compound(CELL *hp,
char *abase,
char *buf, CELL *amax);
1183static CELL *import_pair(CELL *hp,
char *abase,
char *buf, CELL *amax);
1186import_arg(CELL *hp,
char *abase,
char *buf, CELL *amax)
1190 hp[0] = (CELL)ShiftPtr(t, abase);
1191 }
else if (IsAtomTerm(t)) {
1192 hp[0] = MkAtomTerm(addAtom(AtomOfTerm(t), buf));
1193 }
else if (IsPairTerm(t)) {
1194 CELL *newp = ShiftPtr((CELL)RepPair(t), abase);
1195 hp[0] = AbsPair(newp);
1197 amax = import_pair(newp, abase, buf, newp);
1199 }
else if (IsApplTerm(t)) {
1200 CELL *newp = ShiftPtr((CELL)RepAppl(t), abase);
1201 hp[0] = AbsAppl(newp);
1203 amax = import_compound(newp, abase, buf, newp);
1210import_compound(CELL *hp,
char *abase,
char *buf, CELL *amax)
1215 if (!((CELL)f & 1) && IsExtensionFunctor(f))
1217 ar = FetchFunctor(hp, buf);
1218 for (i=1; i<=ar; i++) {
1219 amax = import_arg(hp+i, abase, buf, amax);
1225import_pair(CELL *hp,
char *abase,
char *buf, CELL *amax)
1227 amax = import_arg(hp, abase, buf, amax);
1228 amax = import_arg(hp+1, abase, buf, amax);
1233Yap_ImportTerm(
char * buf) {
1235 CELL *bc = (CELL *)buf;
1239 if (IsVarTerm(tinp))
1241 else if (IsIntTerm(tinp))
1243 else if (IsAtomTerm(tinp)) {
1244 tret = MkAtomTerm(addAtom(NULL,(
char *)(bc+3)));
1249 while (HR + sz > ASP - 4096) {
1250 if (!Yap_dogc(PASS_REGS1)) {
1251 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
1255 memcpy(HR, buf+bc[0],
sizeof(CELL)*sz);
1256 if (IsApplTerm(tinp)) {
1258 import_compound(HR, (
char *)HR, buf, HR);
1261 import_pair(HR, (
char *)HR, buf, HR);
1268Yap_SizeOfExportedTerm(
char * buf) {
1269 CELL *bc = (CELL *)buf;
1271 return bc[0]+bc[1]*
sizeof(CELL);
1275p_export_term( USES_REGS1 )
1277 size_t sz = 4096, osz;
1280 export_buf = malloc(sz);
1283 if (!(osz = Yap_ExportTerm(ARG1, export_buf, sz, 1))) {
1288 return Yap_unify(ARG3,MkIntegerTerm(osz)) &&
1289 Yap_unify(ARG2, MkIntegerTerm((Int)export_buf));
1293p_import_term( USES_REGS1 )
1295 char *export_buf = (
char *)IntegerOfTerm(Deref(ARG1));
1298 Int out = Yap_unify(ARG2,Yap_ImportTerm(export_buf));
1303p_kill_exported_term( USES_REGS1 )
1305 char *export_buf = (
char *)IntegerOfTerm(Deref(ARG1));
1313static Term vars_in_complex_term(
register CELL *pt0,
register CELL *pt0_end, Term inp USES_REGS)
1316 register CELL **tovisit0, **tovisit = (CELL **)Yap_PreAllocCodeSpace();
1317 register tr_fr_ptr TR0 = TR;
1318 CELL *InitialH = HR;
1319 CELL output = AbsPair(HR);
1323 while (pt0 < pt0_end) {
1325 register CELL *ptd0;
1329 deref_head(d0, vars_in_term_unk);
1332 if (IsPairTerm(d0)) {
1333 if (tovisit + 1024 >= (CELL **)AuxSp) {
1336#ifdef RATIONAL_TREES
1338 tovisit[1] = pt0_end;
1339 tovisit[2] = (CELL *)*pt0;
1343 if (pt0 < pt0_end) {
1345 tovisit[1] = pt0_end;
1349 pt0 = RepPair(d0) - 1;
1350 pt0_end = RepPair(d0) + 1;
1351 }
else if (IsApplTerm(d0)) {
1357 if (IsExtensionFunctor(f)) {
1361 if (tovisit + 1024 >= (CELL **)AuxSp) {
1364#ifdef RATIONAL_TREES
1366 tovisit[1] = pt0_end;
1367 tovisit[2] = (CELL *)*pt0;
1371 if (pt0 < pt0_end) {
1373 tovisit[1] = pt0_end;
1377 d0 = ArityOfFunctor(f);
1385 derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
1389 if (HR+1024 > ASP) {
1390 goto global_overflow;
1392 HR[1] = AbsPair(HR+2);
1394 HR[-2] = (CELL)ptd0;
1396 if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
1398 if (!Yap_growtrail((TR-TR0)*
sizeof(tr_fr_ptr *), TRUE)) {
1399 goto trail_overflow;
1402 TrailTerm(TR++) = (CELL)ptd0;
1405 if (tovisit > tovisit0) {
1406#ifdef RATIONAL_TREES
1409 pt0_end = tovisit[1];
1410 *pt0 = (CELL)tovisit[2];
1414 pt0_end = tovisit[1];
1419 clean_tr(TR0 PASS_REGS);
1420 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
1421 if (HR != InitialH) {
1423 Term t2 = Deref(inp);
1424 if (IsVarTerm(t2)) {
1425 RESET_VARIABLE(HR-1);
1426 Yap_unify((CELL)(HR-1),inp);
1436#ifdef RATIONAL_TREES
1437 while (tovisit > tovisit0) {
1440 *pt0 = (CELL)tovisit[2];
1443 LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
1444 LOCAL_Error_Size = (TR-TR0)*
sizeof(tr_fr_ptr *);
1445 clean_tr(TR0 PASS_REGS);
1446 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
1451 LOCAL_Error_Size = (tovisit-tovisit0)*
sizeof(CELL **);
1452#ifdef RATIONAL_TREES
1453 while (tovisit > tovisit0) {
1456 *pt0 = (CELL)tovisit[2];
1459 LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
1460 clean_tr(TR0 PASS_REGS);
1461 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
1466#ifdef RATIONAL_TREES
1467 while (tovisit > tovisit0) {
1470 *pt0 = (CELL)tovisit[2];
1473 clean_tr(TR0 PASS_REGS);
1474 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
1476 LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
1477 LOCAL_Error_Size = (ASP-HR)*
sizeof(CELL);
1483expand_vts(
int args USES_REGS )
1485 UInt expand = LOCAL_Error_Size;
1486 yap_error_number yap_errno = LOCAL_Error_TYPE;
1488 LOCAL_Error_Size = 0;
1489 LOCAL_Error_TYPE = YAP_NO_ERROR;
1490 if (yap_errno == RESOURCE_ERROR_TRAIL) {
1492 if (!Yap_growtrail(expand, FALSE)) {
1495 }
else if (yap_errno == RESOURCE_ERROR_AUXILIARY_STACK) {
1497 if (expand > 4*1024*1024)
1498 expand = 4*1024*1024;
1499 if (!Yap_ExpandPreAllocCodeSpace(expand, NULL, TRUE)) {
1503 if (!Yap_dogc(PASS_REGS1)) {
1504 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil,
"in term_variables");
1512p_variables_in_term( USES_REGS1 )
1521 while (!IsVarTerm(inp) && IsPairTerm(inp)) {
1522 Term t = HeadOfTerm(inp);
1524 CELL *ptr = VarOfTerm(t);
1525 *ptr = TermFoundVar;
1526 TrailTerm(TR++) = t;
1528 if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
1529 clean_tr(TR-count PASS_REGS);
1530 if (!Yap_growtrail(count*
sizeof(tr_fr_ptr *), FALSE)) {
1536 inp = TailOfTerm(inp);
1539 Term t = Deref(ARG1);
1543 RESET_VARIABLE(HR-2);
1544 RESET_VARIABLE(HR-1);
1545 Yap_unify((CELL)(HR-2),ARG1);
1546 Yap_unify((CELL)(HR-1),ARG2);
1547 }
else if (IsPrimitiveTerm(t))
1549 else if (IsPairTerm(t)) {
1550 out = vars_in_complex_term(RepPair(t)-1,
1551 RepPair(t)+1, ARG2 PASS_REGS);
1555 out = vars_in_complex_term(RepAppl(t),
1557 ArityOfFunctor(f), ARG2 PASS_REGS);
1560 if (!expand_vts( 3 PASS_REGS ))
1563 }
while (out == 0L);
1564 clean_tr(TR-count PASS_REGS);
1565 return Yap_unify(ARG3,out);
1570p_term_variables( USES_REGS1 )
1574 if (!Yap_IsListOrPartialListTerm(ARG2)) {
1575 Yap_ThrowError(TYPE_ERROR_LIST,ARG2,
"term_variables/2");
1580 Term t = Deref(ARG1);
1582 Term out = Yap_MkNewPairTerm();
1584 Yap_unify(t,HeadOfTerm(out)) &&
1585 Yap_unify(TermNil, TailOfTerm(out)) &&
1586 Yap_unify(out, ARG2);
1587 }
else if (IsPrimitiveTerm(t)) {
1588 return Yap_unify(TermNil, ARG2);
1589 }
else if (IsPairTerm(t)) {
1590 out = vars_in_complex_term(RepPair(t)-1,
1591 RepPair(t)+1, TermNil PASS_REGS);
1595 if (IsExtensionFunctor(f)) {
1597 out = vars_in_complex_term(RepAppl(t),
1599 ArityOfFunctor(f), TermNil PASS_REGS);
1602 if (!expand_vts( 3 PASS_REGS ))
1605 }
while (out == 0L);
1606 return Yap_unify(ARG2,out);
1616static Term attvars_in_complex_term(
register CELL *pt0,
register CELL *pt0_end, Term inp USES_REGS)
1619 register CELL **tovisit0, **tovisit = (CELL **)Yap_PreAllocCodeSpace();
1620 register tr_fr_ptr TR0 = TR;
1621 CELL *InitialH = HR;
1622 CELL output = AbsPair(HR);
1626 while (pt0 < pt0_end) {
1628 register CELL *ptd0;
1632 deref_head(d0, attvars_in_term_unk);
1633 attvars_in_term_nvar:
1635 if (IsPairTerm(d0)) {
1636 if (tovisit + 1024 >= (CELL **)AuxSp) {
1640 CELL *npt0 = RepPair(d0);
1641 if(IsAtomicTerm(Deref(npt0[0]))) {
1647#ifdef RATIONAL_TREES
1649 tovisit[1] = pt0_end;
1650 tovisit[2] = (CELL *)*pt0;
1654 if (pt0 < pt0_end) {
1656 tovisit[1] = pt0_end;
1660 pt0 = RepPair(d0) - 1;
1662 }
else if (IsApplTerm(d0)) {
1668 if (IsExtensionFunctor(f)) {
1672 if (tovisit + 1024 >= (CELL **)AuxSp) {
1675#ifdef RATIONAL_TREES
1677 tovisit[1] = pt0_end;
1678 tovisit[2] = (CELL *)*pt0;
1682 if (pt0 < pt0_end) {
1684 tovisit[1] = pt0_end;
1688 d0 = ArityOfFunctor(f);
1696 derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar);
1697 if (IsAttVar(ptd0)) {
1701 if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
1703 if (!Yap_growtrail((TR-TR0)*
sizeof(tr_fr_ptr *), TRUE)) {
1704 goto trail_overflow;
1707 TrailTerm(TR++) = (CELL)ptd0;
1709 if (HR+1024 > ASP) {
1710 goto global_overflow;
1712 HR[1] = AbsPair(HR+2);
1714 HR[-2] = (CELL)ptd0;
1716 if (tovisit + 1024 >= (CELL **)AuxSp) {
1719#ifdef RATIONAL_TREES
1721 tovisit[1] = pt0_end;
1722 tovisit[2] = (CELL *)*pt0;
1726 if (pt0 < pt0_end) {
1728 tovisit[1] = pt0_end;
1732 pt0 = &RepAttVar(ptd0)->Future;
1733 pt0_end = &RepAttVar(ptd0)->Atts;
1737 if (tovisit > tovisit0) {
1738#ifdef RATIONAL_TREES
1741 pt0_end = tovisit[1];
1742 *pt0 = (CELL)tovisit[2];
1746 pt0_end = tovisit[1];
1751 clean_tr(TR0 PASS_REGS);
1752 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
1753 if (HR != InitialH) {
1755 Term t2 = Deref(inp);
1756 if (IsVarTerm(t2)) {
1757 RESET_VARIABLE(HR-1);
1758 Yap_unify((CELL)(HR-1), t2);
1768#ifdef RATIONAL_TREES
1769 while (tovisit > tovisit0) {
1772 *pt0 = (CELL)tovisit[2];
1775 LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
1776 LOCAL_Error_Size = (TR-TR0)*
sizeof(tr_fr_ptr *);
1777 clean_tr(TR0 PASS_REGS);
1778 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
1783 LOCAL_Error_Size = (tovisit-tovisit0)*
sizeof(CELL **);
1784#ifdef RATIONAL_TREES
1785 while (tovisit > tovisit0) {
1788 *pt0 = (CELL)tovisit[2];
1791 LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
1792 clean_tr(TR0 PASS_REGS);
1793 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
1798#ifdef RATIONAL_TREES
1799 while (tovisit > tovisit0) {
1802 *pt0 = (CELL)tovisit[2];
1805 clean_tr(TR0 PASS_REGS);
1806 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
1808 LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
1809 LOCAL_Error_Size = (ASP-HR)*
sizeof(CELL);
1815p_term_attvars( USES_REGS1 )
1820 Term t = Deref(ARG1);
1822 out = attvars_in_complex_term(VarOfTerm(t)-1,
1823 VarOfTerm(t)+1, TermNil PASS_REGS);
1824 }
else if (IsPrimitiveTerm(t)) {
1825 return Yap_unify(TermNil, ARG2);
1826 }
else if (IsPairTerm(t)) {
1827 out = attvars_in_complex_term(RepPair(t)-1,
1828 RepPair(t)+1, TermNil PASS_REGS);
1832 out = attvars_in_complex_term(RepAppl(t),
1834 ArityOfFunctor(f), TermNil PASS_REGS);
1837 if (!expand_vts( 3 PASS_REGS ))
1840 }
while (out == 0L);
1841 return Yap_unify(ARG2,out);
1845static Term vars_within_complex_term(
register CELL *pt0,
register CELL *pt0_end, Term inp USES_REGS)
1848 register CELL **tovisit0, **tovisit = (CELL **)Yap_PreAllocCodeSpace();
1849 register tr_fr_ptr TR0 = TR;
1850 CELL *InitialH = HR;
1851 CELL output = AbsPair(HR);
1854 while (!IsVarTerm(inp) && IsPairTerm(inp)) {
1855 Term t = HeadOfTerm(inp);
1857 CELL *ptr = VarOfTerm(t);
1858 *ptr = TermFoundVar;
1859 TrailTerm(TR++) = t;
1860 if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
1861 if (!Yap_growtrail((TR-TR0)*
sizeof(tr_fr_ptr *), TRUE)) {
1862 goto trail_overflow;
1866 inp = TailOfTerm(inp);
1869 while (pt0 < pt0_end) {
1871 register CELL *ptd0;
1875 deref_head(d0, vars_within_term_unk);
1876 vars_within_term_nvar:
1878 if (IsPairTerm(d0)) {
1879 if (tovisit + 1024 >= (CELL **)AuxSp) {
1882#ifdef RATIONAL_TREES
1884 tovisit[1] = pt0_end;
1885 tovisit[2] = (CELL *)*pt0;
1889 if (pt0 < pt0_end) {
1891 tovisit[1] = pt0_end;
1895 pt0 = RepPair(d0) - 1;
1896 pt0_end = RepPair(d0) + 1;
1897 }
else if (IsApplTerm(d0)) {
1903 if (IsExtensionFunctor(f)) {
1907 if (tovisit + 1024 >= (CELL **)AuxSp) {
1910#ifdef RATIONAL_TREES
1912 tovisit[1] = pt0_end;
1913 tovisit[2] = (CELL *)*pt0;
1917 if (pt0 < pt0_end) {
1919 tovisit[1] = pt0_end;
1923 d0 = ArityOfFunctor(f);
1926 }
else if (d0 == TermFoundVar) {
1928 if (HR+1024 > ASP) {
1929 goto global_overflow;
1931 HR[1] = AbsPair(HR+2);
1933 HR[-2] = (CELL)ptd0;
1939 derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
1942 if (tovisit > tovisit0) {
1943#ifdef RATIONAL_TREES
1946 pt0_end = tovisit[1];
1947 *pt0 = (CELL)tovisit[2];
1951 pt0_end = tovisit[1];
1956 clean_tr(TR0 PASS_REGS);
1957 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
1958 if (HR != InitialH) {
1966#ifdef RATIONAL_TREES
1967 while (tovisit > tovisit0) {
1970 *pt0 = (CELL)tovisit[2];
1973 LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
1974 LOCAL_Error_Size = (TR-TR0)*
sizeof(tr_fr_ptr *);
1975 clean_tr(TR0 PASS_REGS);
1976 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
1981 LOCAL_Error_Size = (tovisit-tovisit0)*
sizeof(CELL **);
1982#ifdef RATIONAL_TREES
1983 while (tovisit > tovisit0) {
1986 *pt0 = (CELL)tovisit[2];
1989 LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
1990 clean_tr(TR0 PASS_REGS);
1991 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
1996#ifdef RATIONAL_TREES
1997 while (tovisit > tovisit0) {
2000 *pt0 = (CELL)tovisit[2];
2003 clean_tr(TR0 PASS_REGS);
2004 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
2006 LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
2007 LOCAL_Error_Size = (ASP-HR)*
sizeof(CELL);
2013p_variables_within_term( USES_REGS1 )
2018 Term t = Deref(ARG2);
2020 out = vars_within_complex_term(VarOfTerm(t)-1,
2021 VarOfTerm(t), Deref(ARG1) PASS_REGS);
2023 }
else if (IsPrimitiveTerm(t))
2025 else if (IsPairTerm(t)) {
2026 out = vars_within_complex_term(RepPair(t)-1,
2027 RepPair(t)+1, Deref(ARG1) PASS_REGS);
2031 out = vars_within_complex_term(RepAppl(t),
2033 ArityOfFunctor(f), Deref(ARG1) PASS_REGS);
2036 if (!expand_vts( 3 PASS_REGS ))
2039 }
while (out == 0L);
2040 return Yap_unify(ARG3,out);
2044static Term free_vars_in_complex_term(
register CELL *pt0,
register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS)
2046 register CELL **tovisit0, **tovisit = (CELL **)Yap_PreAllocCodeSpace();
2047 CELL *InitialH = HR;
2048 *HR++ = MkAtomTerm(AtomDollar);
2052 while (pt0 < pt0_end) {
2054 register CELL *ptd0;
2058 deref_head(d0, vars_within_term_unk);
2059 vars_within_term_nvar:
2061 if (IsPairTerm(d0)) {
2062 if (tovisit + 1024 >= (CELL **)AuxSp) {
2065#ifdef RATIONAL_TREES
2067 tovisit[1] = pt0_end;
2068 tovisit[2] = (CELL *)*pt0;
2072 if (pt0 < pt0_end) {
2074 tovisit[1] = pt0_end;
2078 pt0 = RepPair(d0) - 1;
2079 pt0_end = RepPair(d0) + 1;
2080 }
else if (IsApplTerm(d0)) {
2086 if (IsExtensionFunctor(f)) {
2090 if (tovisit + 1024 >= (CELL **)AuxSp) {
2093#ifdef RATIONAL_TREES
2095 tovisit[1] = pt0_end;
2096 tovisit[2] = (CELL *)*pt0;
2100 if (pt0 < pt0_end) {
2102 tovisit[1] = pt0_end;
2106 d0 = ArityOfFunctor(f);
2113 derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
2117 if (HR+1024 > ASP) {
2118 goto global_overflow;
2123 if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
2125 if (!Yap_growtrail((TR-TR0)*
sizeof(tr_fr_ptr *), TRUE)) {
2126 goto trail_overflow;
2129 TrailTerm(TR++) = (CELL)ptd0;
2132 if (tovisit > tovisit0) {
2133#ifdef RATIONAL_TREES
2136 pt0_end = tovisit[1];
2137 *pt0 = (CELL)tovisit[2];
2141 pt0_end = tovisit[1];
2146 clean_tr(TR0 PASS_REGS);
2147 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
2148 if (HR != InitialH+1) {
2149 InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (HR-InitialH)-1);
2150 return AbsAppl(InitialH);
2152 return MkAtomTerm(AtomDollar);
2156#ifdef RATIONAL_TREES
2157 while (tovisit > tovisit0) {
2160 *pt0 = (CELL)tovisit[2];
2163 LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
2164 LOCAL_Error_Size = (TR-TR0)*
sizeof(tr_fr_ptr *);
2165 clean_tr(TR0 PASS_REGS);
2166 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
2171 LOCAL_Error_Size = (tovisit-tovisit0)*
sizeof(CELL **);
2172#ifdef RATIONAL_TREES
2173 while (tovisit > tovisit0) {
2176 *pt0 = (CELL)tovisit[2];
2179 LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
2180 clean_tr(TR0 PASS_REGS);
2181 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
2186#ifdef RATIONAL_TREES
2187 while (tovisit > tovisit0) {
2190 *pt0 = (CELL)tovisit[2];
2193 clean_tr(TR0 PASS_REGS);
2194 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
2196 LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
2197 LOCAL_Error_Size = (ASP-HR)*
sizeof(CELL);
2203static Term bind_vars_in_complex_term(
register CELL *pt0,
register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS)
2205 register CELL **tovisit0, **tovisit = (CELL **)Yap_PreAllocCodeSpace();
2206 CELL *InitialH = HR;
2210 while (pt0 < pt0_end) {
2212 register CELL *ptd0;
2216 deref_head(d0, vars_within_term_unk);
2217 vars_within_term_nvar:
2219 if (IsPairTerm(d0)) {
2220 if (tovisit + 1024 >= (CELL **)AuxSp) {
2223#ifdef RATIONAL_TREES
2225 tovisit[1] = pt0_end;
2226 tovisit[2] = (CELL *)*pt0;
2230 if (pt0 < pt0_end) {
2232 tovisit[1] = pt0_end;
2236 pt0 = RepPair(d0) - 1;
2237 pt0_end = RepPair(d0) + 1;
2238 }
else if (IsApplTerm(d0)) {
2244 if (IsExtensionFunctor(f)) {
2248 if (tovisit + 1024 >= (CELL **)AuxSp) {
2251#ifdef RATIONAL_TREES
2253 tovisit[1] = pt0_end;
2254 tovisit[2] = (CELL *)*pt0;
2258 if (pt0 < pt0_end) {
2260 tovisit[1] = pt0_end;
2264 d0 = ArityOfFunctor(f);
2271 derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar);
2273 *ptd0 = TermFoundVar;
2275 if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
2277 if (!Yap_growtrail((TR-TR0)*
sizeof(tr_fr_ptr *), TRUE)) {
2278 goto trail_overflow;
2281 TrailTerm(TR++) = (CELL)ptd0;
2284 if (tovisit > tovisit0) {
2285#ifdef RATIONAL_TREES
2288 pt0_end = tovisit[1];
2289 *pt0 = (CELL)tovisit[2];
2293 pt0_end = tovisit[1];
2298 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
2302#ifdef RATIONAL_TREES
2303 while (tovisit > tovisit0) {
2306 *pt0 = (CELL)tovisit[2];
2309 LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
2310 LOCAL_Error_Size = (TR-TR0)*
sizeof(tr_fr_ptr *);
2311 clean_tr(TR0 PASS_REGS);
2312 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
2317 LOCAL_Error_Size = (tovisit-tovisit0)*
sizeof(CELL **);
2318#ifdef RATIONAL_TREES
2319 while (tovisit > tovisit0) {
2322 *pt0 = (CELL)tovisit[2];
2325 LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
2326 clean_tr(TR0 PASS_REGS);
2327 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit0);
2336static Term non_singletons_in_complex_term(
register CELL *pt0,
register CELL *pt0_end USES_REGS)
2339 register CELL **tovisit0, **tovisit = (CELL **)Yap_PreAllocCodeSpace();
2340 register tr_fr_ptr TR0 = TR;
2341 CELL *InitialH = HR;
2342 CELL output = AbsPair(HR);
2346 while (pt0 < pt0_end) {
2348 register CELL *ptd0;
2352 deref_head(d0, vars_in_term_unk);
2355 if (IsPairTerm(d0)) {
2356 if (tovisit + 1024 >= (CELL **)AuxSp) {
2359#ifdef RATIONAL_TREES
2361 tovisit[1] = pt0_end;
2362 tovisit[2] = (CELL *)*pt0;
2366 if (pt0 < pt0_end) {
2368 tovisit[1] = pt0_end;
2372 pt0 = RepPair(d0) - 1;
2373 pt0_end = RepPair(d0) + 1;
2374 }
else if (IsApplTerm(d0)) {
2381 if (IsExtensionFunctor(f)) {
2385 if (tovisit + 1024 >= (CELL **)AuxSp) {
2388#ifdef RATIONAL_TREES
2390 tovisit[1] = pt0_end;
2391 tovisit[2] = (CELL *)*pt0;
2396 if (pt0 < pt0_end) {
2398 tovisit[1] = pt0_end;
2402 d0 = ArityOfFunctor(f);
2405 }
else if (d0 == TermFoundVar) {
2407 while(IsVarTerm(*pt2))
2408 pt2 = (CELL *)(*pt2);
2409 HR[1] = AbsPair(HR+2);
2412 *pt2 = TermRefoundVar;
2418 derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
2420 *ptd0 = TermFoundVar;
2422 TrailTerm(TR++) = (CELL)ptd0;
2425 if (tovisit > tovisit0) {
2426#ifdef RATIONAL_TREES
2429 pt0_end = tovisit[1];
2430 *pt0 = (CELL)tovisit[2];
2434 pt0_end = tovisit[1];
2439 clean_tr(TR0 PASS_REGS);
2440 if (HR != InitialH) {
2442 RESET_VARIABLE(HR-1);
2443 Yap_unify((CELL)(HR-1),ARG2);
2450#ifdef RATIONAL_TREES
2451 while (tovisit > tovisit0) {
2454 *pt0 = (CELL)tovisit[2];
2457 clean_tr(TR0 PASS_REGS);
2458 if (HR != InitialH) {
2460 RESET_VARIABLE(HR-1);
2466p_non_singletons_in_term( USES_REGS1 )
2474 out = MkPairTerm(t,ARG2);
2475 }
else if (IsPrimitiveTerm(t)) {
2477 }
else if (IsPairTerm(t)) {
2478 out = non_singletons_in_complex_term(RepPair(t)-1,
2479 RepPair(t)+1 PASS_REGS);
2481 out = non_singletons_in_complex_term(RepAppl(t),
2483 ArityOfFunctor(FunctorOfTerm(t)) PASS_REGS);
2486 return Yap_unify(ARG3,out);
2488 if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
2489 Yap_ThrowError(RESOURCE_ERROR_AUXILIARY_STACK, ARG1,
"overflow in singletons");
2497p_ground( USES_REGS1 )
2499 return Yap_IsGroundTerm(Deref(ARG1));
2503SizeOfExtension(Term t)
2506 if (f== FunctorDouble) {
2507 return 2 +
sizeof(Float)/
sizeof(CELL);
2509 if (f== FunctorString) {
2510 return 3 + RepAppl(t)[1];
2512 if (f== FunctorLongInt) {
2513 return 2 +
sizeof(Float)/
sizeof(CELL);
2515 if (f== FunctorDBRef) {
2518 if (f== FunctorBigInt) {
2519 CELL *pt = RepAppl(t)+2;
2520 return 3+
sizeof(
MP_INT)+(((
MP_INT *)(pt))->_mp_alloc*
sizeof(mp_limb_t));
2526static Int sz_ground_complex_term(
register CELL *pt0,
register CELL *pt0_end,
int ground USES_REGS)
2529 register CELL **tovisit0, **tovisit = (CELL **)Yap_PreAllocCodeSpace();
2534 while (pt0 < pt0_end) {
2536 register CELL *ptd0;
2541 deref_head(d0, vars_in_term_unk);
2544 if (IsPairTerm(d0)) {
2546 if (tovisit + 1024 >= (CELL **)AuxSp) {
2549#ifdef RATIONAL_TREES
2551 tovisit[1] = pt0_end;
2552 tovisit[2] = (CELL *)*pt0;
2556 if (pt0 < pt0_end) {
2558 tovisit[1] = pt0_end;
2562 pt0 = RepPair(d0) - 1;
2563 pt0_end = RepPair(d0) + 1;
2564 }
else if (IsApplTerm(d0)) {
2571 if (IsExtensionFunctor(f)) {
2572 sz += SizeOfExtension(d0);
2575 if (tovisit + 1024 >= (CELL **)AuxSp) {
2578#ifdef RATIONAL_TREES
2580 tovisit[1] = pt0_end;
2581 tovisit[2] = (CELL *)*pt0;
2586 if (pt0 < pt0_end) {
2588 tovisit[1] = pt0_end;
2592 d0 = ArityOfFunctor(f);
2601 derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
2604#ifdef RATIONAL_TREES
2605 while (tovisit > tovisit0) {
2608 pt0_end = tovisit[1];
2609 *pt0 = (CELL)tovisit[2];
2615 if (tovisit > tovisit0) {
2616#ifdef RATIONAL_TREES
2619 pt0_end = tovisit[1];
2620 *pt0 = (CELL)tovisit[2];
2624 pt0_end = tovisit[1];
2632#ifdef RATIONAL_TREES
2633 while (tovisit > tovisit0) {
2636 *pt0 = (CELL)tovisit[2];
2643Yap_SizeGroundTerm(Term t,
int ground)
2650 }
else if (IsPrimitiveTerm(t)) {
2652 }
else if (IsPairTerm(t)) {
2653 int sz = sz_ground_complex_term(RepPair(t)-1, RepPair(t)+1, ground PASS_REGS);
2659 Functor fun = FunctorOfTerm(t);
2661 if (IsExtensionFunctor(fun))
2662 return 1+ SizeOfExtension(t);
2664 sz = sz_ground_complex_term(RepAppl(t),
2666 ArityOfFunctor(fun),
2670 return 1+ArityOfFunctor(fun)+sz;
2694MurmurHashNeutral2 (
const void * key,
int len,
unsigned int seed )
2696 const unsigned int m = 0x5bd1e995;
2699 unsigned int h = seed ^ len;
2701 const unsigned char * data = (
const unsigned char *)key;
2725 case 3: h ^= data[2] << 16;
2726 case 2: h ^= data[1] << 8;
2727 case 1: h ^= data[0];
2739addAtomToHash(CELL *st,
Atom at)
2743 char *c = RepAtom(at)->StrOfAE;
2744 int ulen = strlen(c);
2749 if (ulen % CellSize == 0) {
2750 len = ulen/CellSize;
2752 len = ulen/CellSize;
2756 strncpy((
char *)st, c, ulen);
2768hash_complex_term(
register CELL *pt0,
2769 register CELL *pt0_end,
2772 int variant USES_REGS)
2778 while (pt0 < pt0_end) {
2780 register CELL *ptd0;
2784 deref_head(d0, hash_complex_unk);
2787 if (st + 1024 >= ASP) {
2788 goto global_overflow;
2790 if (IsAtomOrIntTerm(d0)) {
2791 if (d0 != TermFoundVar) {
2792 if (IsAtomTerm(d0)) {
2793 st = addAtomToHash(st, AtomOfTerm(d0));
2795 *st++ = IntOfTerm(d0);
2799 }
else if (IsPairTerm(d0)) {
2800 st = addAtomToHash(st, AtomDot);
2803 if (tovisit + 256 >= (
visited_t *)AuxSp) {
2806 tovisit->start = pt0;
2807 tovisit->end = pt0_end;
2808 tovisit->old = *pt0;
2809 tovisit->vdepth = depth;
2812 *pt0 = TermFoundVar;
2813 pt0 = RepPair(d0) - 1;
2814 pt0_end = RepPair(d0) + 1;
2816 }
else if (IsApplTerm(d0)) {
2823 if (IsExtensionFunctor(f)) {
2828 case (CELL)FunctorDBRef:
2831 case (CELL)FunctorLongInt:
2832 *st++ = LongIntOfTerm(d0);
2834 case (CELL)FunctorString:
2835 memcpy(st, RepAppl(d0), (3+RepAppl(d0)[1])*
sizeof(CELL));
2836 st += 3+RepAppl(d0)[1];
2839 case (CELL)FunctorBigInt:
2841 CELL *pt = RepAppl(d0);
2844 (((
MP_INT *)(pt+2))->_mp_alloc*
sizeof(mp_limb_t));
2846 if (st + (1024 + sz/CellSize) >= ASP) {
2847 goto global_overflow;
2850 memcpy((
void *)(st+1), (
void *)(pt+1), sz);
2851 st = st+sz/CellSize;
2855 case (CELL)FunctorDouble:
2857 CELL *pt = RepAppl(d0);
2859#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
2867 st = addAtomToHash(st, NameOfFunctor(f));
2870 if (tovisit + 1024 >= (
visited_t *)AuxSp) {
2873 tovisit->start = pt0;
2874 tovisit->end = pt0_end;
2875 tovisit->old = *pt0;
2876 tovisit->vdepth = depth;
2879 *pt0 = TermFoundVar;
2880 d0 = ArityOfFunctor(f);
2888 deref_body(d0, ptd0, hash_complex_unk, hash_complex_nvar);
2895 if (tovisit > tovisit0) {
2897 pt0 = tovisit->start;
2898 pt0_end = tovisit->end;
2899 *pt0 = tovisit->old;
2900 depth = tovisit->vdepth;
2907 while (tovisit > tovisit0) {
2909 pt0 = tovisit->start;
2910 *pt0 = tovisit->old;
2916 while (tovisit > tovisit0) {
2918 pt0 = tovisit->start;
2919 *pt0 = tovisit->old;
2925Yap_TermHash(Term t, Int size, Int depth,
int variant)
2932 CELL *ar = hash_complex_term(&t1-1, &t1, depth, HR, FALSE PASS_REGS);
2933 if (ar == (CELL *)-1) {
2934 if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
2935 Yap_ThrowError(RESOURCE_ERROR_AUXILIARY_STACK, ARG1,
"overflow in term_hash");
2939 }
else if(ar == (CELL *)-2) {
2940 if (!Yap_dogc(PASS_REGS1)) {
2941 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil,
"in term_hash");
2945 }
else if (ar == NULL) {
2948 i1 = MurmurHashNeutral2((
const void *)HR, CellSize*(ar-HR),0x1a3be34a);
2957p_term_hash( USES_REGS1 )
2960 Term t1 = Deref(ARG1);
2961 Term t2 = Deref(ARG2);
2962 Term t3 = Deref(ARG3);
2966 if (IsVarTerm(t2)) {
2967 Yap_ThrowError(INSTANTIATION_ERROR,t2,
"term_hash/4");
2970 if (!IsIntegerTerm(t2)) {
2971 Yap_ThrowError(TYPE_ERROR_INTEGER,t2,
"term_hash/4");
2974 depth = IntegerOfTerm(t2);
2976 if (IsVarTerm(t1))
return(TRUE);
2977 return(Yap_unify(ARG4,MkIntTerm(0)));
2979 if (IsVarTerm(t3)) {
2980 Yap_ThrowError(INSTANTIATION_ERROR,t3,
"term_hash/4");
2983 if (!IsIntegerTerm(t3)) {
2984 Yap_ThrowError(TYPE_ERROR_INTEGER,t3,
"term_hash/4");
2987 size = IntegerOfTerm(t3);
2989 CELL *ar = hash_complex_term(&t1-1, &t1, depth, HR, FALSE PASS_REGS);
2990 if (ar == (CELL *)-1) {
2991 if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
2992 Yap_ThrowError(RESOURCE_ERROR_AUXILIARY_STACK, ARG1,
"overflow in term_hash");
2996 }
else if(ar == (CELL *)-2) {
2997 if (!Yap_dogc(PASS_REGS1)) {
2998 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil,
"in term_hash");
3002 }
else if (ar == NULL) {
3005 i1 = MurmurHashNeutral2((
const void *)HR, CellSize*(ar-HR),0x1a3be34a);
3010 result = MkIntegerTerm(i1 % size);
3011 return Yap_unify(ARG4,result);
3015p_instantiated_term_hash( USES_REGS1 )
3018 Term t1 = Deref(ARG1);
3019 Term t2 = Deref(ARG2);
3020 Term t3 = Deref(ARG3);
3024 if (IsVarTerm(t2)) {
3025 Yap_ThrowError(INSTANTIATION_ERROR,t2,
"term_hash/4");
3028 if (!IsIntegerTerm(t2)) {
3029 Yap_ThrowError(TYPE_ERROR_INTEGER,t2,
"term_hash/4");
3032 depth = IntegerOfTerm(t2);
3034 if (IsVarTerm(t1))
return(TRUE);
3035 return(Yap_unify(ARG4,MkIntTerm(0)));
3037 if (IsVarTerm(t3)) {
3038 Yap_ThrowError(INSTANTIATION_ERROR,t3,
"term_hash/4");
3041 if (!IsIntegerTerm(t3)) {
3042 Yap_ThrowError(TYPE_ERROR_INTEGER,t3,
"term_hash/4");
3045 size = IntegerOfTerm(t3);
3047 CELL *ar = hash_complex_term(&t1-1, &t1, depth, HR, TRUE PASS_REGS);
3048 if (ar == (CELL *)-1) {
3049 if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
3050 Yap_ThrowError(RESOURCE_ERROR_AUXILIARY_STACK, ARG1,
"overflow in term_hash");
3054 }
else if(ar == (CELL *)-2) {
3055 if (!Yap_dogc(PASS_REGS1)) {
3056 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil,
"in term_hash");
3060 }
else if (ar == NULL) {
3063 i1 = MurmurHashNeutral2((
const void *)HR, CellSize*(ar-HR),0x1a3be34a);
3068 result = MkIntegerTerm(i1 % size);
3069 return Yap_unify(ARG4,result);
3072static int variant_complex(
register CELL *pt0,
register CELL *pt0_end,
register
3073 CELL *pt1 USES_REGS)
3075 tr_fr_ptr OLDTR = TR;
3076 register CELL **tovisit = (CELL **)ASP;
3082 while (pt0 < pt0_end) {
3083 register CELL d0, d1;
3088 if (IsVarTerm(d0)) {
3089 if (IsVarTerm(d1)) {
3090 CELL *pt0 = VarOfTerm(d0);
3091 CELL *pt1 = VarOfTerm(d1);
3092 if (pt0 >= HBREG || pt1 >= HBREG) {
3094 if (VarOfTerm(d0)+1 == VarOfTerm(d1))
continue;
3098 Term n0 = MkVarTerm(), n1 = MkVarTerm();
3099 Bind_Global(VarOfTerm(d0), n0);
3100 Bind_Global(VarOfTerm(d1), n1);
3106 }
else if (IsVarTerm(d1)) {
3109 if (d0 == d1)
continue;
3110 else if (IsAtomOrIntTerm(d0)) {
3112 }
else if (IsPairTerm(d0)) {
3113 if (!IsPairTerm(d1)) {
3116#ifdef RATIONAL_TREES
3120 if ((CELL *)tovisit < HR+1024)
3123 tovisit[1] = pt0_end;
3125 tovisit[3] = (CELL *)*pt0;
3129 if (pt0 < pt0_end) {
3131 if ((CELL *)tovisit < HR+1024)
3134 tovisit[1] = pt0_end;
3138 pt0 = RepPair(d0) - 1;
3139 pt0_end = RepPair(d0) + 1;
3140 pt1 = RepPair(d1) - 1;
3142 }
else if (IsApplTerm(d0)) {
3144 register CELL *ap2, *ap3;
3145 if (!IsApplTerm(d1)) {
3156 if (IsExtensionFunctor(f)) {
3157 if (!unify_extension(f, d0, ap2, d1))
3161#ifdef RATIONAL_TREES
3165 if ((CELL *)tovisit < HR+1024)
3168 tovisit[1] = pt0_end;
3170 tovisit[3] = (CELL *)*pt0;
3174 if (pt0 < pt0_end) {
3176 if ((CELL *)tovisit < HR+1024)
3179 tovisit[1] = pt0_end;
3183 d0 = ArityOfFunctor(f);
3193 if (tovisit < (CELL **)ASP) {
3194#ifdef RATIONAL_TREES
3196 pt0_end = tovisit[1];
3198 *pt0 = (CELL)tovisit[3];
3202 pt0_end = tovisit[1];
3211 while (TR != (tr_fr_ptr)OLDTR) {
3212 CELL *pt1 = (CELL *) TrailTerm(--TR);
3213 RESET_VARIABLE(pt1);
3221#ifdef RATIONAL_TREES
3222 while (tovisit < (CELL **)ASP) {
3224 pt0_end = tovisit[1];
3226 *pt0 = (CELL)tovisit[3];
3230 while (TR != (tr_fr_ptr)OLDTR) {
3231 CELL *pt1 = (CELL *) TrailTerm(--TR);
3232 RESET_VARIABLE(pt1);
3241#ifdef RATIONAL_TREES
3242 while (tovisit < (CELL **)ASP) {
3244 pt0_end = tovisit[1];
3246 *pt0 = (CELL)tovisit[3];
3251 while (TR != (tr_fr_ptr)OLDTR) {
3252 CELL *pt1 = (CELL *) TrailTerm(--TR);
3253 RESET_VARIABLE(pt1);
3260is_variant(Term t1, Term t2,
int parity USES_REGS)
3266 if (IsVarTerm(t1)) {
3270 }
else if (IsVarTerm(t2))
3272 if (IsAtomOrIntTerm(t1)) {
3275 if (IsPairTerm(t1)) {
3276 if (IsPairTerm(t2)) {
3277 out = variant_complex(RepPair(t1)-1,
3279 RepPair(t2)-1 PASS_REGS);
3280 if (out < 0)
goto error;
3285 if (!IsApplTerm(t2)) {
3288 Functor f1 = FunctorOfTerm(t1);
3290 if (f1 != FunctorOfTerm(t2))
return(FALSE);
3291 if (IsExtensionFunctor(f1)) {
3292 return(unify_extension(f1, t1, RepAppl(t1), t2));
3294 out = variant_complex(RepAppl(t1),
3295 RepAppl(t1)+ArityOfFunctor(f1),
3296 RepAppl(t2) PASS_REGS);
3297 if (out < 0)
goto error;
3302 if (!Yap_dogc(PASS_REGS1)) {
3303 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil,
"in variant");
3306 return is_variant(t1, t2, parity PASS_REGS);
3312Yap_Variant(Term t1, Term t2)
3315 return is_variant(t1, t2, 0 PASS_REGS);
3319p_variant( USES_REGS1 )
3321 return is_variant(Deref(ARG1), Deref(ARG2), 2 PASS_REGS);
3325static int subsumes_complex(
register CELL *pt0,
register CELL *pt0_end,
register
3326 CELL *pt1 USES_REGS)
3328 register CELL **tovisit = (CELL **)ASP;
3329 tr_fr_ptr OLDTR = TR;
3330 UInt write_mode = TRUE;
3335 while (pt0 < pt0_end) {
3336 register CELL d0, d1;
3337 Int our_write_mode = write_mode;
3347 if (npt0 >= HBREG) {
3348 our_write_mode = FALSE;
3351 if (IsVarTerm(d0) &&
3367 if (npt1 >= HBREG) {
3375 if (IsVarTerm(d0)) {
3376 if (our_write_mode) {
3378 CELL *pt0 = VarOfTerm(d0);
3379 Term
new = MkVarTerm();
3381 Bind_and_Trail(pt0,
new);
3383 Bind_and_Trail(VarOfTerm(
new), d1);
3384 if (Yap_rational_tree_loop(VarOfTerm(
new)-1,VarOfTerm(
new),(CELL **)AuxSp,(CELL **)AuxBase))
3388 if (d0 == d1)
continue;
3392 }
else if (IsVarTerm(d1)) {
3395 if (d0 == d1)
continue;
3396 else if (IsAtomOrIntTerm(d0)) {
3398 }
else if (IsPairTerm(d0)) {
3399 if (!IsPairTerm(d1)) {
3402#ifdef RATIONAL_TREES
3407 tovisit[1] = pt0_end;
3409 tovisit[3] = (CELL *)*pt0;
3410 tovisit[4] = (CELL *)write_mode;
3414 if (pt0 < pt0_end) {
3417 tovisit[1] = pt0_end;
3419 tovisit[3] = (CELL *)write_mode;
3422 write_mode = our_write_mode;
3423 pt0 = RepPair(d0) - 1;
3424 pt0_end = RepPair(d0) + 1;
3425 pt1 = RepPair(d1) - 1;
3427 }
else if (IsApplTerm(d0)) {
3429 register CELL *ap2, *ap3;
3430 if (!IsApplTerm(d1)) {
3441 if (IsExtensionFunctor(f)) {
3442 if (!unify_extension(f, d0, ap2, d1))
3446#ifdef RATIONAL_TREES
3451 tovisit[1] = pt0_end;
3453 tovisit[3] = (CELL *)*pt0;
3454 tovisit[4] = (CELL *)write_mode;
3458 if (pt0 < pt0_end) {
3461 tovisit[1] = pt0_end;
3463 tovisit[3] = (CELL *)write_mode;
3466 write_mode = our_write_mode;
3467 d0 = ArityOfFunctor(f);
3477 if (tovisit < (CELL **)ASP) {
3478#ifdef RATIONAL_TREES
3480 pt0_end = tovisit[1];
3482 *pt0 = (CELL)tovisit[3];
3483 write_mode = (Int)tovisit[ 4];
3487 pt0_end = tovisit[1];
3489 write_mode = (UInt)tovisit[3];
3497 while (TR != OLDTR) {
3499 CELL *pt1 = (CELL *) TrailTerm(--TR);
3500 RESET_VARIABLE(pt1);
3507#ifdef RATIONAL_TREES
3508 while (tovisit < (CELL **)ASP) {
3510 pt0_end = tovisit[1];
3512 *pt0 = (CELL)tovisit[3];
3517 while (TR != (tr_fr_ptr)OLDTR) {
3518 CELL *pt1 = (CELL *) TrailTerm(--TR);
3519 RESET_VARIABLE(pt1);
3526p_subsumes( USES_REGS1 )
3528 Term t1 = Deref(ARG1);
3529 Term t2 = Deref(ARG2);
3533 if (IsVarTerm(t1)) {
3534 YapBind(VarOfTerm(t1), t2);
3535 if (Yap_rational_tree_loop(VarOfTerm(t1)-1,VarOfTerm(t1),(CELL **)AuxSp,(CELL **)AuxBase))
3538 RESET_VARIABLE(VarOfTerm(t1));
3540 }
else if (IsVarTerm(t2))
3542 if (IsAtomOrIntTerm(t1)) {
3545 if (IsPairTerm(t1)) {
3546 if (IsPairTerm(t2)) {
3547 return(subsumes_complex(RepPair(t1)-1,
3549 RepPair(t2)-1 PASS_REGS));
3551 else return (FALSE);
3555 if (!IsApplTerm(t2))
return(FALSE);
3556 f1 = FunctorOfTerm(t1);
3557 if (f1 != FunctorOfTerm(t2))
3559 if (IsExtensionFunctor(f1)) {
3560 return(unify_extension(f1, t1, RepAppl(t1), t2));
3562 return(subsumes_complex(RepAppl(t1),
3563 RepAppl(t1)+ArityOfFunctor(f1),
3564 RepAppl(t2) PASS_REGS));
3569static int term_subsumer_complex(
register CELL *pt0,
register CELL *pt0_end,
register
3570 CELL *pt1, CELL *npt USES_REGS)
3572 register CELL **tovisit = (CELL **)ASP;
3573 tr_fr_ptr OLDTR = TR;
3575 CELL *bindings = NULL, *tbindings = NULL;
3579 while (pt0 < pt0_end) {
3580 register CELL d0, d1;
3589 }
else if (IsVarTerm(d0)) {
3590 CELL *
match, *omatch = NULL;
3592 match = VarOfTerm(d0);
3594 while (
match >= HB) {
3596 if (Yap_eq(d1,
match[1]) ) {
3610 HR[3] = (CELL)
match;
3611 omatch[3] = (CELL)HR;
3613 RESET_VARIABLE(npt);
3617 if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
3618 goto trail_overflow;
3624 YapBind(VarOfTerm(d0), (CELL)HR);
3626 RESET_VARIABLE(npt);
3629 }
else if (IsPairTerm(d0) && IsPairTerm(d1)) {
3630 CELL *
match = bindings;
3643 *tbindings = (CELL)HR;
3649 HR[2] = AbsPair(HR+4);
3653 *npt++ = AbsPair(HR);
3654#ifdef RATIONAL_TREES
3659 tovisit[1] = pt0_end;
3661 tovisit[3] = tbindings;
3665 if (pt0 < pt0_end) {
3668 tovisit[1] = pt0_end;
3673 pt0 = RepPair(d0) - 1;
3674 pt0_end = RepPair(d0) + 1;
3675 pt1 = RepPair(d1) - 1;
3678 if (HR > (CELL *)tovisit -1024)
3679 goto stack_overflow;
3681 }
else if (IsApplTerm(d0) && IsApplTerm(d1)) {
3682 CELL *ap2 = RepAppl(d0);
3683 CELL *ap3 = RepAppl(d1);
3687 CELL *
match = bindings;
3689 if (IsExtensionFunctor(f)) {
3690 if (unify_extension(f, d0, ap2, d1)) {
3706 *tbindings = (CELL)HR;
3712 HR[2] = AbsAppl(HR+4);
3716 *npt++ = AbsAppl(HR);
3717#ifdef RATIONAL_TREES
3722 tovisit[1] = pt0_end;
3724 tovisit[3] = tbindings;
3728 if (pt0 < pt0_end) {
3731 tovisit[1] = pt0_end;
3736 d0 = ArityOfFunctor(f);
3743 if (HR > (CELL *)tovisit -1024)
3744 goto stack_overflow;
3748 RESET_VARIABLE(npt);
3752 if (tovisit < (CELL **)ASP) {
3753#ifdef RATIONAL_TREES
3755 pt0_end = tovisit[1];
3757 tbindings = tovisit[3];
3765 pt0_end = tovisit[1];
3776 while (TR != OLDTR) {
3777 CELL *pt1 = (CELL *) TrailTerm(--TR);
3778 RESET_VARIABLE(pt1);
3794p_term_subsumer( USES_REGS1 )
3799 Term t1 = Deref(ARG1);
3800 Term t2 = Deref(ARG2);
3804 return Yap_unify(ARG3,t1);
3805 if (IsPairTerm(t1) && IsPairTerm(t2)) {
3806 Term tf = AbsAppl(HR);
3809 if ((out = term_subsumer_complex(RepPair(t1)-1,
3811 RepPair(t2)-1, HR-2 PASS_REGS)) > 0) {
3813 return Yap_unify(ARG3,tf);
3815 }
else if (IsApplTerm(t1) && IsApplTerm(t2)) {
3818 if ((f1 = FunctorOfTerm(t1)) == FunctorOfTerm(t2)) {
3819 if (IsExtensionFunctor(f1)) {
3820 if (unify_extension(f1, t1, RepAppl(t1), t2)) {
3821 return Yap_unify(ARG3,t1);
3824 Term tf = AbsAppl(HR);
3825 UInt ar = ArityOfFunctor(f1);
3829 if ((out = term_subsumer_complex(RepAppl(t1),
3830 RepAppl(t1)+ArityOfFunctor(f1),
3831 RepAppl(t2), HR-ar PASS_REGS)) > 0) {
3833 return Yap_unify(ARG3,tf);
3840 return Yap_unify(ARG3, MkVarTerm());
3844 if (!Yap_dogc(PASS_REGS1)) {
3845 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil,
"in term_subsumer");
3850 if (!Yap_growtrail(0, FALSE)) {
3851 Yap_ThrowError(RESOURCE_ERROR_TRAIL, TermNil,
"in term_subsumer");
3862p_force_trail_expansion( USES_REGS1 )
3864 Int i = IntOfTerm(Deref(ARG1))*1024, j = 0;
3867 for (j = 0; j < i; j++) {
3877camacho_dum( USES_REGS1 )
3885 t2 = MkPairTerm(MkIntegerTerm(max), t1);
3887 return(Yap_unify(t2, ARG1));
3895Yap_IsListTerm(Term t)
3898 Yap_SkipList(&t, &tailp);
3899 return *tailp == TermNil;
3903p_is_list( USES_REGS1 )
3905 return Yap_IsListTerm(Deref(ARG1));
3909Yap_IsListOrPartialListTerm(Term t)
3912 Yap_SkipList(&t, &tailp);
3914 return tail == TermNil || IsVarTerm(tail);
3918p_is_list_or_partial_list( USES_REGS1 )
3920 return Yap_IsListOrPartialListTerm(Deref(ARG1));
3924unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow,
int share USES_REGS)
3927 struct cp_frame *tovisit0, *tovisit = (
struct cp_frame *)Yap_PreAllocCodeSpace();
3936 while (pt0 < pt0_end) {
3938 register CELL *ptd0;
3942 deref_head(d0, unnumber_term_unk);
3945 if (IsPairTerm(d0)) {
3946 CELL *ap2 = RepPair(d0);
3947 if (ap2 >= HB && ap2 < HR) {
3954#ifdef RATIONAL_TREES
3955 if (tovisit+1 >= (
struct cp_frame *)AuxSp) {
3959 tovisit->pt0_end = pt0_end;
3961 tovisit->oldv = *pt0;
3962 tovisit->ground = ground;
3967 if (pt0 < pt0_end) {
3968 if (tovisit+1 >= (
struct cp_frame *)AuxSp) {
3972 tovisit->pt0_end = pt0_end;
3974 tovisit->ground = ground;
3983 if (HR > ASP - 2048) {
3986 }
else if (IsApplTerm(d0)) {
3991 if (ap2 >= HB && ap2 <= HR) {
3998 if (IsExtensionFunctor(f)) {
4002 if (f == FunctorDollarVar) {
4003 Int
id = IntegerOfTerm(ap2[1]);
4006 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil,
"unnumber vars cannot cope with VAR(-%d)",
id);
4010 if (ASP-(max+1) <= HR) {
4015 *ptf++ = ASP[-
id-1];
4017 RESET_VARIABLE(ptf);
4018 ASP[-
id-1] = (CELL)ptf;
4024 if (ASP-(
id+1) <= HR) {
4032 RESET_VARIABLE(ptf);
4033 ASP[-(
id+1)] = (CELL)ptf;
4040#ifdef RATIONAL_TREES
4041 if (tovisit+1 >= (
struct cp_frame *)AuxSp) {
4045 tovisit->pt0_end = pt0_end;
4047 tovisit->oldv = *pt0;
4048 tovisit->ground = ground;
4053 if (pt0 < pt0_end) {
4054 if (tovisit+1 >= (
struct cp_frame *)AuxSp) {
4058 tovisit->pt0_end = pt0_end;
4060 tovisit->ground = ground;
4064 ground = (f != FunctorMutable) && share;
4065 d0 = ArityOfFunctor(f);
4072 if (HR > ASP - 2048) {
4082 derefa_body(d0, ptd0, unnumber_term_unk, unnumber_term_nvar);
4085 *ptf++ = (CELL) ptd0;
4088 if (tovisit > tovisit0) {
4091 CELL old = tovisit->oldv;
4092 CELL *newp = tovisit->ptf-1;
4096 if (IsApplTerm(
new))
4102 pt0_end = tovisit->pt0_end;
4104#ifdef RATIONAL_TREES
4105 *pt0 = tovisit->oldv;
4107 ground = (ground && tovisit->ground);
4112 clean_dirty_tr(TR0 PASS_REGS);
4122#ifdef RATIONAL_TREES
4123 while (tovisit > tovisit0) {
4126 pt0_end = tovisit->pt0_end;
4128 *pt0 = tovisit->oldv;
4141#ifdef RATIONAL_TREES
4142 while (tovisit > tovisit0) {
4145 pt0_end = tovisit->pt0_end;
4146 ptf = tovisit->pt0_end;
4147 *pt0 = tovisit->oldv;
4151 LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)tovisit0;
4157UnnumberTerm(Term inp, UInt arity,
int share USES_REGS) {
4158 Term t = Deref(inp);
4163 }
else if (IsPrimitiveTerm(t)) {
4165 }
else if (IsPairTerm(t)) {
4177 if ((res = unnumber_complex_term(ap-1, ap+1, Hi, Hi, share PASS_REGS)) < 0) {
4179 if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
4195 f = FunctorOfTerm(t);
4200 HR += 1+ArityOfFunctor(f);
4203 if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L)
4209 if ((res = unnumber_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0, share PASS_REGS)) < 0) {
4211 if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
4214 }
else if (res && FunctorOfTerm(t) != FunctorMutable) {
4232unnumbervars( USES_REGS1 ) {
4234 return Yap_unify(UnnumberTerm(ARG1, 2, FALSE PASS_REGS), ARG2);
4239Yap_SkipList(Term *l, Term **tailp)
4245 do_derefa(v,l,derefa_unk,derefa_nonvar);
4248 if ( IsPairTerm(*l) )
4249 { intptr_t power = 1, lam = 0;
4251 {
if ( power == lam )
4259 do_derefa(v,l,derefa2_unk,derefa2_nonvar);
4260 }
while ( *l != *s && IsPairTerm(*l) );
4269p_skip_list( USES_REGS1 ) {
4271 Int len = Yap_SkipList(XREGS+2, &tail);
4273 return Yap_unify(MkIntegerTerm(len), ARG1) &&
4274 Yap_unify(*tail, ARG3);
4278p_skip_list4( USES_REGS1 ) {
4281 Term t2 = Deref(ARG2), t;
4283 if (!IsVarTerm(t2)) {
4284 if (!IsIntegerTerm(t2)) {
4285 Yap_ThrowError(TYPE_ERROR_INTEGER, t2,
"length/2");
4288 if ((len1 = IntegerOfTerm(t2)) < 0) {
4289 Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2,
"length/2");
4294 len = Yap_SkipList(XREGS+1, &tail);
4303 return Yap_unify_constant(ARG4, TermNil) &&
4304 Yap_unify_constant(ARG2, MkIntegerTerm(len));
4307 return Yap_unify(MkIntegerTerm(len), ARG3) &&
4312p_free_arguments( USES_REGS1 )
4314 Term t = Deref(ARG1);
4317 if (IsAtomTerm(t) || IsIntTerm(t))
4319 if (IsPairTerm(t)) {
4320 Term th = HeadOfTerm(t);
4321 Term tl = TailOfTerm(t);
4322 return IsVarTerm(th) && IsVarTerm(tl) && th != tl;
4328 if (IsExtensionFunctor(f))
4330 ar = ArityOfFunctor(f);
4331 for (i = 1 ; i <= ar; i++) {
4332 Term ta = ArgOfTerm(i, t);
4335 ret = IsVarTerm(ta);
4338 for (j = 1 ; j < i; j++) {
4339 ret = ArgOfTerm(j, t) != ta;
4349p_freshen_variables( USES_REGS1 )
4351 Term t = Deref(ARG1);
4353 UInt arity = ArityOfFunctor(f), i;
4354 Term tn = Yap_MkNewApplTerm(f, arity);
4355 CELL *src = RepAppl(t)+1;
4356 CELL *targ = RepAppl(tn)+1;
4357 for (i=0; i< arity; i++) {
4358 RESET_VARIABLE(targ);
4359 *VarOfTerm(*src) = (CELL)targ;
4367p_reset_variables( USES_REGS1 )
4369 Term t = Deref(ARG1);
4371 UInt arity = ArityOfFunctor(f), i;
4372 CELL *src = RepAppl(t)+1;
4374 for (i=0; i< arity; i++) {
4375 RESET_VARIABLE(VarOfTerm(*src));
4381void Yap_InitUtilCPreds(
void)
4384 Term cm = CurrentModule;
4388 Yap_InitCPred(
"_ground", 1, p_ground, SafePredFlag);
4396 Yap_InitCPred(
"$_variables_in_term", 3, p_variables_in_term, 0);
4398 Yap_InitCPred(
"$non_singletons_in_term", 3, p_non_singletons_in_term, 0);
4421 Yap_InitCPred(
"is_list", 1, p_is_list, SafePredFlag|TestPredFlag);
4422 Yap_InitCPred(
"$is_list_or_partial_list", 1, p_is_list_or_partial_list, SafePredFlag|TestPredFlag);
4423 Yap_InitCPred(
"rational_term_to_tree", 4, p_break_rational, 0);
4435 Yap_InitCPred(
"term_factorized", 3, p_break_rational3, 0);
4443 Yap_InitCPred(
"=@=", 2, p_variant, 0);
4445 Yap_InitCPred(
"unnumbervars", 2, unnumbervars, 0);
4446 Yap_InitCPred(
"varnumbers", 2, unnumbervars, 0);
4448 Yap_InitCPred(
"$skip_list", 3, p_skip_list, SafePredFlag|TestPredFlag);
4449 Yap_InitCPred(
"$skip_list", 4, p_skip_list4, SafePredFlag|TestPredFlag);
4450 Yap_InitCPred(
"$free_arguments", 1, p_free_arguments, TestPredFlag);
4451 CurrentModule = TERMS_MODULE;
4453 Yap_InitCPred(
"term_hash", 4, p_term_hash, 0);
4454 Yap_InitCPred(
"instantiated_term_hash", 4, p_instantiated_term_hash, 0);
4455 Yap_InitCPred(
"variant", 2, p_variant, 0);
4456 Yap_InitCPred(
"subsumes", 2, p_subsumes, 0);
4457 Yap_InitCPred(
"term_subsumer", 3, p_term_subsumer, 0);
4458 Yap_InitCPred(
"variables_within_term", 3, p_variables_within_term, 0);
4460 Yap_InitCPred(
"export_term", 3, p_export_term, 0);
4461 Yap_InitCPred(
"kill_exported_term", 1, p_kill_exported_term, SafePredFlag);
4462 Yap_InitCPred(
"import_term", 2, p_import_term, 0);
4463 Yap_InitCPred(
"freshen_variables", 1, p_freshen_variables, 0);
4464 Yap_InitCPred(
"reset_variables", 1, p_reset_variables, 0);
4467 Yap_InitCPred(
"$force_trail_expansion", 1, p_force_trail_expansion, SafePredFlag);
4468 Yap_InitCPred(
"dum", 1, camacho_dum, SafePredFlag);