YAP 7.1.0
inlines.c
Go to the documentation of this file.
1/*************************************************************************
2* *
3* YAP Prolog *
4* *
5* Yap Prolog was developed at NCCUP - Universidade do Porto *
6* *
7* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8* *
9**************************************************************************
10* *
11* File: inlines.c *
12* Last rev: *
13* mods: *
14* comments: C-version for inline code used in meta-calls *
15* *
16*************************************************************************/
17
18
33#define IN_INLINES_C 1
34
35#include "absmi.h"
36
37#include "attvar.h"
38
39#include "cut_c.h"
40
41static Int p_atom( USES_REGS1 );
42static Int p_atomic( USES_REGS1 );
43static Int p_integer( USES_REGS1 );
44static Int p_nonvar( USES_REGS1 );
45static Int p_number( USES_REGS1 );
46static Int p_var( USES_REGS1 );
47static Int p_db_ref( USES_REGS1 );
48static Int p_primitive( USES_REGS1 );
49static Int p_compound( USES_REGS1 );
50static Int p_float( USES_REGS1 );
51static Int p_equal( USES_REGS1 );
52static Int p_dif( USES_REGS1 );
53static Int p_eq( USES_REGS1 );
54static Int p_arg( USES_REGS1 );
55static Int p_functor( USES_REGS1 );
56static Int p_fail( USES_REGS1 );
57static Int p_true( USES_REGS1 );
58
77static Int p_fail( USES_REGS1 )
78{
79 return false;
80}
81
103static Int p_true( USES_REGS1 )
104{
105 return true;
106}
107
108
116static Int
117p_atom( USES_REGS1 )
118{ /* atom(?) */
119 BEGD(d0);
120 d0 = ARG1;
121 deref_head(d0, atom_unk);
122 atom_nvar:
123 if (IsAtomTerm(d0) && !IsBlob(AtomOfTerm(d0))) {
124 return(TRUE);
125 }
126 else {
127 return(FALSE);
128 }
129
130 BEGP(pt0);
131 deref_body(d0, pt0, atom_unk, atom_nvar);
132 return(FALSE);
133 ENDP(pt0);
134 ENDD(d0);
135}
136
144static Int
145p_atomic( USES_REGS1 )
146{ /* atomic(?) */
147 BEGD(d0);
148 d0 = ARG1;
149 deref_head(d0, atomic_unk);
150 atomic_nvar:
151 if (IsAtomicTerm(d0)) {
152 return(TRUE);
153 }
154 else {
155 return(FALSE);
156 }
157
158 BEGP(pt0);
159 deref_body(d0, pt0, atomic_unk, atomic_nvar);
160 return(FALSE);
161 ENDP(pt0);
162 ENDD(d0);
163}
164
172static Int
173p_integer( USES_REGS1 )
174{ /* integer(?,?) */
175 BEGD(d0);
176 d0 = ARG1;
177 deref_head(d0, integer_unk);
178 integer_nvar:
179 if (IsIntTerm(d0)) {
180 return(TRUE);
181 }
182 if (IsApplTerm(d0)) {
183 Functor f0 = FunctorOfTerm(d0);
184 if (IsExtensionFunctor(f0)) {
185 switch ((CELL)f0) {
186 case (CELL)FunctorBigInt:
187 { CELL *pt = RepAppl(d0);
188 if ( pt[1] != BIG_INT ) {
189 return FALSE;
190 }
191 return TRUE;
192 }
193 case (CELL)FunctorLongInt:
194 return(TRUE);
195 default:
196 return(FALSE);
197 }
198 }
199 return(FALSE);
200 } else {
201 return(FALSE);
202 }
203
204 BEGP(pt0);
205 deref_body(d0, pt0, integer_unk, integer_nvar);
206 ENDP(pt0);
207 return(FALSE);
208 ENDD(d0);
209}
210
218static Int
219p_number( USES_REGS1 )
220{ /* number(?) */
221 BEGD(d0);
222 d0 = ARG1;
223 deref_head(d0, number_unk);
224 number_nvar:
225 if (IsIntTerm(d0)) {
226 return(TRUE);
227 }
228 if (IsApplTerm(d0)) {
229 Functor f0 = FunctorOfTerm(d0);
230 if (IsExtensionFunctor(f0)) {
231 switch ((CELL)f0) {
232 case (CELL)FunctorBigInt:
233 { CELL *pt = RepAppl(d0);
234 if ( pt[1] != BIG_RATIONAL && pt[1] != BIG_INT ) {
235 return FALSE;
236 }
237 return(TRUE);
238 }
239 case (CELL)FunctorLongInt:
240 case (CELL)FunctorDouble:
241 return(TRUE);
242 default:
243 return(FALSE);
244 }
245 }
246 return(FALSE);
247 } else {
248 return(FALSE);
249 }
250
251 BEGP(pt0);
252 deref_body(d0, pt0, number_unk, number_nvar);
253 return(FALSE);
254 ENDP(pt0);
255 ENDD(d0);
256}
257
265static Int
266p_db_ref( USES_REGS1 )
267{ /* db_reference(?,?) */
268 BEGD(d0);
269 d0 = ARG1;
270 deref_head(d0, db_ref_unk);
271 db_ref_nvar:
272 if (IsDBRefTerm(d0)) {
273 return(TRUE);
274 }
275 else {
276 return(FALSE);
277 }
278
279 BEGP(pt0);
280 deref_body(d0, pt0, db_ref_unk, db_ref_nvar);
281 return(FALSE);
282 ENDP(pt0);
283 ENDD(d0);
284}
285
293static Int
294p_primitive( USES_REGS1 )
295{ /* primitive(?) */
296 BEGD(d0);
297 d0 = ARG1;
298 deref_head(d0, primitive_unk);
299 primitive_nvar:
300 if (IsPrimitiveTerm(d0)) {
301 return(TRUE);
302 }
303 else {
304 return(FALSE);
305 }
306
307 BEGP(pt0);
308 deref_body(d0, pt0, primitive_unk, primitive_nvar);
309 return(FALSE);
310 ENDP(pt0);
311 ENDD(d0);
312}
313
321static Int
322p_float( USES_REGS1 )
323{ /* float(?) */
324 BEGD(d0);
325 d0 = ARG1;
326 deref_head(d0, float_unk);
327 float_nvar:
328 if (IsFloatTerm(d0)) {
329 return(TRUE);
330 }
331 else {
332 return(FALSE);
333 }
334
335 BEGP(pt0);
336 deref_body(d0, pt0, float_unk, float_nvar);
337 return(FALSE);
338 ENDP(pt0);
339 ENDD(d0);
340}
341
349static Int
350p_compound( USES_REGS1 )
351{ /* compound(?) */
352 BEGD(d0);
353 d0 = ARG1;
354 deref_head(d0, compound_unk);
355 compound_nvar:
356 if (IsPairTerm(d0)) {
357 return(TRUE);
358 }
359 else if (IsApplTerm(d0)) {
360 if (IsExtensionFunctor(FunctorOfTerm(d0))) {
361 return(FALSE);
362 }
363 return(TRUE);
364 }
365 else {
366 return(FALSE);
367 }
368
369 BEGP(pt0);
370 deref_body(d0, pt0, compound_unk, compound_nvar);
371 return(FALSE);
372 ENDP(pt0);
373 ENDD(d0);
374}
375
383static Int
384p_nonvar( USES_REGS1 )
385{ /* nonvar(?) */
386 BEGD(d0);
387 d0 = ARG1;
388 deref_head(d0, nonvar_unk);
389 nonvar_nvar:
390 return(TRUE);
391
392 BEGP(pt0);
393 deref_body(d0, pt0, nonvar_unk, nonvar_nvar);
394 return(FALSE);
395 ENDP(pt0);
396 ENDD(d0);
397}
398
406static Int
407p_var( USES_REGS1 )
408{ /* var(?) */
409 BEGD(d0);
410 d0 = ARG1;
411 deref_head(d0, var_unk);
412 var_nvar:
413 return(FALSE);
414
415 BEGP(pt0);
416 deref_body(d0, pt0, var_unk, var_nvar);
417 return(TRUE);
418 ENDP(pt0);
419 ENDD(d0);
420}
421
429static Int
430p_equal( USES_REGS1 )
431{ /* ?=? */
432 return(Yap_IUnify(ARG1, ARG2));
433}
434
435static Int
436eq(Term t1, Term t2 USES_REGS)
437{ /* ? == ? */
438 BEGD(d0);
439 d0 = t1;
440 deref_head(d0, p_eq_unk1);
441 p_eq_nvar1:
442 /* first argument is bound */
443 BEGD(d1);
444 d1 = t2;
445 deref_head(d1, p_eq_nvar1_unk2);
446 p_eq_nvar1_nvar2:
447 /* both arguments are bound */
448 if (d0 == d1) {
449 return(TRUE);
450 }
451 if (IsPairTerm(d0)) {
452 if (!IsPairTerm(d1)) {
453 return false;
454 }
455 return(iequ_complex(RepPair(d0)-1, RepPair(d0)+1,RepPair(d1)-1));
456 }
457 if (IsApplTerm(d0)) {
458 Functor f0 = FunctorOfTerm(d0);
459 Functor f1;
460 if (!IsApplTerm(d1)) {
461 return false;
462 }
463 f1 = FunctorOfTerm(d1);
464 if (f0 != f1) {
465 return false;
466 }
467 if (IsExtensionFunctor(f0)) {
468 switch ((CELL)f0) {
469 case (CELL)FunctorDBRef:
470 return (d0 == d1);
471 case (CELL)FunctorLongInt:
472 return(LongIntOfTerm(d0) == LongIntOfTerm(d1));
473 case (CELL)FunctorString:
474 return(strcmp((char *)StringOfTerm(d0), (char *)StringOfTerm(d1)) == 0);
475#ifdef USE_GMP
476 case (CELL)FunctorBigInt:
477 return (Yap_gmp_tcmp_big_big(d0, d1) == 0);
478#endif
479 case (CELL)FunctorDouble:
480 return(FloatOfTerm(d0) == FloatOfTerm(d1));
481 default:
482 return(FALSE);
483 }
484 }
485 return(iequ_complex(RepAppl(d0), RepAppl(d0)+ArityOfFunctor(f0), RepAppl(d1)));
486 }
487 return(FALSE);
488
489 BEGP(pt0);
490 deref_body(d1, pt0, p_eq_nvar1_unk2, p_eq_nvar1_nvar2);
491 if (IsAttVar(pt0)) {
492 AddCompareToQueue(TermEq, d0, d1);
493 return true;
494 }
495 ENDP(pt0);
496 /* first argument is bound */
497 /* second argument is unbound */
498 /* I don't need to worry about co-routining because an
499 unbound variable may never be == to a constrained variable!! */
500 return(FALSE);
501 ENDD(d1);
502
503 BEGP(pt0);
504 deref_body(d0, pt0, p_eq_unk1, p_eq_nvar1);
505 BEGD(d1);
506 d1 = ARG2;
507 deref_head(d1, p_eq_var1_unk2);
508 p_eq_var1_nvar2:
509if (IsAttVar(pt0)) {
510 AddCompareToQueue(TermEq, d0, d1);
511 return true;
512 }
513 /* I don't need to worry about co-routining because an
514 unbound variable may never be == to a constrained variable!! */
515 return(FALSE);
516
517 BEGP(pt1);
518 deref_body(d1, pt1, p_eq_var1_unk2, p_eq_var1_nvar2);
519 /* first argument is unbound */
520 /* second argument is unbound */
521 if ((IsAttVar(pt0)||IsAttVar(pt1)) && pt1!=pt0) {
522 AddCompareToQueue(TermEq, d0, d1);
523 return true;
524 }
525 return(pt1 == pt0);
526 ENDP(pt1);
527 ENDD(d1);
528 ENDP(pt0);
529
530 ENDD(d0);
531}
532
533
534
564static Int
565p_eq( USES_REGS1 )
566{ /* ? == ? */
567 return eq(ARG1,ARG2 PASS_REGS);
568}
569
570int
571Yap_eq(Term t1, Term t2)
572{ /* ? == ? */
573 CACHE_REGS
574 return eq(t1,t2 PASS_REGS);
575}
576
584static Int
585p_dif( USES_REGS1 )
586{ /* ? \= ? */
587#if SHADOW_HB
588 register CELL *HBREG = HB;
589#endif
590 BEGD(d0);
591 BEGD(d1);
592 d0 = ARG1;
593 deref_head(d0, dif_unk1);
594 dif_nvar1:
595 /* first argument is bound */
596 d1 = ARG2;
597 deref_head(d1, dif_nvar1_unk2);
598 dif_nvar1_nvar2:
599 /* both arguments are bound */
600 if (d0 == d1) {
601 return FALSE;
602 }
603 if (IsAtomOrIntTerm(d0) || IsAtomOrIntTerm(d1)) {
604 return TRUE;
605 } else {
606#ifdef COROUTINING
607 /*
608 * We may wake up goals during our attempt to unify the
609 * two terms. If we are adding to the tail of a list of
610 * woken goals that should be ok, but otherwise we need
611 * to restore LOCAL_WokenGoals to its previous value.
612 */
613 LOCAL_DoNotWakeUp = true;
614#endif
615 register tr_fr_ptr pt0;
616 /* store the old value of TR for clearing bindings */
617 pt0 = TR;
618 BEGCHO(pt1);
619 pt1 = B;
620 /* make B and HB point to H to guarantee all bindings will
621 * be trailed
622 */
623 HBREG = HR;
624 B = (choiceptr) HR;
625 B->cp_h = HR;
626 SET_BB(B);
627 save_hb();
628 d0 = Yap_IUnify(d0, d1);
629#ifdef COROUTINING
630 LOCAL_DoNotWakeUp = false;
631#endif
632 /* restore B */
633 B = pt1;
634 SET_BB(PROTECT_FROZEN_B(pt1));
635#ifdef COROUTINING
636 HR = HBREG;
637#endif
638 HBREG = B->cp_h;
639 /* untrail all bindings made by Yap_IUnify */
640 while (TR != pt0) {
641 BEGD(d1);
642 d1 = TrailTerm(--TR);
643 if (IsVarTerm(d1)) {
644#if defined(YAPOR_SBA) && defined(YAPOR)
645 /* clean up the trail when we backtrack */
646 if (Unsigned((Int)(d1)-(Int)(H_FZ)) >
647 Unsigned((Int)(B_FZ)-(Int)(H_FZ))) {
648 RESET_VARIABLE(STACK_TO_SBA(d1));
649 } else
650#endif
651 /* normal variable */
652 RESET_VARIABLE(d1);
653#ifdef MULTI_ASSIGNMENT_VARIABLES
654 } else /* if (IsApplTerm(d1)) */ {
655 CELL *pt = RepAppl(d1);
656 /* AbsAppl means */
657 /* multi-assignment variable */
658 /* so the next cell is the old value */
659#ifdef FROZEN_STACKS
660 pt[0] = TrailVal(--TR);
661#else
662 pt[0] = TrailTerm(--TR);
663 TR--;
664#endif /* FROZEN_STACKS */
665#endif /* MULTI_ASSIGNMENT_VARIABLES */
666 }
667 ENDD(d1);
668 }
669 return !d0;
670 ENDP(pt0);
671 }
672
673 BEGP(pt0);
674 deref_body(d0, pt0, dif_unk1, dif_nvar1);
675 ENDP(pt0);
676 /* first argument is unbound */
677 return FALSE;
678
679 BEGP(pt0);
680 deref_body(d1, pt0, dif_nvar1_unk2, dif_nvar1_nvar2);
681 ENDP(pt0);
682 /* second argument is unbound */
683 return FALSE;
684 ENDD(d1);
685 ENDD(d0);
686}
687
688
702static Int
703p_arg( USES_REGS1 )
704{ /* arg(?,?,?) */
705#if SHADOW_HB
706 register CELL *HBREG = HB;
707#endif
708 BEGD(d0);
709 d0 = ARG1;
710 deref_head(d0, arg_arg1_unk);
711 arg_arg1_nvar:
712 /* ARG1 is ok! */
713 if (IsIntTerm(d0))
714 d0 = IntOfTerm(d0);
715 else if (IsLongIntTerm(d0)) {
716 d0 = LongIntOfTerm(d0);
717 } else {
718 if (!IsBigIntTerm( d0 ))
719 Yap_Error(TYPE_ERROR_INTEGER,d0,"arg 1 of arg/3");
720 return(FALSE);
721 }
722
723 /* d0 now got the argument we want */
724 BEGD(d1);
725 d1 = ARG2;
726 deref_head(d1, arg_arg2_unk);
727 arg_arg2_nvar:
728 /* d1 now got the structure we want to fetch the argument
729 * from */
730 if (IsApplTerm(d1)) {
731 BEGP(pt0);
732 pt0 = RepAppl(d1);
733 d1 = *pt0;
734 if (IsExtensionFunctor((Functor) d1)) {
735 Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
736 return(FALSE);
737 }
738 save_hb();
739 if ((Int)d0 <= 0 ||
740 (Int)d0 > ArityOfFunctor((Functor) d1) ||
741 Yap_IUnify(pt0[d0], ARG3) == FALSE) {
742 /* don't complain here for Prolog compatibility
743 if ((Int)d0 <= 0) {
744 Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
745 MkIntegerTerm(d0),"arg 1 of arg/3");
746 }
747 */
748 return(FALSE);
749 }
750 return(TRUE);
751 ENDP(pt0);
752 }
753 else if (IsPairTerm(d1)) {
754 BEGP(pt0);
755 pt0 = RepPair(d1);
756 if (d0 == 1) {
757 save_hb();
758 if (Yap_IUnify((CELL)pt0, ARG3) == FALSE) {
759 return(FALSE);
760 }
761 return(TRUE);
762 }
763 else if (d0 == 2) {
764 save_hb();
765 if (Yap_IUnify((CELL)(pt0+1), ARG3) == FALSE) {
766 return(FALSE);
767 }
768 return(TRUE);
769 }
770 else {
771 if ((Int)d0 < 0)
772 Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
773 MkIntegerTerm(d0),"arg 1 of arg/3");
774 return(FALSE);
775 }
776 ENDP(pt0);
777 }
778 else {
779 Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
780 return(FALSE);
781 }
782
783 BEGP(pt0);
784 deref_body(d1, pt0, arg_arg2_unk, arg_arg2_nvar);
785 Yap_Error(INSTANTIATION_ERROR,(CELL)pt0,"arg 2 of arg/3");;
786 ENDP(pt0);
787 return(FALSE);
788 ENDD(d1);
789
790 BEGP(pt0);
791 deref_body(d0, pt0, arg_arg1_unk, arg_arg1_nvar);
792 Yap_Error(INSTANTIATION_ERROR,(CELL)pt0,"arg 1 of arg/3");;
793 ENDP(pt0);
794 return(FALSE);
795 ENDD(d0);
796
797}
798
819static Int
820p_functor( USES_REGS1 ) /* functor(?,?,?) */
821{
822#if SHADOW_HB
823 register CELL *HBREG;
824#endif
825
826 restart:
827#if SHADOW_HB
828 HBREG = HB;
829#endif
830 BEGD(d0);
831 d0 = ARG1;
832 deref_head(d0, func_unk);
833 func_nvar:
834 /* A1 is bound */
835 BEGD(d1);
836 if (IsApplTerm(d0)) {
837 d1 = *RepAppl(d0);
838 if (IsExtensionFunctor((Functor) d1)) {
839 if (d1 == (CELL)FunctorDouble) {
840 d1 = MkIntTerm(0);
841 } else if (d1 == (CELL)FunctorLongInt) {
842 d1 = MkIntTerm(0);
843 } else if (d1 == (CELL)FunctorString) {
844 d1 = MkIntTerm(0);
845 } else
846 return(FALSE);
847 } else {
848 d0 = MkAtomTerm(NameOfFunctor((Functor) d1));
849 d1 = MkIntTerm(ArityOfFunctor((Functor) d1));
850 }
851 }
852 else if (IsPairTerm(d0)) {
853 d0 = TermDot;
854 d1 = MkIntTerm(2);
855 }
856 else {
857 d1 = MkIntTerm(0);
858 }
859 /* d1 and d0 now have the two arguments */
860 /* let's go and bind them */
861 {
862 register CELL arity = d1;
863
864 d1 = ARG2;
865 deref_head(d1, func_nvar_unk);
866 func_nvar_nvar:
867 /* A2 was bound */
868 if (d0 != d1) {
869 return(FALSE);
870 }
871 /* have to buffer ENDP and label */
872 d0 = arity;
873 goto func_bind_x3;
874
875 BEGP(pt0);
876 deref_body(d1, pt0, func_nvar_unk, func_nvar_nvar);
877 /* A2 is a variable, go and bind it */
878 YapBind(pt0, d0);
879 /* have to buffer ENDP and label */
880 d0 = arity;
881 ENDP(pt0);
882 /* now let's process A3 */
883
884 func_bind_x3:
885 d1 = ARG3;
886 deref_head(d1, func_nvar3_unk);
887 func_nvar3_nvar:
888 /* A3 was bound */
889 if (d0 != d1) {
890 return(FALSE);
891 }
892 /* Done */
893 return(TRUE);
894
895
896 BEGP(pt0);
897 deref_body(d1, pt0, func_nvar3_unk, func_nvar3_nvar);
898 /* A3 is a variable, go and bind it */
899 YapBind(pt0, d0);
900 return(TRUE);
901
902 ENDP(pt0);
903
904 }
905 ENDD(d1);
906
907 BEGP(pt0);
908 deref_body(d0, pt0, func_unk, func_nvar);
909 /* A1 is a variable */
910 /* We have to build the structure */
911 d0 = ARG2;
912 deref_head(d0, func_var_2unk);
913 func_var_2nvar:
914 /* we do, let's get the third argument */
915 BEGD(d1);
916 d1 = ARG3;
917 deref_head(d1, func_var_3unk);
918 func_var_3nvar:
919 /* Uuuff, the second and third argument are bound */
920 if (IsIntegerTerm(d1))
921 d1 = IntegerOfTerm(d1);
922 else {
923 if (IsBigIntTerm(d1)) {
924 Yap_Error(RESOURCE_ERROR_STACK, ARG3, "functor/3");
925 } else {
926 Yap_Error(TYPE_ERROR_INTEGER,ARG3,"functor/3");
927 }
928 return(FALSE);
929 }
930 if (!IsAtomicTerm(d0)) {
931 Yap_Error(TYPE_ERROR_ATOMIC,d0,"functor/3");
932 return(FALSE);
933 }
934 /* We made it!!!!! we got in d0 the name, in d1 the arity and
935 * in pt0 the variable to bind it to. */
936 if (d0 == TermDot && d1 == 2) {
937 RESET_VARIABLE(HR);
938 RESET_VARIABLE(HR+1);
939 d0 = AbsPair(HR);
940 HR += 2;
941 }
942 else if ((Int)d1 > 0) {
943 /* now let's build a compound term */
944 if (!IsAtomTerm(d0)) {
945 Yap_Error(TYPE_ERROR_ATOM,d0,"functor/3");
946 return(FALSE);
947 }
948 BEGP(pt1);
949 if (!IsAtomTerm(d0)) {
950 return(FALSE);
951 }
952 else
953 d0 = (CELL) Yap_MkFunctor(AtomOfTerm(d0), (Int) d1);
954 pt1 = HR;
955 *pt1++ = d0;
956 d0 = AbsAppl(HR);
957 while (pt1+d1 > ENV - StackGap( PASS_REGS1 )) {
958 if (!Yap_dogc()) {
959 Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
960 return FALSE;
961 }
962 goto restart;
963 }
964 while (d1-- > 0) {
965 RESET_VARIABLE(pt1);
966 pt1++;
967 }
968 /* done building the term */
969 HR = pt1;
970 ENDP(pt1);
971 } else if ((Int)d1 < 0) {
972 Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,MkIntegerTerm(d1),"functor/3");
973 return(FALSE);
974 }
975 /* else if arity is 0 just pass d0 through */
976 /* Ding, ding, we made it */
977 YapBind(pt0, d0);
978 return(TRUE);
979
980
981 BEGP(pt1);
982 deref_body(d1, pt1, func_var_3unk, func_var_3nvar);
983 Yap_ThrowError(INSTANTIATION_ERROR,(CELL)pt1,"functor/3");
984 ENDP(pt1);
985 /* Oops, third argument was unbound */
986 return false;
987 ENDD(d1);
988
989 BEGP(pt1);
990
991 deref_body(d0, pt1, func_var_2unk, func_var_2nvar);
992 Yap_ThrowError(INSTANTIATION_ERROR,(CELL)pt1,"functor/3");
993 ENDP(pt1);
994 /* Oops, second argument was unbound too */
995 return(FALSE);
996 ENDP(pt0);
997 ENDD(d0);
998}
999
1000static Term
1001cp_as_integer(choiceptr cp USES_REGS)
1002{
1003 return(MkIntegerTerm(LCL0-(CELL *)cp));
1004}
1005
1006
1007static Int
1008p_cut_by( USES_REGS1 )
1009{
1010 BEGD(d0);
1011 d0 = ARG1;
1012 deref_head(d0, cutby_x_unk);
1013 cutby_x_nvar:
1014#if YAPOR_SBA
1015 if (!IsIntegerTerm(d0)) {
1016#else
1017 if (!IsIntTerm(d0)) {
1018#endif
1019 return(FALSE);
1020 }
1021 BEGCHO(pt0);
1022#if YAPOR_SBA
1023 pt0 = (choiceptr)IntegerOfTerm(d0);
1024#else
1025 pt0 = (choiceptr)(LCL0-IntOfTerm(d0));
1026#endif
1027 {
1028 while (POP_CHOICE_POINT(pt0))
1029 {
1030 POP_EXECUTE();
1031 }
1032 }
1033#ifdef YAPOR
1034 CUT_prune_to(pt0);
1035#endif /* YAPOR */
1036 /* find where to cut to */
1037 if (pt0 > B) {
1038 /* Wow, we're gonna cut!!! */
1039#ifdef TABLING
1040 while (B->cp_b < pt0) {
1041 B = B->cp_b;
1042 }
1043 abolish_incomplete_subgoals(B);
1044#endif /* TABLING */
1045 B = pt0;
1046 HB = B->cp_h;
1047 Yap_TrimTrail();
1048 }
1049 ENDCHO(pt0);
1050 return(TRUE);
1051
1052 BEGP(pt0);
1053 deref_body(d0, pt0, cutby_x_unk, cutby_x_nvar);
1054 /* never cut to a variable */
1055 /* Abort */
1056 return(FALSE);
1057 ENDP(pt0);
1058 ENDD(d0);
1059}
1060
1061static Int
1062p_erroneous_call( USES_REGS1 )
1063{
1064 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "bad call to internal built-in");
1065 return(FALSE);
1066}
1067
1076static Int current_choice_point(USES_REGS1)
1077{
1078 Term t = Deref(ARG1);
1079 Term td;
1080#if SHADOW_HB
1081 register CELL *HBREG = HB;
1082#endif
1083 if (!IsVarTerm(t))
1084 return false;
1085 choiceptr b = B;
1086 while (b && b->cp_ap == TRUSTFAILCODE && b->cp_b)
1087 b = b->cp_b;
1088 td = cp_as_integer(b PASS_REGS);
1089 YapBind((CELL *)t, td);
1090 return true;
1091}
1092
1094
1118 static Int
1119 genarg( USES_REGS1 )
1120 { /* getarg(?Atom) */
1121 Term t0 = Deref(ARG1);
1122 Term t1 = Deref(ARG2);
1123 CELL *pt, *end;
1124 int res;
1125 UInt arity;
1126
1127 if (!IsVarTerm(t0)) {
1128 res = p_arg( PASS_REGS1 );
1129 if (res) {
1130 cut_succeed();
1131 } else {
1132 cut_fail();
1133 }
1134 }
1135 if (IsVarTerm(t1)) {
1136 Yap_Error(INSTANTIATION_ERROR,t1,"genarg/3");
1137 return FALSE;
1138 }
1139 if (IsPrimitiveTerm(t1)) {
1140 Yap_Error(TYPE_ERROR_COMPOUND,t1,"genarg/3");
1141 return FALSE;
1142 }
1143 if (IsPairTerm(t1)) {
1144 pt = RepPair(t1);
1145 end = RepPair(t1)+1;
1146 arity = 2;
1147 } else {
1148 arity = ArityOfFunctor(FunctorOfTerm(t1));
1149 pt = RepAppl(t1);
1150 end = pt+arity;
1151 pt += 1;
1152 }
1153 res = Yap_unify(ARG1,MkIntTerm(1)) &&
1154 Yap_unify(ARG3,pt[0]);
1155 if (arity == 1) {
1156 if (res) {
1157 cut_succeed();
1158 } else {
1159 cut_fail();
1160 }
1161 }
1162 EXTRA_CBACK_ARG(3,1) = (Term)(pt+1);
1163 EXTRA_CBACK_ARG(3,2) = (Term)(end);
1164 EXTRA_CBACK_ARG(3,3) = MkIntegerTerm(arity);
1165 return res;
1166}
1167
1168static Int
1169cont_genarg( USES_REGS1 )
1170{ /* genarg(?Atom) */
1171 CELL *pt, *end;
1172 int res;
1173 UInt arity;
1174
1175 pt = (CELL *)EXTRA_CBACK_ARG(3,1);
1176 end = (CELL *)EXTRA_CBACK_ARG(3,2);
1177 arity = IntegerOfTerm(EXTRA_CBACK_ARG(3,3));
1178 if (pt == end) {
1179 res = Yap_unify(ARG1,MkIntegerTerm(arity)) &&
1180 Yap_unify(ARG3,pt[0]);
1181 if (res) {
1182 cut_succeed();
1183 } else {
1184 cut_fail();
1185 }
1186 }
1187 EXTRA_CBACK_ARG(3,1) = (Term)(pt+1);
1188 return Yap_unify(ARG1,MkIntegerTerm(arity-(end-pt))) &&
1189 Yap_unify(ARG3,pt[0]);
1190}
1191
1192
1193 void
1194 Yap_InitInlines(void)
1195 {
1196 CACHE_REGS
1197 Term cm = CurrentModule;
1198 Yap_InitAsmPred("cut_by", 1, _cut_by, p_cut_by, SafePredFlag);
1199 Yap_InitAsmPred("current_choice_point", 1, _save_by, current_choice_point, SafePredFlag);
1200 Yap_InitAsmPred("atom", 1, _atom, p_atom, SafePredFlag);
1201 Yap_InitAsmPred("atomic", 1, _atomic, p_atomic, SafePredFlag);
1202 Yap_InitAsmPred("integer", 1, _integer, p_integer, SafePredFlag);
1203 Yap_InitAsmPred("nonvar", 1, _nonvar, p_nonvar, SafePredFlag);
1204 Yap_InitAsmPred("number", 1, _number, p_number, SafePredFlag);
1205 Yap_InitAsmPred("var", 1, _var, p_var, SafePredFlag);
1206 Yap_InitAsmPred("db_reference", 1, _db_ref, p_db_ref, SafePredFlag);
1207 Yap_InitAsmPred("primitive", 1, _primitive, p_primitive, SafePredFlag);
1208 Yap_InitAsmPred("compound", 1, _compound, p_compound, SafePredFlag);
1209 Yap_InitAsmPred("float", 1, _float, p_float, SafePredFlag);
1210 Yap_InitAsmPred("=", 2, _equal, p_equal, SafePredFlag);
1211#if INLINE_BIG_COMPARISONS
1212 Yap_InitAsmPred("\\=", 2, _dif, p_dif, SafePredFlag|TestPredFlag);
1213 Yap_InitAsmPred("==", 2, _eq, p_eq, SafePredFlag|TestPredFlag);
1214#else
1215 Yap_InitCPred("\\=", 2, p_dif, SafePredFlag);
1216 Yap_InitCPred("==", 2, p_eq, SafePredFlag);
1217#endif
1218 Yap_InitAsmPred("arg", 3, _arg, p_arg, SafePredFlag);
1219 Yap_InitAsmPred("functor", 3, _functor, p_functor, 0);
1220 Yap_InitAsmPred("$label_ctl", 2, _p_label_ctl, p_erroneous_call, SafePredFlag);
1221 CurrentModule = ARG_MODULE;
1222 Yap_InitCPredBack("genarg", 3, 3, genarg, cont_genarg,SafePredFlag);
1223 CurrentModule = cm;
1224 Yap_InitCPred("true", 0, p_true, SafePredFlag);
1225 Yap_InitCPred("otherwise", 0, p_true, SafePredFlag);
1226 Yap_InitCPred("false", 0, p_fail, SafePredFlag);
1227 Yap_InitCPred("fail", 0, p_fail, SafePredFlag);
1228}
1229