diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'new_atts'

Browse Source
This commit is contained in:
Vitor Santos Costa 2010-03-15 15:05:42 +00:00
commit 3c6a4435d8
45 changed files with 1635 additions and 1761 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

216
C/absmi.c
View File

@ -2039,7 +2039,7 @@ Yap_absmi(int inp)
goto failloop;
} else
#endif /* FROZEN_STACKS */
if (IN_BETWEEN(Yap_GlobalBase, pt1, H0))
if (IsAttVar(pt1))
goto failloop;
flags = *pt1;
#if defined(YAPOR) || defined(THREADS)
@ -3278,7 +3278,7 @@ Yap_absmi(int inp)
BIND_AND_JUMP(pt0, d0);
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
#endif
GONext();
@ -3299,7 +3299,7 @@ Yap_absmi(int inp)
BIND(pt0, d1, bind_gvalx_var_nonvar);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_gvalx_var_nonvar:
#endif
GONext();
@ -3311,14 +3311,14 @@ Yap_absmi(int inp)
UnifyCells(pt0, pt1, uc1, uc2);
#ifdef COROUTINING
DO_TRAIL(pt0, (CELL)pt1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
uc1:
#endif
GONext();
#ifdef COROUTINING
uc2:
DO_TRAIL(pt1, (CELL)pt0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
GONext();
#endif
ENDP(pt1);
@ -3360,7 +3360,7 @@ Yap_absmi(int inp)
BIND(pt1, d0, bind_gvaly_nonvar_var);
#ifdef COROUTINING
DO_TRAIL(pt1, d0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
bind_gvaly_nonvar_var:
#endif
GONext();
@ -3379,7 +3379,7 @@ Yap_absmi(int inp)
BIND(pt0, d1, bind_gvaly_var_nonvar);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_gvaly_var_nonvar:
#endif
GONext();
@ -3391,14 +3391,14 @@ Yap_absmi(int inp)
UnifyCells(pt0, pt1, uc3, uc4);
#ifdef COROUTINING
DO_TRAIL(pt0, (CELL)pt1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
uc3:
#endif
GONext();
#ifdef COROUTINING
uc4:
DO_TRAIL(pt1, (CELL)pt0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
GONext();
#endif
ENDP(pt1);
@ -3432,7 +3432,7 @@ Yap_absmi(int inp)
BIND(pt0, d1, bind_gatom);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_gatom:
#endif
GONext();
@ -3463,7 +3463,7 @@ Yap_absmi(int inp)
BIND(pt0, PREG->u.cc.c1, gatom_2b);
#ifdef COROUTINING
DO_TRAIL(pt0, PREG->u.cc.c1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
#endif
ENDP(pt0);
gatom_2b:
@ -3489,7 +3489,7 @@ Yap_absmi(int inp)
BIND(pt0, d1, gatom_2c);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
gatom_2c:
#endif
GONext();
@ -3520,7 +3520,7 @@ Yap_absmi(int inp)
BIND(pt0, PREG->u.ccc.c1, gatom_3b);
#ifdef COROUTINING
DO_TRAIL(pt0, PREG->u.ccc.c1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
#endif
ENDP(pt0);
gatom_3b:
@ -3543,7 +3543,7 @@ Yap_absmi(int inp)
BIND(pt0, PREG->u.ccc.c2, gatom_3c);
#ifdef COROUTINING
DO_TRAIL(pt0, PREG->u.ccc.c2);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
#endif
ENDP(pt0);
gatom_3c:
@ -3569,7 +3569,7 @@ Yap_absmi(int inp)
BIND(pt0, d1, gatom_3d);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
gatom_3d:
#endif
GONext();
@ -3600,7 +3600,7 @@ Yap_absmi(int inp)
BIND(pt0, PREG->u.cccc.c1, gatom_4b);
#ifdef COROUTINING
DO_TRAIL(pt0, PREG->u.cccc.c1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
#endif
ENDP(pt0);
gatom_4b:
@ -3623,7 +3623,7 @@ Yap_absmi(int inp)
BIND(pt0, PREG->u.cccc.c2, gatom_4c);
#ifdef COROUTINING
DO_TRAIL(pt0, PREG->u.cccc.c2);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
#endif
ENDP(pt0);
gatom_4c:
@ -3646,7 +3646,7 @@ Yap_absmi(int inp)
BIND(pt0, PREG->u.cccc.c3, gatom_4d);
#ifdef COROUTINING
DO_TRAIL(pt0, PREG->u.cccc.c3);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
#endif
ENDP(pt0);
gatom_4d:
@ -3672,7 +3672,7 @@ Yap_absmi(int inp)
BIND(pt0, d1, gatom_4e);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
gatom_4e:
#endif
GONext();
@ -3703,7 +3703,7 @@ Yap_absmi(int inp)
BIND(pt0, PREG->u.ccccc.c1, gatom_5b);
#ifdef COROUTINING
DO_TRAIL(pt0, PREG->u.ccccc.c1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
#endif
ENDP(pt0);
gatom_5b:
@ -3726,7 +3726,7 @@ Yap_absmi(int inp)
BIND(pt0, PREG->u.ccccc.c2, gatom_5c);
#ifdef COROUTINING
DO_TRAIL(pt0, PREG->u.ccccc.c2);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
#endif
ENDP(pt0);
gatom_5c:
@ -3749,7 +3749,7 @@ Yap_absmi(int inp)
BIND(pt0, PREG->u.ccccc.c3, gatom_5d);
#ifdef COROUTINING
DO_TRAIL(pt0, PREG->u.ccccc.c3);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
#endif
ENDP(pt0);
gatom_5d:
@ -3772,7 +3772,7 @@ Yap_absmi(int inp)
BIND(pt0, PREG->u.ccccc.c4, gatom_5e);
#ifdef COROUTINING
DO_TRAIL(pt0, PREG->u.ccccc.c4);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
#endif
ENDP(pt0);
gatom_5e:
@ -3798,7 +3798,7 @@ Yap_absmi(int inp)
BIND(pt0, d1, gatom_5f);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
gatom_5f:
#endif
GONext();
@ -3829,7 +3829,7 @@ Yap_absmi(int inp)
BIND(pt0, PREG->u.cccccc.c1, gatom_6b);
#ifdef COROUTINING
DO_TRAIL(pt0, PREG->u.cccccc.c1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
#endif
ENDP(pt0);
gatom_6b:
@ -3852,7 +3852,7 @@ Yap_absmi(int inp)
BIND(pt0, PREG->u.cccccc.c2, gatom_6c);
#ifdef COROUTINING
DO_TRAIL(pt0, PREG->u.cccccc.c2);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
#endif
ENDP(pt0);
gatom_6c:
@ -3875,7 +3875,7 @@ Yap_absmi(int inp)
BIND(pt0, PREG->u.cccccc.c3, gatom_6d);
#ifdef COROUTINING
DO_TRAIL(pt0, PREG->u.cccccc.c3);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
#endif
ENDP(pt0);
gatom_6d:
@ -3898,7 +3898,7 @@ Yap_absmi(int inp)
BIND(pt0, PREG->u.cccccc.c4, gatom_6e);
#ifdef COROUTINING
DO_TRAIL(pt0, PREG->u.cccccc.c4);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
#endif
ENDP(pt0);
gatom_6e:
@ -3921,7 +3921,7 @@ Yap_absmi(int inp)
BIND(pt0, PREG->u.cccccc.c5, gatom_6f);
#ifdef COROUTINING
DO_TRAIL(pt0, PREG->u.cccccc.c5);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
#endif
ENDP(pt0);
gatom_6f:
@ -3947,7 +3947,7 @@ Yap_absmi(int inp)
BIND(pt0, d1, gatom_6g);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
gatom_6g:
#endif
GONext();
@ -3989,7 +3989,7 @@ Yap_absmi(int inp)
BIND(pt0, d0, bind_glist);
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) {
if (IsAttVar(pt0)) {
Yap_WakeUp(pt0);
S_SREG = H;
}
@ -4043,7 +4043,7 @@ Yap_absmi(int inp)
BIND(pt0, d1, bind_gstruct);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) {
if (IsAttVar(pt0)) {
Yap_WakeUp(pt0);
}
bind_gstruct:
@ -4109,7 +4109,7 @@ Yap_absmi(int inp)
BIND(pt0, d1, bind_gfloat);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_gfloat:
#endif
GONext();
@ -4154,7 +4154,7 @@ Yap_absmi(int inp)
BIND(pt0, d1, bind_glongint);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_glongint:
#endif
GONext();
@ -4202,7 +4202,7 @@ Yap_absmi(int inp)
BIND(pt0, d1, bind_gbigint);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_gbigint:
#endif
GONext();
@ -4241,7 +4241,7 @@ Yap_absmi(int inp)
BIND(pt0, d1, bind_gdbterm);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_gdbterm:
#endif
GONext();
@ -4293,7 +4293,7 @@ Yap_absmi(int inp)
BIND(pt1, d0, bind_glist_valx_nonvar_var);
#ifdef COROUTINING
DO_TRAIL(pt1, d0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
bind_glist_valx_nonvar_var:
#endif
GONext();
@ -4314,7 +4314,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d0, bind_glist_valx_var_nonvar);
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_glist_valx_var_nonvar:
#endif
GONext();
@ -4326,14 +4326,14 @@ Yap_absmi(int inp)
UnifyGlobalRegCells(pt0, pt1, uc5, uc6);
#ifdef COROUTINING
DO_TRAIL(pt0, (CELL)pt1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
uc5:
#endif
GONext();
#ifdef COROUTINING
uc6:
DO_TRAIL(pt1, (CELL)pt0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
GONext();
#endif
ENDP(pt1);
@ -4366,7 +4366,7 @@ Yap_absmi(int inp)
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
dbind:
#endif
ALWAYS_GONextW();
@ -4415,7 +4415,7 @@ Yap_absmi(int inp)
BIND(pt1, d0, bind_glist_valy_nonvar_var);
#ifdef COROUTINING
DO_TRAIL(pt1, d0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
bind_glist_valy_nonvar_var:
#endif
GONext();
@ -4436,7 +4436,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_glist_valy_var_nonvar);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_glist_valy_var_nonvar:
#endif
GONext();
@ -4447,14 +4447,14 @@ Yap_absmi(int inp)
UnifyGlobalRegCells(pt0, pt1, uc7, uc8);
#ifdef COROUTINING
DO_TRAIL(pt0, (CELL)pt1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
uc7:
#endif
GONext();
#ifdef COROUTINING
uc8:
DO_TRAIL(pt1, (CELL)pt0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
GONext();
#endif
ENDP(pt1);
@ -4473,7 +4473,7 @@ Yap_absmi(int inp)
BIND(pt0, d0, bind_glist_valy_write);
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) {
if (IsAttVar(pt0)) {
Yap_WakeUp(pt0);
pt1 = H;
}
@ -4530,7 +4530,7 @@ Yap_absmi(int inp)
BIND(pt0, d0, bind_glist_varx_write);
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_glist_varx_write:
#endif
PREG = NEXTOP(PREG, xx);
@ -4581,7 +4581,7 @@ Yap_absmi(int inp)
BIND(pt0, d0, bind_glist_void_vary_write);
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_glist_void_vary_write:
#endif
GONext();
@ -4626,7 +4626,7 @@ Yap_absmi(int inp)
BIND(pt1, d0, bind_glist_void_valx_nonvar_var);
#ifdef COROUTINING
DO_TRAIL(pt1, d0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
bind_glist_void_valx_nonvar_var:
#endif
GONext();
@ -4646,7 +4646,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_glist_void_valx_var_nonvar);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_glist_void_valx_var_nonvar:
#endif
GONext();
@ -4658,14 +4658,14 @@ Yap_absmi(int inp)
UnifyGlobalRegCells(pt0, pt1, uc9, uc10);
#ifdef COROUTINING
DO_TRAIL(pt0, (CELL)pt1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
uc9:
#endif
GONext();
#ifdef COROUTINING
uc10:
DO_TRAIL(pt1, (CELL)pt0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
GONext();
#endif
ENDP(pt1);
@ -4681,7 +4681,7 @@ Yap_absmi(int inp)
BIND(pt0, d0, bind_glist_void_valx_write);
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) {
if (IsAttVar(pt0)) {
Yap_WakeUp(pt0);
pt1 = H;
}
@ -4738,7 +4738,7 @@ Yap_absmi(int inp)
BIND(pt1, d0, bind_glist_void_valy_nonvar_var);
#ifdef COROUTINING
DO_TRAIL(pt1, d0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
bind_glist_void_valy_nonvar_var:
#endif
GONext();
@ -4759,7 +4759,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_glist_void_valy_var_nonvar);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_glist_void_valy_var_nonvar:
#endif
GONext();
@ -4770,14 +4770,14 @@ Yap_absmi(int inp)
UnifyGlobalRegCells(pt0, pt1, uc11, uc12);
#ifdef COROUTINING
DO_TRAIL(pt0, (CELL)pt1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
uc11:
#endif
GONext();
#ifdef COROUTINING
uc12:
DO_TRAIL(pt1, (CELL)pt0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
GONext();
#endif
ENDP(pt1);
@ -4793,7 +4793,7 @@ Yap_absmi(int inp)
BIND(pt0, d0, bind_glist_void_valy_write);
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) {
if (IsAttVar(pt0)) {
Yap_WakeUp(pt0);
S_SREG = H;
}
@ -5087,7 +5087,7 @@ Yap_absmi(int inp)
BIND(pt1, d0, bind_uvalx_nonvar_var);
#ifdef COROUTINING
DO_TRAIL(pt1, d0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
bind_uvalx_nonvar_var:
#endif
GONext();
@ -5106,7 +5106,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_uvalx_var_nonvar);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_uvalx_var_nonvar:
#endif
GONext();
@ -5119,14 +5119,14 @@ Yap_absmi(int inp)
UnifyGlobalRegCells(pt0, pt1, uc13, uc14);
#ifdef COROUTINING
DO_TRAIL(pt0, (CELL)pt1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
uc13:
#endif
GONext();
#ifdef COROUTINING
uc14:
DO_TRAIL(pt1, (CELL)pt0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
GONext();
#endif
ENDP(pt1);
@ -5171,7 +5171,7 @@ Yap_absmi(int inp)
BIND(pt1, d0, bind_ulvalx_nonvar_var);
#ifdef COROUTINING
DO_TRAIL(pt1, d0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
bind_ulvalx_nonvar_var:
#endif
GONext();
@ -5189,7 +5189,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_ulvalx_var_nonvar);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_ulvalx_var_nonvar:
#endif
GONext();
@ -5201,14 +5201,14 @@ Yap_absmi(int inp)
UnifyGlobalRegCells(pt0, pt1, uc15, uc16);
#ifdef COROUTINING
DO_TRAIL(pt0, (CELL)pt1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
uc15:
#endif
GONext();
#ifdef COROUTINING
uc16:
DO_TRAIL(pt1, (CELL)pt0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
GONext();
#endif
ENDP(pt1);
@ -5256,7 +5256,7 @@ Yap_absmi(int inp)
BIND(pt1, d0, bind_uvaly_nonvar_var);
#ifdef COROUTINING
DO_TRAIL(pt1, d0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
bind_uvaly_nonvar_var:
#endif
GONext();
@ -5277,7 +5277,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_uvaly_var_nonvar);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_uvaly_var_nonvar:
#endif
GONext();
@ -5289,14 +5289,14 @@ Yap_absmi(int inp)
UnifyGlobalRegCells(pt0, pt1, uc17, uc18);
#ifdef COROUTINING
DO_TRAIL(pt0, (CELL)pt1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
uc17:
#endif
GONext();
#ifdef COROUTINING
uc18:
DO_TRAIL(pt1, (CELL)pt1);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
GONext();
#endif
ENDP(pt1);
@ -5350,7 +5350,7 @@ Yap_absmi(int inp)
BIND(pt1, d0, bind_ulvaly_nonvar_var);
#ifdef COROUTINING
DO_TRAIL(pt1, d0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
bind_ulvaly_nonvar_var:
#endif
GONext();
@ -5370,7 +5370,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_ulvaly_var_nonvar);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_ulvaly_var_nonvar:
#endif
GONext();
@ -5383,14 +5383,14 @@ Yap_absmi(int inp)
UnifyGlobalRegCells(pt0, pt1, uc19, uc20);
#ifdef COROUTINING
DO_TRAIL(pt0, (CELL)pt1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
uc19:
#endif
GONext();
#ifdef COROUTINING
uc20:
DO_TRAIL(pt1, (CELL)pt0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
GONext();
#endif
ENDP(pt1);
@ -5445,7 +5445,7 @@ Yap_absmi(int inp)
BIND(pt1, d0, bind_uvalx_loc_nonvar_var);
#ifdef COROUTINING
DO_TRAIL(pt1, d0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
bind_uvalx_loc_nonvar_var:
#endif
GONext();
@ -5465,7 +5465,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_uvalx_loc_var_nonvar);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_uvalx_loc_var_nonvar:
#endif
GONext();
@ -5480,14 +5480,14 @@ Yap_absmi(int inp)
UnifyGlobalRegCells(pt0, pt1, uc21, uc22);
#ifdef COROUTINING
DO_TRAIL(pt0, (CELL)pt1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
uc21:
#endif
GONext();
#ifdef COROUTINING
uc22:
DO_TRAIL(pt1, (CELL)pt0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
GONext();
#endif
ENDP(pt1);
@ -5558,7 +5558,7 @@ Yap_absmi(int inp)
BIND(pt0, d0, bind_ulvalx_loc_nonvar_var);
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_ulvalx_loc_nonvar_var:
#endif
GONext();
@ -5575,7 +5575,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_ulvalx_loc_var_nonvar);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_ulvalx_loc_var_nonvar:
#endif
GONext();
@ -5587,14 +5587,14 @@ Yap_absmi(int inp)
UnifyGlobalRegCells(pt0, pt1, uc23, uc24);
#ifdef COROUTINING
DO_TRAIL(pt0, (CELL)pt1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
uc23:
#endif
GONext();
#ifdef COROUTINING
uc24:
DO_TRAIL(pt1, (CELL)pt0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
GONext();
#endif
ENDP(pt1);
@ -5663,7 +5663,7 @@ Yap_absmi(int inp)
BIND(pt1, d0, bind_uvaly_loc_nonvar_var);
#ifdef COROUTINING
DO_TRAIL(pt1, d0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
bind_uvaly_loc_nonvar_var:
#endif
GONext();
@ -5684,7 +5684,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_uvaly_loc_var_nonvar);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_uvaly_loc_var_nonvar:
#endif
GONext();
@ -5698,14 +5698,14 @@ Yap_absmi(int inp)
UnifyGlobalRegCells(pt0, pt1, uc25, uc26);
#ifdef COROUTINING
DO_TRAIL(pt0, (CELL)pt1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
uc25:
#endif
GONext();
#ifdef COROUTINING
uc26:
DO_TRAIL(pt1, (CELL)pt0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
GONext();
#endif
ENDP(pt1);
@ -5777,7 +5777,7 @@ Yap_absmi(int inp)
BIND(pt1, d0, bind_ulvaly_loc_nonvar_var);
#ifdef COROUTINING
DO_TRAIL(pt1, d0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
bind_ulvaly_loc_nonvar_var:
#endif
GONext();
@ -5797,7 +5797,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_ulvaly_loc_var_nonvar);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_ulvaly_loc_var_nonvar:
#endif
GONext();
@ -5810,14 +5810,14 @@ Yap_absmi(int inp)
UnifyGlobalRegCells(pt0, pt1, uc27, uc28);
#ifdef COROUTINING
DO_TRAIL(pt0, (CELL)pt1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
uc27:
#endif
GONext();
#ifdef COROUTINING
uc28:
DO_TRAIL(pt1, (CELL)pt0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
GONext();
#endif
ENDP(pt1);
@ -5947,7 +5947,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d0, bind_uatom);
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_uatom:
#endif
GONext();
@ -5980,7 +5980,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d0, bind_ulatom);
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_ulatom:
#endif
GONext();
@ -6016,7 +6016,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_unlatom);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_unlatom:
continue;
#endif
@ -6086,7 +6086,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_ufloat);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_ufloat:
#endif
GONext();
@ -6139,7 +6139,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(S_SREG, d1, bind_ulfloat);
#ifdef COROUTINING
DO_TRAIL(S_SREG, d1);
if (S_SREG < H0) Yap_WakeUp(S_SREG);
if (IsAttVar(S_SREG)) Yap_WakeUp(S_SREG);
bind_ulfloat:
#endif
GONext();
@ -6188,7 +6188,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_ulongint);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_ulongint:
#endif
GONext();
@ -6236,7 +6236,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(S_SREG, d1, bind_ullongint);
#ifdef COROUTINING
DO_TRAIL(S_SREG, d1);
if (S_SREG < H0) Yap_WakeUp(S_SREG);
if (IsAttVar(S_SREG)) Yap_WakeUp(S_SREG);
bind_ullongint:
#endif
GONext();
@ -6285,7 +6285,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_ubigint);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_ubigint:
#endif
GONext();
@ -6330,7 +6330,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(S_SREG, d1, bind_ulbigint);
#ifdef COROUTINING
DO_TRAIL(S_SREG, d1);
if (S_SREG < H0) Yap_WakeUp(S_SREG);
if (IsAttVar(S_SREG)) Yap_WakeUp(S_SREG);
bind_ulbigint:
#endif
GONext();
@ -6363,7 +6363,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_udbterm);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_udbterm:
#endif
GONext();
@ -6393,7 +6393,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(S_SREG, d1, bind_uldbterm);
#ifdef COROUTINING
DO_TRAIL(S_SREG, d1);
if (S_SREG < H0) Yap_WakeUp(S_SREG);
if (IsAttVar(S_SREG)) Yap_WakeUp(S_SREG);
bind_uldbterm:
#endif
GONext();
@ -6435,7 +6435,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d0, bind_ulist_var);
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_ulist_var:
#endif
GONextW();
@ -6495,7 +6495,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d0, bind_ullist_var);
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_ullist_var:
#endif
GONextW();
@ -6560,7 +6560,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_ustruct);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_ustruct:
#endif
/* now, set pt0 to point to the heap where we are going to
@ -6636,7 +6636,7 @@ Yap_absmi(int inp)
BIND_GLOBAL(pt0, d1, bind_ulstruct);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_ulstruct:
#endif
/* now, set pt0 to point to the heap where we are going to
@ -13455,7 +13455,7 @@ Yap_absmi(int inp)
BIND(pt0, d0, bind_func_nvar_var);
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_func_nvar_var:
#endif
/* I have to this here so that I don't have a jump to a closing bracket */
@ -13482,7 +13482,7 @@ Yap_absmi(int inp)
/* Done */
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_func_nvar3_var:
#endif
GONext();
@ -13575,7 +13575,7 @@ Yap_absmi(int inp)
BIND(pt0, d0, bind_func_var_3nvar);
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_func_var_3nvar:
#endif
GONext();

4
C/agc.c
View File

@ -322,11 +322,7 @@ mark_global(void)
* to clean the global now that functors are just variables pointing to
* the code
*/
#if COROUTINING
pt = (CELL *)DelayTop();
#else
pt = H0;
#endif
while (pt < H) {
pt = mark_global_cell(pt);
}

32
C/arith1.c
View File

@ -240,7 +240,7 @@ eval1(Int fi, Term t) {
RBIG(&new);
}
#endif
case db_ref_e:
default:
RERROR();
}
case op_unot:
@ -259,7 +259,7 @@ eval1(Int fi, Term t) {
RBIG(&new);
}
#endif
case db_ref_e:
default:
RERROR();
}
case op_exp:
@ -480,7 +480,7 @@ eval1(Int fi, Term t) {
}
break;
#endif
case db_ref_e:
default:
RERROR();
}
#if HAVE_ISNAN
@ -518,7 +518,7 @@ eval1(Int fi, Term t) {
}
break;
#endif
case db_ref_e:
default:
RERROR();
}
#if HAVE_ISNAN
@ -555,7 +555,7 @@ eval1(Int fi, Term t) {
}
return t;
break;
case db_ref_e:
default:
#endif
RERROR();
}
@ -591,7 +591,7 @@ eval1(Int fi, Term t) {
return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is round(BIGNUM)");
}
return t;
case db_ref_e:
default:
#endif
RERROR();
}
@ -624,12 +624,12 @@ eval1(Int fi, Term t) {
case long_int_e:
RFLOAT(IntegerOfTerm(t));
case double_e:
RFLOAT(FloatOfTerm(t));
return t;
case big_int_e:
#ifdef USE_GMP
RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t)));
#endif
case db_ref_e:
default:
RERROR();
}
case op_abs:
@ -648,7 +648,7 @@ eval1(Int fi, Term t) {
RBIG(&new);
}
#endif
case db_ref_e:
default:
RERROR();
}
case op_msb:
@ -667,7 +667,7 @@ eval1(Int fi, Term t) {
RINT(mpz_sizeinbase(big,2));
}
#endif
case db_ref_e:
default:
RERROR();
}
case op_lsb:
@ -686,7 +686,7 @@ eval1(Int fi, Term t) {
RINT(mpz_scan1(big,0));
}
#endif
case db_ref_e:
default:
RERROR();
}
case op_popcount:
@ -705,7 +705,7 @@ eval1(Int fi, Term t) {
RINT(mpz_popcount(big));
}
#endif
case db_ref_e:
default:
RERROR();
}
case op_ffracp:
@ -731,7 +731,7 @@ eval1(Int fi, Term t) {
RFLOAT(0.0);
}
#endif
case db_ref_e:
default:
RERROR();
}
case op_fintp:
@ -753,7 +753,7 @@ eval1(Int fi, Term t) {
RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t)));
}
#endif
case db_ref_e:
default:
RERROR();
}
case op_sign:
@ -775,7 +775,7 @@ eval1(Int fi, Term t) {
#ifdef USE_GMP
RINT(mpz_sgn(Yap_BigIntOfTerm(t)));
#endif
case db_ref_e:
default:
RERROR();
}
case op_random1:
@ -788,7 +788,7 @@ eval1(Int fi, Term t) {
#ifdef USE_GMP
return Yap_ArithError(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t));
#endif
case db_ref_e:
default:
RERROR();
}
}

72
C/arith2.c
View File

@ -93,7 +93,7 @@ p_mod(Term t1, Term t2) {
#ifdef USE_GMP
return Yap_gmp_mod_int_big(IntegerOfTerm(t1), Yap_BigIntOfTerm(t2));
#endif
case db_ref_e:
default:
RERROR();
break;
}
@ -115,11 +115,11 @@ p_mod(Term t1, Term t2) {
return Yap_gmp_mod_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2));
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
zero_divisor:
@ -157,7 +157,7 @@ p_rem(Term t1, Term t2) {
/* I know the term is much larger, so: */
RINT(IntegerOfTerm(t1));
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -191,11 +191,11 @@ p_rem(Term t1, Term t2) {
}
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2");
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
zero_divisor:
@ -234,7 +234,7 @@ p_fdiv(Term t1, Term t2)
RFLOAT(((Float)i1/f2));
}
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -257,7 +257,7 @@ p_fdiv(Term t1, Term t2)
RFLOAT(FloatOfTerm(t1)/mpz_get_d(Yap_BigIntOfTerm(t2)));
}
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -278,11 +278,11 @@ p_fdiv(Term t1, Term t2)
Float dbl = FloatOfTerm(t2);
RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t1))/dbl);
}
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
RERROR();
@ -334,7 +334,7 @@ p_xor(Term t1, Term t2)
RBIG(&new);
}
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -362,11 +362,11 @@ p_xor(Term t1, Term t2)
}
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2");
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
RERROR();
@ -394,7 +394,7 @@ p_atan2(Term t1, Term t2)
RFLOAT(atan2(i1,f2));
}
#endif
case db_ref_e:
default:
RERROR();
break;
}
@ -417,7 +417,7 @@ p_atan2(Term t1, Term t2)
RFLOAT(atan2(FloatOfTerm(t1),mpz_get_d(Yap_BigIntOfTerm(t2))));
}
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -437,11 +437,11 @@ p_atan2(Term t1, Term t2)
Float dbl = FloatOfTerm(t2);
RFLOAT(atan2(mpz_get_d(Yap_BigIntOfTerm(t1)),dbl));
}
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
RERROR();
@ -479,7 +479,7 @@ p_power(Term t1, Term t2)
RFLOAT(pow(i1,f2));
}
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -502,7 +502,7 @@ p_power(Term t1, Term t2)
RFLOAT(pow(FloatOfTerm(t1),mpz_get_d(Yap_BigIntOfTerm(t2))));
}
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -522,11 +522,11 @@ p_power(Term t1, Term t2)
Float dbl = FloatOfTerm(t2);
RFLOAT(pow(mpz_get_d(Yap_BigIntOfTerm(t1)),dbl));
}
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
RERROR();
@ -605,7 +605,7 @@ p_exp(Term t1, Term t2)
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "^/2");
}
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -628,7 +628,7 @@ p_exp(Term t1, Term t2)
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "^/2");
}
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -649,11 +649,11 @@ p_exp(Term t1, Term t2)
Float dbl = FloatOfTerm(t2);
RFLOAT(pow(mpz_get_d(Yap_BigIntOfTerm(t1)),dbl));
}
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
RERROR();
@ -741,7 +741,7 @@ p_gcd(Term t1, Term t2)
}
}
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -774,11 +774,11 @@ p_gcd(Term t1, Term t2)
}
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2");
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
RERROR();
@ -821,7 +821,7 @@ p_min(Term t1, Term t2)
return t1;
}
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -858,7 +858,7 @@ p_min(Term t1, Term t2)
}
}
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -897,11 +897,11 @@ p_min(Term t1, Term t2)
return t1;
}
}
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
RERROR();
@ -944,7 +944,7 @@ p_max(Term t1, Term t2)
return t1;
}
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -981,7 +981,7 @@ p_max(Term t1, Term t2)
}
}
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -1020,11 +1020,11 @@ p_max(Term t1, Term t2)
return t1;
}
}
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
RERROR();

