/[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.35 by camm, Thu Oct 6 20:30:08 2005 UTC revision 1.36 by camm, Wed Oct 12 03:12:57 2005 UTC
# Line 26  Foundation, 675 Mass Ave, Cambridge, MA Line 26  Foundation, 675 Mass Ave, Cambridge, MA
26  */  */
27    
28  #include "include.h"  #include "include.h"
29    #include "num_include.h"
30    
31  static int reverse_comparison;  #define TARG1(a,b) (reverse_comparison!=Cnil ? (b) : (a))
32    #define TARG2(a,b) (reverse_comparison!=Cnil ? (a) : (b))
 #define TARG1(a,b) (reverse_comparison ? (b) : (a))  
 #define TARG2(a,b) (reverse_comparison ? (a) : (b))  
33    
34  object sKinitial_element;  object sKinitial_element;
35    
# Line 39  object sKinitial_element; Line 38  object sKinitial_element;
38  #define saveTEST  \  #define saveTEST  \
39          object old_test_function = test_function;  \          object old_test_function = test_function;  \
40          object old_item_compared = item_compared;  \          object old_item_compared = item_compared;  \
41            object old_reverse_comparison = reverse_comparison;  \
42          bool (*old_tf)() = tf;  \          bool (*old_tf)() = tf;  \
43          object old_key_function = key_function;  \          object old_key_function = key_function;  \
44          object (*old_kf)() = kf;  \          object (*old_kf)() = kf;  \
# Line 56  L:  \ Line 56  L:  \
56          frs_pop();  \          frs_pop();  \
57          test_function = old_test_function;  \          test_function = old_test_function;  \
58          item_compared = old_item_compared;  \          item_compared = old_item_compared;  \
59            reverse_comparison = old_reverse_comparison;  \
60          tf = old_tf;  \          tf = old_tf;  \
61          key_function = old_key_function;  \          key_function = old_key_function;  \
62          kf = old_kf;  \          kf = old_kf;  \
# Line 114  object x; Line 115  object x;
115  }  }
116    
117  static void  static void
118  setupTEST(item, test, test_not, key)  setupTEST(item, test, test_not, key, rev)
119  object item, test, test_not, key;  object item, test, test_not, key, rev;
120  {  {
121          item_compared = item;          item_compared = item;
122          if (test != Cnil) {          if (test != Cnil) {
# Line 133  object item, test, test_not, key; Line 134  object item, test, test_not, key;
134                  kf = apply_key_function;                  kf = apply_key_function;
135          } else          } else
136                  kf = identity;                  kf = identity;
137            reverse_comparison=rev;
138  }  }
139    
140  #define PREDICATE(f, f_if, f_if_not, n)  \  #define PREDICATE(f, f_if, f_if_not, n)  \
# Line 516  object alist, tree; Line 518  object alist, tree;
518          object x;          object x;
519          cs_check(alist);          cs_check(alist);
520    
   
