/[gcl]/gcl/o/list.d
ViewVC logotype

Diff of /gcl/o/list.d

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.34 by camm, Thu Sep 22 17:26:50 2005 UTC revision 1.35 by camm, Thu Oct 6 20:30:08 2005 UTC
# Line 159  endp1(x) Line 159  endp1(x)
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);
# Line 174  object x; Line 174  object x;
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);
# Line 186  object x; Line 186  object x;
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);
# Line 196  object Line 196  object
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);
# Line 206  object x; Line 206  object x;
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);
# Line 360  object x, y; Line 360  object x, y;
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;
# Line 410  object x; Line 410  object x;
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          }          }
# Line 456  object x; Line 456  object x;
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();
# Line 477  object new, tree; Line 477  object new, tree;
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();
# Line 498  object new, *treep; Line 498  object new, *treep;
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          }          }
# Line 524  object alist, tree; Line 524  object alist, tree;
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();
# Line 553  object alist, *treep; Line 553  object alist, *treep;
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          }          }
# Line 563  LFD(Lcar)() Line 563  LFD(Lcar)()
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]);
# Line 573  LFD(Lcdr)() Line 573  LFD(Lcdr)()
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]);
# Line 642  DEFUNO_NEW("NTH",object,fLnth,LISP,2,2,N Line 642  DEFUNO_NEW("NTH",object,fLnth,LISP,2,2,N
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--;}}
# Line 709  LFD(Lendp)() Line 709  LFD(Lendp)()
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          }          }
# Line 776  nthcdr(fixnum n, object x) { Line 776  nthcdr(fixnum n, object x) {
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;
# Line 801  LFD(Llast)() { Line 801  LFD(Llast)() {
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                  }                  }
# Line 835  object x; Line 835  object x;
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
# Line 920  LFD(Lrevappend)() { Line 920  LFD(Lrevappend)() {
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();
# Line 961  LFD(Lnconc)() { Line 959  LFD(Lnconc)() {
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 {
# Line 976  LFD(Lreconc)() { Line 974  LFD(Lreconc)() {
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;
# Line 989  LFD(Lreconc)() { Line 987  LFD(Lreconc)() {
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;
# Line 1011  LFD(Lreconc)() { Line 1011  LFD(Lreconc)() {
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  @)  @)
# Line 1028  LFD(Lldiff)() { Line 1028  LFD(Lldiff)() {
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  }  }
# Line 1095  sublis1(alist,tree,tst) Line 1092  sublis1(alist,tree,tst)
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);
# Line 1115  object alist; Line 1112  object alist;
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    
# Line 1128  object alist; Line 1125  object alist;
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  }  }
# Line 1162  object alist; Line 1159  object alist;
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;
# Line 1182  PREDICATE(Lmember,Lmember_if,Lmember_if_ Line 1179  PREDICATE(Lmember,Lmember_if,Lmember_if_
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;
# Line 1196  LFD(Ltailp)() { Line 1193  LFD(Ltailp)() {
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  }  }
# Line 1242  LFD(Lacons)() Line 1236  LFD(Lacons)()
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);
# Line 1253  LFD(Lacons)() Line 1245  LFD(Lacons)()
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);
# Line 1310  member_eq(x, l) Line 1302  member_eq(x, l)
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);
# Line 1326  object x, l; Line 1318  object x, l;
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; */
# Line 1341  void Line 1333  void
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;

Legend:
Removed from v.1.34  
changed lines
  Added in v.1.35

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26