244
C/attvar.c
View File

@ -67,70 +67,64 @@ AddFailToQueue(void)
}
}
static attvar_record *
BuildNewAttVar(void)
{
attvar_record *newv;
/* add a new attributed variable */
if (!(newv = (attvar_record *)Yap_GetFromArena(&GlobalArena, sizeof(attvar_record)/sizeof(CELL),2)))
return NULL;
newv->AttFunc = FunctorAttVar;
RESET_VARIABLE(&(newv->Value));
RESET_VARIABLE(&(newv->Done));
RESET_VARIABLE(&(newv->Atts));
return newv;
}
static int
CopyAttVar(CELL *orig, struct cp_frame **to_visit_ptr, CELL *res)
{
register attvar_record *attv = (attvar_record *)orig;
register attvar_record *attv = RepAttVar(orig);
register attvar_record *newv;
struct cp_frame *to_visit = *to_visit_ptr;
CELL *vt;
/* add a new attributed variable */
newv = DelayTop();
if ((ADDR)newv - Yap_GlobalBase < 1024*sizeof(CELL))
if (!(newv = BuildNewAttVar()))
return FALSE;
newv--;
RESET_VARIABLE(&(newv->Value));
RESET_VARIABLE(&(newv->Done));
vt = &(attv->Atts);
to_visit->start_cp = vt-1;
to_visit->end_cp = vt;
if (IsVarTerm(attv->Atts)) {
newv->Atts = (CELL)H;
Bind(&newv->Atts, (CELL)H);
to_visit->to = H;
H++;
} else {
to_visit->to = &(newv->Atts);
}
to_visit->oldv = vt[-1];
/* you're coming from a variable */
to_visit->ground = FALSE;
*to_visit_ptr = to_visit+1;
*res = (CELL)&(newv->Done);
SetDelayTop(newv);
return TRUE;
}
static Term
AttVarToTerm(CELL *orig)
{
attvar_record *attv = (attvar_record *)orig;
attvar_record *attv = RepAttVar(orig);
return attv->Atts;
}
static attvar_record *
BuildNewAttVar(void)
{
attvar_record *attv = DelayTop();
if ((ADDR)attv - Yap_GlobalBase < 1024*sizeof(CELL))
return FALSE;
attv--;
RESET_VARIABLE(&(attv->Done));
RESET_VARIABLE(&(attv->Value));
RESET_VARIABLE(&(attv->Atts));
SetDelayTop(attv);
return attv;
}
static int
TermToAttVar(Term attvar, Term to)
{
attvar_record *attv = BuildNewAttVar();
if (!attv)
return FALSE;
attv->Atts = attvar;
*VarOfTerm(to) = (CELL)attv;
Bind(&attv->Atts, attvar);
*VarOfTerm(to) = AbsAttVar(attv);
return TRUE;
}
@ -139,15 +133,19 @@ WakeAttVar(CELL* pt1, CELL reg2)
{
/* if bound to someone else, follow until we find the last one */
attvar_record *attv = (attvar_record *)pt1;
attvar_record *attv = RepAttVar(pt1);
CELL *myH = H;
CELL *bind_ptr;
if (IsVarTerm(Deref(attv->Atts))) {
/* no attributes to wake */
return;
}
if (IsVarTerm(reg2)) {
if (pt1 == VarOfTerm(reg2))
return;
if (IsAttachedTerm(reg2)) {
attvar_record *susp2 = (attvar_record *)VarOfTerm(reg2);
attvar_record *susp2 = RepAttVar(VarOfTerm(reg2));
/* binding two suspended variables, be careful */
if (susp2 >= attv) {
@ -196,11 +194,7 @@ Yap_WakeUp(CELL *pt0) {
static void
mark_attvar(CELL *orig)
{
register attvar_record *attv = (attvar_record *)orig;
Yap_mark_external_reference(&(attv->Value));
Yap_mark_external_reference(&(attv->Done));
Yap_mark_external_reference(&(attv->Atts));
return;
}
static Term
@ -264,11 +258,7 @@ AddNewModule(attvar_record *attv, Term t, int new, int do_it)
if (!do_it)
return;
if (IsVarTerm(attv->Atts)) {
if (new) {
attv->Atts = t;
} else {
Bind(&(attv->Atts),t);
}
Bind(&(attv->Atts),t);
} else {
Term *wherep = &attv->Atts;
@ -388,11 +378,11 @@ BindAttVar(attvar_record *attv) {
Term t = Deref(attv->Value);
if (IsVarTerm(t)) {
if (IsAttachedTerm(t)) {
attvar_record *attv2 = (attvar_record *)VarOfTerm(t);
attvar_record *attv2 = RepAttVar(VarOfTerm(t));
if (attv2 < attv) {
Bind_Global(&(attv->Done), t);
} else {
Bind_Global(&(attv2->Done), (CELL)attv);
Bind_Global(&(attv2->Done), AbsAttVar(attv));
}
} else {
Yap_Error(SYSTEM_ERROR,(CELL)&(attv->Done),"attvar was bound when unset");
@ -421,43 +411,6 @@ GetAllAtts(attvar_record *attv) {
return attv->Atts;
}
static Term
AllAttVars(attvar_record *attv) {
CELL *h0 = H;
attvar_record *max = DelayTop();
while (--attv >= max) {
if (ASP - H < 1024) {
H = h0;
Yap_Error_Size = (ASP-H)*sizeof(CELL);
return 0L;
}
if (IsVarTerm(attv->Done) && IsUnboundVar(&attv->Done)) {
if (IsVarTerm(attv->Atts)) {
if (VarOfTerm(attv->Atts) < (CELL *)attv) {
/* skip call residue(s) */
attv = (attvar_record *)(attv->Atts);
continue;
} else if (IsUnboundVar(&attv->Atts)) {
/* ignore arena */
continue;
}
}
if (H != h0) {
H[-1] = AbsPair(H);
}
H[0] = (CELL)attv;
H += 2;
}
}
if (H != h0) {
H[-1] = TermNil;
return AbsPair(h0);
} else {
return TermNil;
}
}
static Int
p_put_att(void) {
/* receive a variable in ARG1 */
@ -472,13 +425,14 @@ p_put_att(void) {
int new = FALSE;
if (IsAttachedTerm(inp)) {
attv = (attvar_record *)VarOfTerm(inp);
attv = RepAttVar(VarOfTerm(inp));
} else {
while (!(attv = BuildNewAttVar())) {
if (!Yap_growglobal(NULL)) {
Yap_Error(OUT_OF_ATTVARS_ERROR, ARG1, Yap_ErrorMessage);
Yap_Error_Size = sizeof(attvar_record);
if (!Yap_gcl(Yap_Error_Size, 5, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
}
inp = Deref(ARG1);
}
new = TRUE;
@ -491,7 +445,7 @@ p_put_att(void) {
return FALSE;
}
}
Yap_unify(ARG1, (Term)attv);
Yap_unify(ARG1, AbsAttVar(attv));
AddNewModule(attv,tatts,new,TRUE);
}
PutAtt(IntegerOfTerm(Deref(ARG4)), tatts, Deref(ARG5));
@ -512,20 +466,21 @@ p_put_att_term(void) {
int new = FALSE;
if (IsAttachedTerm(inp)) {
attv = (attvar_record *)VarOfTerm(inp);
attv = RepAttVar(VarOfTerm(inp));
} else {
while (!(attv = BuildNewAttVar())) {
if (!Yap_growglobal(NULL)) {
Yap_Error(OUT_OF_ATTVARS_ERROR, ARG1, Yap_ErrorMessage);
Yap_Error_Size = sizeof(attvar_record);
if (!Yap_gcl(Yap_Error_Size, 5, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
}
inp = Deref(ARG1);
}
new = TRUE;
}
if (new) {
Bind(VarOfTerm(inp), (CELL)attv);
attv->Atts = Deref(ARG2);
Bind(VarOfTerm(inp), AbsAttVar(attv));
Bind(&attv->Atts, Deref(ARG2));
} else {
MaBind(&(attv->Atts), Deref(ARG2));
}
@ -550,17 +505,18 @@ p_rm_att(void) {
int new = FALSE;
if (IsAttachedTerm(inp)) {
attv = (attvar_record *)VarOfTerm(inp);
attv = RepAttVar(VarOfTerm(inp));
} else {
while (!(attv = BuildNewAttVar())) {
if (!Yap_growglobal(NULL)) {
Yap_Error(OUT_OF_ATTVARS_ERROR, ARG1, Yap_ErrorMessage);
Yap_Error_Size = sizeof(attvar_record);
if (!Yap_gcl(Yap_Error_Size, 5, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
}
inp = Deref(ARG1);
}
new = TRUE;
Yap_unify(ARG1, (Term)attv);
Yap_unify(ARG1, AbsAttVar(attv));
}
mfun= Yap_MkFunctor(modname,ar);
if (IsVarTerm(tatts = SearchAttsForModule(attv->Atts,mfun))) {
@ -595,17 +551,18 @@ p_put_atts(void) {
int new = FALSE;
if (IsAttachedTerm(inp)) {
attv = (attvar_record *)VarOfTerm(inp);
attv = RepAttVar(VarOfTerm(inp));
} else {
while (!(attv = BuildNewAttVar())) {
if (!Yap_growglobal(NULL)) {
Yap_Error(OUT_OF_ATTVARS_ERROR, ARG1, Yap_ErrorMessage);
Yap_Error_Size = sizeof(attvar_record);
if (!Yap_gcl(Yap_Error_Size, 5, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
}
tatts = Deref(ARG2);
}
new = TRUE;
Yap_unify(ARG1, (Term)attv);
Yap_unify(ARG1, AbsAttVar(attv));
}
if (IsVarTerm(otatts = SearchAttsForModule(attv->Atts,mfun))) {
AddNewModule(attv,tatts,new,FALSE);
@ -632,7 +589,7 @@ p_del_atts(void) {
Functor mfun = FunctorOfTerm(tatts);
if (IsAttachedTerm(inp)) {
attv = (attvar_record *)VarOfTerm(inp);
attv = RepAttVar(VarOfTerm(inp));
} else {
return TRUE;
}
@ -656,7 +613,7 @@ p_del_all_atts(void) {
if (IsVarTerm(inp) && IsAttachedTerm(inp)) {
attvar_record *attv;
attv = (attvar_record *)VarOfTerm(inp);
attv = RepAttVar(VarOfTerm(inp));
DelAllAtts(attv);
}
return TRUE;
@ -674,7 +631,7 @@ p_get_att(void) {
attvar_record *attv;
Term tout, tatts;
attv = (attvar_record *)VarOfTerm(inp);
attv = RepAttVar(VarOfTerm(inp));
if (IsVarTerm(tatts = SearchAttsForModuleName(attv->Atts,modname)))
return FALSE;
tout = ArgOfTerm(IntegerOfTerm(Deref(ARG3)),tatts);
@ -702,7 +659,7 @@ p_free_att(void) {
attvar_record *attv;
Term tout, tatts;
attv = (attvar_record *)VarOfTerm(inp);
attv = RepAttVar(VarOfTerm(inp));
if (IsVarTerm(tatts = SearchAttsForModuleName(attv->Atts,modname)))
return TRUE;
tout = ArgOfTerm(IntegerOfTerm(Deref(ARG3)),tatts);
@ -731,7 +688,7 @@ p_get_atts(void) {
UInt ar, i;
CELL *old, *new;
attv = (attvar_record *)VarOfTerm(inp);
attv = RepAttVar(VarOfTerm(inp));
if (IsVarTerm(tatts = SearchAttsForModule(attv->Atts,mfun)))
return FALSE;
@ -769,7 +726,7 @@ p_has_atts(void) {
Term access = Deref(ARG2);
Functor mfun = FunctorOfTerm(access);
attv = (attvar_record *)VarOfTerm(inp);
attv = RepAttVar(VarOfTerm(inp));
return !IsVarTerm(tatts = SearchAttsForModule(attv->Atts,mfun));
} else {
/* Yap_Error(INSTANTIATION_ERROR,inp,"get_att/2"); */
@ -788,7 +745,7 @@ p_bind_attvar(void) {
/* if this is unbound, ok */
if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) {
attvar_record *attv = (attvar_record *)VarOfTerm(inp);
attvar_record *attv = RepAttVar(VarOfTerm(inp));
return(BindAttVar(attv));
}
return(TRUE);
@ -805,7 +762,7 @@ p_unbind_attvar(void) {
/* if this is unbound, ok */
if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) {
attvar_record *attv = (attvar_record *)VarOfTerm(inp);
attvar_record *attv = RepAttVar(VarOfTerm(inp));
return(UnBindAttVar(attv));
}
return(TRUE);
@ -822,7 +779,7 @@ p_get_all_atts(void) {
/* if this is unbound, ok */
if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) {
attvar_record *attv = (attvar_record *)VarOfTerm(inp);
attvar_record *attv = RepAttVar(VarOfTerm(inp));
return Yap_unify(ARG2,GetAllAtts(attv));
}
return TRUE;
@ -852,7 +809,7 @@ p_modules_with_atts(void) {
/* if this is unbound, ok */
if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) {
attvar_record *attv = (attvar_record *)VarOfTerm(inp);
attvar_record *attv = RepAttVar(VarOfTerm(inp));
CELL *h0 = H;
Term tatt;
@ -889,7 +846,7 @@ p_swi_all_atts(void) {
/* if this is unbound, ok */
if (IsVarTerm(inp)) {
if (IsAttachedTerm(inp)) {
attvar_record *attv = (attvar_record *)VarOfTerm(inp);
attvar_record *attv = RepAttVar(VarOfTerm(inp));
CELL *h0 = H;
Term tatt;
@ -920,15 +877,67 @@ p_swi_all_atts(void) {
}
}
static Term
AllAttVars(void) {
CELL *pt = H0;
CELL *myH = H;
while (pt < H) {
switch(*pt) {
case (CELL)FunctorAttVar:
if (IsUnboundVar(pt+1)) {
if (ASP - myH < 1024) {
Yap_Error_Size = (ASP-H)*sizeof(CELL);
return 0L;
}
if (myH != H) {
myH[-1] = AbsPair(myH);
}
myH[0] = AbsAttVar((attvar_record *)pt);
myH += 2;
}
pt += (1+ATT_RECORD_ARITY);
break;
case (CELL)FunctorDouble:
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
pt += 4;
#else
pt += 3;
#endif
break;
case (CELL)FunctorBigInt:
{
Int sz = 3 +
(sizeof(MP_INT)+
(((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/sizeof(CELL);
pt += sz;
}
break;
case (CELL)FunctorLongInt:
pt += 3;
break;
default:
pt++;
}
}
if (myH != H) {
Term out = AbsPair(H);
myH[-1] = TermNil;
H = myH;
return out;
} else {
return TermNil;
}
}
static Int
p_all_attvars(void)
{
do {
Term out;
attvar_record *base;
base = (attvar_record *)Yap_ReadTimedVar(AttsMutableList);
if (!(out = AllAttVars(base))) {
if (!(out = AllAttVars())) {
if (!Yap_gcl(Yap_Error_Size, 1, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
@ -944,7 +953,7 @@ p_is_attvar(void)
{
Term t = Deref(ARG1);
return(IsVarTerm(t) &&
IsAttachedTerm(t));
IsAttVar(VarOfTerm(t)));
}
/* check if we are not redoing effort */
@ -952,9 +961,10 @@ static Int
p_attvar_bound(void)
{
Term t = Deref(ARG1);
return(IsVarTerm(t) &&
IsAttachedTerm(t) &&
!IsUnboundVar(&((attvar_record *)VarOfTerm(t))->Done));
return
IsVarTerm(t) &&
IsAttachedTerm(t) &&
!IsUnboundVar(&(RepAttVar(VarOfTerm(t))->Done));
}
static Int

6
C/c_interface.c
View File

@ -2940,7 +2940,7 @@ YAP_IsAttVar(Term t)
t = Deref(t);
if (!IsVarTerm(t))
return FALSE;
return (VarOfTerm(t) < H0);
return IsAttVar(VarOfTerm(t));
}
X_API Term
@ -2951,7 +2951,7 @@ YAP_AttsOfVar(Term t)
t = Deref(t);
if (!IsVarTerm(t))
return TermNil;
if (VarOfTerm(t) >= H0)
if (IsAttVar(VarOfTerm(t)))
return TermNil;
attv = (attvar_record *)VarOfTerm(t);
return attv->Atts;
@ -2965,7 +2965,7 @@ YAP_TermHash(Term t)
t = Deref(t);
if (!IsVarTerm(t))
return TermNil;
if (VarOfTerm(t) >= H0)
if (IsAttVar(VarOfTerm(t)))
return TermNil;
attv = (attvar_record *)VarOfTerm(t);
return attv->Atts;

8
C/cdmgr.c
View File

@ -4024,8 +4024,8 @@ p_is_profiled(void)
else ta = MkAtomTerm(AtomOff);
BIND((CELL *)t,ta,bind_is_profiled);
#ifdef COROUTINING
DO_TRAIL(CellPtr(t), ta);
if (CellPtr(t) < H0) Yap_WakeUp((CELL *)t);
DO_TRAIL(VarOfTerm(t), ta);
if (IsAttVar(VarOfTerm(t))) Yap_WakeUp((CELL *)t);
bind_is_profiled:
#endif
return(TRUE);
@ -4127,8 +4127,8 @@ p_is_call_counted(void)
else ta = MkAtomTerm(AtomOff);
BIND((CELL *)t,ta,bind_is_call_counted);
#ifdef COROUTINING
DO_TRAIL(CellPtr(t), ta);
if (CellPtr(t) < H0) Yap_WakeUp((CELL *)t);
DO_TRAIL(VarOfTerm(t), ta);
if (IsAttVar(VarOfTerm(t))) Yap_WakeUp((CELL *)t);
bind_is_call_counted:
#endif
return(TRUE);

50
C/corout.c
View File

@ -27,54 +27,6 @@ static char SccsId[]="%W% %G%";
#define NULL (void *)0
#endif
static Int
p_read_svar_list(void)
{
#ifdef COROUTINING
#ifdef MULTI_ASSIGNMENT_VARIABLES
return Yap_unify(ARG1,Yap_ReadTimedVar(AttsMutableList));
#else
return(TRUE);
#endif
#else
return(TRUE);
#endif
}
static Int
p_set_svar_list(void)
{
#ifdef COROUTINING
#ifdef MULTI_ASSIGNMENT_VARIABLES
Term newl = Deref(ARG1);
attvar_record *max = DelayTop();
if (IsVarTerm(newl) && VarOfTerm(newl) > H0) {
/* set to current top */
max--;
RESET_VARIABLE(&max->Done);
RESET_VARIABLE(&max->Value);
RESET_VARIABLE(&(max->Atts));
SetDelayTop(max);
Yap_UpdateTimedVar(AttsMutableList,(CELL)max);
return Yap_unify(ARG1,(CELL)max);
} else {
attvar_record *aold = (attvar_record *)Yap_UpdateTimedVar(AttsMutableList,newl);
if (max < aold) {
/* we are moving forward */
/* these items are protected by call-residue, should not
be visible to AllAtts
*/
MaBind(&(aold->Atts),(CELL)max);
}
}
#endif
#endif
return TRUE;
}
#ifdef COROUTINING
/* check if variable was there */
@ -612,8 +564,6 @@ Yap_InitCoroutPreds(void)
Yap_InitAttVarPreds();
Yap_InitCPred("$yap_has_rational_trees", 0, p_yap_has_rational_trees, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$yap_has_coroutining", 0, p_yap_has_coroutining, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$read_svar_list", 1, p_read_svar_list, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$set_svar_list", 1, p_set_svar_list, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$can_unify", 3, p_can_unify, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$non_ground", 2, p_non_ground, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$coroutining", 0, p_coroutining, SafePredFlag|HiddenPredFlag);

2
C/dbase.c
View File

@ -2347,7 +2347,6 @@ static int
copy_attachments(CELL *ts)
{
/* we will change delayed vars, and that also means the trail */
Term orig = Yap_ReadTimedVar(DelayedVars);
tr_fr_ptr tr0 = TR;
while (TRUE) {
@ -2356,7 +2355,6 @@ copy_attachments(CELL *ts)
if (attas[IntegerOfTerm(ts[2])].term_to_op(ts[1], ts[0]) == FALSE) {
/* oops, we did not have enough space to copy the elements */
/* reset queue of woken up goals */
Yap_UpdateTimedVar(DelayedVars, orig);
TR = tr0;
return FALSE;
}

10
C/exec.c
View File

@ -126,8 +126,8 @@ p_save_cp(void)
td = cp_as_integer(B);
BIND((CELL *)t,td,bind_save_cp);
#ifdef COROUTINING
DO_TRAIL(CellPtr(t), td);
if (CellPtr(t) < H0) Yap_WakeUp((CELL *)t);
DO_TRAIL(VarOfTerm(t), td);
if (IsAttVar(VarOfTerm(t))) Yap_WakeUp((CELL *)t);
bind_save_cp:
#endif
return(TRUE);
@ -145,8 +145,8 @@ p_save_env_b(void)
td = cp_as_integer((choiceptr)YENV[E_CB]);
BIND((CELL *)t,td,bind_save_cp);
#ifdef COROUTINING
DO_TRAIL(CellPtr(t), td);
if (CellPtr(t) < H0) Yap_WakeUp((CELL *)t);
DO_TRAIL(VarOfTerm(t), td);
if (IsAttVar(VarOfTerm(t))) Yap_WakeUp((CELL *)t);
bind_save_cp:
#endif
return(TRUE);
@ -1629,10 +1629,8 @@ Yap_InitYaamRegs(void)
GlobalArena = TermNil;
h0var = MkVarTerm();
#if COROUTINING
DelayedVars = Yap_NewTimedVar(h0var);
WokenGoals = Yap_NewTimedVar(TermNil);
AttsMutableList = Yap_NewTimedVar(h0var);
GlobalDelayArena = TermNil;
#endif
GcGeneration = Yap_NewTimedVar(h0var);
GcCurrentPhase = 0L;

402
C/globals.c
View File

@ -32,17 +32,19 @@ static char SccsId[] = "%W% %G%";
*/
#define QUEUE_FUNCTOR_ARITY 4
#define QUEUE_ARENA 0
#define QUEUE_DELAY_ARENA 1
#define QUEUE_HEAD 2
#define QUEUE_TAIL 3
#define QUEUE_SIZE 4
#define QUEUE_HEAD 1
#define QUEUE_TAIL 2
#define QUEUE_SIZE 3
#define HEAP_FUNCTOR_MIN_ARITY
#define HEAP_SIZE 0
#define HEAP_MAX 1
#define HEAP_ARENA 2
#define HEAP_DELAY_ARENA 3
#define HEAP_START 4
#define HEAP_START 3
#define MIN_ARENA_SIZE 1048
#define MAX_ARENA_SIZE (2048*16)
@ -99,102 +101,6 @@ CreateNewArena(CELL *ptr, UInt size)
return t;
}
#if COROUTINING
/* pointer to top of an arena */
static inline attvar_record *
DelayArenaPt(Term arena)
{
return (attvar_record *)arena;
}
static inline UInt
DelayArenaSz(Term arena)
{
attvar_record *ptr = (attvar_record *)arena-1;
return 1+(ptr-(attvar_record *)ptr->Done);
}
static void
ResetDelayArena(Term old_delay_arena, Term *new_arenap)
{
attvar_record *min = (attvar_record *)*new_arenap;
Term base = min[-1].Done;
while (min < (attvar_record *)old_delay_arena) {
min->Value = (Term)(min-1);
min->Done = base;
RESET_VARIABLE(&min->Atts);
min++;
}
*new_arenap = old_delay_arena;
}
static Term
CreateDelayArena(attvar_record *max, attvar_record *min)
{
attvar_record *ptr = max;
while (ptr > min) {
--ptr;
ptr->Done = (CELL)min;
ptr->Value = (CELL)(ptr-1);
RESET_VARIABLE(&ptr->Atts);
}
RESET_VARIABLE(&(ptr->Value));
return (CELL)max;
}
static Term
NewDelayArena(UInt size)
{
attvar_record *max = DelayTop(), *min = max-size;
Term out;
UInt howmuch;
while ((ADDR)min < Yap_GlobalBase+1024) {
UInt bsize = size*sizeof(attvar_record);
if ((howmuch = Yap_InsertInGlobal((CELL *)max, bsize))==0) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms");
return TermNil;
}
max = DelayTop(), min = max-size;
}
out = CreateDelayArena(max, min);
SetDelayTop(min);
return out;
}
static Term
GrowDelayArena(Term *arenap, UInt old_size, UInt size, UInt arity)
{
Term arena = *arenap;
UInt howmuch;
DelayArenaOverflows++;
if (size == 0) {
if (old_size < 1024) {
size = old_size*2;
} else {
size = old_size+1024;
}
}
if (size < 64) {
size = 64;
}
/* just make sure we are shifted up when we expand stacks */
XREGS[arity+1] = arena;
if ((howmuch = Yap_InsertInGlobal((CELL *)arena, (size-old_size)*sizeof(attvar_record)))==0) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return TermNil;
}
size = howmuch/sizeof(attvar_record)+old_size;
arena = XREGS[arity+1];
CreateDelayArena(DelayArenaPt(arena), DelayArenaPt(arena)-size);
return arena;
}
#endif
static Term
NewArena(UInt size, UInt arity, CELL *where)
{
@ -247,9 +153,6 @@ void
Yap_AllocateDefaultArena(Int gsize, Int attsize)
{
GlobalArena = NewArena(gsize, 2, NULL);
#if COROUTINING
GlobalDelayArena = NewDelayArena(attsize);
#endif
}
static void
@ -314,6 +217,35 @@ GrowArena(Term arena, CELL *pt, UInt old_size, UInt size, UInt arity)
return TRUE;
}
CELL *
Yap_GetFromArena(Term *arenap, UInt cells, UInt arity)
{
restart:
{
Term arena = *arenap;
CELL *max = ArenaLimit(arena);
CELL *base = ArenaPt(arena);
CELL *newH;
UInt old_sz = ArenaSz(arena), new_size;
if (IN_BETWEEN(base, H, max)) {
base = H;
H += cells;
return base;
}
if (base+cells > ASP-1024) {
if (!GrowArena(arena, max, old_sz, old_sz+sizeof(CELL)*1024, arity))
return NULL;
goto restart;
}
newH = base+cells;
new_size = old_sz - cells;
*arenap = CreateNewArena(newH, new_size);
return base;
}
}
static void
CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP, UInt old_size)
{
@ -349,54 +281,17 @@ clean_dirty_tr(tr_fr_ptr TR0) {
}
}
#if COROUTINING
static int
CopyAttVar(CELL *orig, struct cp_frame **to_visit_ptr, CELL *res, Term *att_arenap)
{
register attvar_record *attv = (attvar_record *)orig;
register attvar_record *newv;
struct cp_frame *to_visit = *to_visit_ptr;
CELL *vt;
/* add a new attributed variable */
if (DelayArenaSz(*att_arenap) < 8)
return FALSE;
newv = DelayArenaPt(*att_arenap);
newv--;
RESET_VARIABLE(&(newv->Value));
RESET_VARIABLE(&(newv->Done));
vt = &(attv->Atts);
to_visit->start_cp = vt-1;
to_visit->end_cp = vt;
if (IsVarTerm(attv->Atts)) {
newv->Atts = (CELL)H;
to_visit->to = H;
H++;
} else {
to_visit->to = &(newv->Atts);
}
to_visit->oldv = vt[-1];
/* you're coming from a variable */
to_visit->ground = FALSE;
*to_visit_ptr = to_visit+1;
*res = (CELL)&(newv->Done);
*att_arenap = (CELL)(newv);
return TRUE;
}
#endif
static int
copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int copy_att_vars, CELL *ptf, CELL *HLow, Term *att_arenap)
copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int copy_att_vars, CELL *ptf, CELL *HLow)
{
struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace();
CELL *HB0 = HB;
tr_fr_ptr TR0 = TR;
#ifdef COROUTINING
CELL *dvars = NULL;
#endif
int ground = TRUE;
#ifdef COROUTINING
CELL *dvarsmin = NULL, *dvarsmax=NULL;
#endif
HB = HLow;
to_visit0 = to_visit;
@ -468,6 +363,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
if (IsExtensionFunctor(f)) {
switch((CELL)f) {
case (CELL)FunctorDBRef:
case (CELL)FunctorAttVar:
*ptf++ = d0;
break;
case (CELL)FunctorLongInt:
@ -571,34 +467,35 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
*ptf++ = (CELL) ptd0;
} else {
#if COROUTINING
if (IsAttachedTerm((CELL)ptd0) && copy_att_vars) {
if (copy_att_vars && IsAttachedTerm((CELL)ptd0)) {
/* if unbound, call the standard copy term routine */
struct cp_frame *bp[1];
struct cp_frame *bp;
if (dvars == NULL) {
dvars = (CELL *)DelayArenaPt(*att_arenap);
}
if (ptd0 < dvars &&
ptd0 >= (CELL *)DelayArenaPt(*att_arenap)) {
if (IN_BETWEEN(dvarsmin, ptd0, dvarsmax)) {
*ptf++ = (CELL) ptd0;
} else {
tr_fr_ptr CurTR;
CELL new;
CurTR = TR;
bp[0] = to_visit;
HB = HB0;
if (!CopyAttVar(ptd0, bp, ptf, att_arenap)) {
goto delay_overflow;
}
if (H > ASP - MIN_ARENA_SIZE) {
bp = to_visit;
if (!attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf)) {
goto overflow;
}
to_visit = bp[0];
HB = HLow;
to_visit = bp;
new = *ptf;
if (TR > (tr_fr_ptr)Yap_TrailTop - 256) {
/* Trail overflow */
if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
goto trail_overflow;
}
}
Bind_and_Trail(ptd0, new);
if (dvarsmin == NULL) {
dvarsmin = CellPtr(new);
} else {
*dvarsmax = (CELL)(CellPtr(new)+1);
}
dvarsmax = CellPtr(new)+1;
ptf++;
if ((ADDR)TR > Yap_TrailTop-MIN_ARENA_SIZE)
goto trail_overflow;
Bind_and_Trail(ptd0, ptf[-1]);
}
} else {
#endif
@ -613,6 +510,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
#endif
}
}
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
to_visit --;
@ -629,6 +527,8 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
/* restore our nice, friendly, term to its original state */
HB = HB0;
clean_dirty_tr(TR0);
/* follow chain of multi-assigned variables */
close_attvar_chain(dvarsmin, dvarsmax);
return 0;
overflow:
@ -647,6 +547,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
}
#endif
reset_trail(TR0);
reset_attvars(dvarsmin, dvarsmax);
return -1;
heap_overflow:
@ -665,29 +566,9 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
}
#endif
reset_trail(TR0);
reset_attvars(dvarsmin, dvarsmax);
return -2;
#if COROUTINING
delay_overflow:
/* oops, we're in trouble */
H = HLow;
/* we've done it */
/* restore our nice, friendly, term to its original state */
HB = HB0;
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit--;
pt0 = to_visit->start_cp;
pt0_end = to_visit->end_cp;
ptf = to_visit->to;
*pt0 = to_visit->oldv;
}
#endif
reset_trail(TR0);
return -3;
#endif
trail_overflow:
/* oops, we're in trouble */
H = HLow;
@ -704,26 +585,21 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop
}
#endif
reset_trail(TR0);
reset_attvars(dvarsmin, dvarsmax);
return -4;
}
static Term
CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Term *newarena, Term *att_arenap, UInt min_grow)
CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Term *newarena, UInt min_grow)
{
UInt old_size = ArenaSz(arena);
CELL *oldH = H;
CELL *oldHB = HB;
CELL *oldASP = ASP;
int res = 0;
#if COROUTINING
Term old_delay_arena;
#endif
Term tn;
restart:
#if COROUTINING
old_delay_arena = *att_arenap;
#endif
t = Deref(t);
if (IsVarTerm(t)) {
ASP = ArenaLimit(arena);
@ -735,7 +611,7 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te
*H = t;
Hi = H+1;
H += 2;
if ((res = copy_complex_term(Hi-2, Hi-1, share, copy_att_vars, Hi, Hi, att_arenap)) < 0)
if ((res = copy_complex_term(Hi-2, Hi-1, share, copy_att_vars, Hi, Hi)) < 0)
goto error_handler;
CloseArena(oldH, oldHB, oldASP, newarena, old_size);
return Hi[0];
@ -768,7 +644,7 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te
Hi = H;
tf = AbsPair(H);
H += 2;
if ((res = copy_complex_term(ap-1, ap+1, share, copy_att_vars, Hi, Hi, att_arenap)) < 0) {
if ((res = copy_complex_term(ap-1, ap+1, share, copy_att_vars, Hi, Hi)) < 0) {
goto error_handler;
}
CloseArena(oldH, oldHB, oldASP, newarena, old_size);
@ -838,7 +714,7 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te
res = -1;
goto error_handler;
}
if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), share, copy_att_vars, HB0+1, HB0, att_arenap)) < 0) {
if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), share, copy_att_vars, HB0+1, HB0)) < 0) {
goto error_handler;
}
}
@ -848,14 +724,9 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te
error_handler:
H = HB;
CloseArena(oldH, oldHB, oldASP, newarena, old_size);
#if COROUTINING
if (old_delay_arena != MkIntTerm(0))
ResetDelayArena(old_delay_arena, att_arenap);
#endif
XREGS[arity+1] = t;
XREGS[arity+2] = arena;
XREGS[arity+3] = (CELL)newarena;
XREGS[arity+4] = (CELL)att_arenap;
{
CELL *old_top = ArenaLimit(*newarena);
ASP = oldASP;
@ -865,29 +736,11 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te
case -1:
if (arena == GlobalArena)
GlobalArenaOverflows++;
if (!GrowArena(arena, old_top, old_size, min_grow, arity+4)) {
if (!GrowArena(arena, old_top, old_size, min_grow, arity+3)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return 0L;
}
break;
#if COROUTINING
case -3:
/* handle delay arena overflow */
old_size = DelayArenaSz(*att_arenap);
if (!GrowDelayArena(att_arenap, old_size, 0L, arity+4)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return 0L;
}
break;
#endif
case -4:
/* handle trail overflow */
if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L, FALSE)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, Yap_ErrorMessage);
return 0L;
}
break;
default: /* temporary space overflow */
if (!Yap_ExpandPreAllocCodeSpace(0,NULL,TRUE)) {
Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage);
@ -898,7 +751,6 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te
oldH = H;
oldHB = HB;
oldASP = ASP;
att_arenap = (Term *)XREGS[arity+4];
newarena = (CELL *)XREGS[arity+3];
arena = Deref(XREGS[arity+2]);
t = XREGS[arity+1];
@ -1071,7 +923,7 @@ p_nb_setarg(void)
}
if (pos < 1 || pos > arity)
return FALSE;
to = CopyTermToArena(ARG3, GlobalArena, FALSE, TRUE, 2, &GlobalArena, &GlobalDelayArena, garena_overflow_size(ArenaPt(GlobalArena)));
to = CopyTermToArena(ARG3, GlobalArena, FALSE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena)));
if (to == 0L)
return FALSE;
destp[pos] = to;
@ -1111,7 +963,7 @@ p_nb_set_shared_arg(void)
}
if (pos < 1 || pos > arity)
return FALSE;
to = CopyTermToArena(ARG3, GlobalArena, TRUE, TRUE, 2, &GlobalArena, &GlobalDelayArena, garena_overflow_size(ArenaPt(GlobalArena)));
to = CopyTermToArena(ARG3, GlobalArena, TRUE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena)));
if (to == 0L)
return FALSE;
destp[pos] = to;
@ -1180,7 +1032,7 @@ Yap_SetGlobalVal(Atom at, Term t0)
Term to;
GlobalEntry *ge;
ge = GetGlobalEntry(at);
to = CopyTermToArena(t0, GlobalArena, FALSE, TRUE, 2, &GlobalArena, &GlobalDelayArena, garena_overflow_size(ArenaPt(GlobalArena)));
to = CopyTermToArena(t0, GlobalArena, FALSE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena)));
if (to == 0L)
return to;
WRITE_LOCK(ge->GRWLock);
@ -1193,7 +1045,7 @@ Term
Yap_SaveTerm(Term t0)
{
Term to;
to = CopyTermToArena(t0, GlobalArena, FALSE, TRUE, 2, &GlobalArena, &GlobalDelayArena, garena_overflow_size(ArenaPt(GlobalArena)));
to = CopyTermToArena(t0, GlobalArena, FALSE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena)));
if (to == 0L)
return to;
return to;
@ -1226,7 +1078,7 @@ p_nb_set_shared_val(void)
return (FALSE);
}
ge = GetGlobalEntry(AtomOfTerm(t));
to = CopyTermToArena(ARG2, GlobalArena, TRUE, TRUE, 2, &GlobalArena, &GlobalDelayArena, garena_overflow_size(ArenaPt(GlobalArena)));
to = CopyTermToArena(ARG2, GlobalArena, TRUE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena)));
if (to == 0L)
return FALSE;
WRITE_LOCK(ge->GRWLock);
@ -1462,10 +1314,7 @@ p_nb_create2(void)
static Int
nb_queue(UInt arena_sz)
{
Term queue_arena, queue, ar[5], *nar;
#if COROUTINING
Term delay_queue_arena;
#endif
Term queue_arena, queue, ar[QUEUE_FUNCTOR_ARITY], *nar;
Term t = Deref(ARG1);
DepthArenas++;
@ -1476,32 +1325,13 @@ nb_queue(UInt arena_sz)
return (FunctorOfTerm(t) == FunctorNBQueue);
}
ar[QUEUE_ARENA] =
ar[QUEUE_DELAY_ARENA] =
ar[QUEUE_HEAD] =
ar[QUEUE_TAIL] =
ar[QUEUE_SIZE] =
MkIntTerm(0);
queue = Yap_MkApplTerm(FunctorNBQueue,5,ar);
queue = Yap_MkApplTerm(FunctorNBQueue,QUEUE_FUNCTOR_ARITY,ar);
if (!Yap_unify(queue,ARG1))
return FALSE;
#if COROUTINING
{
UInt delay_arena_sz = 2;
if (DelayArenaOverflows) {
delay_arena_sz = ((attvar_record *)H0- DelayTop())/16;
if (delay_arena_sz <2)
delay_arena_sz = 2;
if (delay_arena_sz > 256)
delay_arena_sz = 256;
}
delay_queue_arena = NewDelayArena(delay_arena_sz);
if (delay_queue_arena == 0L) {
return FALSE;
}
nar = RepAppl(Deref(ARG1))+1;
nar[QUEUE_DELAY_ARENA] = delay_queue_arena;
}
#endif
if (arena_sz < 4*1024)
arena_sz = 4*1024;
queue_arena = NewArena(arena_sz,1,NULL);
@ -1581,19 +1411,6 @@ GetQueueArena(CELL *qd, char* caller)
return t;
}
#if COROUTINING
static void
RecoverDelayArena(Term delay_arena)
{
attvar_record *pt = DelayArenaPt(delay_arena),
*max = DelayTop();
if (max == pt-DelayArenaSz(delay_arena)) {
SetDelayTop(pt);
} else {
}
}
#endif
static void
RecoverArena(Term arena)
{
@ -1611,7 +1428,7 @@ p_nb_queue_close(void)
Term t = Deref(ARG1);
Int out;
DepthArenas--;
DepthArenas--;
if (!IsVarTerm(t)) {
CELL *qp;
@ -1622,10 +1439,6 @@ p_nb_queue_close(void)
}
if (qp[QUEUE_ARENA] != MkIntTerm(0))
RecoverArena(qp[QUEUE_ARENA]);
#if COROUTINING
if (qp[QUEUE_DELAY_ARENA] != MkIntTerm(0))
RecoverDelayArena(qp[QUEUE_DELAY_ARENA]);
#endif
if (qp[QUEUE_SIZE] == MkIntTerm(0)) {
return
Yap_unify(ARG3, ARG2);
@ -1635,7 +1448,6 @@ p_nb_queue_close(void)
Yap_unify(ARG2, qp[QUEUE_HEAD]);
qp[-1] = (CELL)Yap_MkFunctor(AtomHeap,1);
qp[QUEUE_ARENA] =
qp[QUEUE_DELAY_ARENA] =
qp[QUEUE_HEAD] =
qp[QUEUE_TAIL] = MkIntegerTerm(0);
return out;
@ -1662,7 +1474,7 @@ p_nb_queue_enqueue(void)
} else {
min_size = 0L;
}
to = CopyTermToArena(ARG2, arena, FALSE, TRUE, 2, qd+QUEUE_ARENA, qd+QUEUE_DELAY_ARENA, min_size);
to = CopyTermToArena(ARG2, arena, FALSE, TRUE, 2, qd+QUEUE_ARENA, min_size);
if (to == 0L)
return FALSE;
qd = GetQueue(ARG1,"enqueue");
@ -1811,9 +1623,6 @@ static Int
p_nb_heap(void)
{
Term heap_arena, heap, *ar, *nar;
#if COROUTINING
Term delay_heap_arena;
#endif
UInt hsize;
Term tsize = Deref(ARG1);
UInt arena_sz = (H-H0)/16;
@ -1839,7 +1648,6 @@ p_nb_heap(void)
return FALSE;
ar = RepAppl(heap)+1;
ar[HEAP_ARENA] =
ar[HEAP_DELAY_ARENA] =
ar[HEAP_SIZE] =
MkIntTerm(0);
ar[HEAP_MAX] = tsize;
@ -1851,19 +1659,6 @@ p_nb_heap(void)
}
nar = RepAppl(Deref(ARG2))+1;
nar[HEAP_ARENA] = heap_arena;
#if COROUTINING
arena_sz = ((attvar_record *)H0- DelayTop())/16;
if (arena_sz <2)
arena_sz = 2;
if (arena_sz > 256)
arena_sz = 256;
delay_heap_arena = NewDelayArena(arena_sz);
if (delay_heap_arena == 0L) {
return FALSE;
}
nar = RepAppl(Deref(ARG2))+1;
nar[HEAP_DELAY_ARENA] = delay_heap_arena;
#endif
return TRUE;
}
@ -1877,10 +1672,6 @@ p_nb_heap_close(void)
qp = RepAppl(t)+1;
if (qp[HEAP_ARENA] != MkIntTerm(0))
RecoverArena(qp[HEAP_ARENA]);
#if COROUTINING
if (qp[HEAP_DELAY_ARENA] != MkIntTerm(0))
RecoverDelayArena(qp[HEAP_DELAY_ARENA]);
#endif
qp[-1] = (CELL)Yap_MkFunctor(AtomHeap,1);
qp[0] = MkIntegerTerm(0);
return TRUE;
@ -1994,9 +1785,9 @@ p_nb_heap_add_to_heap(void)
if (arena == 0L)
return FALSE;
mingrow = garena_overflow_size(ArenaPt(arena));
key = CopyTermToArena(ARG2, arena, FALSE, TRUE, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA, mingrow);
key = CopyTermToArena(ARG2, arena, FALSE, TRUE, 3, qd+HEAP_ARENA, mingrow);
arena = qd[HEAP_ARENA];
to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA, mingrow);
to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, qd+HEAP_ARENA, mingrow);
if (key == 0 || to == 0L)
return FALSE;
qd = GetHeap(ARG1,"add_to_heap");
@ -2110,9 +1901,6 @@ static Int
p_nb_beam(void)
{
Term beam_arena, beam, *ar, *nar;
#if COROUTINING
Term delay_beam_arena;
#endif
UInt hsize;
Term tsize = Deref(ARG1);
UInt arena_sz = (H-H0)/16;
@ -2128,7 +1916,7 @@ p_nb_beam(void)
hsize = IntegerOfTerm(tsize);
}
while ((beam = MkZeroApplTerm(Yap_MkFunctor(AtomHeap,5*hsize+HEAP_START+1),5*hsize+HEAP_START+1)) == TermNil) {
if (!Yap_gcl((5*hsize+HEAP_START+1)*sizeof(CELL), 2, ENV, P)) {
if (!Yap_gcl((4*hsize+HEAP_START+1)*sizeof(CELL), 2, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
@ -2137,7 +1925,6 @@ p_nb_beam(void)
return FALSE;
ar = RepAppl(beam)+1;
ar[HEAP_ARENA] =
ar[HEAP_DELAY_ARENA] =
ar[HEAP_SIZE] =
MkIntTerm(0);
ar[HEAP_MAX] = tsize;
@ -2149,19 +1936,6 @@ p_nb_beam(void)
}
nar = RepAppl(Deref(ARG2))+1;
nar[HEAP_ARENA] = beam_arena;
#if COROUTINING
arena_sz = ((attvar_record *)H0- DelayTop())/16;
if (arena_sz <2)
arena_sz = 2;
if (arena_sz > 256)
arena_sz = 256;
delay_beam_arena = NewDelayArena(arena_sz);
if (delay_beam_arena == 0L) {
return FALSE;
}
nar = RepAppl(Deref(ARG2))+1;
nar[HEAP_DELAY_ARENA] = delay_beam_arena;
#endif
return TRUE;
}
@ -2397,9 +2171,9 @@ p_nb_beam_add_to_beam(void)
if (arena == 0L)
return FALSE;
mingrow = garena_overflow_size(ArenaPt(arena));
key = CopyTermToArena(ARG2, qd[HEAP_ARENA], FALSE, TRUE, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA, mingrow);
key = CopyTermToArena(ARG2, qd[HEAP_ARENA], FALSE, TRUE, 3, qd+HEAP_ARENA, mingrow);
arena = qd[HEAP_ARENA];
to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA, mingrow);
to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, qd+HEAP_ARENA, mingrow);
if (key == 0 || to == 0L)
return FALSE;
qd = GetHeap(ARG1,"add_to_beam");

23
C/grow.c
View File

@ -33,10 +33,6 @@
#define strncat(s0,s1,sz) strcat(s0,s1)
#endif
#if !COROUTINING
#define DelayTop() H0
#endif
typedef enum {
STACK_SHIFTING = 0,
STACK_COPYING = 1,
@ -134,7 +130,6 @@ SetHeapRegs(int copying_threads)
OldTR = TR;
OldHeapBase = Yap_HeapBase;
OldHeapTop = HeapTop;
OldDelayTop = CurrentDelayTop;
/* Adjust stack addresses */
Yap_TrailBase = TrailAddrAdjust(Yap_TrailBase);
Yap_TrailTop = TrailAddrAdjust(Yap_TrailTop);
@ -172,8 +167,6 @@ SetHeapRegs(int copying_threads)
HB = PtoGloAdjust(HB);
if (B)
B = ChoicePtrAdjust(B);
if (CurrentDelayTop)
CurrentDelayTop = PtoDelayAdjust(CurrentDelayTop);
#ifdef TABLING
if (B_FZ)
B_FZ = ChoicePtrAdjust(B_FZ);
@ -195,12 +188,8 @@ SetHeapRegs(int copying_threads)
if (!copying_threads) {
if (GlobalArena)
GlobalArena = AbsAppl(PtoGloAdjust(RepAppl(GlobalArena)));
if (GlobalDelayArena)
GlobalDelayArena = GlobalAdjust(GlobalDelayArena);
}
#ifdef COROUTINING
if (DelayedVars)
DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars)));
if (AttsMutableList)
AttsMutableList = AbsAppl(PtoGloAdjust(RepAppl(AttsMutableList)));
if (WokenGoals)
@ -256,7 +245,7 @@ worker_p_binding(int worker_p, CELL *aux_ptr)
reg = AdjustGlobTerm(reg);
return reg;
} else {
CELL reg = ThreadHandle[worker_p].current_yaam_regs->H0_[aux_ptr-H0];
CELL reg = ThreadHandle[worker_p].current_yaam_regs-> H0_[aux_ptr-H0];
reg = AdjustGlobTerm(reg);
return reg;
}
@ -567,12 +556,12 @@ AdjustGlobal(long sz, int thread_copying)
pt_max = (CELL *) (LOCAL_end_global_copy);
} else {
#endif
pt = CurrentDelayTop;
pt = H0;
pt_max = (H-sz/CellSize);
#if defined(YAPOR) && defined(THREADS)
}
#endif
pt = CurrentDelayTop;
pt = H0;
while (pt < pt_max) {
CELL reg;
@ -777,7 +766,6 @@ static_growheap(long size, int fix_code, struct intermediates *cip, tr_fr_ptr *o
int gc_verbose;
UInt minimal_request = 0L;
CurrentDelayTop = (CELL *)DelayTop();
/* adjust to a multiple of 256) */
if (size < YAP_ALLOC_SIZE)
size = YAP_ALLOC_SIZE;
@ -859,7 +847,7 @@ static_growglobal(long request, CELL **ptr, CELL *hsplit)
{
UInt start_growth_time, growth_time;
int gc_verbose;
char *omax = (ADDR)DelayTop();
char *omax = (char *)H0;
ADDR old_GlobalBase = Yap_GlobalBase;
UInt minimal_request = 0L;
long size = request;
@ -874,7 +862,6 @@ static_growglobal(long request, CELL **ptr, CELL *hsplit)
do_grow is whether we expand stacks
*/
CurrentDelayTop = (CELL *)omax;
if (hsplit) {
/* just a little bit of sanity checking */
if (hsplit < H0 && hsplit > (CELL *)Yap_GlobalBase) {
@ -1492,7 +1479,6 @@ execute_growstack(long size0, int from_trail, int in_parser, tr_fr_ptr *old_trp,
long size = size0;
ADDR old_Yap_GlobalBase = Yap_GlobalBase;
CurrentDelayTop = (CELL *)DelayTop();
if (!Yap_AllowGlobalExpansion) {
Yap_ErrorMessage = "Database crashed against stacks";
return FALSE;
@ -1869,7 +1855,6 @@ Yap_CopyThreadStacks(int worker_q, int worker_p, int incremental)
Yap_REGS.CUT_C_TOP = ThreadHandle[worker_p].current_yaam_regs->CUT_C_TOP;
#endif
DelayedVars = ThreadHandle[worker_p].current_yaam_regs->DelayedVars_;
CurrentDelayTop = (CELL *)DelayTop();
DynamicArrays = NULL;
StaticArrays = NULL;
GlobalVariables = NULL;

132
C/heapgc.c
View File

@ -34,8 +34,8 @@ static char SccsId[] = "%W% %G%";
STATIC_PROTO(Int p_inform_gc, (void));
STATIC_PROTO(Int p_gc, (void));
STATIC_PROTO(void push_registers, (Int, yamop *));
STATIC_PROTO(void marking_phase, (tr_fr_ptr, CELL *, yamop *, CELL *));
STATIC_PROTO(void compaction_phase, (tr_fr_ptr, CELL *, yamop *, CELL *));
STATIC_PROTO(void marking_phase, (tr_fr_ptr, CELL *, yamop *));
STATIC_PROTO(void compaction_phase, (tr_fr_ptr, CELL *, yamop *));
STATIC_PROTO(void pop_registers, (Int, yamop *));
STATIC_PROTO(void init_dbtable, (tr_fr_ptr));
STATIC_PROTO(void mark_db_fixed, (CELL *));
@ -442,7 +442,6 @@ push_registers(Int num_regs, yamop *nextop)
ArrayEntry *al = DynamicArrays;
GlobalEntry *gl = GlobalVariables;
TrailTerm(TR++) = GlobalArena;
TrailTerm(TR++) = GlobalDelayArena;
while (al) {
check_pr_trail(TR);
TrailTerm(TR++) = al->ValueOfVE;
@ -474,8 +473,7 @@ push_registers(Int num_regs, yamop *nextop)
#ifdef COROUTINING
TrailTerm(TR) = WokenGoals;
TrailTerm(TR+1) = AttsMutableList;
TrailTerm(TR+2) = DelayedVars;
TR += 3;
TR += 2;
#endif
for (i = 1; i <= num_regs; i++) {
check_pr_trail(TR);
@ -521,7 +519,6 @@ pop_registers(Int num_regs, yamop *nextop)
GlobalEntry *gl = GlobalVariables;
GlobalArena = TrailTerm(ptr++);
GlobalDelayArena = TrailTerm(ptr++);
while (al) {
al->ValueOfVE = TrailTerm(ptr++);
al = al->NextAE;
@ -549,7 +546,6 @@ pop_registers(Int num_regs, yamop *nextop)
#ifdef MULTI_ASSIGNMENT_VARIABLES
WokenGoals = TrailTerm(ptr++);
AttsMutableList = TrailTerm(ptr++);
DelayedVars = TrailTerm(ptr++);
#endif
#endif
for (i = 1; i <= num_regs; i++)
@ -1154,6 +1150,33 @@ check_global(void) {
/* mark a heap object and all heap objects accessible from it */
static void
mark_variable(CELL_PTR current);
static void
mark_att_var(CELL *hp)
{
if (!MARKED_PTR(hp-1)) {
MARK(hp-1);
PUSH_POINTER(hp-1);
total_marked++;
if (hp < HGEN) {
total_oldies++;
}
}
if (!MARKED_PTR(hp)) {
MARK(hp);
PUSH_POINTER(hp);
total_marked++;
if (hp < HGEN) {
total_oldies++;
}
}
mark_variable(hp+1);
mark_variable(hp+2);
}
static void
mark_variable(CELL_PTR current)
{
@ -1177,7 +1200,10 @@ mark_variable(CELL_PTR current)
next = GET_NEXT(ccur);
if (IsVarTerm(ccur)) {
if (ONHEAP(next)) {
if (IsAttVar(current) && current==next) {
mark_att_var(current);
POP_CONTINUATION();
} else if (ONHEAP(next)) {
#ifdef EASY_SHUNTING
CELL cnext;
/* do variable shunting between variables in the global */
@ -1596,20 +1622,6 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
*/
static void
mark_att_var(CELL *hp)
{
attvar_record *top = (attvar_record *)Yap_GlobalBase;
Int relpos = top-(attvar_record *)hp;
attvar_record *attv = top-relpos;
if (attv != (attvar_record *)hp)
attv--;
mark_external_reference2(&attv->Done);
mark_external_reference2(&attv->Value);
mark_external_reference2(&attv->Atts);
}
static void
mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B)
{
@ -1652,7 +1664,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
#endif
discard_trail_entries++;
} else {
if ( hp > (CELL*)Yap_GlobalBase && hp < H0) {
if ( IsAttVar(hp)) {
if (!detatt || hp >= detatt) {
mark_att_var(hp);
} else {
@ -1712,9 +1724,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
*/
if (cptr < (CELL *)gc_B && cptr >= gc_H) {
goto remove_trash_entry;
} else if (!detatt && cptr == RepAppl(DelayedVars)+1) {
/* detatt = cptr; */
} else if (cptr > (CELL*)Yap_GlobalBase && cptr < H0) {
} else if (IsAttVar(cptr)) {
/* MABINDING that should be recovered */
if (detatt && cptr < detatt) {
goto remove_trash_entry;
@ -1847,24 +1857,6 @@ mark_slots(CELL *ptr)
}
#ifdef COROUTINING
static void
mark_delays(attvar_record *top, attvar_record *bottom)
{
attvar_record *attv = (attvar_record *)top;
for (; attv < bottom; attv++) {
/* only mark what is accessible */
if (IsVarTerm(attv->Done) && IsUnboundVar(&attv->Done)) {
mark_external_reference2(&attv->Done);
mark_external_reference2(&attv->Value);
mark_external_reference2(&attv->Atts);
}
}
}
#else
#define mark_delays(T,B)
#endif
#ifdef TABLING
static choiceptr
youngest_cp(choiceptr gc_B, dep_fr_ptr *depfrp)
@ -3595,7 +3587,7 @@ set_conditionals(tr_fr_ptr str) {
*/
static void
marking_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
marking_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp)
{
#ifdef EASY_SHUNTING
@ -3615,7 +3607,6 @@ marking_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
values */
mark_regs(old_TR); /* active registers & trail */
/* active environments */
mark_delays((attvar_record *)max, (attvar_record *)H0);
mark_environments(current_env, EnvSize(curp), EnvBMap(curp));
mark_choicepoints(B, old_TR, is_gc_very_verbose()); /* choicepoints, and environs */
#ifdef EASY_SHUNTING
@ -3640,22 +3631,6 @@ sweep_oldgen(CELL *max, CELL *base)
}
}
#ifdef COROUTINING
static void
sweep_delays(CELL *max, CELL *myH0)
{
while (max < myH0) {
if (MARKED_PTR(max)) {
UNMARK(max);
if (HEAP_PTR(*max)) {
into_relocation_chain(max, GET_NEXT(*max));
}
}
max++;
}
}
#endif
/*
* move marked heap objects upwards over unmarked objects, and reset all
@ -3663,9 +3638,9 @@ sweep_delays(CELL *max, CELL *myH0)
*/
static void
compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp)
{
CELL *CurrentH0 = NULL, *myH0 = H0;
CELL *CurrentH0 = NULL;
int icompact = (iptop < (CELL_PTR *)ASP && 10*total_marked < H-H0);
@ -3682,9 +3657,6 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
sweep_oldgen(HGEN, CurrentH0);
}
}
#ifdef COROUTINING
sweep_delays(max, myH0);
#endif
sweep_environments(current_env, EnvSize(curp), EnvBMap(curp));
sweep_choicepoints(B);
sweep_trail(B, old_TR);
@ -3738,7 +3710,6 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
int gc_verbose;
volatile tr_fr_ptr old_TR = NULL;
UInt m_time, c_time, time_start, gc_time;
CELL *max;
Int effectiveness, tot;
int gc_trace;
UInt gc_phase;
@ -3795,24 +3766,9 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
}
current_env = (CELL *)*ASP;
ASP++;
#if COROUTINING
max = (CELL *)DelayTop();
#endif
}
#endif
time_start = Yap_cputime();
#if COROUTINING
max = (CELL *)DelayTop();
while (max - (CELL*)Yap_GlobalBase < 1024+(2*NUM_OF_ATTS)) {
if (!Yap_growglobal(&current_env)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return -1;
}
max = (CELL *)DelayTop();
}
#else
max = NULL;
#endif
if (setjmp(Yap_gc_restore) == 2) {
UInt sz;
@ -3838,9 +3794,6 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
discard_trail_entries = 0;
current_env = (CELL *)*ASP;
ASP++;
#if COROUTINING
max = (CELL *)DelayTop();
#endif
}
}
#if EASY_SHUNTING
@ -3862,9 +3815,6 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
return -1;
current_env = (CELL *)*ASP;
ASP++;
#if COROUTINING
max = (CELL *)DelayTop();
#endif
}
memset((void *)Yap_bp, 0, alloc_sz);
#ifdef HYBRID_SCHEME
@ -3882,7 +3832,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
OldTR = (tr_fr_ptr)(old_TR = TR);
push_registers(predarity, nextop);
/* make sure we clean bits after a reset */
marking_phase(old_TR, current_env, nextop, max);
marking_phase(old_TR, current_env, nextop);
if (total_oldies > ((HGEN-H0)*8)/10) {
total_marked -= total_oldies;
tot = total_marked+(HGEN-H0);
@ -3922,7 +3872,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
#endif
}
time_start = m_time;
compaction_phase(old_TR, current_env, nextop, max);
compaction_phase(old_TR, current_env, nextop);
TR = old_TR;
pop_registers(predarity, nextop);
TR = new_TR;

2
C/init.c
View File

@ -1167,7 +1167,6 @@ InitCodes(void)
Yap_heap_regs->wl[i].global_variables = NULL;
Yap_heap_regs->wl[i].global_arena = 0L;
Yap_heap_regs->wl[i].global_arena_overflows = 0;
Yap_heap_regs->wl[i].global_delay_arena = 0L;
Yap_heap_regs->wl[i].allow_restart = FALSE;
Yap_heap_regs->wl[i].tot_gc_time = 0;
Yap_heap_regs->wl[i].tot_gc_recovered = 0;
@ -1193,7 +1192,6 @@ InitCodes(void)
Yap_heap_regs->wl.global_arena = 0L;
Yap_heap_regs->wl.global_arena_overflows = 0;
Yap_heap_regs->wl.allow_restart = FALSE;
Yap_heap_regs->wl.global_delay_arena = 0L;
Yap_heap_regs->wl.tot_gc_time = 0;
Yap_heap_regs->wl.tot_gc_recovered = 0;
Yap_heap_regs->wl.gc_calls = 0;

6
C/inlines.c
View File

@ -628,7 +628,7 @@ p_functor(void) /* functor(?,?,?) */
BIND(pt0, d0, bind_func_nvar_var);
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_func_nvar_var:
#endif
/* have to buffer ENDP and label */
@ -655,7 +655,7 @@ p_functor(void) /* functor(?,?,?) */
/* Done */
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_func_nvar3_var:
#endif
return(TRUE);
@ -738,7 +738,7 @@ p_functor(void) /* functor(?,?,?) */
BIND(pt0, d0, bind_func_var_3nvar);
#ifdef COROUTINING
DO_TRAIL(pt0, d0);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_func_var_3nvar:
#endif
return(TRUE);

13
C/save.c
View File

@ -409,9 +409,6 @@ save_regs(int mode)
putcellptr((CELL *)P);
putout(CreepFlag);
putout(EX);
#ifdef COROUTINING
putout(DelayedVars);
#endif
#if defined(SBA) || defined(TABLING)
putcellptr(H_FZ);
putcellptr((CELL *)B_FZ);
@ -807,11 +804,6 @@ get_regs(int flag)
EX = get_cell();
if (Yap_ErrorMessage)
return -1;
#ifdef COROUTINING
DelayedVars = get_cell();
if (Yap_ErrorMessage)
return -1;
#endif
#if defined(SBA) || defined(TABLING)
H_FZ = get_cellptr();
if (Yap_ErrorMessage)
@ -1035,12 +1027,7 @@ restore_regs(int flag)
S = PtoGloAdjust(S);
if (EX)
EX = AbsAppl(PtoGloAdjust(RepAppl(EX)));
#ifdef COROUTINING
DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars)));
#ifdef MULTI_ASSIGNMENT_VARIABLES
WokenGoals = AbsAppl(PtoGloAdjust(RepAppl(WokenGoals)));
#endif
#endif
}
}

2
C/tracer.c
View File

@ -113,7 +113,7 @@ check_trail_consistency(void) {
} else {
if (IsPairTerm(TrailTerm(ptr))) {
CELL *p = RepPair(TrailTerm(ptr));
if (p < H0) continue;
if IsAttVar(p) continue;
}
printf("Oops at call %ld, B->cp(%p) TR(%p) pt(%p)\n", vsc_count,B->cp_tr, TR, ptr);
return(FALSE);

20
C/unify.c
View File

@ -259,7 +259,7 @@ loop:
BIND_GLOBAL(ptd1, d0, bind_ocunify1);
#ifdef COROUTINING
DO_TRAIL(ptd1, d0);
if (ptd1 < H0) Yap_WakeUp(ptd1);
if (IsAttVar(ptd1)) Yap_WakeUp(ptd1);
bind_ocunify1:
#endif
if (Yap_rational_tree_loop(ptd1-1, ptd1, (CELL **)to_visit, (CELL **)unif))
@ -282,7 +282,7 @@ loop:
BIND_GLOBAL(ptd0, d1, bind_ocunify2);
#ifdef COROUTINING
DO_TRAIL(ptd0, d1);
if (ptd0 < H0) Yap_WakeUp(ptd0);
if (IsAttVar(ptd0)) Yap_WakeUp(ptd0);
bind_ocunify2:
#endif
if (Yap_rational_tree_loop(ptd0-1, ptd0, (CELL **)to_visit, (CELL **)unif))
@ -403,7 +403,7 @@ oc_unify_nvar_nvar:
BIND(pt1, d0, bind_ocunify4);
#ifdef COROUTINING
DO_TRAIL(pt1, d0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
bind_ocunify4:
#endif
/* local variables cannot be in a term */
@ -421,7 +421,7 @@ oc_unify_var_nvar:
BIND(pt0, d1, bind_ocunify5);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_ocunify5:
#endif
/* local variables cannot be in a term */
@ -436,14 +436,14 @@ oc_unify_var_nvar:
UnifyCells(pt0, pt1, uc1, uc2);
#ifdef COROUTINING
DO_TRAIL(pt0, (CELL)pt1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
uc1:
#endif
return (TRUE);
#ifdef COROUTINING
uc2:
DO_TRAIL(pt1, (CELL)pt0);
if (pt1 < H0) {
if (IsAttVar(pt1)) {
Yap_WakeUp(pt1);
}
#endif
@ -550,7 +550,7 @@ unify_nvar_nvar:
BIND(pt1, d0, bind_unify3);
#ifdef COROUTINING
DO_TRAIL(pt1, d0);
if (pt1 < H0) Yap_WakeUp(pt1);
if (IsAttVar(pt1)) Yap_WakeUp(pt1);
bind_unify3:
#endif
return (TRUE);
@ -563,7 +563,7 @@ unify_var_nvar:
BIND(pt0, d1, bind_unify4);
#ifdef COROUTINING
DO_TRAIL(pt0, d1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
bind_unify4:
#endif
return TRUE;
@ -579,14 +579,14 @@ unify_var_nvar_trail:
UnifyCells(pt0, pt1, uc1, uc2);
#ifdef COROUTINING
DO_TRAIL(pt0, (CELL)pt1);
if (pt0 < H0) Yap_WakeUp(pt0);
if (IsAttVar(pt0)) Yap_WakeUp(pt0);
uc1:
#endif
return (TRUE);
#ifdef COROUTINING
uc2:
DO_TRAIL(pt1, (CELL)pt0);
if (pt1 < H0) {
if (IsAttVar(pt1)) {
Yap_WakeUp(pt1);
}
return (TRUE);

276
C/utilpreds.c
View File

@ -65,15 +65,7 @@ clean_dirty_tr(tr_fr_ptr TR0) {
do {
Term p = TrailTerm(pt++);
if (IsVarTerm(p)) {
RESET_VARIABLE(p);
} else {
/* copy downwards */
TrailTerm(TR0+1) = TrailTerm(pt);
TrailTerm(TR0) = TrailTerm(TR0+2) = p;
pt+=2;
TR0 += 3;
}
RESET_VARIABLE(p);
} while (pt != TR);
TR = TR0;
}
@ -89,7 +81,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
tr_fr_ptr TR0 = TR;
int ground = TRUE;
#ifdef COROUTINING
CELL *dvars = NULL;
CELL *dvarsmin = NULL, *dvarsmax=NULL;
#endif
HB = HLow;
@ -251,32 +243,27 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
#if COROUTINING
if (newattvs && IsAttachedTerm((CELL)ptd0)) {
/* if unbound, call the standard copy term routine */
struct cp_frame *bp[1];
struct cp_frame *bp;
if (dvars == NULL) {
dvars = (CELL *)DelayTop();
}
if (ptd0 < dvars) {
if (IN_BETWEEN(dvarsmin, ptd0, dvarsmax)) {
*ptf++ = (CELL) ptd0;
} else {
tr_fr_ptr CurTR;
CELL new;
CurTR = TR;
bp[0] = to_visit;
HB = HB0;
if (!attas[ExtFromCell(ptd0)].copy_term_op(ptd0, bp, ptf)) {
bp = to_visit;
if (!attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf)) {
goto overflow;
}
to_visit = bp[0];
HB = HLow;
ptf++;
if (TR > (tr_fr_ptr)Yap_TrailTop - 256) {
/* Trail overflow */
if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
goto trail_overflow;
}
to_visit = bp;
new = *ptf;
Bind(ptd0, new);
if (dvarsmin == NULL) {
dvarsmin = CellPtr(new);
} else {
*dvarsmax = (CELL)(CellPtr(new)+1);
}
Bind(ptd0, ptf[-1]);
dvarsmax = CellPtr(new)+1;
ptf++;
}
} else {
#endif
@ -288,8 +275,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
goto trail_overflow;
}
}
Bind(ptd0, (CELL)ptf);
ptf++;
Bind(ptd0, (CELL)ptf++);
#ifdef COROUTINING
}
#endif
@ -320,8 +306,9 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
}
/* restore our nice, friendly, term to its original state */
HB = HB0;
clean_dirty_tr(TR0);
close_attvar_chain(dvarsmin, dvarsmax);
HB = HB0;
return ground;
overflow:
@ -340,6 +327,8 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
}
#endif
reset_trail(TR0);
/* follow chain of multi-assigned variables */
reset_attvars(dvarsmin, dvarsmax);
return -1;
trail_overflow:
@ -360,6 +349,7 @@ trail_overflow:
{
tr_fr_ptr oTR = TR;
reset_trail(TR0);
reset_attvars(dvarsmin, dvarsmax);
if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
return -4;
}
@ -382,6 +372,7 @@ trail_overflow:
}
#endif
reset_trail(TR0);
reset_attvars(dvarsmin, dvarsmax);
Yap_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0;
return -3;
}
@ -839,6 +830,226 @@ p_term_variables(void) /* variables in term t */
return Yap_unify(ARG2,out);
}
static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp)
{
register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
register tr_fr_ptr TR0 = TR;
CELL *InitialH = H;
CELL output = AbsPair(H);
to_visit0 = to_visit;
loop:
while (pt0 < pt0_end) {
register CELL d0;
register CELL *ptd0;
++ pt0;
ptd0 = pt0;
d0 = *ptd0;
deref_head(d0, attvars_in_term_unk);
attvars_in_term_nvar:
{
if (IsPairTerm(d0)) {
if (to_visit + 1024 >= (CELL **)AuxSp) {
goto aux_overflow;
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit += 2;
}
#endif
pt0 = RepPair(d0) - 1;
pt0_end = RepPair(d0) + 1;
} else if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2;
/* store the terms to visit */
ap2 = RepAppl(d0);
f = (Functor)(*ap2);
if (IsExtensionFunctor(f)) {
continue;
}
/* store the terms to visit */
if (to_visit + 1024 >= (CELL **)AuxSp) {
goto aux_overflow;
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit += 2;
}
#endif
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
}
continue;
}
derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar);
if (IsAttVar(ptd0)) {
/* do or pt2 are unbound */
*ptd0 = TermNil;
/* next make sure noone will see this as a variable again */
if (TR > (tr_fr_ptr)Yap_TrailTop - 256) {
/* Trail overflow */
if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
goto trail_overflow;
}
}
TrailTerm(TR++) = (CELL)ptd0;
/* leave an empty slot to fill in later */
if (H+1024 > ASP) {
goto global_overflow;
}
H[1] = AbsPair(H+2);
H += 2;
H[-2] = (CELL)ptd0;
/* store the terms to visit */
if (to_visit + 1024 >= (CELL **)AuxSp) {
goto aux_overflow;
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
to_visit += 3;
*pt0 = TermNil;
#else
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit += 2;
}
#endif
pt0 = &RepAttVar(ptd0)->Value;
pt0_end = &RepAttVar(ptd0)->Atts;
}
}
/* Do we still have compound terms to visit */
if (to_visit > to_visit0) {
#ifdef RATIONAL_TREES
to_visit -= 3;
pt0 = to_visit[0];
pt0_end = to_visit[1];
*pt0 = (CELL)to_visit[2];
#else
to_visit -= 2;
pt0 = to_visit[0];
pt0_end = to_visit[1];
#endif
goto loop;
}
clean_tr(TR0);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
if (H != InitialH) {
/* close the list */
Term t2 = Deref(inp);
if (IsVarTerm(t2)) {
RESET_VARIABLE(H-1);
Yap_unify((CELL)(H-1),ARG2);
} else {
H[-1] = t2; /* don't need to trail */
}
return(output);
} else {
return(inp);
}
trail_overflow:
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit -= 3;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[2];
}
#endif
Yap_Error_TYPE = OUT_OF_TRAIL_ERROR;
Yap_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);
clean_tr(TR0);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
H = InitialH;
return 0L;
aux_overflow:
Yap_Error_Size = (to_visit-to_visit0)*sizeof(CELL **);
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit -= 3;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[2];
}
#endif
Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
clean_tr(TR0);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
H = InitialH;
return 0L;
global_overflow:
#ifdef RATIONAL_TREES
while (to_visit > to_visit0) {
to_visit -= 3;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[2];
}
#endif
clean_tr(TR0);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
H = InitialH;
Yap_Error_TYPE = OUT_OF_STACK_ERROR;
Yap_Error_Size = (ASP-H)*sizeof(CELL);
return 0L;
}
static Int
p_term_attvars(void) /* variables in term t */
{
Term out;
do {
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
out = attvars_in_complex_term(VarOfTerm(t)-1,
VarOfTerm(t)+1, TermNil);
} else if (IsPrimitiveTerm(t)) {
return Yap_unify(TermNil, ARG2);
} else if (IsPairTerm(t)) {
out = attvars_in_complex_term(RepPair(t)-1,
RepPair(t)+1, TermNil);
}
else {
Functor f = FunctorOfTerm(t);
out = attvars_in_complex_term(RepAppl(t),
RepAppl(t)+
ArityOfFunctor(f), TermNil);
}
if (out == 0L) {
if (!expand_vts())
return FALSE;
}
} while (out == 0L);
return Yap_unify(ARG2,out);
}
static Int
p_term_variables3(void) /* variables in term t */
{
@ -2861,6 +3072,7 @@ void Yap_InitUtilCPreds(void)
Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("term_variables", 2, p_term_variables, 0);
Yap_InitCPred("term_variables", 3, p_term_variables3, 0);
Yap_InitCPred("term_attvars", 2, p_term_attvars, 0);
Yap_InitCPred("is_list", 1, p_is_list, SafePredFlag);
Yap_InitCPred("=@=", 2, p_variant, 0);
CurrentModule = TERMS_MODULE;

9
C/write.c
View File

@ -406,8 +406,8 @@ write_var(CELL *t, struct write_globs *wglb, struct rewind_term *rwt)
wrputc('_', wglb->writewch);
/* make sure we don't get no creepy spaces where they shouldn't be */
lastw = separator;
if (CellPtr(t) < H0) {
Int vcount = (H0-t);
if (IsAttVar(t)) {
Int vcount = (t-H0);
#if COROUTINING
#if DEBUG
if (Yap_Portray_delays) {
@ -415,7 +415,7 @@ write_var(CELL *t, struct write_globs *wglb, struct rewind_term *rwt)
Yap_Portray_delays = FALSE;
if (ext == attvars_ext) {
attvar_record *attv = (attvar_record *)t;
attvar_record *attv = RepAttVar(t);
long sl = 0;
Term l = attv->Atts;
@ -613,6 +613,9 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str
case (CELL)FunctorDouble:
wrputf(FloatOfTerm(t),wglb->writewch);
return;
case (CELL)FunctorAttVar:
write_var(RepAppl(t)+1, wglb, &nrwt);
return;
case (CELL)FunctorDBRef:
wrputref(RefOfTerm(t), wglb->Quote_illegal, wglb->writewch);
return;

6
H/Regs.h
View File

@ -110,9 +110,6 @@ typedef struct
ADDR AuxTop_; /* 10 Auxiliary stack top */
/* visualc*/
CELL EX_; /* 18 */
#ifdef COROUTINING
Term DelayedVars_; /* maximum number of attributed variables */
#endif
Term CurrentModule_;
#if defined(SBA) || defined(TABLING)
CELL *H_FZ_;
@ -697,9 +694,6 @@ EXTERN inline void restore_B(void) {
#define frame_tail Yap_REGS.frame_tail_
#endif /* SBA */
#endif /* YAPOR */
#ifdef COROUTINING
#define DelayedVars Yap_REGS.DelayedVars_
#endif
#if defined(YAPOR) || defined(TABLING)
#define LOCAL Yap_REGS.LOCAL_
#endif

23
H/TermExt.h
View File

@ -44,18 +44,28 @@
typedef enum
{
db_ref_e = sizeof (Functor *),
long_int_e = 2 * sizeof (Functor *),
big_int_e = 3 * sizeof (Functor *),
double_e = 4 * sizeof (Functor *)
attvar_e = 2*sizeof (Functor *),
long_int_e = 3 * sizeof (Functor *),
big_int_e = 4 * sizeof (Functor *),
double_e = 5 * sizeof (Functor *)
}
blob_type;
#define FunctorDBRef ((Functor)(db_ref_e))
#define FunctorAttVar ((Functor)(attvar_e))
#define FunctorLongInt ((Functor)(long_int_e))
#define FunctorBigInt ((Functor)(big_int_e))
#define FunctorDouble ((Functor)(double_e))
#define EndSpecials (double_e+sizeof(Functor *))
inline EXTERN int IsAttVar (CELL *pt);
inline EXTERN int
IsAttVar (CELL *pt)
{
return (pt)[-1] == (CELL)attvar_e;
}
typedef enum
{
BIG_INT = 0x01,
@ -450,7 +460,7 @@ inline EXTERN Int IsAttachedTerm (Term);
inline EXTERN Int
IsAttachedTerm (Term t)
{
return (Int) ((IsVarTerm (t) && VarOfTerm (t) < H0));
return (Int) ((IsVarTerm (t) && IsAttVar(VarOfTerm(t))));
}
@ -461,8 +471,7 @@ inline EXTERN Int SafeIsAttachedTerm (Term);
inline EXTERN Int
SafeIsAttachedTerm (Term t)
{
return (Int) ((IsVarTerm (t) && VarOfTerm (t) < H0
&& VarOfTerm (t) >= (CELL *) Yap_GlobalBase));
return (Int) (IsVarTerm (t) && IsAttVar(VarOfTerm(t)));
}
@ -516,6 +525,8 @@ unify_extension (Functor f, CELL d0, CELL * pt0, CELL d1)
{
case db_ref_e:
return (d0 == d1);
case attvar_e:
return (d0 == d1);
case long_int_e:
return (pt0[1] == RepAppl (d1)[1]);
case big_int_e:

5
H/YapHeap.h
View File

@ -91,7 +91,6 @@ typedef struct restore_info {
CELL *g_split;
tr_fr_ptr old_TR;
CELL *old_GlobalBase, *old_H, *old_H0;
CELL *old_DelayTop, *current_DelayTop;
ADDR old_TrailBase, old_TrailTop;
ADDR old_HeapBase, old_HeapTop;
} restoreinfo;
@ -183,7 +182,6 @@ typedef struct worker_local_struct {
int allow_restart;
Term global_arena;
UInt global_arena_overflows;
Term global_delay_arena;
yamop trust_lu_code[3];
#if (defined(YAPOR) || defined(TABLING) ) && defined(THREADS)
#ifdef YAPOR
@ -293,8 +291,6 @@ extern struct various_codes *Yap_heap_regs;
#define OldTrailTop RINFO.old_TrailTop
#define OldHeapBase RINFO.old_HeapBase
#define OldHeapTop RINFO.old_HeapTop
#define OldDelayTop RINFO.old_DelayTop
#define CurrentDelayTop RINFO.current_DelayTop
#define ClDiff RINFO.cl_diff
#define GDiff RINFO.g_diff
#define GDiff0 RINFO.g_diff0
@ -360,7 +356,6 @@ extern struct various_codes *Yap_heap_regs;
#define GlobalArena Yap_heap_regs->WL.global_arena
#define GlobalArenaOverflows Yap_heap_regs->WL.global_arena_overflows
#define Yap_AllowRestart Yap_heap_regs->WL.allow_restart
#define GlobalDelayArena Yap_heap_regs->WL.global_delay_arena
#define PredHashInitialSize 1039L
#define PredHashIncrement 7919L

1
H/Yapproto.h
View File

@ -190,6 +190,7 @@ void STD_PROTO(Yap_inform_profiler_of_clause,(struct yami *,struct yami *,struct
/* globals.c */
Term STD_PROTO(Yap_NewArena,(UInt,CELL *));
CELL *STD_PROTO(Yap_GetFromArena,(Term *,UInt,UInt));
void STD_PROTO(Yap_InitGlobals,(void));
Term STD_PROTO(Yap_SaveTerm, (Term));
Term STD_PROTO(Yap_SetGlobalVal, (Atom, Term));

1
H/Yatom.h
View File

@ -216,6 +216,7 @@ typedef struct global_entry
struct AtomEntryStruct *AtomOfGE; /* parent atom for deletion */
struct global_entry *NextGE; /* linked list of global entries */
Term global; /* index in module table */
Term AttChain; /* index in module table */
} GlobalEntry;

24
H/amidefs.h
View File

@ -65,6 +65,30 @@
#include <stdio.h>
#endif
#ifdef FROZEN_STACKS
#ifdef SBA
#define PROTECT_FROZEN_H(CPTR) \
((Unsigned((Int)((CPTR)->cp_h)-(Int)(H_FZ)) < \
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) ? \
(CPTR)->cp_h : H_FZ)
#define PROTECT_FROZEN_B(CPTR) \
((Unsigned((Int)(CPTR)-(Int)(H_FZ)) < \
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) ? \
(CPTR) : B_FZ)
/*
#define PROTECT_FROZEN_H(CPTR) ((CPTR)->cp_h > H_FZ && (CPTR)->cp_h < (CELL *)B_FZ ? (CPTR)->cp_h : H_FZ )
#define PROTECT_FROZEN_B(CPTR) ((CPTR) < B_FZ && (CPTR) > (choiceptr)H_FZ ? (CPTR) : B_FZ )
*/
#else /* TABLING */
#define PROTECT_FROZEN_B(CPTR) (YOUNGER_CP(CPTR, B_FZ) ? CPTR : B_FZ)
#define PROTECT_FROZEN_H(CPTR) (((CPTR)->cp_h > H_FZ) ? (CPTR)->cp_h : H_FZ)
#endif /* SBA */
#else
#define PROTECT_FROZEN_B(CPTR) (CPTR)
#define PROTECT_FROZEN_H(CPTR) (CPTR)->cp_h
#endif /* FROZEN_STACKS */
#if ALIGN_LONGS
/* */ typedef Int DISPREG;
/* */ typedef CELL SMALLUNSGN;

36
H/amiops.h
View File

@ -354,7 +354,7 @@ Binding Macros for Multiple Assignment Variables.
#define BIND_GLOBALCELL(A,D) *(A) = (D); \
if ((A) >= HBREG) continue; \
TRAIL_GLOBAL(A,D); if ((A) >= H0) continue; \
TRAIL_GLOBAL(A,D); if (!IsAttVar(A)) continue; \
Yap_WakeUp((A)); continue
#define BIND_GLOBALCELL_NONATT(A,D) *(A) = (D); \
@ -436,6 +436,38 @@ reset_trail(tr_fr_ptr TR0) {
}
}
inline EXTERN void
reset_attvars(CELL *dvarsmin, CELL *dvarsmax) {
if (dvarsmin) {
dvarsmin += 1;
do {
CELL *newv;
newv = CellPtr(*dvarsmin);
RESET_VARIABLE(dvarsmin+1);
if (IsUnboundVar(dvarsmin))
break;
RESET_VARIABLE(dvarsmin);
dvarsmin = newv;
} while (TRUE);
}
}
inline EXTERN void
close_attvar_chain(CELL *dvarsmin, CELL *dvarsmax) {
if (dvarsmin) {
dvarsmin += 1;
do {
CELL *newv;
Bind(dvarsmin+1, dvarsmin[1]);
if (IsUnboundVar(dvarsmin))
break;
newv = CellPtr(*dvarsmin);
RESET_VARIABLE(dvarsmin);
dvarsmin = newv;
} while (TRUE);
}
}
EXTERN inline
Int Yap_unify(Term t0, Term t1)
{
@ -502,7 +534,7 @@ Yap_unify_constant(register Term a, register Term cons)
BIND(pt,cons,wake_for_cons);
#ifdef COROUTINING
DO_TRAIL(pt, cons);
if (pt < H0) Yap_WakeUp(pt);
if (IsAttVar(pt)) Yap_WakeUp(pt);
wake_for_cons:
#endif
return(TRUE);

54
H/arith2.h
View File

@ -158,7 +158,7 @@ p_plus(Term t1, Term t2) {
#ifdef USE_GMP
return(Yap_gmp_add_int_big(IntegerOfTerm(t1), Yap_BigIntOfTerm(t2)));
#endif
case db_ref_e:
default:
RERROR();
}
case double_e:
@ -172,7 +172,7 @@ p_plus(Term t1, Term t2) {
#ifdef USE_GMP
return(Yap_gmp_add_float_big(FloatOfTerm(t1),Yap_BigIntOfTerm(t2)));
#endif
case db_ref_e:
default:
RERROR();
}
case big_int_e:
@ -185,11 +185,11 @@ p_plus(Term t1, Term t2) {
return(Yap_gmp_add_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2)));
case double_e:
return(Yap_gmp_add_float_big(FloatOfTerm(t2),Yap_BigIntOfTerm(t1)));
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
RERROR();
@ -214,7 +214,7 @@ p_minus(Term t1, Term t2) {
#ifdef USE_GMP
return(Yap_gmp_sub_int_big(IntegerOfTerm(t1), Yap_BigIntOfTerm(t2)));
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -231,7 +231,7 @@ p_minus(Term t1, Term t2) {
#ifdef USE_GMP
return(Yap_gmp_sub_float_big(FloatOfTerm(t1),Yap_BigIntOfTerm(t2)));
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -244,11 +244,11 @@ p_minus(Term t1, Term t2) {
return(Yap_gmp_sub_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2)));
case double_e:
return(Yap_gmp_sub_big_float(Yap_BigIntOfTerm(t1),FloatOfTerm(t2)));
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
RERROR();
@ -274,7 +274,7 @@ p_times(Term t1, Term t2) {
#ifdef USE_GMP
return(Yap_gmp_mul_int_big(IntegerOfTerm(t1), Yap_BigIntOfTerm(t2)));
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -289,7 +289,7 @@ p_times(Term t1, Term t2) {
#ifdef USE_GMP
return(Yap_gmp_mul_float_big(FloatOfTerm(t1),Yap_BigIntOfTerm(t2)));
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -303,11 +303,11 @@ p_times(Term t1, Term t2) {
return(Yap_gmp_mul_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2)));
case double_e:
return(Yap_gmp_mul_float_big(FloatOfTerm(t2),Yap_BigIntOfTerm(t1)));
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
RERROR();
@ -343,7 +343,7 @@ p_div(Term t1, Term t2) {
/* Cool */
RINT(0);
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -360,11 +360,11 @@ p_div(Term t1, Term t2) {
return Yap_gmp_div_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2));
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "// /2");
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
RERROR();
@ -384,7 +384,7 @@ p_and(Term t1, Term t2) {
#ifdef USE_GMP
return(Yap_gmp_and_int_big(IntegerOfTerm(t1),Yap_BigIntOfTerm(t2)));
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -401,11 +401,11 @@ p_and(Term t1, Term t2) {
return(Yap_gmp_and_big_big(Yap_BigIntOfTerm(t2), Yap_BigIntOfTerm(t1)));
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "/\\ /2");
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
RERROR();
@ -425,7 +425,7 @@ p_or(Term t1, Term t2) {
#ifdef USE_GMP
return(Yap_gmp_ior_int_big(IntegerOfTerm(t1),Yap_BigIntOfTerm(t2)));
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -442,11 +442,11 @@ p_or(Term t1, Term t2) {
return Yap_gmp_ior_big_big(Yap_BigIntOfTerm(t2), Yap_BigIntOfTerm(t1));
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "\\/ /2");
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
RERROR();
@ -473,7 +473,7 @@ p_sll(Term t1, Term t2) {
#ifdef USE_GMP
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "<</2");
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -488,11 +488,11 @@ p_sll(Term t1, Term t2) {
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "<</2");
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
RERROR();
@ -519,7 +519,7 @@ p_slr(Term t1, Term t2) {
#ifdef USE_GMP
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
#endif
case db_ref_e:
default:
RERROR();
}
break;
@ -534,11 +534,11 @@ p_slr(Term t1, Term t2) {
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, ">>/2");
case db_ref_e:
default:
RERROR();
}
#endif
case db_ref_e:
default:
RERROR();
}
RERROR();

18
H/attvar.h
View File

@ -42,24 +42,24 @@ Each attribute contains;
*/
typedef struct attvar_struct {
Functor AttFunc; /* functor for attvar */
Term Done; /* if unbound suspension active, if bound terminated */
Term Value; /* value the variable will take */
Term Atts; /* actual data */
} attvar_record;
#define ATT_RECORD_ARITY 3
/*********** tags for suspension variables */
#define AbsAttVar(attvar_ptr) AbsAppl(((CELL *)(attvar_ptr)))
#define RepAttVar(val) ((attvar_record *)RepAppl(val))
static inline attvar_record *
DelayTop(void) {
return (attvar_record *)Yap_ReadTimedVar(DelayedVars);
static inline Term
AbsAttVar(attvar_record *attvar_ptr) {
return attvar_ptr->Done;
}
static inline void
SetDelayTop(attvar_record *new_top) {
Yap_UpdateTimedVar(DelayedVars, (CELL)new_top);
static inline attvar_record *
RepAttVar(Term *var_ptr) {
return (attvar_record *)(var_ptr-1);
}
#endif

2
H/iatoms.h
View File

@ -374,7 +374,7 @@
FunctorMultiFileClause = Yap_MkFunctor(AtomMfClause,5);
FunctorMutable = Yap_MkFunctor(AtomMutableVariable,(sizeof(timed_var)/sizeof(CELL)));
FunctorNotImplemented = Yap_MkFunctor(AtomNotImplemented,2);
FunctorNBQueue = Yap_MkFunctor(AtomQueue,5);
FunctorNBQueue = Yap_MkFunctor(AtomQueue,4);
FunctorNot = Yap_MkFunctor(AtomNot,1);
FunctorOr = Yap_MkFunctor(AtomSemic,2);
FunctorPermissionError = Yap_MkFunctor(AtomPermissionError,3);

4
H/rheap.h
View File

@ -1024,10 +1024,6 @@ restore_codes(void)
AbsAppl(PtoGloAdjust(RepAppl(Yap_heap_regs->wl.global_arena)));
}
}
if (Yap_heap_regs->wl.global_delay_arena) {
Yap_heap_regs->wl.global_delay_arena =
GlobalAdjust(Yap_heap_regs->wl.global_delay_arena);
}
Yap_heap_regs->wl.allow_restart = FALSE;
#endif
#endif

4
H/trim_trail.h
View File

@ -27,7 +27,7 @@
/* skip, this is a problem because we lose information,
namely active references */
pt1 = (tr_fr_ptr)pt;
} else if (IN_BETWEEN(Yap_GlobalBase, pt, H0)) {
} else if (IsAttVar(pt)) {
CELL val = Deref(*pt);
if (IsVarTerm(val)) {
Bind(pt, MkAtomTerm(AtomCut));
@ -130,7 +130,7 @@
} else if (IsPairTerm(d1)) {
CELL *pt = RepPair(d1);
if (IN_BETWEEN(Yap_GlobalBase, pt, H0)) {
if (IsAttVar(pt)) {
CELL val = Deref(*pt);
if (IsVarTerm(val)) {
Bind(VarOfTerm(val), MkAtomTerm(AtomCut));

5
Makefile.in
View File

@ -210,7 +210,10 @@ C_SOURCES= \
$(srcdir)/MYDDAS/myddas_wkb2prolog.c
PL_SOURCES= \
$(srcdir)/pl/arith.yap $(srcdir)/pl/arrays.yap $(srcdir)/pl/boot.yap \
$(srcdir)/pl/arith.yap \
$(srcdir)/pl/arrays.yap \
$(srcdir)/pl/attributes.yap \
$(srcdir)/pl/boot.yap \
$(srcdir)/pl/callcount.yap\
$(srcdir)/pl/checker.yap $(srcdir)/pl/chtypes.yap \
$(srcdir)/pl/consult.yap \

191
docs/swi.tex
View File

@ -1,8 +1,8 @@
@chapter SWI-Prolog Emulation
This library provides a number of SWI-Prolog builtins that are not by
default in YAP. This library is loaded with the
@code{use_module(library(swi))} command.
default in YAP. This support is loaded with the
@code{expects_dialect(swi)} command.
@table @code
@ -168,7 +168,7 @@ triple. See the example above.
@c @var{Pred} applies.
@end table
@node Forall,hProlog and SWI-Prolog Attributed Variables,Invoking Predicates on all Members of a List, SWI-Prolog
@node Forall, ,Invoking Predicates on all Members of a List, SWI-Prolog
@section Forall
@c \label{sec:forall2}
@ -189,176 +189,8 @@ The next example verifies that all arithmetic statements in the list
@end table
@node hProlog and SWI-Prolog Attributed Variables, SWI-Prolog Global Variables, Forall,SWI-Prolog
@section hProlog and SWI-Prolog Attributed Variables
@cindex hProlog Attributed Variables
Attributed variables
@c @ref{Attributed variables}
provide a technique for extending the
Prolog unification algorithm by hooking the binding of attributed
variables. There is little consensus in the Prolog community on the
exact definition and interface to attributed variables. Yap Prolog
traditionally implements a SICStus-like interface, but to enable
SWI-compatibility we have implemented the SWI-Prolog interface,
identical to the one realised by Bart Demoen for hProlog.
Binding an attributed variable schedules a goal to be executed at the
first possible opportunity. In the current implementation the hooks are
executed immediately after a successful unification of the clause-head
or successful completion of a foreign language (builtin) predicate. Each
attribute is associated to a module and the hook (attr_unify_hook/2) is
executed in this module. The example below realises a very simple and
incomplete finite domain reasoner.
@example
:- module(domain,
[ domain/2 % Var, ?Domain
]).
:- use_module(library(oset)).
domain(X, Dom) :-
var(Dom), !,
get_attr(X, domain, Dom).
domain(X, List) :-
sort(List, Domain),
put_attr(Y, domain, Domain),
X = Y.
% An attributed variable with attribute value Domain has been
% assigned the value Y
attr_unify_hook(Domain, Y) :-
( get_attr(Y, domain, Dom2)
-> oset_int(Domain, Dom2, NewDomain),
( NewDomain == []
-> fail
; NewDomain = [Value]
-> Y = Value
; put_attr(Y, domain, NewDomain)
)
; var(Y)
-> put_attr( Y, domain, Domain )
; memberchk(Y, Domain)
).
@end example
Before explaining the code we give some example queries:
@table @code
@item ?- domain(X, [a,b]), X = c
no
@item ?- domain(X, [a,b]), domain(X, [a,c]).
X = a
@item ?- domain(X, [a,b,c]), domain(X, [a,c]).
X = _D0
@end table
The predicate @code{domain/2} fetches (first clause) or assigns
(second clause) the variable a @emph{domain}, a set of values it can
be unified with. In the second clause first associates the domain
with a fresh variable and then unifies X to this variable to deal
with the possibility that X already has a domain. The
predicate @code{attr_unify_hook/2} is a hook called after a variable with
a domain is assigned a value. In the simple case where the variable
is bound to a concrete value we simply check whether this value is in
the domain. Otherwise we take the intersection of the domains and either
fail if the intersection is empty (first example), simply assign the
value if there is only one value in the intersection (second example) or
assign the intersection as the new domain of the variable (third
example).
@table @code
@item put_attr(+@var{Var},+@var{Module},+@var{Value})
@findex put_attr/3
@snindex put_attr/3
@cnindex put_attr/3
If @var{Var} is a variable or attributed variable, set the value for the
attribute named @var{Module} to @var{Value}. If an attribute with this
name is already associated with @var{Var}, the old value is replaced.
Backtracking will restore the old value (i.e. an attribute is a mutable
term. See also @code{setarg/3}). This predicate raises a type error if
@var{Var} is not a variable or @var{Module} is not an atom.
@item get_attr(+@var{Var},+@var{Module},+@var{Value})
@findex get_attr/3
@snindex get_attr/3
@cnindex get_attr/3
Request the current @var{value} for the attribute named @var{Module}. If
@var{Var} is not an attributed variable or the named attribute is not
associated to @var{Var} this predicate fails silently. If @var{Module}
is not an atom, a type error is raised.
@item del_attr(+@var{Var},+@var{Module})
@findex del_attr/2
@snindex del_attr/2
@cnindex del_attr/2
Delete the named attribute. If @var{Var} loses its last attribute it
is transformed back into a traditional Prolog variable. If @var{Module}
is not an atom, a type error is raised. In all other cases this
predicate succeeds regardless of whether or not the named attribute is
present.
@item attr_unify_hook(+@var{AttValue},+@var{VarValue})
@findex attr_unify_hook/2
@snindex attr_unify_hook/2
@cnindex attr_unify_hook/2
Hook that must be defined in the module an attributed variable refers
to. It is called @emph{after} the attributed variable has been
unified with a non-var term, possibly another attributed variable.
@var{AttValue} is the attribute that was associated to the variable
in this module and @var{VarValue} is the new value of the variable.
Normally this predicate fails to veto binding the variable to
@var{VarValue}, forcing backtracking to undo the binding. If
@var{VarValue} is another attributed variable the hook often combines
the two attribute and associates the combined attribute with
@var{VarValue} using @code{put_attr/3}.
@c \predicate{attr_portray_hook}{2}{+AttValue, +Var}
@c Called by write_term/2 and friends for each attribute if the option
@c \term{attributes}{portray} is in effect. If the hook succeeds the
@c attribute is considered printed. Otherwise \exam{Module = ...} is
@c printed to indicate the existence of a variable.
@end table
@subsection Special Purpose SWI Predicates for Attributes
Normal user code should deal with @code{put_attr/3}, @code{get_attr/3}
and @code{del_attr/2}. The routines in this section fetch or set the
entire attribute list of a variables. Use of these predicates is
anticipated to be restricted to printing and other special purpose
operations.
@table @code
@item get_attrs(+@var{Var},-@var{Attributes})
@findex get_attrs/2
@snindex get_attrs/2
@cnindex get_attrs/2
Get all attributes of @var{Var}. @var{Attributes} is a term of the form
@code{att(Module, Value, MoreAttributes)}, where @var{MoreAttributes} is
@code{[]} for the last attribute.
@item put_attrs(+@var{Var},+@var{Attributes})
@findex put_attrs/2
@snindex put_attrs/2
@cnindex put_attrs/2
Set all attributes of @var{Var}. See get_attrs/2 for a description of
@var{Attributes}.
@item copy_term_nat(?@var{TI},-@var{TF})
@findex copy_term_nat/2
@snindex copy_term_nat/2
@cnindex copy_term_nat/2
As @code{copy_term/2}. Attributes however, are @emph{not} copied but replaced
by fresh variables.
@end table
@node SWI-Prolog Global Variables, ,hProlog and SWI-Prolog Attributed Variables,SWI-Prolog
@section SWI Global variables
@node SWI-Prolog Global Variables, Extensions, SWI-Prolog, Top
@chapter SWI Global variables
@c \label{sec:gvar}
SWI-Prolog global variables are associations between names (atoms) and
@ -478,11 +310,11 @@ enumeration is undefined.
Delete the named global variable.
@end table
@subsection Compatibility of SWI-Prolog Global Variables
@section Compatibility of Global Variables
Global variables have been introduced by various Prolog
implementations recently. The implementation of them in SWI-Prolog is
based on hProlog by Bart Demoen. In discussion with Bart it was
implementations recently. YAP follows their implementation in SWI-Prolog, itself
based on hProlog by Bart Demoen. Jan and Bart
decided that the semantics if hProlog @code{nb_setval/2}, which is
equivalent to @code{nb_linkval/2} is not acceptable for normal Prolog
users as the behaviour is influenced by how builtin predicates
@ -493,10 +325,3 @@ Arrays can be implemented easily in SWI-Prolog using @code{functor/3} and
@code{setarg/3} due to the unrestricted arity of compound terms.
@node Extensions,Debugging,SWI-Prolog,Top
@chapter Extensions to Prolog
YAP includes several extensions that are not enabled by
default, but that can be used to extend the functionality of the
system. These options can be set at compilation time by enabling the
related compilation flag, as explained in the @code{Makefile}

318
docs/yap.tex
View File

@ -91,6 +91,7 @@ us to include his text in this document.
* Built-ins:: Built In Predicates
* Library:: Library Predicates
* SWI-Prolog:: SWI-Prolog emulation
* Global Variables :: Global Variables for Prolog
* Extensions:: Extensions to Standard YAP
* Rational Trees:: Working with Rational Trees
* Co-routining:: Changing the Execution of Goals
@ -242,7 +243,6 @@ Subnodes of Attributes
Subnodes of SWI-Prolog
* Invoking Predicates on all Members of a List :: maplist and friends
* hProlog and SWI-Prolog Attributed Variables :: Emulating SWI-like attributed variables
* SWI-Prolog Global Variables :: Emulating SWI-like attributed variables
@c Subnodes of CLP(Q,R)
@ -3317,22 +3317,6 @@ in @var{TI} are also duplicated.
Also refer to @code{copy_term/2}.
@item copy_term(?@var{TI},-@var{TF},-@var{Goals})
@findex copy_term/3
@syindex copy_term/3
@cnindex copy_term/3
Term @var{TF} is a variant of the original term @var{TI}, such that for
each variable @var{V} in the term @var{TI} there is a new variable @var{V'}
in term @var{TF} without any attributes attached. Attributed
variables are thus converted to standard variables. @var{Goals} is
unified with a list that represents the attributes. The goal
@code{maplist(call,@var{Goals})} can be called to recreate the
attributes.
Before the actual copying, @code{copy_term/3} calls
@code{attribute_goals/1} in the module where the attribute is
defined.
@end table
@node Predicates on Atoms, Predicates on Characters, Testing Terms, Top
@ -6567,7 +6551,7 @@ Execute a new shell.
@snindex alarm/3
@cnindex alarm/3
Arranges for YAP to be interrupted in @var{Seconds} seconds, or in
@var{[Seconds|MicroSeconds]}. When interrupted, YAP will execute
[@var{Seconds}|@var{MicroSeconds}]. When interrupted, YAP will execute
@var{Callable} and then return to the previous execution. If
@var{Seconds} is @code{0}, no new alarm is scheduled. In any event,
any previously set alarm is canceled.
@ -12222,19 +12206,25 @@ are released.
@end table
@node SWI-Prolog, Extensions, Library, Top
@node SWI-Prolog, SWI-Prolog Global Variables, Library, Top
@cindex SWI-Prolog
@menu SWI-Prolog Emulation
Subnodes of SWI-Prolog
* Invoking Predicates on all Members of a List :: maplist and friends
* Forall :: forall built-in
* hProlog and SWI-Prolog Attributed Variables :: Emulating SWI-like attributed variables
* SWI-Prolog Global Variables :: Emulating SWI-like attributed variables
@end menu
@include swi.tex
@node Extensions,Debugging,SWI-Prolog Global Variables,Top
@chapter Extensions to Prolog
YAP includes several extensions that are not enabled by
default, but that can be used to extend the functionality of the
system. These options can be set at compilation time by enabling the
related compilation flag, as explained in the @code{Makefile}
@menu
Extensions to Traditional Prolog
@ -12401,16 +12391,11 @@ no
@cindex attributed variables
@menu
* Attribute Declarations:: Declaring New Attributes
* Attribute Manipulation:: Setting and Reading Attributes
* Attributed Unification:: Tuning the Unification Algorithm
* Displaying Attributes:: Displaying Attributes in User-Readable Form
* Projecting Attributes:: Obtaining the Attributes of Interest
* Attribute Examples:: Two Simple Examples of how to use Attributes.
* New Style Attribute Declarations:: New Style code
* Old Style Attribute Declarations:: Old Style code (deprecated)
@end menu
YAP now supports the attributed variables packaged developed at OFAI by
YAP supports attributed variables, originally developed at OFAI by
Christian Holzbaur. Attributes are a means of declaring that an
arbitrary term is a property for a variable. These properties can be
updated during forward execution. Moreover, the unification algorithm is
@ -12419,16 +12404,257 @@ trying to unify these variables.
Attributed variables provide an elegant abstraction over which one can
extend Prolog systems. Their main application so far has been in
implementing constraint handlers, such as Holzbaur's CLPQR and Fruewirth
and Holzbaur's CHR, but other applications have been proposed in the
literature.
implementing constraint handlers, such as Holzbaur's CLPQR, Fruewirth
and Holzbaur's CHR, and CLP(BN).
Different Prolog systems implement attributed variables in different
ways. Traditionally, YAP has used the interface designed by SICStus
Prolog. This interface is still
available in the @t{atts} library, but from YAP-6.0.3 we recommend using
the hProlog, SWI style interface. The main reason to do so is that
most packages included in YAP that use attributed variables, such as CHR, CLP(FD), and CLP(QR),
rely on the SWI-Prolog interface.
The command
@node New Style Attribute Declarations, Old Style Attribute Declarations, , Attributed Variables
@section hProlog and SWI-Prolog style Attribute Declarations
The following documentation is taken from the SWI-Prolog manual.
Binding an attributed variable schedules a goal to be executed at the
first possible opportunity. In the current implementation the hooks are
executed immediately after a successful unification of the clause-head
or successful completion of a foreign language (built-in) predicate. Each
attribute is associated to a module and the hook @code{attr_unify_hook/2} is
executed in this module. The example below realises a very simple and
incomplete finite domain reasoner.
@example
:- module(domain,
[ domain/2 % Var, ?Domain
]).
:- use_module(library(ordsets)).
domain(X, Dom) :-
var(Dom), !,
get_attr(X, domain, Dom).
domain(X, List) :-
list_to_ord_set(List, Domain),
put_attr(Y, domain, Domain),
X = Y.
% An attributed variable with attribute value Domain has been
% assigned the value Y
attr_unify_hook(Domain, Y) :-
( get_attr(Y, domain, Dom2)
-> ord_intersection(Domain, Dom2, NewDomain),
( NewDomain == []
-> fail
; NewDomain = [Value]
-> Y = Value
; put_attr(Y, domain, NewDomain)
)
; var(Y)
-> put_attr( Y, domain, Domain )
; ord_memberchk(Y, Domain)
).
% Translate attributes from this module to residual goals
attribute_goals(X) -->
@{ get_attr(X, domain, List) @},
[domain(X, List)].
@end example
Before explaining the code we give some example queries:
@multitable @columnfractions .70 .30
@item @code{?- domain(X, [a,b]), X = c}
@tab @code{fail}
@item @code{domain(X, [a,b]), domain(X, [a,c]).}
@tab @code{X=a}
@item @code{domain(X, [a,b,c]), domain(X, [a,c]).}
@tab @code{domain(X, [a,c]).}
@end multitable
The predicate @code{domain/2} fetches (first clause) or assigns
(second clause) the variable a @emph{domain}, a set of values it can
be unified with. In the second clause first associates the domain
with a fresh variable and then unifies X to this variable to deal
with the possibility that X already has a domain. The
predicate @code{attr_unify_hook/2} is a hook called after a variable with
a domain is assigned a value. In the simple case where the variable
is bound to a concrete value we simply check whether this value is in
the domain. Otherwise we take the intersection of the domains and either
fail if the intersection is empty (first example), simply assign the
value if there is only one value in the intersection (second example) or
assign the intersection as the new domain of the variable (third
example). The nonterminal @code{attribute_goals/3} is used to translate
remaining attributes to user-readable goals that, when executed, reinstate
these attributes.
@table @code
@item attvar(?@var{Term})
@findex attvar/1
@snindex attvar/1
@cnindex attvar/1
Succeeds if @code{Term} is an attributed variable. Note that @code{var/1} also
succeeds on attributed variables. Attributed variables are created with
@code{put_attr/3}.
@item put_attr(+@var{Var},+@var{Module},+@var{Value})
@findex put_attr/3
@snindex put_attr/3
@cnindex put_attr/3
If @var{Var} is a variable or attributed variable, set the value for the
attribute named @var{Module} to @var{Value}. If an attribute with this
name is already associated with @var{Var}, the old value is replaced.
Backtracking will restore the old value (i.e., an attribute is a mutable
term. See also @code{setarg/3}). This predicate raises a representation error if
@var{Var} is not a variable and a type error if @var{Module} is not an atom.
@item get_attr(+@var{Var},+@var{Module},-@var{Value})
@findex get_attr/3
@snindex get_attr/3
@cnindex get_attr/3
Request the current @var{value} for the attribute named @var{Module}. If
@var{Var} is not an attributed variable or the named attribute is not
associated to @var{Var} this predicate fails silently. If @var{Module}
is not an atom, a type error is raised.
@item del_attr(+@var{Var},+@var{Module})
@findex del_attr/2
@snindex del_attr/2
@cnindex del_attr/2
Delete the named attribute. If @var{Var} loses its last attribute it
is transformed back into a traditional Prolog variable. If @var{Module}
is not an atom, a type error is raised. In all other cases this
predicate succeeds regardless whether or not the named attribute is
present.
@item attr_unify_hook(+@var{AttValue},+@var{VarValue})
@findex attr_unify_hook/2
@snindex attr_unify_hook/2
@cnindex attr_unify_hook/2
Hook that must be defined in the module an attributed variable refers
to. Is is called @emph{after} the attributed variable has been
unified with a non-var term, possibly another attributed variable.
@var{AttValue} is the attribute that was associated to the variable
in this module and @var{VarValue} is the new value of the variable.
Normally this predicate fails to veto binding the variable to
@var{VarValue}, forcing backtracking to undo the binding. If
@var{VarValue} is another attributed variable the hook often combines
the two attribute and associates the combined attribute with
@var{VarValue} using @code{put_attr/3}.
@item attr_portray_hook(+@var{AttValue},+@var{Var})
@findex attr_portray_hook/2
@snindex attr_portray_hook/2
@cnindex attr_portray_hook/2
Called by @code{write_term/2} and friends for each attribute if the option
@code{attributes(portray)} is in effect. If the hook succeeds the
attribute is considered printed. Otherwise @code{Module = ...} is
printed to indicate the existence of a variable.
@item attribute_goals(+@var{Var},-@var{Gs},+@var{GsRest})
@findex attribute_goals/2
@snindex attribute_goals/2
@cnindex attribute_goals/2
This nonterminal, if it is defined in a module, is used by @var{copy_term/3}
to project attributes of that module to residual goals. It is also
used by the toplevel to obtain residual goals after executing a query.
@end table
Normal user code should deal with @code{put_attr/3}, @code{get_attr/3} and @code{del_attr/2}.
The routines in this section fetch or set the entire attribute list of a
variables. Use of these predicates is anticipated to be restricted to
printing and other special purpose operations.
@table @code
@item get_attrs(+@var{Var},-@var{Attributes})
@findex get_attrs/2
@snindex get_attrs/2
@cnindex get_attrs/2
Get all attributes of @var{Var}. @var{Attributes} is a term of the form
@code{att(@var{Module}, @var{Value}, @var{MoreAttributes})}, where @var{MoreAttributes} is
@code{[]} for the last attribute.
@item put_attrs(+@var{Var},+@var{Attributes})
@findex put_attrs/2
@snindex put_attrs/2
@cnindex put_attrs/2
Set all attributes of @var{Var}. See @code{get_attrs/2} for a description of
@var{Attributes}.
@item del_attrs(+@var{Var})
@findex del_attrs/1
@snindex del_attrs/1
@cnindex del_attrs/1
If @var{Var} is an attributed variable, delete @emph{all} its
attributes. In all other cases, this predicate succeeds without
side-effects.
@item term_attvars(+@var{Term},-@var{AttVars})
@findex term_attvars/2
@snindex term_attvars/2
@cnindex term_attvars/2
@var{AttVars} is a list of all attributed variables in @var{Term} and
its attributes. I.e., @code{term_attvars/2} works recursively through
attributes. This predicate is Cycle-safe.
@item copy_term(?@var{TI},-@var{TF},-@var{Goals})
@findex copy_term/3
@syindex copy_term/3
@cnindex copy_term/3
Term @var{TF} is a variant of the original term @var{TI}, such that for
each variable @var{V} in the term @var{TI} there is a new variable @var{V'}
in term @var{TF} without any attributes attached. Attributed
variables are thus converted to standard variables. @var{Goals} is
unified with a list that represents the attributes. The goal
@code{maplist(call,@var{Goals})} can be called to recreate the
attributes.
Before the actual copying, @code{copy_term/3} calls
@code{attribute_goals/1} in the module where the attribute is
defined.
@item copy_term_nat(?@var{TI},-@var{TF})
@findex copy_term_nat/2
@syindex copy_term_nat/2
@cnindex copy_term_nat/2
As @code{copy_term/2}. Attributes however, are @emph{not} copied but replaced
by fresh variables.
@end table
@node Old Style Attribute Declarations, , New Style Attribute Declarations, Attributed Variables
@section SICStus Prolog style Attribute Declarations
@menu
* Attribute Declarations:: Declaring New Attributes
* Attribute Manipulation:: Setting and Reading Attributes
* Attributed Unification:: Tuning the Unification Algorithm
* Displaying Attributes:: Displaying Attributes in User-Readable Form
* Projecting Attributes:: Obtaining the Attributes of Interest
* Attribute Examples:: Two Simple Examples of how to use Attributes.
@end menu
Old style attribute declarations are activated through loading the library @t{atts} . The command
@example
| ?- use_module(library(atts)).
@end example
enables the use of attributed variables. The package provides the
enables this form of use of attributed variables. The package provides the
following functionality:
@itemize @bullet
@item Each attribute must be declared first. Attributes are described by a functor
@ -12453,8 +12679,8 @@ the top-level, where it is used to output the set of
floundered constraints at the end of a query.
@end itemize
@node Attribute Declarations, Attribute Manipulation, , Attributed Variables
@section Attribute Declarations
@node Attribute Declarations, Attribute Manipulation, , Old Style Attribute Declarations
@subsection Attribute Declarations
Attributes are compound terms associated with a variable. Each attribute
has a @emph{name} which is @emph{private} to the module in which the
@ -12480,8 +12706,8 @@ preprocessed depending on the module. The @code{user:goal_expansion/3}
mechanism is used for this purpose.
@node Attribute Manipulation, Attributed Unification, Attribute Declarations, Attributed Variables
@section Attribute Manipulation
@node Attribute Manipulation, Attributed Unification, Attribute Declarations, Old Style Attribute Declarations
@subsection Attribute Manipulation
The attribute manipulation predicates always work as follows:
@ -12531,8 +12757,8 @@ Remove the attribute with the same name. If no such attribute existed,
simply succeed.
@end table
@node Attributed Unification, Displaying Attributes, Attribute Manipulation, Attributed Variables
@section Attributed Unification
@node Attributed Unification, Displaying Attributes, Attribute Manipulation, Old Style Attribute Declarations
@subsection Attributed Unification
The user-predicate predicate @code{verify_attributes/3} is called when
attempting to unify an attributed variable which might have attributes
@ -12569,8 +12795,8 @@ Succeed if @var{Var} is an attributed variable.
@node Displaying Attributes, Projecting Attributes,Attributed Unification, Attributed Variables
@section Displaying Attributes
@node Displaying Attributes, Projecting Attributes,Attributed Unification, Old Style Attribute Declarations
@subsection Displaying Attributes
Attributes are usually presented as goals. The following routines are
used by built-in predicates such as @code{call_residue/2} and by the
@ -12594,8 +12820,8 @@ User-defined procedure, called to project the attributes in the query,
@end table
@node Projecting Attributes, Attribute Examples, Displaying Attributes, Attributed Variables
@section Projecting Attributes
@node Projecting Attributes, Attribute Examples, Displaying Attributes, Old Style Attribute Declarations
@subsection Projecting Attributes
Constraint solvers must be able to project a set of constraints to a set
of variables. This is useful when displaying the solution to a goal, but
@ -12626,8 +12852,8 @@ original constraints into a set of new constraints on the projection,
and these constraints are the ones that will have an
@code{attribute_goal/2} handler.
@node Attribute Examples, ,Projecting Attributes, Attributed Variables
@section Attribute Examples
@node Attribute Examples, ,Projecting Attributes, Old Style Attribute Declarations
@subsection Attribute Examples
The following two examples example is taken from the SICStus Prolog manual. It
sketches the implementation of a simple finite domain ``solver''. Note

70
library/atts.yap
View File

@ -156,21 +156,12 @@ expand_put_attributes(Atts,Mod,Var,attributes:put_module_atts(Var,AccessTerm)) :
expand_put_attributes(Att,Mod,Var,Goal) :-
expand_put_attributes([Att],Mod,Var,Goal).
woken_att_do(AttVar, Binding) :-
get_all_swi_atts(AttVar,SWIAtts),
woken_att_do(AttVar, Binding, NGoals, DoNotBind) :-
modules_with_attributes(AttVar,Mods0),
modules_with_attributes(Mods),
find_used(Mods,Mods0,[],ModsI),
do_verify_attributes(ModsI, AttVar, Binding, Goals),
process_goals(Goals, NGoals, DoNotBind),
( DoNotBind == true
->
unbind_attvar(AttVar)
;
bind_attvar(AttVar)
),
do_hook_attributes(SWIAtts, Binding),
lcall(NGoals).
process_goals(Goals, NGoals, DoNotBind).
% dirty trick to be able to unbind a variable that has been constrained.
process_goals([], [], _).
@ -198,62 +189,5 @@ do_verify_attributes([Mod|Mods], AttVar, Binding, [Mod:Goal|Goals]) :-
do_verify_attributes([_|Mods], AttVar, Binding, Goals) :-
do_verify_attributes(Mods, AttVar, Binding, Goals).
do_hook_attributes([], _).
do_hook_attributes(att(Mod,Att,Atts), Binding) :-
current_predicate(attr_unify_hook,Mod:attr_unify_hook(_,_)),
!,
Mod:attr_unify_hook(Att, Binding),
do_hook_attributes(Atts, Binding).
do_hook_attributes(att(_,_,Atts), Binding) :-
do_hook_attributes(Atts, Binding).
lcall([]).
lcall([Mod:Gls|Goals]) :-
lcall2(Gls,Mod),
lcall(Goals).
lcall2([], _).
lcall2([Goal|Goals], Mod) :-
call(Mod:Goal),
lcall2(Goals, Mod).
convert_att_var(V, Gs) :-
modules_with_attributes(V,LMods),
fetch_att_goals(LMods,V,Gs0), !,
simplify_trues(Gs0, Gs).
convert_att_var(_, true).
fetch_att_goals([Mod], Att, G1) :-
call_module_attributes(Mod, Att, G1), !.
fetch_att_goals([_], _, true) :- !.
fetch_att_goals([Mod|LMods], Att, (G1,LGoal)) :-
call_module_attributes(Mod, Att, G1), !,
fetch_att_goals(LMods, Att, LGoal).
fetch_att_goals([_|LMods], Att, LGoal) :-
fetch_att_goals(LMods, Att, LGoal).
%
% if there is an active attribute for this module call attribute_goal.
%
call_module_attributes(Mod, AttV, G1) :-
current_predicate(attribute_goal, Mod:attribute_goal(AttV,G1)),
Mod:attribute_goal(AttV, G1).
simplify_trues((A,B), NG) :- !,
simplify_trues(A, NA),
simplify_trues(B, NB),
simplify_true(NA, NB, NG).
simplify_trues(G, G).
simplify_true(true, G, G) :- !.
simplify_true(G, true, G) :- !.
simplify_true(A, B, (A,B)).
convert_to_goals([G],G) :- !.
convert_to_goals([A|G],(A,Gs)) :-
convert_to_goals(G,Gs).

37
library/dialect/hprolog.yap
View File

@ -38,7 +38,7 @@
split_at/4, % +N, +List, -FirstElements, -LastElements
max_go_list/2, % +List, -Max
or_list/2, % +ListOfInts, -BitwiseOr
chr_sublist/2, % ?Sublist, +List
sublist/2, % ?Sublist, +List
bounded_sublist/3, % ?Sublist, +List, +Bound
chr_delete/3,
init_store/2,
@ -54,7 +54,10 @@
put_ds/4
% lookup_ht1/4
]).
:- use_module(library(lists)).
:- reexport('../lists',[sublist/2]).
%:- use_module(library(lists)).
:- use_module(library(assoc)).
/** <module> hProlog compatibility library
@ -93,7 +96,7 @@ make_update_store_goal(Name,Value,Goal) :- Goal = b_setval(Name,Value).
*******************************/
%% substitute_eq(+OldVal, +OldList, +NewVal, -NewList)
%
%
% Substitute OldVal by NewVal in OldList and unify the result
% with NewList.
@ -107,7 +110,7 @@ substitute_eq(X, [U|Us], Y, [V|Vs]) :-
).
%% memberchk_eq(+Val, +List)
%
%
% Deterministic check of membership using == rather than
% unification.
@ -120,7 +123,7 @@ memberchk_eq(X, [Y|Ys]) :-
% :- load_foreign_library(chr_support).
%% list_difference_eq(+List, -Subtract, -Rest)
%
%
% Delete all elements of Subtract from List and unify the result
% with Rest. Element comparision is done using ==/2.
@ -133,7 +136,7 @@ list_difference_eq([X|Xs],Ys,L) :-
).
%% intersect_eq(+List1, +List2, -Intersection)
%
%
% Determine the intersection of two lists without unifying values.
intersect_eq([], _, []).
@ -146,7 +149,7 @@ intersect_eq([X|Xs], Ys, L) :-
%% take(+N, +List, -FirstElements)
%
%
% Take the first N elements from List and unify this with
% FirstElements. The definition is based on the GNU-Prolog lists
% library. Implementation by Jan Wielemaker.
@ -178,7 +181,7 @@ split_at(N,[H|T],[H|L1],L2) :-
split_at(M,T,L1,L2).
%% max_go_list(+List, -Max)
%
%
% Return the maximum of List in the standard order of terms.
max_go_list([H|T], Max) :-
@ -192,7 +195,7 @@ max_go_list([H|T], X, Max) :-
).
%% or_list(+ListOfInts, -BitwiseOr)
%
%
% Do a bitwise disjuction over all integer members of ListOfInts.
or_list(L, Or) :-
@ -210,15 +213,15 @@ or_list([H|T], Or0, Or) :-
%
% True if all elements of Sub appear in List in the same order.
chr_sublist(L, L).
chr_sublist(Sub, [H|T]) :-
'$sublist1'(T, H, Sub).
%sublist(L, L).
%sublist(Sub, [H|T]) :-
% '$sublist1'(T, H, Sub).
'$sublist1'(Sub, _, Sub).
'$sublist1'([H|T], _, Sub) :-
'$sublist1'(T, H, Sub).
'$sublist1'([H|T], X, [X|Sub]) :-
'$sublist1'(T, H, Sub).
%'$sublist1'(Sub, _, Sub).
%'$sublist1'([H|T], _, Sub) :-
% '$sublist1'(T, H, Sub).
%'$sublist1'([H|T], X, [X|Sub]) :-
% '$sublist1'(T, H, Sub).
%% bounded_sublist(?Sub, +List, +Bound:integer)
%

34
library/dialect/swi.yap
View File

@ -15,8 +15,6 @@
:- set_prolog_flag(user_flags,silent).
:- ensure_loaded(library(atts)).
:- use_module(library(charsio),[write_to_chars/2,read_from_chars/2]).
:- use_module(library(lists),[append/2,
@ -268,38 +266,6 @@ slp(T) :- sleep(T).
prolog:sleep(T) :-
slp(T).
% SWI has a dynamic attribute scheme
prolog:get_attr(Var, Mod, Att) :-
functor(AttTerm, Mod, 2),
arg(2, AttTerm, Att),
attributes:get_module_atts(Var, AttTerm).
prolog:put_attr(Var, Mod, Att) :-
functor(AttTerm, Mod, 2),
arg(2, AttTerm, Att),
attributes:put_module_atts(Var, AttTerm).
prolog:del_attr(Var, Mod) :-
functor(AttTerm, Mod, 2),
attributes:del_all_module_atts(Var, AttTerm).
prolog:del_attrs(Var) :-
attributes:del_all_atts(Var).
prolog:get_attrs(AttVar, SWIAtts) :-
get_all_swi_atts(AttVar,SWIAtts).
prolog:put_attrs(_, []).
prolog:put_attrs(V, Atts) :-
cvt_to_swi_atts(Atts, YapAtts),
attributes:put_att_term(V, YapAtts).
cvt_to_swi_atts([], _).
cvt_to_swi_atts(att(Mod,Attribute,Atts), ModAttribute) :-
ModAttribute =.. [Mod, YapAtts, Attribute],
cvt_to_swi_atts(Atts, YapAtts).
bindings_message(V) -->
{ cvt_bindings(V, Bindings) },
prolog:message(query(_YesNo,Bindings)), !.

19
library/lists.yap
View File

@ -267,10 +267,21 @@ select(Element, [Head|Tail], [Head|Rest]) :-
% sublist(Sublist, List)
% is true when both append(_,Sublist,S) and append(S,_,List) hold.
sublist(Sublist, List) :-
prefix(Sublist, List).
sublist(Sublist, [_|List]) :-
sublist(Sublist, List).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% sublist(?Sub, +List) is nondet.
%
% True if all elements of Sub appear in List in the same order.
sublist(L, L).
sublist(Sub, [H|T]) :-
'$sublist1'(T, H, Sub).
'$sublist1'(Sub, _, Sub).
'$sublist1'([H|T], _, Sub) :-
'$sublist1'(T, H, Sub).
'$sublist1'([H|T], X, [X|Sub]) :-
'$sublist1'(T, H, Sub).
% substitute(X, XList, Y, YList)
% is true when XList and YList only differ in that the elements X in XList

4
misc/ATOMS
View File

@ -86,7 +86,7 @@ A DollarUndef F "$undef"
A DomainError N "domain_error"
A E N "e"
A EOFBeforeEOT N "end_of_file_found_before_end_of_term"
A EQ N "="
A EQ N "="
A EmptyAtom N ""
A EndOfStream N "$end_of_stream"
A Eof N "end_of_file"
@ -383,7 +383,7 @@ F Module Colomn 2
F MultiFileClause MfClause 5
F Mutable MutableVariable (sizeof(timed_var)/sizeof(CELL))
F NotImplemented NotImplemented 2
F NBQueue Queue 5
F NBQueue Queue 4
F Not Not 1
F Or Semic 2
F PermissionError PermissionError 3

305
pl/attributes.yap Normal file
View File

@ -0,0 +1,305 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: atts.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: attribute support for Prolog *
* *
*************************************************************************/
:- module('$attributes', [
project_delayed_goals/2
]).
prolog:get_attr(Var, Mod, Att) :-
functor(AttTerm, Mod, 2),
arg(2, AttTerm, Att),
attributes:get_module_atts(Var, AttTerm).
prolog:put_attr(Var, Mod, Att) :-
functor(AttTerm, Mod, 2),
arg(2, AttTerm, Att),
attributes:put_module_atts(Var, AttTerm).
prolog:del_attr(Var, Mod) :-
functor(AttTerm, Mod, 2),
attributes:del_all_module_atts(Var, AttTerm).
prolog:del_attrs(Var) :-
attributes:del_all_atts(Var).
prolog:get_attrs(AttVar, SWIAtts) :-
attributes:get_all_swi_atts(AttVar,SWIAtts).
prolog:put_attrs(_, []).
prolog:put_attrs(V, Atts) :-
cvt_to_swi_atts(Atts, YapAtts),
attributes:put_att_term(V, YapAtts).
cvt_to_swi_atts([], _).
cvt_to_swi_atts(att(Mod,Attribute,Atts), ModAttribute) :-
ModAttribute =.. [Mod, YapAtts, Attribute],
cvt_to_swi_atts(Atts, YapAtts).
%
% wake_up_goal is called by the system whenever a suspended goal
% resumes.
%
/* The first case may happen if this variable was used for dif.
In this case, we need a way to keep the original
suspended goal around
*/
%'$wake_up_goal'([Module1|Continuation],G) :-
% '$write'(4,vsc_woke:G+[Module1|Continuation]:'
%'), fail.
prolog:'$wake_up_goal'([Module1|Continuation], LG) :-
execute_woken_system_goals(LG),
do_continuation(Continuation, Module1).
%
% in the first two cases restore register immediately and proceed
% to continuation. In the last case take care with modules, but do
% not act as if a meta-call.
%
%
do_continuation('$cut_by'(X), _) :- !,
'$$cut_by'(X).
do_continuation('$restore_regs'(X), _) :- !,
'$restore_regs'(X).
do_continuation('$restore_regs'(X,Y), _) :- !,
'$restore_regs'(X,Y).
do_continuation(Continuation, Module1) :-
execute_continuation(Continuation,Module1).
execute_continuation(Continuation, Module1) :-
'$undefined'(Continuation, Module1), !,
'$undefp'([Module1|Continuation]).
execute_continuation(Continuation, Mod) :-
% do not do meta-expansion nor any fancy stuff.
'$execute0'(Continuation, Mod).
execute_woken_system_goals([]).
execute_woken_system_goals(['$att_do'(V,New)|LG]) :-
execute_woken_system_goals(LG),
call_atts(V,New).
%
% what to do when an attribute gets bound
%
call_atts(V,_) :-
nonvar(V), !.
call_atts(V,_) :-
'$att_bound'(V), !.
call_atts(V,New) :-
attributes:get_all_swi_atts(V,SWIAtts),
(
'$undefined'(woken_att_do(V, New, LGoals, DoNotBind), attributes)
->
LGoals = [],
DoNotBind = false
;
attributes:woken_att_do(V, New, LGoals, DoNotBind)
),
( DoNotBind == true
->
attributes:unbind_attvar(V)
;
attributes:bind_attvar(V)
),
do_hook_attributes(SWIAtts, New),
lcall(LGoals).
do_hook_attributes([], _).
do_hook_attributes(att(Mod,Att,Atts), Binding) :-
('$undefined'(attr_unify_hook(Att,Binding), Mod)
->
true
;
Mod:attr_unify_hook(Att, Binding)
),
do_hook_attributes(Atts, Binding).
lcall([]).
lcall([Mod:Gls|Goals]) :-
lcall2(Gls,Mod),
lcall(Goals).
lcall2([], _).
lcall2([Goal|Goals], Mod) :-
call(Mod:Goal),
lcall2(Goals, Mod).
prolog:call_residue_vars(Goal,Residue) :-
attributes:all_attvars(Vs0),
call(Goal),
attributes:all_attvars(Vs),
% this should not be actually strictly necessary right now.
% but it makes it a safe bet.
sort(Vs, Vss),
sort(Vs0, Vs0s),
'$ord_remove'(Vss, Vs0s, Residue).
'$ord_remove'([], _, []).
'$ord_remove'([V|Vs], [], [V|Vs]).
'$ord_remove'([V1|Vss], [V2|Vs0s], Residue) :-
( V1 == V2 ->
'$ord_remove'(Vss, Vs0s, Residue)
;
V1 @< V2 ->
Residue = [V1|ResidueF],
'$ord_remove'(Vss, [V2|Vs0s], ResidueF)
;
'$ord_remove'([V1|Vss], Vs0s, Residue)
).
prolog:copy_term(Term, Copy, Goals) :-
term_variables(Term, TVars),
'$get_goalist_from_attvars'(TVars, Goals0),
copy_term_nat([Term|Goals0], [Copy|Goals]).
prolog:call_residue(Goal,Residue) :-
var(Goal), !,
'$do_error'(instantiation_error,call_residue(Goal,Residue)).
prolog:call_residue(Module:Goal,Residue) :-
atom(Module), !,
call_residue(Goal,Module,Residue).
prolog:call_residue(Goal,Residue) :-
'$current_module'(Module),
call_residue(Goal,Module,Residue).
call_residue(Goal,Module,Residue) :-
call(Module:Goal).
project_delayed_goals(G,LGs) :-
(
current_predicate(attributes:modules_with_attributes/1), false
->
% SICStus compatible step,
% just try to simplify store by projecting constraints
% over query variables.
% called by top_level to find out about delayed goals
attributes:all_attvars(LAV),
LAV = [_|_],
!,
project_attributes(LAV, G),
% now get a list of frozen goals.
attributes:all_attvars(NLAV)
;
attributed(G, NLAV),
NLAV = [_|_]
),
!,
get_goalist_from_attvars(NLAV, LGs).
project_delayed_goals(_,[]).
attributed(G, Vs) :-
term_variables(G, LAV),
att_vars(LAV, Vs).
att_vars([], []).
att_vars([V|LGs], [V|AttVars]) :- attvar(V), !,
att_vars(LGs, AttVars).
att_vars([_|LGs], AttVars) :-
att_vars(LGs, AttVars).
% make sure we set the suspended goal list to its previous state!
% make sure we have installed a SICStus like constraint solver.
project_attributes(_, _) :-
'$undefined'(modules_with_attributes(_),attributes), !.
project_attributes(AllVs, G) :-
attributes:modules_with_attributes(LMods),
term_variables(G, InputVs),
pick_att_vars(InputVs, AttIVs),
project_module(LMods, AttIVs, AllVs).
pick_att_vars([],[]).
pick_att_vars([V|L],[V|NL]) :- attvar(V), !,
pick_att_vars(L,NL).
pick_att_vars([_|L],NL) :-
pick_att_vars(L,NL).
project_module([], _, _).
project_module([Mod|LMods], LIV, LAV) :-
'$pred_exists'(project_attributes(LIV, LAV),Mod),
'$notrace'(Mod:project_attributes(LIV, LAV)), !,
attributes:all_attvars(NLAV),
project_module(LMods,LIV,NLAV).
project_module([_|LMods], LIV, LAV) :-
project_module(LMods,LIV,LAV).
% given a list of attributed variables, generate a conjunction of goals.
%
get_conj_from_attvars(TVars, Goals) :-
get_goalist_from_attvars(TVars, [], GoalList, []),
list_to_conjunction(GoalList, Goals).
%
% same, but generate list
%
get_goalist_from_attvars(TVars, GoalList) :-
get_goalist_from_attvars(TVars, GoalList, []).
get_goalist_from_attvars([]) --> [].
get_goalist_from_attvars([V|TVars]) -->
get_goalist_from_attvar(V),
get_goalist_from_attvars(TVars).
get_goalist_from_attvar(V) --> { attvar(V) }, !,
{ attributes:get_all_atts(V, AllAtts) },
all_atts_to_goals(AllAtts, V).
get_goalist_from_attvar(_) --> [].
all_atts_to_goals(AllAtts, _) --> { var(AllAtts) }, !.
all_atts_to_goals(AllAtts, V) -->
{
functor(AllAtts, Mod, _),
arg(1, AllAtts, MoreAtts)
},
attgoals_for_module(Mod, V, AllAtts),
all_atts_to_goals(MoreAtts, V).
%
% check constraints for variable
%
attgoals_for_module(Mod, V, _Gs, GoalListF, GoalList0) :-
% SWI, HProlog
'$pred_exists'(attribute_goals(V,GoalListF,GoalList0), Mod), !,
(
'$notrace'(Mod:attribute_goals(V,GoalListF,GoalList0))
->
true
;
GoalListF = GoalList0
).
attgoals_for_module(Mod, V, _, GoalListF, GoalList0) :-
% SICStus
'$pred_exists'(attribute_goal(V,G),Mod), !,
(
'$notrace'(Mod:attribute_goal(V,G))
->
GoalListF = [G|GoalList0]
;
GoalListF = GoalList0
).
attgoals_for_module(Mod, V, _, GoalList, GoalList).
list_to_conjunction([], true).
list_to_conjunction([G], G) :- !.
list_to_conjunction([G|GoalList], (G,Goals0)) :-
list_to_conjunction(GoalList, Goals0).

2
pl/boot.yap
View File

@ -569,7 +569,7 @@ true :- true.
\+ '$undefined'(bindings_message(_,_,_), swi),
swi:bindings_message(V, LGs, []), !.
'$output_frozen'(G,V,LGs) :-
'$project_and_delayed_goals'(G,LGs).
'$attributes':project_delayed_goals(G,LGs).
%
% present_answer has three components. First it flushes the streams,

694
pl/corout.yap
View File

@ -16,138 +16,69 @@
*************************************************************************/
%:- module(coroutining,[
%dif/2,
%when/2,
%block/1,
%wait/1,
%frozen/2
%]).
:- module('$coroutining',[
op(1150, fx, block)
%dif/2,
%when/2,
%block/1,
%wait/1,
%frozen/2
]).
attr_unify_hook(DelayList, _) :-
wake_delays(DelayList).
wake_delays([]).
wake_delays(Delay.List) :-
wake_delay(Delay),
wake_delays(List).
%
% Interface to attributed variables.
%
wake_delay(redo_dif(Done, X, Y)) :-
redo_dif(Done, X, Y).
wake_delay(redo_freeze(Done, V, Goal)) :-
redo_freeze(Done, V, Goal).
wake_delay(redo_eq(Done, X, Y, Goal)) :-
redo_eq(Done, X, Y, Goal, G).
wake_delay(redo_ground(Done, X, Goal)) :-
redo_ground(Done, X, Goal).
attribute_goals(Var) -->
{ get_attr(Var, '$coroutining', Delays) },
attgoal_for_delays(Delays, Var).
attgoal_for_delays([], V) --> [].
attgoal_for_delays([G|AllAtts], V) -->
attgoal_for_delay(G, V),
attgoal_for_delays(AllAtts, V).
attgoal_for_delay(redo_dif(Done, X, Y), V) --> { var(Done), first_att(dif(X,Y), V) }, !, [prolog:dif(X,Y)].
attgoal_for_delay(redo_freeze(Done, V, Goal), V) --> { var(Done) }, !, [prolog:freeze(V,Goal)].
attgoal_for_delay(redo_eq(Done, X, Y, Goal), V) --> { var(Done), first_att(Goal, V) }, !, [prolog:when(X=Y,Goal)].
attgoal_for_delay(redo_ground(Done, X, Goal), V) --> { var(Done) }, !, [prolog:when(ground(X),Goal)].
attgoal_for_delay(_, V) --> [].
%
% operators defined in this module:
%
:- op(1150, fx, block).
%
% Tell the system how to present frozen goals.
%
:- assert((extensions_to_present_answer(Level) :-
'$show_frozen_goals'(Level))).
'$project_and_delayed_goals'(G,LGs) :-
attributes:all_attvars(LAV),
LAV = [_|_], !,
% SICStus compatible step,
% just try to simplify store by projecting constraints
% over query variables.
'$project_attributes'(LAV, G),
% now get a list of frozen goals.
attributes:all_attvars(NLAV),
'$get_goalist_from_attvars'(NLAV, LGs).
'$project_and_delayed_goals'(_,[]).
%
% wake_up_goal is called by the system whenever a suspended goal
% resumes.
%
/* The first case may happen if this variable was used for dif.
In this case, we need a way to keep the original
suspended goal around
*/
%'$wake_up_goal'([Module1|Continuation],G) :-
% '$write'(4,vsc_woke:G+[Module1|Continuation]:'
%'), fail.
'$wake_up_goal'([Module1|Continuation], LG) :-
%write(waking:LG),nl,
'$execute_woken_system_goals'(LG),
'$do_continuation'(Continuation, Module1).
%
% in the first two cases restore register immediately and proceed
% to continuation. In the last case take care with modules, but do
% not act as if a meta-call.
%
%
'$do_continuation'('$cut_by'(X), _) :- !,
'$$cut_by'(X).
'$do_continuation'('$restore_regs'(X), _) :- !,
'$restore_regs'(X).
'$do_continuation'('$restore_regs'(X,Y), _) :- !,
'$restore_regs'(X,Y).
'$do_continuation'(Continuation, Module1) :-
'$execute_continuation'(Continuation,Module1).
'$execute_continuation'(Continuation, Module1) :-
'$undefined'(Continuation, Module1), !,
'$undefp'([Module1|Continuation]).
'$execute_continuation'(Continuation, Mod) :-
% do not do meta-expansion nor any fancy stuff.
'$execute0'(Continuation, Mod).
'$execute_woken_system_goals'([]).
'$execute_woken_system_goals'([G|LG]) :-
'$execute_woken_system_goals'(LG),
'$execute_woken_system_goal'(G).
%
% X surely was bound, otherwise we would not be awaken.
%
'$execute_woken_system_goal'('$att_do'(V,New)) :-
( '$frozen_goals'(V, Goals) ->
'$call_atts'(V,New),
'$execute_frozen_goals'(Goals)
;
'$call_atts'(V,New)
).
'$call_atts'(V,_) :-
nonvar(V), !.
'$call_atts'(V,_) :-
'$undefined'(woken_att_do(_,_), attributes), !,
attributes:bind_attvar(V).
'$call_atts'(V,_) :-
'$att_bound'(V), !.
'$call_atts'(V,New) :-
attributes:woken_att_do(V,New).
'$execute_frozen_goals'([]).
'$execute_frozen_goals'([G0|Gs]) :-
'$execute_frozen_goal'(G0,G0),
'$execute_frozen_goals'(Gs).
%
% X and Y may not be bound (multiple suspensions on the same goal).
%
'$execute_frozen_goal'('$redo_dif'(Done, X, Y), G) :-
'$redo_dif'(Done, X, Y, G).
'$execute_frozen_goal'('$redo_freeze'(Done, V, Goal), _) :-
'$redo_freeze'(Done, V, Goal).
'$execute_frozen_goal'('$redo_eq'(Done, X, Y, Goal), G) :-
'$redo_eq'(Done, X, Y, Goal, G).
'$execute_frozen_goal'('$redo_ground'(Done, X, Goal), _) :-
'$redo_ground'(Done, X, Goal).
freeze(V, G) :-
prolog:freeze(V, G) :-
var(V), !,
'$freeze_goal'(V,G).
freeze(_, G) :-
freeze_goal(V,G).
prolog:freeze(_, G) :-
'$execute'(G).
'$freeze_goal'(V,VG) :-
freeze_goal(V,VG) :-
var(VG), !,
'$current_module'(M),
'$freeze'(V, '$redo_freeze'(_Done,V,M:VG)).
'$freeze_goal'(V,M:G) :- !,
'$freeze'(V, '$redo_freeze'(_Done,V,M:G)).
'$freeze_goal'(V,G) :-
internal_freeze(V, redo_freeze(_Done,V,M:VG)).
freeze_goal(V,M:G) :- !,
internal_freeze(V, redo_freeze(_Done,V,M:G)).
freeze_goal(V,G) :-
'$current_module'(M),
'$freeze'(V, '$redo_freeze'(_Done,V,M:G)).
internal_freeze(V, redo_freeze(_Done,V,M:G)).
%
%
@ -185,16 +116,17 @@ freeze(_, G) :-
% several times. dif calls a special version of freeze that checks
% whether that is in fact the case.
%
dif(X, Y) :- '$can_unify'(X, Y, LVars), !,
prolog:dif(X, Y) :-
'$can_unify'(X, Y, LVars), !,
LVars = [_|_],
'$dif_suspend_on_lvars'(LVars, '$redo_dif'(_Done, X, Y)).
dif(_, _).
dif_suspend_on_lvars(LVars, redo_dif(_Done, X, Y)).
prolog:dif(_, _).
'$dif_suspend_on_lvars'([], _).
'$dif_suspend_on_lvars'([H|T], G) :-
'$freeze'(H, G),
'$dif_suspend_on_lvars'(T, G).
dif_suspend_on_lvars([], _).
dif_suspend_on_lvars([H|T], G) :-
internal_freeze(H, G),
dif_suspend_on_lvars(T, G).
%
% This predicate is called whenever a variable dif was suspended on is
@ -205,72 +137,72 @@ dif(_, _).
% we try to increase the number of suspensions; last, the two terms
% did not unify, we are done, so we succeed and bind the Done variable.
%
'$redo_dif'(Done, _, _, _) :- nonvar(Done), !.
'$redo_dif'(_, X, Y, G) :-
redo_dif(Done, _, _) :- nonvar(Done), !.
redo_dif(Done, X, Y) :-
'$can_unify'(X, Y, LVars), !,
LVars = [_|_],
'$dif_suspend_on_lvars'(LVars, G).
'$redo_dif'('$done', _, _, _).
dif_suspend_on_lvars(LVars, redo_dif(Done, X, Y)).
redo_dif('$done', _, _).
% If you called nonvar as condition for when, then you may find yourself
% here.
%
% someone else (that is Cond had ;) did the work, do nothing
%
'$redo_freeze'(Done, _, _) :- nonvar(Done), !.
redo_freeze(Done, _, _) :- nonvar(Done), !.
%
% We still have some more conditions: continue the analysis.
%
'$redo_freeze'(Done, _, '$when'(C, G, Done)) :- !,
redo_freeze(Done, _, '$when'(C, G, Done)) :- !,
'$when'(C, G, Done).
%
% check if the variable was really bound
%
'$redo_freeze'(Done, V, G) :- var(V), !,
'$freeze'(V, '$redo_freeze'(Done,V,G)).
redo_freeze(Done, V, G) :- var(V), !,
internal_freeze(V, redo_freeze(Done,V,G)).
%
% I can't believe it: we're done and can actually execute our
% goal. Notice we have to say we are done, otherwise someone else in
% the disjunction might decide to wake up the goal themselves.
%
'$redo_freeze'('$done', _, G) :-
redo_freeze('$done', _, G) :-
'$execute'(G).
%
% eq is a combination of dif and freeze
'$redo_eq'(Done, _, _, _, _) :- nonvar(Done), !.
'$redo_eq'(_, X, Y, _, G) :-
redo_eq(Done, _, _, _, _) :- nonvar(Done), !.
redo_eq(_, X, Y, _, G) :-
'$can_unify'(X, Y, LVars),
LVars = [_|_], !,
'$dif_suspend_on_lvars'(LVars, G).
'$redo_eq'(Done, _, _, '$when'(C, G, Done), _) :- !,
'$when'(C, G, Done).
'$redo_eq'('$done', _ ,_ , Goal, _) :-
dif_suspend_on_lvars(LVars, G).
redo_eq(Done, _, _, when(C, G, Done), _) :- !,
when(C, G, Done).
redo_eq('$done', _ ,_ , Goal, _) :-
'$execute'(Goal).
%
% ground is similar to freeze
'$redo_ground'(Done, _, _) :- nonvar(Done), !.
'$redo_ground'(Done, X, Goal) :-
redo_ground(Done, _, _) :- nonvar(Done), !.
redo_ground(Done, X, Goal) :-
'$non_ground'(X, Var), !,
'$freeze'(Var, '$redo_ground'(Done, X, Goal)).
'$redo_ground'(Done, _, '$when'(C, G, Done)) :- !,
'$when'(C, G, Done).
'$redo_ground'('$done', _, Goal) :-
internal_freeze(Var, redo_ground(Done, X, Goal)).
redo_ground(Done, _, when(C, G, Done)) :- !,
when(C, G, Done).
redo_ground('$done', _, Goal) :-
'$execute'(Goal).
%
% support for when/2 built-in
%
when(Conds,Goal) :-
prolog:when(Conds,Goal) :-
'$current_module'(Mod),
'$prepare_goal_for_when'(Goal, Mod, ModG),
'$when'(Conds, ModG, Done, [], LG), !,
prepare_goal_for_when(Goal, Mod, ModG),
when(Conds, ModG, Done, [], LG), !,
%write(vsc:freezing(LG,Done)),nl,
'$suspend_when_goals'(LG, Done).
when(_,Goal) :-
suspend_when_goals(LG, Done).
prolog:when(_,Goal) :-
'$execute'(Goal).
%
@ -282,7 +214,7 @@ when(_,Goal) :-
%
%
'$declare_when'(Cond, G) :-
'$generate_code_for_when'(Cond, G, Code),
generate_code_for_when(Cond, G, Code),
'$current_module'(Module),
'$$compile'(Code, Code, 5, Module), fail.
'$declare_when'(_,_).
@ -290,19 +222,19 @@ when(_,Goal) :-
%
% use a meta interpreter for now
%
'$generate_code_for_when'(Conds, G,
( G :- '$when'(Conds, ModG, Done, [], LG), !,
'$suspend_when_goals'(LG, Done)) ) :-
generate_code_for_when(Conds, G,
( G :- when(Conds, ModG, Done, [], LG), !,
suspend_when_goals(LG, Done)) ) :-
'$current_module'(Mod),
'$prepare_goal_for_when'(G, Mod, ModG).
prepare_goal_for_when(G, Mod, ModG).
%
% make sure we have module info for G!
%
'$prepare_goal_for_when'(G, Mod, Mod:call(G)) :- var(G), !.
'$prepare_goal_for_when'(M:G, _, M:G) :- !.
'$prepare_goal_for_when'(G, Mod, Mod:G).
prepare_goal_for_when(G, Mod, Mod:call(G)) :- var(G), !.
prepare_goal_for_when(M:G, _, M:G) :- !.
prepare_goal_for_when(G, Mod, Mod:G).
%
@ -315,39 +247,39 @@ when(_,Goal) :-
% $when/5 and $when_suspend succeds when there is need to suspend a goal
%
%
'$when'(V, G, Done, LG0, LGF) :- var(V), !,
when(V, G, Done, LG0, LGF) :- var(V), !,
'$do_error'(instantiation_error,when(V,G)).
'$when'(nonvar(V), G, Done, LG0, LGF) :-
'$when_suspend'(nonvar(V), G, Done, LG0, LGF).
'$when'(?=(X,Y), G, Done, LG0, LGF) :-
'$when_suspend'(?=(X,Y), G, Done, LG0, LGF).
'$when'(ground(T), G, Done, LG0, LGF) :-
'$when_suspend'(ground(T), G, Done, LG0, LGF).
'$when'((C1, C2), G, Done, LG0, LGF) :-
when(nonvar(V), G, Done, LG0, LGF) :-
when_suspend(nonvar(V), G, Done, LG0, LGF).
when(?=(X,Y), G, Done, LG0, LGF) :-
when_suspend(?=(X,Y), G, Done, LG0, LGF).
when(ground(T), G, Done, LG0, LGF) :-
when_suspend(ground(T), G, Done, LG0, LGF).
when((C1, C2), G, Done, LG0, LGF) :-
% leave it open to continue with when.
(
'$when'(C1, '$when'(C2, G, Done), Done, LG0, LGI)
when(C1, when(C2, G, Done), Done, LG0, LGI)
->
LGI = LGF
;
% we solved C1, great, now we just have to solve C2!
'$when'(C2, G, Done, LG0, LGF)
when(C2, G, Done, LG0, LGF)
).
'$when'((G1 ; G2), G, Done, LG0, LGF) :-
'$when'(G1, G, Done, LG0, LGI),
'$when'(G2, G, Done, LGI, LGF).
when((G1 ; G2), G, Done, LG0, LGF) :-
when(G1, G, Done, LG0, LGI),
when(G2, G, Done, LGI, LGF).
%
% Auxiliary predicate called from within a conjunction.
% Repeat basic code for when, as inserted in first clause for predicate.
%
'$when'(_, _, Done) :-
when(_, _, Done) :-
nonvar(Done), !.
'$when'(Cond, G, Done) :-
'$when'(Cond, G, Done, [], LG),
when(Cond, G, Done) :-
when(Cond, G, Done, [], LG),
!,
'$suspend_when_goals'(LG, Done).
'$when'(_, G, '$done') :-
suspend_when_goals(LG, Done).
when(_, G, '$done') :-
'$execute'(G).
%
@ -355,47 +287,47 @@ when(_,Goal) :-
%
% some one else did the work.
%
'$when_suspend'(_, _, Done, _, []) :- nonvar(Done), !.
when_suspend(_, _, Done, _, []) :- nonvar(Done), !.
%
% now for the serious stuff.
%
'$when_suspend'(nonvar(V), G, Done, LG0, LGF) :-
'$try_freeze'(V, G, Done, LG0, LGF).
'$when_suspend'(?=(X,Y), G, Done, LG0, LGF) :-
'$try_eq'(X, Y, G, Done, LG0, LGF).
'$when_suspend'(ground(X), G, Done, LG0, LGF) :-
'$try_ground'(X, G, Done, LG0, LGF).
when_suspend(nonvar(V), G, Done, LG0, LGF) :-
try_freeze(V, G, Done, LG0, LGF).
when_suspend(?=(X,Y), G, Done, LG0, LGF) :-
try_eq(X, Y, G, Done, LG0, LGF).
when_suspend(ground(X), G, Done, LG0, LGF) :-
try_ground(X, G, Done, LG0, LGF).
'$try_freeze'(V, G, Done, LG0, LGF) :-
try_freeze(V, G, Done, LG0, LGF) :-
var(V),
LGF = ['$freeze'(V, '$redo_freeze'(Done, V, G))|LG0].
LGF = ['$coroutining':internal_freeze(V, redo_freeze(Done, V, G))|LG0].
'$try_eq'(X, Y, G, Done, LG0, LGF) :-
try_eq(X, Y, G, Done, LG0, LGF) :-
'$can_unify'(X, Y, LVars), LVars = [_|_],
LGF = ['$dif_suspend_on_lvars'(LVars, '$redo_eq'(Done, X, Y, G))|LG0].
LGF = ['$coroutining':dif_suspend_on_lvars(LVars, redo_eq(Done, X, Y, G))|LG0].
'$try_ground'(X, G, Done, LG0, LGF) :-
try_ground(X, G, Done, LG0, LGF) :-
'$non_ground'(X, Var), % the C predicate that succeds if
% finding out the term is nonground
% and gives the first variable it
% finds. Notice that this predicate
% must know about svars.
LGF = ['$freeze'(Var, '$redo_ground'(Done, X, G))| LG0].
LGF = ['$coroutining':internal_freeze(Var, redo_ground(Done, X, G))| LG0].
%
% When executing a when, if nobody succeeded, we need to create suspensions.
%
'$suspend_when_goals'([], _).
'$suspend_when_goals'(['$freeze'(V, G)|Ls], Done) :-
suspend_when_goals([], _).
suspend_when_goals(['$coroutining':internal_freeze(V, G)|Ls], Done) :-
var(Done), !,
'$freeze'(V, G),
'$suspend_when_goals'(Ls, Done).
'$suspend_when_goals'(['$dif_suspend_on_lvars'(LVars, G)|LG], Done) :-
internal_freeze(V, G),
suspend_when_goals(Ls, Done).
suspend_when_goals([dif_suspend_on_lvars(LVars, G)|LG], Done) :-
var(Done), !,
'$dif_suspend_on_lvars'(LVars, G),
'$suspend_when_goals'(LG, Done).
'$suspend_when_goals'([_|_], _).
dif_suspend_on_lvars(LVars, G),
suspend_when_goals(LG, Done).
suspend_when_goals([_|_], _).
%
% Support for wait declarations on goals.
@ -410,31 +342,31 @@ when(_,Goal) :-
% choicepoint and make things a bit slower, but it's probably not as
% significant as the remaining overheads.
%
'$block'(Conds) :-
'$generate_blocking_code'(Conds, _, Code),
prolog:'$block'(Conds) :-
generate_blocking_code(Conds, _, Code),
'$current_module'(Module),
'$$compile'(Code, Code, 5, Module), fail.
'$block'(_).
prolog:'$block'(_).
'$generate_blocking_code'(Conds, G, Code) :-
generate_blocking_code(Conds, G, Code) :-
'$extract_head_for_block'(Conds, G),
'$recorded'('$blocking_code','$code'(G,OldConds),R), !,
erase(R),
functor(G, Na, Ar),
'$current_module'(M),
abolish(M:Na, Ar),
'$generate_blocking_code'((Conds,OldConds), G, Code).
'$generate_blocking_code'(Conds, G, (G :- (If, !, when(When, G)))) :-
'$extract_head_for_block'(Conds, G),
generate_blocking_code((Conds,OldConds), G, Code).
generate_blocking_code(Conds, G, (G :- (If, !, when(When, G)))) :-
extract_head_for_block(Conds, G),
recorda('$blocking_code','$code'(G,Conds),_),
'$generate_body_for_block'(Conds, G, If, When).
generate_body_for_block(Conds, G, If, When).
%
% find out what we are blocking on.
%
'$extract_head_for_block'((C1, _), G) :- !,
'$extract_head_for_block'(C1, G).
'$extract_head_for_block'(C, G) :-
extract_head_for_block((C1, _), G) :- !,
extract_head_for_block(C1, G).
extract_head_for_block(C, G) :-
functor(C, Na, Ar),
functor(G, Na, Ar).
@ -458,323 +390,73 @@ when(_,Goal) :-
% (var(A1), var(A2) -> true ; (var(A2), var(A3) -> true ; fail)), !,
% when(((nonvar(A1);nonvar(A2)),(nonvar(A2);nonvar(A3))),G).
'$generate_body_for_block'((C1, C2), G, (Code1 -> true ; Code2), (WhenConds,OtherWhenConds)) :- !,
'$generate_for_cond_in_block'(C1, G, Code1, WhenConds),
'$generate_body_for_block'(C2, G, Code2, OtherWhenConds).
'$generate_body_for_block'(C, G, (Code -> true ; fail), WhenConds) :-
'$generate_for_cond_in_block'(C, G, Code, WhenConds).
generate_body_for_block((C1, C2), G, (Code1 -> true ; Code2), (WhenConds,OtherWhenConds)) :- !,
generate_for_cond_in_block(C1, G, Code1, WhenConds),
generate_body_for_block(C2, G, Code2, OtherWhenConds).
generate_body_for_block(C, G, (Code -> true ; fail), WhenConds) :-
generate_for_cond_in_block(C, G, Code, WhenConds).
'$generate_for_cond_in_block'(C, G, Code, Whens) :-
generate_for_cond_in_block(C, G, Code, Whens) :-
C =.. [_|Args],
G =.. [_|GArgs],
'$fetch_out_variables_for_block'(Args,GArgs,L0Vars),
'$add_blocking_vars'(L0Vars, LVars),
'$generate_for_each_arg_in_block'(LVars, Code, Whens).
fetch_out_variables_for_block(Args,GArgs,L0Vars),
add_blocking_vars(L0Vars, LVars),
generate_for_each_arg_in_block(LVars, Code, Whens).
'$add_blocking_vars'([], [_]) :- !.
'$add_blocking_vars'(LV, LV).
add_blocking_vars([], [_]) :- !.
add_blocking_vars(LV, LV).
'$fetch_out_variables_for_block'([], [], []).
'$fetch_out_variables_for_block'(['?'|Args], [_|GArgs], LV) :-
'$fetch_out_variables_for_block'(Args, GArgs, LV).
'$fetch_out_variables_for_block'(['-'|Args], [GArg|GArgs],
fetch_out_variables_for_block([], [], []).
fetch_out_variables_for_block(['?'|Args], [_|GArgs], LV) :-
fetch_out_variables_for_block(Args, GArgs, LV).
fetch_out_variables_for_block(['-'|Args], [GArg|GArgs],
[GArg|LV]) :-
'$fetch_out_variables_for_block'(Args, GArgs, LV).
fetch_out_variables_for_block(Args, GArgs, LV).
'$generate_for_each_arg_in_block'([], false, true).
'$generate_for_each_arg_in_block'([V], var(V), nonvar(V)) :- !.
'$generate_for_each_arg_in_block'([V|L], (var(V),If), (nonvar(V);Whens)) :-
'$generate_for_each_arg_in_block'(L, If, Whens).
generate_for_each_arg_in_block([], false, true).
generate_for_each_arg_in_block([V], var(V), nonvar(V)) :- !.
generate_for_each_arg_in_block([V|L], (var(V),If), (nonvar(V);Whens)) :-
generate_for_each_arg_in_block(L, If, Whens).
%
% The wait declaration is a simpler and more efficient version of block.
%
'$wait'(Na/Ar) :-
prolog:'$wait'(Na/Ar) :-
functor(S, Na, Ar),
arg(1, S, A),
'$current_module'(M),
'$$compile'((S :- var(A), !, freeze(A, S)), (S :- var(A), !, freeze(A, S)), 5, M), fail.
'$wait'(_).
prolog:'$wait'(_).
frozen(V, G) :- nonvar(V), !,
'$do_error'(type_error(variable,V),frozen(V,G)).
frozen(V, LG) :-
'$get_conj_from_attvars'([V], LG).
'$attributes':get_conj_from_attvars([V], LG).
'$find_att_vars'([], []).
'$find_att_vars'([V|LGs], [V|AttVars]) :- attvar(V), !,
'$find_att_vars'(LGs, AttVars).
'$find_att_vars'([_|LGs], AttVars) :-
'$find_att_vars'(LGs, AttVars).
'$purge_done_goals'([], []).
'$purge_done_goals'([V|G0], GF) :- attvar(V), !,
'$purge_done_goals'(G0, GF).
'$purge_done_goals'(['$redo_dif'(Done, _ , _)|G0], GF) :- nonvar(Done), !,
'$purge_done_goals'(G0, GF).
'$purge_done_goals'(['$redo_freeze'(Done, _, _)|G0], GF) :- nonvar(Done), !,
'$purge_done_goals'(G0, GF).
'$purge_done_goals'(['$redo_freeze'(_Done, _, CallCleanup)|G0], GF) :-
nonvar(CallCleanup),
% be careful about possibly adding extra binding at this point.
CallCleanup = _:T, nonvar(T), T = '$clean_call'(_,_), !,
'$purge_done_goals'(G0, GF).
'$purge_done_goals'(['$redo_eq'(Done, _, _, _)|G0], GF) :- nonvar(Done), !,
'$purge_done_goals'(G0, GF).
'$purge_done_goals'(['$redo_ground'(Done, _, _)|G0], GF) :- nonvar(Done), !,
'$purge_done_goals'(G0, GF).
'$purge_done_goals'([G|G0], [G|GF]) :-
'$purge_done_goals'(G0, GF).
'$convert_frozen_goal'(V, _, _, V, _) :- attvar(V), !.
'$convert_frozen_goal'('$redo_dif'(Done, X, Y), LV, Done, [X,Y|LV], dif(X,Y)).
'$convert_frozen_goal'('$redo_freeze'(Done, FV, G), LV, Done, [FV|LV], G).
'$convert_frozen_goal'('$redo_eq'(Done, X, Y, G), LV, Done, [X,Y|LV], G).
'$convert_frozen_goal'('$redo_ground'(Done, V, G), LV, Done, [V|LV], G).
'$fetch_same_done_goals'([], _, [], []).
'$fetch_same_done_goals'([V|G0], Done, NL, GF) :- attvar(V), !,
'$fetch_same_done_goals'(G0, Done, NL, GF).
'$fetch_same_done_goals'(['$redo_dif'(Done, X , Y)|G0], D0, [X,Y|LV], GF) :-
Done == D0, !,
'$fetch_same_done_goals'(G0, D0, LV, GF).
'$fetch_same_done_goals'(['$redo_freeze'(Done, V, _)|G0], D0, [V|LV], GF) :-
Done == D0, !,
'$fetch_same_done_goals'(G0, D0, LV, GF).
'$fetch_same_done_goals'(['$redo_eq'(Done, X, Y, _)|G0], D0, [X,Y|LV], GF) :-
Done == D0, !,
'$fetch_same_done_goals'(G0, D0, LV, GF).
'$fetch_same_done_goals'(['$redo_ground'(Done, G, _)|G0], D0, [G|LV], GF) :-
Done == D0, !,
'$fetch_same_done_goals'(G0, D0, LV, GF).
'$fetch_same_done_goals'([G|G0], D0, LV, [G|GF]) :-
'$fetch_same_done_goals'(G0, D0, LV, GF).
call_residue_vars(Goal,Residue) :-
attributes:all_attvars(Vs0),
call(Goal),
attributes:all_attvars(Vs),
% this should not be actually strictly necessary right now.
% but it makes it a safe bet.
sort(Vs, Vss),
sort(Vs0, Vs0s),
'$ord_remove'(Vss, Vs0s, Residue).
'$ord_remove'([], _, []).
'$ord_remove'([V|Vs], [], [V|Vs]).
'$ord_remove'([V1|Vss], [V2|Vs0s], Residue) :-
( V1 == V2 ->
'$ord_remove'(Vss, Vs0s, Residue)
;
V1 @< V2 ->
Residue = [V1|ResidueF],
'$ord_remove'(Vss, [V2|Vs0s], ResidueF)
;
'$ord_remove'([V1|Vss], Vs0s, Residue)
).
copy_term(Term, Copy, Goals) :-
term_variables(Term, TVars),
'$get_goalist_from_attvars'(TVars, Goals0),
copy_term_nat([Term|Goals0], [Copy|Goals]).
call_residue(Goal,Residue) :-
var(Goal), !,
'$do_error'(instantiation_error,call_residue(Goal,Residue)).
call_residue(Module:Goal,Residue) :-
atom(Module), !,
'$call_residue'(Goal,Module,Residue).
call_residue(Goal,Residue) :-
'$current_module'(Module),
'$call_residue'(Goal,Module,Residue).
'$call_residue'(Goal,Module,Residue) :-
'$read_svar_list'(OldAttsList),
copy_term_nat(Goal, NGoal),
( '$set_svar_list'(CurrentAttsList),
'$system_catch'(NGoal,Module,Error,'$residue_catch_trap'(Error,OldAttsList)),
'$project_and_delayed_goals'(NGoal,Residue0),
'$add_vs_to_vlist'(Residue0, Residue),
( '$set_svar_list'(OldAttsList),
copy_term_nat(NGoal+NResidue, Goal+Residue)
;
'$set_svar_list'(CurrentAttsList), fail
)
;
'$set_svar_list'(OldAttsList), fail
).
'$add_vs_to_vlist'([], []).
'$add_vs_to_vlist'([G|Residue0], [Vs-G|Residue]) :-
term_variables(G, TVs),
'$pick_att_vars'(TVs, Vs),
'$add_vs_to_vlist'(Residue0, Residue).
% make sure we set the suspended goal list to its previous state!
'$residue_catch_trap'(Error,OldAttsList) :-
'$set_svar_list'(OldAttsList),
throw(Error).
% make sure we have installed a SICStus like constraint solver.
'$project_attributes'(_, _) :-
'$undefined'(modules_with_attributes(_),attributes), !.
'$project_attributes'(AllVs, G) :-
attributes:modules_with_attributes(LMods),
term_variables(G, InputVs),
'$pick_att_vars'(InputVs, AttIVs),
'$project_module'(LMods, AttIVs, AllVs).
'$pick_att_vars'([],[]).
'$pick_att_vars'([V|L],[V|NL]) :- attvar(V), !,
'$pick_att_vars'(L,NL).
'$pick_att_vars'([_|L],NL) :-
'$pick_att_vars'(L,NL).
'$project_module'([], _, _).
'$project_module'([Mod|LMods], LIV, LAV) :-
'$pred_exists'(project_attributes(LIV, LAV),Mod),
'$notrace'(Mod:project_attributes(LIV, LAV)), !,
attributes:all_attvars(NLAV),
'$project_module'(LMods,LIV,NLAV).
'$project_module'([_|LMods], LIV, LAV) :-
'$project_module'(LMods,LIV,LAV).
'$convert_att_vars'(_, []) :-
% do nothing
'$undefined'(convert_att_var(Vs,LIV),attributes), !.
'$convert_att_vars'(Vs0, LGs) :-
'$sort'(Vs0, Vs),
'$do_convert_att_vars'(Vs0, LGs).
'$do_convert_att_vars'([],[]).
'$do_convert_att_vars'([V|LAV], NGs) :-
attvar(V),
attributes:convert_att_var(V,G),
G \= true,
!,
'$split_goals_for_catv'(G,V,NGs,IGs),
'$do_convert_att_vars'(LAV, IGs).
'$do_convert_att_vars'([_|LAV], Gs) :-
'$do_convert_att_vars'(LAV, Gs).
'$split_goals_for_catv'((G,NG),V,[V-G|Gs],Gs0) :- !,
'$split_goals_for_catv'(NG,V,Gs,Gs0).
'$split_goals_for_catv'(NG,V,[V-NG|Gs],Gs).
'$vars_interset_for_constr'([V1|_],[V2|_]) :-
V1 == V2, !.
'$vars_interset_for_constr'([V1|GV],[V2|LIV]) :-
V1 @< V2, !,
'$vars_interset_for_constr'(GV,[V2|LIV]).
'$vars_interset_for_constr'([V1|GV],[_|LIV]) :-
'$vars_interset_for_constr'([V1|GV],LIV).
'$process_when'('$when'(_,G,_), NG) :- !,
'$process_when'(G, NG).
'$process_when'(G, G).
%'$freeze'(V,G) :-
%internal_freeze(V,G) :-
% attributes:get_att(V, 0, Gs), write(G+Gs),nl,fail.
'$freeze'(V,G) :-
'$update_att'(V, G).
internal_freeze(V,G) :-
update_att(V, G).
'$update_att'(V, G) :-
attributes:get_module_atts(V, prolog(_,Gs)), !,
attributes:put_module_atts(V, prolog(_,[G|Gs])).
'$update_att'(V, G) :-
attributes:put_module_atts(V, prolog(_,[G])).
update_att(V, G) :-
attributes:get_module_atts(V, '$coroutining'(_,Gs)),
not_vmember(G, Gs), !,
attributes:put_module_atts(V, '$coroutining'(_,[G|Gs])).
update_att(V, G) :-
attributes:put_module_atts(V, '$coroutining'(_,[G])).
'$goal_in'(G,[G1|_]) :- G == G1, !.
'$goal_in'(G,[_|Gs]) :-
'$goal_in'(G,Gs).
'$frozen_goals'(V,Gs) :-
var(V),
attributes:get_att(V, prolog, 2, Gs), nonvar(Gs).
%
% given a list of attributed variables, generate a conjunction of goals.
%
'$get_conj_from_attvars'(TVars, Goals) :-
'$get_goalist_from_attvars'(TVars, [], GoalList, []),
'$list_to_conjunction'(GoalList, Goals).
%
% same, but generate list
%
'$get_goalist_from_attvars'(TVars, GoalList) :-
'$get_goalist_from_attvars'(TVars, [], GoalList, []).
'$get_goalist_from_attvars'([], _, GoalList, GoalList).
'$get_goalist_from_attvars'([V|TVars], DonesSoFar, GoalListF, GoalList0) :-
'$get_goalist_from_attvar'(V, DonesSoFar, MoreDonesSoFar, GoalListF, GoalListI),
'$get_goalist_from_attvars'(TVars, MoreDonesSoFar, GoalListI, GoalList0).
'$get_goalist_from_attvar'(V, DonesSoFar, MoreDonesSoFar, GoalListF, GoalList0) :- attvar(V), !,
attributes:get_all_atts(V, AllAtts),
'$all_atts_to_goals'(AllAtts, V, DonesSoFar, MoreDonesSoFar, GoalListF, GoalList0).
'$get_goalist_from_attvar'(_, DonesSoFar, DonesSoFar, GoalList, GoalList).
'$all_atts_to_goals'(AllAtts, _, DonesSoFar, DonesSoFar, GoalList, GoalList) :- var(AllAtts), !.
'$all_atts_to_goals'(AllAtts, V, DonesSoFar, MoreDonesSoFar, GoalListF, GoalList0) :-
functor(AllAtts, Mod, _),
arg(1, AllAtts, MoreAtts),
'$attgoals_for_module'(Mod, V, AllAtts, DonesSoFar, IDonesSoFar, GoalListF, GoalListI),
'$all_atts_to_goals'(MoreAtts, V, IDonesSoFar, MoreDonesSoFar, GoalListI, GoalList0).
%
% check constraints for variable
%
'$attgoals_for_module'(prolog, V, prolog(_,Gs), DonesSoFar, MoreDonesSoFar, GoalListF, GoalList0) :- !,
% dif, when, freeze
'$attgoals_for_prolog'(Gs, V, DonesSoFar, MoreDonesSoFar, GoalListF, GoalList0).
'$attgoals_for_module'(Mod, V, _Gs, DonesSoFar, DonesSoFar, GoalListF, GoalList0) :-
% SWI, HProlog
current_predicate(Mod:attribute_goals/3), !,
(
'$notrace'(Mod:attribute_goals(V,GoalListF,GoalList0))
->
true
;
GoalListF = GoalList0
).
'$attgoals_for_module'(Mod, V, _, DonesSoFar, DonesSoFar, GoalListF, GoalList0) :-
% SICStus
current_predicate(Mod:attribute_goal/2), !,
(
'$notrace'(Mod:attribute_goal(V,G))
->
GoalListF = [G|GoalList0]
;
GoalListF = GoalList0
).
'$attgoals_for_module'(Mod, V, _, DonesSoFar, DonesSoFar, GoalList, GoalList).
'$attgoals_for_prolog'([], _, DonesSoFar, DonesSoFar, GoalList, GoalList).
'$attgoals_for_prolog'([G|AllAtts], V, DonesSoFar, MoreDonesSoFar, [AttGoal|GoalListI], GoalList0) :-
'$attgoal_for_prolog'(G, Done, AttGoal),
'$not_vmember'(Done, DonesSoFar), !,
'$attgoals_for_prolog'(AllAtts, V, [Done|DonesSoFar], MoreDonesSoFar, GoalListI, GoalList0).
'$attgoals_for_prolog'([_|AllAtts], V, DonesSoFar, MoreDonesSoFar, GoalListI, GoalList0) :-
'$attgoals_for_prolog'(AllAtts, V, DonesSoFar, MoreDonesSoFar, GoalListI, GoalList0).
'$attgoal_for_prolog'('$redo_dif'(Done, X, Y), Done, prolog:dif(X,Y)).
'$attgoal_for_prolog'('$redo_freeze'(_, _, _:'$clean_call'(_,_)), _, _) :- !, fail.
'$attgoal_for_prolog'('$redo_freeze'(Done, V, Goal), Done, prolog:freeze(V,Goal)).
'$attgoal_for_prolog'('$redo_eq'(Done, X, Y, Goal), Done, prolog:when(X=Y,Goal)).
'$attgoal_for_prolog'('$redo_ground'(Done, X, Goal), Done, prolog:when(ground(X),Goal)).
'$not_vmember'(_, []).
'$not_vmember'(V, [V1|DonesSoFar]) :-
not_vmember(_, []).
not_vmember(V, [V1|DonesSoFar]) :-
V \== V1,
'$not_vmember'(V, DonesSoFar).
not_vmember(V, DonesSoFar).
first_att(T, V) :-
term_variables(T, Vs),
check_first_attvar(Vs, V).
check_first_attvar(V.Vs, V0) :- attvar(V), !, V == V0.
check_first_attvar(_.Vs, V0) :-
check_first_attvar(Vs, V0).
'$list_to_conjunction'([], true).
'$list_to_conjunction'([G], G) :- !.
'$list_to_conjunction'([G|GoalList], (G,Goals0)) :-
'$list_to_conjunction'(GoalList, Goals0).

7
pl/init.yap
View File

@ -125,14 +125,17 @@ system_mode(verbose,off) :- set_value('$verbose',off).
:- dynamic 'extensions_to_present_answer'/1.
:- ['corout.yap',
'arrays.yap'].
:- ['arrays.yap'].
:- use_module('messages.yap').
:- use_module('hacks.yap').
:- use_module('attributes.yap').
:- use_module('corout.yap').
'$system_module'('$messages').
'$system_module'('$hacks').
'$system_module'('$attributes').
'$system_module'('$coroutining').
yap_hacks:cut_by(CP) :- '$$cut_by'(CP).

3
pl/setof.yap
View File

@ -122,7 +122,8 @@ bagof(Template, Generator, Bag) :-
% The fourth gives the free variables being currently used.
% The fifth outputs the current solution.
%
'$decide'([], Bag, Key, Key, Bag) :- !.
'$decide'([], Bag, Key0, Key, Bag) :- !,
Key0=Key.
'$decide'(_, Bag, Key, Key, Bag).
'$decide'(Bags, _, _, Key, Bag) :-
'$pick'(Bags, Key, Bag).