521          for (x = alist;  !endp(x);  x = x->c.c_cdr) {          for (x = alist;  !endp(x);  x = x->c.c_cdr) {
522                  item_compared = car(x->c.c_car);                  item_compared = car(x->c.c_car);
523                  if (TEST(tree)) {                  if (TEST(tree)) {
# Line 694  LFD(Lcons)() Line 695  LFD(Lcons)()
695          saveTEST;          saveTEST;
696  @  @
697          protectTEST;              protectTEST;    
698          setupTEST(Cnil, test, test_not, Cnil);          setupTEST(Cnil, test, test_not, Cnil, Cnil);
699          x=(tree_equal(x, y) ? Ct : Cnil);          x=(tree_equal(x, y) ? Ct : Cnil);
700          restoreTEST;          restoreTEST;
701          @(return x)          @(return x)
# Line 795  LFD(Llast)() { Line 796  LFD(Llast)() {
796          if (endp(vs_base[0]))          if (endp(vs_base[0]))
797                  return;                  return;
798          if (n==2) {          if (n==2) {
799                  if (type_of(vs_base[1])!=t_fixnum || (n=fix(vs_base[1]))<0)            enum type tp=type_of(vs_base[1]);
800                          FEwrong_type_argument(sLnon_negative_fixnum,vs_base[1]);            if ((tp!=t_fixnum && tp!=t_bignum)|| number_minusp(vs_base[1]))
801                  vs_popp;              TYPE_ERROR(vs_base[1],list(2,sLinteger,make_fixnum(0)));
802              n=tp==t_fixnum ? fix(vs_base[1]) : MOST_POSITIVE_FIX;
803              vs_popp;
804          }                }      
805    
806          if (!n)          if (!n)
# Line 1062  LFD(Lrplacd)() Line 1065  LFD(Lrplacd)()
1065          saveTEST;          saveTEST;
1066  @  @
1067          protectTEST;          protectTEST;
1068          setupTEST(old, test, test_not, key);          setupTEST(old, test, test_not, key, Cnil);
1069          subst(new, tree);          subst(new, tree);
1070          tree = vs_pop;          tree = vs_pop;
1071          restoreTEST;          restoreTEST;
# Line 1076  PREDICATE(Lsubst,Lsubst_if,Lsubst_if_not Line 1079  PREDICATE(Lsubst,Lsubst_if,Lsubst_if_not
1079          saveTEST;          saveTEST;
1080  @  @
1081          protectTEST;          protectTEST;
1082          setupTEST(old, test, test_not, key);          setupTEST(old, test, test_not, key, Cnil);
1083          nsubst(new, &tree);          nsubst(new, &tree);
1084          restoreTEST;          restoreTEST;
1085          @(return tree)          @(return tree)
# Line 1127  object alist; Line 1130  object alist;
1130      */      */
1131      for (v=alist ; consp(v) ; v=v->c.c_cdr);      for (v=alist ; consp(v) ; v=v->c.c_cdr);
1132      if (v != Cnil)      if (v != Cnil)
1133           FEwrong_type_argument(sLlist, alist);        TYPE_ERROR(alist,siLproper_list);
1134  }  }
1135    
1136    
# Line 1136  object alist; Line 1139  object alist;
1139          saveTEST;          saveTEST;
1140  @    @  
1141          protectTEST;          protectTEST;
1142          setupTEST(Cnil, test, test_not, key);          setupTEST(Cnil, test, test_not, key, Ct);
1143          sublis(alist, tree);          sublis(alist, tree);
1144          tree = vs_pop;          tree = vs_pop;
1145          restoreTEST;          restoreTEST;
# Line 1147  object alist; Line 1150  object alist;
1150          saveTEST;          saveTEST;
1151  @  @
1152          protectTEST;          protectTEST;
1153          setupTEST(Cnil, test, test_not, key);          setupTEST(Cnil, test, test_not, key, Ct);
1154          nsublis(alist, &tree);          nsublis(alist, &tree);
1155          restoreTEST;          restoreTEST;
1156          @(return tree)          @(return tree)
# Line 1158  object alist; Line 1161  object alist;
1161    
1162  @  @
1163          protectTEST;          protectTEST;
1164          setupTEST(item, test, test_not, key);          setupTEST(item, test, test_not, key, Cnil);
1165          while (!endp(list)) {          while (!endp(list)) {
1166                  if (TEST(list->c.c_car))                  if (TEST(list->c.c_car))
1167                          goto L;                          goto L;
# Line 1176  PREDICATE(Lmember,Lmember_if,Lmember_if_ Line 1179  PREDICATE(Lmember,Lmember_if,Lmember_if_
1179          protectTEST;          protectTEST;
1180          if (key != Cnil)          if (key != Cnil)
1181                  item = ifuncall1(key, item);                  item = ifuncall1(key, item);
1182          if (rev != Cnil)          setupTEST(item, test, test_not, key, rev);
                 reverse_comparison=1;  
         setupTEST(item, test, test_not, key);  
1183          while (!endp(list)) {          while (!endp(list)) {
1184                  if (TEST(list->c.c_car))                  if (TEST(list->c.c_car))
1185                          goto L;                          goto L;
1186                  list = list->c.c_cdr;                  list = list->c.c_cdr;
1187          }          }
1188          restoreTEST;          restoreTEST;
         reverse_comparison=0;  
1189          @(return list)          @(return list)
1190  @)  @)
1191    
# Line 1258  LFD(Lacons)() Line 1258  LFD(Lacons)()
1258          saveTEST;          saveTEST;
1259  @  @
1260          protectTEST;          protectTEST;
1261          setupTEST(item, test, test_not, key);          setupTEST(item, test, test_not, key, Cnil);
1262          while (!endp(a_list)) {          while (!endp(a_list)) {
1263                  if (a_list->c.c_car != Cnil &&                  if (a_list->c.c_car != Cnil &&
1264                      TEST((*car_or_cdr)(a_list->c.c_car))) {                      TEST((*car_or_cdr)(a_list->c.c_car))) {

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

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