/[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.8 by camm, Wed Aug 21 04:36:43 2002 UTC revision 1.9 by camm, Tue Sep 24 19:01:45 2002 UTC
# Line 364  object x, y; Line 364  object x, y;
364  {  {
365          object z;          object z;
366    
         object endp_temp;  
367          if (endp(x))          if (endp(x))
368                  return(y);                  return(y);
369          z = make_cons(Cnil, Cnil);          z = make_cons(Cnil, Cnil);
# Line 411  object x; Line 410  object x;
410  {  {
411          object y;          object y;
412    
         object endp_temp;  
413          if (endp(x))          if (endp(x))
414                  return(Cnil);                  return(Cnil);
415          y = make_cons(Cnil, Cnil);          y = make_cons(Cnil, Cnil);
# Line 495  sublis(alist, tree) Line 493  sublis(alist, tree)
493  object alist, tree;  object alist, tree;
494  {  {
495          object x;          object x;
         object endp_temp;  
496          cs_check(alist);          cs_check(alist);
497    
498    
# Line 524  nsublis(alist, treep) Line 521  nsublis(alist, treep)
521  object alist, *treep;  object alist, *treep;
522  {  {
523          object x;          object x;
         object endp_temp;  
524    
525          cs_check(alist);          cs_check(alist);
526    
# Line 715  Llist_length() Line 711  Llist_length()
711  {  {
712          int n;          int n;
713          object fast, slow;          object fast, slow;
         object endp_temp;  
714          check_arg(1);          check_arg(1);
715          n = 0;          n = 0;
716          fast = slow = vs_base[0];          fast = slow = vs_base[0];
# Line 740  Llist_length() Line 735  Llist_length()
735    
736    
737  object  object
738  nth(n, x)  nth(int n, object x) {
739  int n;  
 object x;  
 {       object endp_temp;  
740          if (n < 0) {          if (n < 0) {
741                  vs_push(make_fixnum(n));                  vs_push(make_fixnum(n));
742                  FEerror("Negative index: ~D.", 1, vs_head);                  FEerror("Negative index: ~D.", 1, vs_head);
# Line 768  Lnthcdr() Line 761  Lnthcdr()
761  }  }
762    
763  object  object
764  nthcdr(n, x)  nthcdr(int n, object x) {
765  int n;  
 object x;  
 {       object endp_temp;  
766          if (n < 0) {          if (n < 0) {
767                  vs_push(make_fixnum(n));                  vs_push(make_fixnum(n));
768                  FEerror("Negative index: ~D.", 1, vs_head);                  FEerror("Negative index: ~D.", 1, vs_head);
# Line 785  object x; Line 776  object x;
776  }  }
777    
778  void  void
779  Llast()  Llast() {
780  {       object endp_temp,t;          object t;
781          int n;          int n;
782    
783          n=vs_top-vs_base;          n=vs_top-vs_base;
# Line 921  Lcopy_tree() Line 912  Lcopy_tree()
912  }  }
913    
914  void  void
915  Lrevappend()  Lrevappend() {
 {       object endp_temp;  
916          object x, y;          object x, y;
917    
918          check_arg(2);          check_arg(2);
# Line 937  Lrevappend() Line 927  Lrevappend()
927  }  }
928    
929  object  object
930  nconc(x, y)  nconc(object x, object y) {
 object x, y;  
 {       object endp_temp;  
931          object x1;          object x1;
932    
933          if (endp(x))          if (endp(x))
# Line 951  object x, y; Line 939  object x, y;
939  }  }
940    
941  void  void
942  Lnconc()  Lnconc() {
 {       object endp_temp;  
943          object x, l, m=Cnil;          object x, l, m=Cnil;
944          int i, narg;          int i, narg;
945                    
# Line 981  Lnconc() Line 968  Lnconc()
968  }  }
969    
970  void  void
971  Lreconc()  Lreconc() {
 {       object endp_temp;  
972          object x, y, z;          object x, y, z;
973    
974          check_arg(2);          check_arg(2);
# Line 998  Lreconc() Line 984  Lreconc()
984    
985  @(defun butlast (lis &optional (nn `make_fixnum(1)`))  @(defun butlast (lis &optional (nn `make_fixnum(1)`))
986          int i;          int i;
         object endp_temp;  
987  @  @
988          check_type_non_negative_integer(&nn);          check_type_non_negative_integer(&nn);
989          if (type_of(nn) != t_fixnum)          if (type_of(nn) != t_fixnum)
990                  @(return Cnil)                  @(return Cnil)
991          for (i = 0;  !endp(lis);  i++, lis = lis->c.c_cdr)          for (i = 0;  !endp(lis) && proper_cons(lis);  i++, lis = lis->c.c_cdr)
992                  vs_check_push(lis->c.c_car);                  vs_check_push(lis->c.c_car);
993          if (i <= fix((nn))) {          if (i <= fix((nn))) {
994                  vs_top -= i;                  vs_top -= i;
# Line 1021  Lreconc() Line 1006  Lreconc()
1006  @(defun nbutlast (lis &optional (nn `make_fixnum(1)`))  @(defun nbutlast (lis &optional (nn `make_fixnum(1)`))
1007          int i;          int i;
1008          object x;          object x;
         object endp_temp;  
1009  @  @
1010          check_type_non_negative_integer(&nn);          check_type_non_negative_integer(&nn);
1011          if (type_of(nn) != t_fixnum)          if (type_of(nn) != t_fixnum)
1012                  @(return Cnil)                  @(return Cnil)
1013          for (i = 0, x = lis;  !endp(x);  i++, x = x->c.c_cdr)          for (i = 0, x = lis;  !endp(x) && proper_cons(x);  i++, x = x->c.c_cdr)
1014                  ;                  ;
1015          if (i <= fix((nn)))          if (i <= fix((nn)))
1016                  @(return Cnil)                  @(return Cnil)
# Line 1037  Lreconc() Line 1021  Lreconc()
1021  @)  @)
1022    
1023  void  void
1024  Lldiff()  Lldiff() {
 {       object endp_temp;  
1025          int i;          int i;
1026          object x;          object x;
1027    
1028          check_arg(2);          check_arg(2);
1029          for (i = 0, x = vs_base[0];  !endp(x);  i++, x = x->c.c_cdr)          for (i = 0, x = vs_base[0];  !endp(x);  i++, x = x->c.c_cdr)
1030                  if (x == vs_base[1])                  if (dot_list_eq(x,vs_base[1]))
1031                          break;                          break;
1032                  else                  else
1033                          vs_check_push(x->c.c_car);                          vs_check_push(x->c.c_car);
1034          vs_push(Cnil);          if (proper_list(x))
1035                    vs_push(Cnil);
1036            else
1037                    i--;
1038          while (i-- > 0)          while (i-- > 0)
1039                  stack_cons();                  stack_cons();
1040          vs_base[0] = vs_pop;          vs_base[0] = vs_pop;
# Line 1126  void Line 1112  void
1112  check_alist(alist)  check_alist(alist)
1113       object alist;       object alist;
1114  {object v;  {object v;
 object endp_temp;  
1115     for (v=alist ; !endp(v) ; v=v->c.c_cdr)     for (v=alist ; !endp(v) ; v=v->c.c_cdr)
1116     {if (type_of(v->c.c_car) != t_cons     {if (type_of(v->c.c_car) != t_cons
1117           && v->c.c_car != Cnil)           && v->c.c_car != Cnil)
# Line 1158  object endp_temp; Line 1143  object endp_temp;
1143  @)  @)
1144    
1145  @(defun member (item list &key test test_not key)  @(defun member (item list &key test test_not key)
         object endp_temp;  
1146          saveTEST;          saveTEST;
1147    
1148  @  @
# Line 1176  object endp_temp; Line 1160  object endp_temp;
1160  PREDICATE(Lmember, Lmember_if, Lmember_if_not, 2)  PREDICATE(Lmember, Lmember_if, Lmember_if_not, 2)
1161    
1162  @(defun member1 (item list &key test test_not key)  @(defun member1 (item list &key test test_not key)
         object endp_temp;  
1163          saveTEST;          saveTEST;
1164  @  @
1165          protectTEST;          protectTEST;
# Line 1193  PREDICATE(Lmember, Lmember_if, Lmember_i Line 1176  PREDICATE(Lmember, Lmember_if, Lmember_i
1176  @)  @)
1177    
1178  void  void
1179  Ltailp()  Ltailp() {
 {       object endp_temp;  
1180          object x;          object x;
1181    
1182          check_arg(2);          check_arg(2);
1183          for (x = vs_base[1];  !endp(x);  x = x->c.c_cdr)          for (x = vs_base[1];  !endp(x);  x = x->c.c_cdr)
1184                  if (x == vs_base[0]) {                  if (dot_list_eq(x,vs_base[0])) {
1185                          vs_base[0] = Ct;                          vs_base[0] = Ct;
1186                          vs_popp;                          vs_popp;
1187                          return;                          return;
1188                  }                  }
1189          vs_base[0] = x == vs_base[0] ? Ct : Cnil;          vs_base[0] = Cnil;
1190          vs_popp;          vs_popp;
1191          return;          return;
1192  }  }
# Line 1236  Lacons() Line 1218  Lacons()
1218  }  }
1219    
1220  @(defun pairlis (keys data &optional a_list)  @(defun pairlis (keys data &optional a_list)
         object endp_temp;  
1221          object *vp, k, d;          object *vp, k, d;
1222  @  @
1223          vp = vs_top + 1;          vp = vs_top + 1;
# Line 1261  Lacons() Line 1242  Lacons()
1242  @)  @)
1243    
1244  @(defun assoc_or_rassoc (item a_list &key test test_not key)  @(defun assoc_or_rassoc (item a_list &key test test_not key)
         object endp_temp;  
1245          saveTEST;          saveTEST;
1246  @  @
1247          protectTEST;          protectTEST;
# Line 1284  void Lrassoc() { car_or_cdr = cdr; Lasso Line 1264  void Lrassoc() { car_or_cdr = cdr; Lasso
1264  static bool true_or_false;  static bool true_or_false;
1265    
1266  @(defun assoc_or_rassoc_predicate (predicate a_list &key key)  @(defun assoc_or_rassoc_predicate (predicate a_list &key key)
         object endp_temp;  
1267          object x;          object x;
1268  @  @
1269          while (!endp(a_list)) {          while (!endp(a_list)) {
# Line 1358  init_list_function() Line 1337  init_list_function()
1337    
1338          sKinitial_element = make_keyword("INITIAL-ELEMENT");          sKinitial_element = make_keyword("INITIAL-ELEMENT");
1339    
1340            memset(&my_dot_pit,0,sizeof(my_dot_pit));
1341            my_dot_pit.t=t_symbol;
1342            my_dot_pit.c_car=my_dot_pit.c_cdr=(object)&my_dot_pit;
1343    
1344            memset(&my_dot,0,sizeof(my_dot));
1345            my_dot.t=t_cons;
1346            my_dot.c_car=my_dot.c_cdr=(object)&my_dot_pit;
1347    
1348          make_function("CAR", Lcar);          make_function("CAR", Lcar);
1349          make_function("CDR", Lcdr);          make_function("CDR", Lcdr);
1350    

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

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