159 |
object x; |
object x; |
160 |
{ |
{ |
161 |
|
|
162 |
if (type_of(x) == t_cons) |
if (consp(x)) |
163 |
return(FALSE); |
return(FALSE); |
164 |
else * if (x == Cnil) * |
else * if (x == Cnil) * |
165 |
return(TRUE); |
return(TRUE); |
174 |
{ |
{ |
175 |
if (x == Cnil) |
if (x == Cnil) |
176 |
return(x); |
return(x); |
177 |
if (type_of(x) == t_cons) |
if (consp(x)) |
178 |
return(x->c.c_car); |
return(x->c.c_car); |
179 |
FEwrong_type_argument(sLlist, x); |
FEwrong_type_argument(sLlist, x); |
180 |
return(Cnil); |
return(Cnil); |
186 |
{ |
{ |
187 |
if (x == Cnil) |
if (x == Cnil) |
188 |
return(x); |
return(x); |
189 |
if (type_of(x) == t_cons) |
if (consp(x)) |
190 |
return(x->c.c_cdr); |
return(x->c.c_cdr); |
191 |
FEwrong_type_argument(sLlist, x); |
FEwrong_type_argument(sLlist, x); |
192 |
return(Cnil); |
return(Cnil); |
196 |
kar(x) |
kar(x) |
197 |
object x; |
object x; |
198 |
{ |
{ |
199 |
if (type_of(x) == t_cons) |
if (consp(x)) |
200 |
return(x->c.c_car); |
return(x->c.c_car); |
201 |
FEwrong_type_argument(sLcons, x); |
FEwrong_type_argument(sLcons, x); |
202 |
return(Cnil); |
return(Cnil); |
206 |
kdr(x) |
kdr(x) |
207 |
object x; |
object x; |
208 |
{ |
{ |
209 |
if (type_of(x) == t_cons) |
if (consp(x)) |
210 |
return(x->c.c_cdr); |
return(x->c.c_cdr); |
211 |
FEwrong_type_argument(sLcons, x); |
FEwrong_type_argument(sLcons, x); |
212 |
return(Cnil); |
return(Cnil); |
360 |
cs_check(x); |
cs_check(x); |
361 |
|
|
362 |
BEGIN: |
BEGIN: |
363 |
if (type_of(x) == t_cons) |
if (consp(x)) |
364 |
if (type_of(y) == t_cons) |
if (consp(y)) |
365 |
if (tree_equal(x->c.c_car, y->c.c_car)) { |
if (tree_equal(x->c.c_car, y->c.c_car)) { |
366 |
x = x->c.c_cdr; |
x = x->c.c_cdr; |
367 |
y = y->c.c_cdr; |
y = y->c.c_cdr; |
410 |
{ |
{ |
411 |
object y; |
object y; |
412 |
|
|
413 |
if (type_of(x) != t_cons) |
if (!consp(x)) |
414 |
return(x); |
return(x); |
415 |
y = make_cons(x->c.c_car, Cnil); |
y = make_cons(x->c.c_car, Cnil); |
416 |
vs_push(y); |
vs_push(y); |
417 |
for (x = x->c.c_cdr; type_of(x) == t_cons; x = x->c.c_cdr) { |
for (x = x->c.c_cdr; consp(x); x = x->c.c_cdr) { |
418 |
y->c.c_cdr = make_cons(x->c.c_car, Cnil); |
y->c.c_cdr = make_cons(x->c.c_car, Cnil); |
419 |
y = y->c.c_cdr; |
y = y->c.c_cdr; |
420 |
} |
} |
456 |
{ |
{ |
457 |
cs_check(x); |
cs_check(x); |
458 |
|
|
459 |
if (type_of(x) == t_cons) { |
if (consp(x)) { |
460 |
copy_tree(x->c.c_car); |
copy_tree(x->c.c_car); |
461 |
copy_tree(x->c.c_cdr); |
copy_tree(x->c.c_cdr); |
462 |
stack_cons(); |
stack_cons(); |
477 |
|
|
478 |
if (TEST(tree)) |
if (TEST(tree)) |
479 |
vs_check_push(new); |
vs_check_push(new); |
480 |
else if (type_of(tree) == t_cons) { |
else if (consp(tree)) { |
481 |
subst(new, tree->c.c_car); |
subst(new, tree->c.c_car); |
482 |
subst(new, tree->c.c_cdr); |
subst(new, tree->c.c_cdr); |
483 |
stack_cons(); |
stack_cons(); |
498 |
|
|
499 |
if (TEST(*treep)) |
if (TEST(*treep)) |
500 |
*treep = new; |
*treep = new; |
501 |
else if (type_of(*treep) == t_cons) { |
else if (consp(*treep)) { |
502 |
nsubst(new, &(*treep)->c.c_car); |
nsubst(new, &(*treep)->c.c_car); |
503 |
nsubst(new, &(*treep)->c.c_cdr); |
nsubst(new, &(*treep)->c.c_cdr); |
504 |
} |
} |
524 |
return; |
return; |
525 |
} |
} |
526 |
} |
} |
527 |
if (type_of(tree) == t_cons) { |
if (consp(tree)) { |
528 |
sublis(alist, tree->c.c_car); |
sublis(alist, tree->c.c_car); |
529 |
sublis(alist, tree->c.c_cdr); |
sublis(alist, tree->c.c_cdr); |
530 |
stack_cons(); |
stack_cons(); |
553 |
return; |
return; |
554 |
} |
} |
555 |
} |
} |
556 |
if (type_of(*treep) == t_cons) { |
if (consp(*treep)) { |
557 |
nsublis(alist, &(*treep)->c.c_car); |
nsublis(alist, &(*treep)->c.c_car); |
558 |
nsublis(alist, &(*treep)->c.c_cdr); |
nsublis(alist, &(*treep)->c.c_cdr); |
559 |
} |
} |
563 |
{ |
{ |
564 |
check_arg(1); |
check_arg(1); |
565 |
|
|
566 |
if (type_of(vs_base[0]) == t_cons || vs_base[0] == Cnil) |
if (listp(vs_base[0])) |
567 |
vs_base[0] = vs_base[0]->c.c_car; |
vs_base[0] = vs_base[0]->c.c_car; |
568 |
else |
else |
569 |
FEwrong_type_argument(sLlist, vs_base[0]); |
FEwrong_type_argument(sLlist, vs_base[0]); |
573 |
{ |
{ |
574 |
check_arg(1); |
check_arg(1); |
575 |
|
|
576 |
if (type_of(vs_base[0]) == t_cons || vs_base[0] == Cnil) |
if (listp(vs_base[0])) |
577 |
vs_base[0] = vs_base[0]->c.c_cdr; |
vs_base[0] = vs_base[0]->c.c_cdr; |
578 |
else |
else |
579 |
FEwrong_type_argument(sLlist, vs_base[0]); |
FEwrong_type_argument(sLlist, vs_base[0]); |
642 |
if (index < 0) |
if (index < 0) |
643 |
FEerror("Negative index: ~D.", 1, make_fixnum(index)); |
FEerror("Negative index: ~D.", 1, make_fixnum(index)); |
644 |
while (1) |
while (1) |
645 |
{if (type_of(x)==t_cons) |
{if (consp(x)) |
646 |
{ if (index == 0) |
{ if (index == 0) |
647 |
RETURN1(Mcar(x)); |
RETURN1(Mcar(x)); |
648 |
else {x = Mcdr(x); index--;}} |
else {x = Mcdr(x); index--;}} |
709 |
vs_base[0] = Ct; |
vs_base[0] = Ct; |
710 |
return; |
return; |
711 |
} |
} |
712 |
if (type_of(vs_base[0]) == t_cons) { |
if (consp(vs_base[0])) { |
713 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
714 |
return; |
return; |
715 |
} |
} |
776 |
FEwrong_type_argument(sLnon_negative_fixnum, vs_head); |
FEwrong_type_argument(sLnon_negative_fixnum, vs_head); |
777 |
} |
} |
778 |
while (n-- > 0) |
while (n-- > 0) |
779 |
if (endp_prop(x)) { |
if (endp(x)) { |
780 |
return(Cnil); |
return(Cnil); |
781 |
} else |
} else |
782 |
x = x->c.c_cdr; |
x = x->c.c_cdr; |
801 |
} |
} |
802 |
|
|
803 |
if (!n) |
if (!n) |
804 |
while (type_of(vs_base[0]) == t_cons) |
while (consp(vs_base[0])) |
805 |
vs_base[0]=vs_base[0]->c.c_cdr; |
vs_base[0]=vs_base[0]->c.c_cdr; |
806 |
else { |
else { |
807 |
t=vs_base[0]; |
t=vs_base[0]; |
808 |
while (type_of(vs_base[0]->c.c_cdr) == t_cons && --n) |
while (consp(vs_base[0]->c.c_cdr) && --n) |
809 |
vs_base[0] = vs_base[0]->c.c_cdr; |
vs_base[0] = vs_base[0]->c.c_cdr; |
810 |
while (type_of(vs_base[0]->c.c_cdr) == t_cons) { |
while (consp(vs_base[0]->c.c_cdr)) { |
811 |
t=t->c.c_cdr; |
t=t->c.c_cdr; |
812 |
vs_base[0] = vs_base[0]->c.c_cdr; |
vs_base[0] = vs_base[0]->c.c_cdr; |
813 |
} |
} |
835 |
{object *p; |
{object *p; |
836 |
p = &x; |
p = &x; |
837 |
TOP: |
TOP: |
838 |
if (type_of(*p) ==t_cons) |
if (consp(*p)) |
839 |
{ if(!inheap(*p)) |
{ if(!inheap(*p)) |
840 |
*p=make_cons(copy_off_stack_tree((*p)->c.c_car),(*p)->c.c_cdr); |
*p=make_cons(copy_off_stack_tree((*p)->c.c_car),(*p)->c.c_cdr); |
841 |
else |
else |
920 |
object x, y; |
object x, y; |
921 |
|
|
922 |
check_arg(2); |
check_arg(2); |
|
/* check_proper_list(vs_base[0]); */ |
|
|
/* endp_prop does check */ |
|
923 |
y = vs_pop; |
y = vs_pop; |
924 |
for (x = vs_base[0]; !endp_prop(x); x = x->c.c_cdr) { |
for (x = vs_base[0]; !endp(x); x = x->c.c_cdr) { |
925 |
vs_push(x->c.c_car); |
vs_push(x->c.c_car); |
926 |
vs_push(y); |
vs_push(y); |
927 |
stack_cons(); |
stack_cons(); |
959 |
m->c.c_cdr = l; |
m->c.c_cdr = l; |
960 |
m = l; |
m = l; |
961 |
} |
} |
962 |
for (; type_of(m->c.c_cdr)==t_cons; m = m->c.c_cdr); |
for (; consp(m->c.c_cdr); m = m->c.c_cdr); |
963 |
} |
} |
964 |
if (x == Cnil) vs_base[0] = vs_top[-1]; |
if (x == Cnil) vs_base[0] = vs_top[-1]; |
965 |
else { |
else { |
974 |
|
|
975 |
check_arg(2); |
check_arg(2); |
976 |
y = vs_pop; |
y = vs_pop; |
977 |
for (x = vs_base[0]; !endp_prop(x);) { |
for (x = vs_base[0]; !endp(x);) { |
978 |
z = x; |
z = x; |
979 |
x = x->c.c_cdr; |
x = x->c.c_cdr; |
980 |
z->c.c_cdr = y; |
z->c.c_cdr = y; |
987 |
fixnum i; |
fixnum i; |
988 |
@ |
@ |
989 |
check_type_non_negative_integer(&nn); |
check_type_non_negative_integer(&nn); |
990 |
|
if (!listp(lis)) |
991 |
|
TYPE_ERROR(lis,sLlist); |
992 |
if (type_of(nn) != t_fixnum) |
if (type_of(nn) != t_fixnum) |
993 |
@(return Cnil) |
@(return Cnil) |
994 |
for (i = 0; !endp(lis) && fix_dot(lis)==lis; i++, lis = lis->c.c_cdr) |
for (i = 0; consp(lis); i++, lis = lis->c.c_cdr) |
995 |
vs_check_push(lis->c.c_car); |
vs_check_push(lis->c.c_car); |
996 |
if (i <= fix((nn))) { |
if (i <= fix((nn))) { |
997 |
vs_top -= i; |
vs_top -= i; |
1011 |
object x; |
object x; |
1012 |
@ |
@ |
1013 |
check_type_non_negative_integer(&nn); |
check_type_non_negative_integer(&nn); |
1014 |
|
if (!listp(lis)) |
1015 |
|
TYPE_ERROR(lis,sLlist); |
1016 |
if (type_of(nn) != t_fixnum) |
if (type_of(nn) != t_fixnum) |
1017 |
@(return Cnil) |
@(return Cnil) |
1018 |
for (i = 0, x = lis; !endp(x) && fix_dot(x)==x; i++, x = x->c.c_cdr) |
for (i = 0, x = lis; consp(x); i++, x = x->c.c_cdr); |
|
; |
|
1019 |
if (i <= fix((nn))) |
if (i <= fix((nn))) |
1020 |
@(return Cnil) |
@(return Cnil) |
1021 |
for (i -= fix((nn)), x = lis; --i > 0; x = x->c.c_cdr) |
for (i -= fix((nn)), x = lis; --i > 0; x = x->c.c_cdr); |
|
; |
|
1022 |
x->c.c_cdr = Cnil; |
x->c.c_cdr = Cnil; |
1023 |
@(return lis) |
@(return lis) |
1024 |
@) |
@) |
1028 |
object x; |
object x; |
1029 |
|
|
1030 |
check_arg(2); |
check_arg(2); |
1031 |
for (i = 0, x = vs_base[0]; !endp(x); i++, x = x->c.c_cdr) |
x = vs_base[0]; |
1032 |
/* if (dot_list_eq(x,vs_base[1]))*/ |
if (!listp(x))/*FIXME checktype*/ |
1033 |
if (eql(fix_dot(x),vs_base[1])) |
TYPE_ERROR(x,sLlist); |
1034 |
break; |
for (i = 0; consp(x) && x!=vs_base[1] ; i++, x = x->c.c_cdr) |
1035 |
else |
vs_check_push(x->c.c_car); /*FIXME but a segfault breaker at vs_limit*/ |
1036 |
vs_check_push(x->c.c_car); |
x=eql(x,vs_base[1]) ? Cnil : x; |
1037 |
if (proper_list(x)) |
vs_check_push(x); |
|
vs_push(Cnil); |
|
|
else |
|
|
i--; |
|
1038 |
while (i-- > 0) |
while (i-- > 0) |
1039 |
stack_cons(); |
stack_cons(); |
1040 |
vs_base[0] = vs_pop; |
vs_base[0] = vs_pop; |
1041 |
vs_popp; |
vs_popp; |
1042 |
} |
} |
1092 |
for (v=alist ; v!=Cnil; v=v->c.c_cdr) |
for (v=alist ; v!=Cnil; v=v->c.c_cdr) |
1093 |
{ if (v->c.c_car->c.c_car == tree || (*tst)(v->c.c_car->c.c_car ,tree)) |
{ if (v->c.c_car->c.c_car == tree || (*tst)(v->c.c_car->c.c_car ,tree)) |
1094 |
return(v->c.c_car->c.c_cdr);} |
return(v->c.c_car->c.c_cdr);} |
1095 |
if (type_of(tree)==t_cons) |
if (consp(tree)) |
1096 |
{object ntree=make_cons(sublis1(alist,tree->c.c_car,tst), |
{object ntree=make_cons(sublis1(alist,tree->c.c_car,tst), |
1097 |
tree->c.c_cdr); |
tree->c.c_cdr); |
1098 |
ntree->c.c_cdr=sublis1(alist,ntree->c.c_cdr,tst); |
ntree->c.c_cdr=sublis1(alist,ntree->c.c_cdr,tst); |
1112 |
{ |
{ |
1113 |
object v; |
object v; |
1114 |
for (v=alist ; !endp(v) ; v=v->c.c_cdr) |
for (v=alist ; !endp(v) ; v=v->c.c_cdr) |
1115 |
if (type_of(v->c.c_car) != t_cons && v->c.c_car != Cnil) |
if (!consp(v->c.c_car) && v->c.c_car != Cnil) |
1116 |
FEwrong_type_argument(sLlist, v); |
FEwrong_type_argument(sLlist, v); |
1117 |
} |
} |
1118 |
|
|
1125 |
if (alist == Cnil) |
if (alist == Cnil) |
1126 |
FEwrong_type_argument(sLlist, alist); |
FEwrong_type_argument(sLlist, alist); |
1127 |
*/ |
*/ |
1128 |
for (v=alist ; type_of(v) == t_cons ; v=v->c.c_cdr); |
for (v=alist ; consp(v) ; v=v->c.c_cdr); |
1129 |
if (v != Cnil) |
if (v != Cnil) |
1130 |
FEwrong_type_argument(sLlist, alist); |
FEwrong_type_argument(sLlist, alist); |
1131 |
} |
} |
1159 |
@ |
@ |
1160 |
protectTEST; |
protectTEST; |
1161 |
setupTEST(item, test, test_not, key); |
setupTEST(item, test, test_not, key); |
1162 |
while (!endp_prop(list)) { |
while (!endp(list)) { |
1163 |
if (TEST(list->c.c_car)) |
if (TEST(list->c.c_car)) |
1164 |
goto L; |
goto L; |
1165 |
list = list->c.c_cdr; |
list = list->c.c_cdr; |
1179 |
if (rev != Cnil) |
if (rev != Cnil) |
1180 |
reverse_comparison=1; |
reverse_comparison=1; |
1181 |
setupTEST(item, test, test_not, key); |
setupTEST(item, test, test_not, key); |
1182 |
while (!endp_prop(list)) { |
while (!endp(list)) { |
1183 |
if (TEST(list->c.c_car)) |
if (TEST(list->c.c_car)) |
1184 |
goto L; |
goto L; |
1185 |
list = list->c.c_cdr; |
list = list->c.c_cdr; |
1193 |
object x; |
object x; |
1194 |
|
|
1195 |
check_arg(2); |
check_arg(2); |
1196 |
for (x = vs_base[1]; !endp(x); x = x->c.c_cdr) |
for (x = vs_base[1]; consp(x); x = x->c.c_cdr) |
1197 |
if (eql(fix_dot(x),vs_base[0])) { |
if (x==vs_base[0]) { |
1198 |
vs_base[0] = Ct; |
vs_base[0] = Ct; |
1199 |
vs_popp; |
vs_popp; |
1200 |
return; |
return; |
1201 |
} |
} |
1202 |
if (eql(x,vs_base[0])) |
vs_base[0]=eql(x,vs_base[0]) ? Ct : Cnil; |
|
vs_base[0] = Ct; |
|
|
else |
|
|
vs_base[0] = Cnil; |
|
1203 |
vs_popp; |
vs_popp; |
1204 |
return; |
return; |
1205 |
} |
} |
1236 |
vp = vs_top + 1; |
vp = vs_top + 1; |
1237 |
k = keys; |
k = keys; |
1238 |
d = data; |
d = data; |
1239 |
/* check_proper_list(k); |
while (!endp(k)) { |
1240 |
check_proper_list(d); */ |
if (endp(d)) |
|
while (!endp_prop(k)) { |
|
|
if (endp_prop(d)) |
|
1241 |
FEerror( |
FEerror( |
1242 |
"The keys ~S and the data ~S are not of the same length", |
"The keys ~S and the data ~S are not of the same length", |
1243 |
2, keys, data); |
2, keys, data); |
1245 |
k = k->c.c_cdr; |
k = k->c.c_cdr; |
1246 |
d = d->c.c_cdr; |
d = d->c.c_cdr; |
1247 |
} |
} |
1248 |
if (!endp_prop(d)) |
if (!endp(d)) |
1249 |
FEerror("The keys ~S and the data ~S are not of the same length", |
FEerror("The keys ~S and the data ~S are not of the same length", |
1250 |
2, keys, data); |
2, keys, data); |
1251 |
vs_push(a_list); |
vs_push(a_list); |
1302 |
object x, l; |
object x, l; |
1303 |
{ |
{ |
1304 |
|
|
1305 |
for (; type_of(l) == t_cons; l = l->c.c_cdr) |
for (; consp(l); l = l->c.c_cdr) |
1306 |
if (x == l->c.c_car) |
if (x == l->c.c_car) |
1307 |
return(TRUE); |
return(TRUE); |
1308 |
return(FALSE); |
return(FALSE); |
1318 |
/* x = vs_base[0]; */ |
/* x = vs_base[0]; */ |
1319 |
/* l = vs_base[1]; */ |
/* l = vs_base[1]; */ |
1320 |
|
|
1321 |
/* for (; type_of(l) == t_cons; l = l->c.c_cdr) */ |
/* for (; consp(l); l = l->c.c_cdr) */ |
1322 |
/* if (x == l->c.c_car) { */ |
/* if (x == l->c.c_car) { */ |
1323 |
/* vs_base[0] = l; */ |
/* vs_base[0] = l; */ |
1324 |
/* vs_popp; */ |
/* vs_popp; */ |
1333 |
delete_eq(x, lp) |
delete_eq(x, lp) |
1334 |
object x, *lp; |
object x, *lp; |
1335 |
{ |
{ |
1336 |
for (; type_of(*lp) == t_cons; lp = &(*lp)->c.c_cdr) |
for (; consp(*lp); lp = &(*lp)->c.c_cdr) |
1337 |
if ((*lp)->c.c_car == x) { |
if ((*lp)->c.c_car == x) { |
1338 |
*lp = (*lp)->c.c_cdr; |
*lp = (*lp)->c.c_cdr; |
1339 |
return; |
return; |