19static char SccsId[] =
"%W% %G%";
55static int p_clean(
void);
56static int p_namelength(
void);
57static int p_getpid(
void);
58static int p_exit(
void);
59static int p_incrcounter(
void);
60static int p_setcounter(
void);
61static int p_trapsignal(
void);
62static int subsumes(Term, Term);
63static int p_subsumes(
void);
64static int p_grab_tokens(
void);
67static typedef int (*SignalProc)();
68static SignalProc skel_signal(
int, SignalProc);
69static int chdir(
char *);
73static int p_softfunctor(
void);
108 }
else if (IsPrimitiveTerm(
T)) {
110 }
else if (IsPairTerm(
T)) {
112 }
else if (IsApplTerm(
T)) {
114 unsigned int arity = ArityOfFunctor(FunctorOfTerm(
T));
116 for (i = 1; i <= arity; ++i)
129static int full_unification(T1, T2) Term T1, T2;
134 if (IsVarTerm(t2) || IsPrimitiveTerm(t2))
135 return (Yap_unify(T1, t2));
137 return (Yap_unify(T1, t2));
142 return (Yap_unify(T2, t1));
145 if (IsPrimitiveTerm(t1)) {
147 return (IsFloatTerm(t2) && FloatOfTerm(t1) == FloatOfTerm(t2));
148 else if (IsRefTerm(t1))
149 return (IsRefTerm(t2) && RefOfTerm(t1) == RefOfTerm(t2));
150 if (IsLongIntTerm(t1))
151 return (IsLongIntTerm(t2) && LongIntOfTerm(t1) == LongIntOfTerm(t2));
155 if (IsPairTerm(t1)) {
158 return (full_unification(HeadOfTermCell(t1), HeadOfTermCell(t2)) &&
159 full_unification(TailOfTermCell(t1), TailOfTermCell(t2)));
161 if (IsApplTerm(t1)) {
162 unsigned int i, arity;
165 if (FunctorOfTerm(t1) != FunctorOfTerm(t2))
167 arity = ArityOfFunctor(FunctorOfTerm(t1));
168 for (i = 1; i <= arity; ++i)
169 if (!full_unification(ArgOfTermCell(i, t1), ArgOfTerm(i, t2)))
178static int p_occurs_check() {
183static int p_unify() {
185 return (full_unification(ARG1, ARG2));
196static int p_counter() {
197 Term TCount, TNext, T1, T2;
205 if (IsVarTerm(T1) || !IsAtomTerm(T1))
209 TCount = Yap_GetValue(a);
210 if (!IsIntTerm(TCount))
212 Yap_unify_constant(ARG2, TCount);
213 val = IntOfTerm(TCount);
221 Yap_PutValue(a, TNext = MkIntTerm(val));
222 return (Yap_unify_constant(ARG3, TNext));
237static int p_iconcat() {
240 register Term *Tkp = Tkeep;
241 register Term L0, L1;
245 *Tkp++ = Unsigned(0);
252 *Tkp++ = HeadOfTerm(L0);
257 L1 = MkPairTerm(L0, L1);
259 return (Yap_unify(T2, ARG3));
263static int p_iconcat() {
264 register Term *Tkp = H, *tp;
265 register Term L0, L1;
273 *tp = AbsPair(++Tkp);
274 *Tkp++ = HeadOfTerm(L0);
277 *Tkp++ = Deref(ARG2);
280 return (Yap_unify(T2, ARG3));
296 unsigned int arity, i;
298 Term t1 = Deref(ARG1);
302 if (!(IsApplTerm(t1) && NameOfFunctor(FunctorOfTerm(t1)) == AtomFB))
304 arity = ArityOfFunctor(FunctorOfTerm(t1));
306 if (arity == SFArity) {
307 CELL *pt = H, *ntp = ArgsOfSFTerm(t1);
308 Term tn = AbsAppl(H);
309 *pt++ = FunctorOfTerm(t1);
312 while (*pt++ = *ntp++)
313 if ((*pt++ = *ntp++) == MkAtomTerm(AtomDollarUndef))
316 return (Yap_unify(tn, ARG2));
319 for (i = 1; i <= arity; ++i) {
320 if ((t = ArgOfTerm(i, t1)) == TermDollarU)
324 t = Yap_MkApplTerm(FunctorOfTerm(t1), arity, Args);
325 return (Yap_unify(ARG2, t));
328static Term *subs_table;
329static int subs_entries;
330#define SUBS_TABLE_SIZE 500
332static int subsumes(T1, T2) Term T1, T2;
341 for (i = 0; i < subs_entries; ++i)
342 if (subs_table[i] == T2)
346 for (i = 0; i < subs_entries; ++i)
347 if (subs_table[i] == T1) {
351 subs_table[subs_entries++] = T2;
356 for (i = 0; i < subs_entries; ++i)
357 if (subs_table[i] == T1)
359 subs_table[subs_entries++] = T1;
363 for (i = 0; i < subs_entries; ++i)
364 if (subs_table[i] == T2)
366 return (Yap_unify(T1, T2));
368 if (IsPrimitiveTerm(T1)) {
370 return (IsFloatTerm(T2) && FloatOfTerm(T1) == FloatOfTerm(T2));
371 else if (IsRefTerm(T1))
372 return (IsRefTerm(T2) && RefOfTerm(T1) == RefOfTerm(T2));
373 else if (IsLongIntTerm(T1))
374 return (IsLongIntTerm(T2) && LongIntOfTerm(T1) == LongIntOfTerm(T2));
378 if (IsPairTerm(T1)) {
381 return (subsumes(HeadOfTerm(T1), HeadOfTerm(T2)) &&
382 subsumes(TailOfTerm(T1), TailOfTerm(T2)));
384 if (IsApplTerm(T1)) {
388 if (FunctorOfTerm(T1) != FunctorOfTerm(T2))
390 arity = ArityOfFunctor(FunctorOfTerm(T1));
392 if (arity == SFArity) {
393 CELL *a1a = ArgsOfSFTerm(T1), *a2a = ArgsOfSFTerm(T2);
394 CELL *a1p = a1a - 1, *a2p = a2a - 1;
398 *pt++ = FunctorOfTerm(T1);
402 if (*a2a < *a1a || *a1a == 0) {
409 for (i = 0; i < subs_entries; ++i)
410 if (subs_table[i] == t2)
412 subs_table[subs_entries++] = t2;
416 if ((flags & 1) == 0) {
417 *a2p = Unsigned(a1p - 1);
419 *TR++ = Unsigned(a2p);
422 while ((*pt++ = *a1a++))
426 *TR++ = Unsigned(a1p);
429 *TR++ = Unsigned(a2p);
433 }
else if (*a2a > *a1a || *a2a == 0) {
438 for (i = 0; i < subs_entries; ++i)
439 if (subs_table[i] == t1)
441 if (i >= subs_entries)
442 subs_table[subs_entries++] = t1;
446 }
else if (*a1a == *a2a) {
454 if (!subsumes(t1, t2))
460 for (i = 1; i <= arity; ++i)
461 if (!subsumes(ArgOfTerm(i, T1), ArgOfTerm(i, T2)))
468static int p_subsumes() {
469 Term work_space[SUBS_TABLE_SIZE];
470 subs_table = work_space;
472 return (subsumes(Deref(ARG1), Deref(ARG2)));
475static int p_namelength() {
476 register Term t = Deref(ARG1);
483 Term tf = MkIntTerm(strlen(RepAtom(AtomOfTerm(t))->StrOfAE));
484 return (Yap_unify_constant(ARG2, tf));
485 }
else if (IsIntTerm(t)) {
486 register int i = 1, k = IntOfTerm(t);
492 return (Yap_unify_constant(ARG2, tf));
497static int p_getpid() {
499 Term t = MkIntTerm(getpid());
501 Term t = MkIntTerm(1);
503 return (Yap_unify_constant(ARG1, t));
507 register Term t = Deref(ARG1);
508 if (IsVarTerm(t) || !IsIntTerm(t))
510 Yap_exit((
int)IntOfTerm(t));
514static int current_pos;
516static int p_incrcounter() {
517 register Term t = Deref(ARG1);
518 if (IsVarTerm(t) || !IsIntTerm(t))
520 current_pos += IntOfTerm(t);
524static int p_setcounter() {
525 register Term t = Deref(ARG1);
526 if (IsVarTerm(t) || !IsIntTerm(t)) {
527 return (Yap_unify_constant(ARG1, MkIntTerm(current_pos)));
529 current_pos = IntOfTerm(t);
536#define signal(A, B) skel_signal(A, B)
543static int p_trapsignal(
void) {
545 signal(SIGINT, SIG_IGN);
550#define varstarter(ch) ((ch >= 'A' && ch <= 'Z') || ch == '_')
551#define idstarter(ch) (ch >= 'a' && ch <= 'z')
553 ((ch >= '0' && ch <= '9') || (ch >= 'A' && ch <= 'Z') || \
554 (ch >= 'a' && ch <= 'z') || ch == '_')
556static int p_grab_tokens() {
557 Term *p = ASP - 20, *p0, t;
559 char ch, IdChars[256], *chp;
561 IdFunctor = FunctorId;
562 VarFunctor = FunctorDollarVar;
564 ch = Yap_PlGetchar();
566 while (ch <=
' ' && ch != EOF)
567 ch = Yap_PlGetchar();
568 if (ch ==
'.' || ch == EOF)
571 while ((ch = Yap_PlGetchar()) != 10)
573 ch = Yap_PlGetchar();
579 ch = Yap_PlGetchar();
585 t = MkAtomTerm(Yap_LookupAtom(IdChars));
586 *p-- = Yap_MkApplTerm(IdFunctor, 1, &t);
587 ch = Yap_PlGetchar();
590 if (varstarter(ch)) {
594 ch = Yap_PlGetchar();
600 t = MkAtomTerm(Yap_LookupAtom(IdChars));
601 *p-- = Yap_MkApplTerm(VarFunctor, 1, &t);
608 ch = Yap_PlGetchar();
614 t = MkAtomTerm(Yap_LookupAtom(IdChars));
615 *p-- = Yap_MkApplTerm(IdFunctor, 1, &t);
620 *p-- = MkAtomTerm(Yap_LookupAtom(IdChars));
621 ch = Yap_PlGetchar();
623 t = MkAtomTerm(AtomNil);
625 t = MkPairTerm(*++p, t);
627 return (Yap_unify(ARG1, t));
634static p_softfunctor() {
639 Term t1 = Deref(ARG1);
640 Term t2 = Deref(ARG2);
647 WRITE_LOCK(RepAtom(a)->ARWLock);
648 if ((p0 = Yap_GetAProp(a, SFProperty)) == NIL) {
649 pe = (SFEntry *)Yap_AllocAtomSpace(
sizeof(*pe));
650 pe->KindOfPE = SFProperty;
651 AddPropToAtom(RepAtom(a), (
PropEntry *)pe);
654 WRITE_UNLOCK(RepAtom(a)->ARWLock);
655 pe->NilValue = nilvalue;
672void Yap_InitUserCPreds(
void) {
677 Yap_InitCPred(
"clean", 2, p_clean, SafePredFlag | SyncPredFlag);
678 Yap_InitCPred(
"name_length", 2, p_namelength, SafePredFlag | SyncPredFlag);
679 Yap_InitCPred(
"get_pid", 1, p_getpid, SafePredFlag);
680 Yap_InitCPred(
"exit", 1, p_exit, SafePredFlag | SyncPredFlag);
681 Yap_InitCPred(
"incr_counter", 1, p_incrcounter, SafePredFlag | SyncPredFlag);
682 Yap_InitCPred(
"set_counter", 1, p_setcounter, SafePredFlag | SyncPredFlag);
683 Yap_InitCPred(
"trap_signal", 0, p_trapsignal, SafePredFlag | SyncPredFlag);
684 Yap_InitCPred(
"mark2_grab_tokens", 1, p_grab_tokens,
685 SafePredFlag | SyncPredFlag);
686 Yap_InitCPred(
"subsumes", 2, p_subsumes, SafePredFlag);
689 Yap_InitCPred(
"sparse_functor", 2, p_softfunctor, SafePredFlag);
699void Yap_InitUserBacks(
void) {}
@ occurs_check
module_independent_operators
If you like being short, use T instead of YapTerm.