commit: Don't share a counter when checking for circularity, list_merge().
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 5283:be436ac36ba4
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Tue Oct 12 18:14:12 2010 +0100
files: src/ChangeLog src/fns.c tests/ChangeLog tests/automated/lisp-tests.el
description:
Don't share a counter when checking for circularity, list_merge().
src/ChangeLog addition:
2010-10-12 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (list_merge):
Circularity checking here needs to be done independently for each
list, they can't share a loop counter. Thank you for the bug
report, Robert Pluim!
tests/ChangeLog addition:
2010-10-12 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
Make sure circularity checking with #'merge is sane.
diff -r dcc34e28cd84 -r be436ac36ba4 src/ChangeLog
--- a/src/ChangeLog Sun Oct 10 12:32:38 2010 +0100
+++ b/src/ChangeLog Tue Oct 12 18:14:12 2010 +0100
＠＠ -1,3 +1,10 ＠＠
+2010-10-12 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (list_merge):
+ Circularity checking here needs to be done independently for each
+ list, they can't share a loop counter. Thank you for the bug
+ report, Robert Pluim!
+
2010-09-20 Aidan Kehoe <kehoea(a)parhasard.net>
* lisp.h (GET_DEFUN_LISP_OBJECT): Make the NEW_GC version of this
diff -r dcc34e28cd84 -r be436ac36ba4 src/fns.c
--- a/src/fns.c Sun Oct 10 12:32:38 2010 +0100
+++ b/src/fns.c Tue Oct 12 18:14:12 2010 +0100
＠＠ -2157,7 +2157,7 ＠＠
Lisp_Object l1, l2;
Lisp_Object tortoises[2];
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
- int looped = 0;
+ int l1_count = 0, l2_count = 0;
l1 = org_l1;
l2 = org_l2;
＠＠ -2203,37 +2203,56 ＠＠
tem = l1;
l1 = Fcdr (l1);
org_l1 = l1;
+
+ if (l1_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
+ {
+ if (l1_count & 1)
+ {
+ if (!CONSP (tortoises[0]))
+ {
+ mapping_interaction_error (Qmerge, tortoises[0]);
+ }
+
+ tortoises[0] = XCDR (tortoises[0]);
+ }
+
+ if (EQ (org_l1, tortoises[0]))
+ {
+ signal_circular_list_error (org_l1);
+ }
+ }
}
else
{
tem = l2;
l2 = Fcdr (l2);
org_l2 = l2;
- }
+
+ if (l2_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
+ {
+ if (l2_count & 1)
+ {
+ if (!CONSP (tortoises[1]))
+ {
+ mapping_interaction_error (Qmerge, tortoises[1]);
+ }
+
+ tortoises[1] = XCDR (tortoises[1]);
+ }
+
+ if (EQ (org_l2, tortoises[1]))
+ {
+ signal_circular_list_error (org_l2);
+ }
+ }
+ }
+
if (NILP (tail))
value = tem;
else
Fsetcdr (tail, tem);
+
tail = tem;
-
- if (++looped > CIRCULAR_LIST_SUSPICION_LENGTH)
- {
- if (looped & 1)
- {
- tortoises[0] = XCDR (tortoises[0]);
- tortoises[1] = XCDR (tortoises[1]);
- }
-
- if (EQ (org_l1, tortoises[0]))
- {
- signal_circular_list_error (org_l1);
- }
-
- if (EQ (org_l2, tortoises[1]))
- {
- signal_circular_list_error (org_l2);
- }
- }
}
}
diff -r dcc34e28cd84 -r be436ac36ba4 tests/ChangeLog
--- a/tests/ChangeLog Sun Oct 10 12:32:38 2010 +0100
+++ b/tests/ChangeLog Tue Oct 12 18:14:12 2010 +0100
＠＠ -1,3 +1,8 ＠＠
+2010-10-12 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el:
+ Make sure circularity checking with #'merge is sane.
+
2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
diff -r dcc34e28cd84 -r be436ac36ba4 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Sun Oct 10 12:32:38 2010 +0100
+++ b/tests/automated/lisp-tests.el Tue Oct 12 18:14:12 2010 +0100
＠＠ -2409,4 +2409,10 ＠＠
(Assert (not (eql '1/5 (read (prin1-to-string (intern "2/10")))))
"checking symbol named \"2/10\" not eql to ratio 1/5 on read"))
+(let* ((count 0)
+ (list (map-into (make-list 2048 nil) #'(lambda () (decf count))))
+ (expected (append list '(1))))
+ (Assert (equal expected (merge 'list list '(1) #'<))
+ "checking merge's circularity checks are sane"))
+
;;; end of lisp-tests.el
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Don't share a counter when checking for circularity, list_merge().
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
Ar an dara lá déag de mí Deireadh Fómhair, scríobh Robert Pluim:
> Aidan, the following changeset
>
> changeset: 5253:b6a398dbb403
> user: Aidan Kehoe <kehoea(a)parhasard.net>
> date: Wed Sep 01 12:51:32 2010 +0100
>
> causes gnus to signal circular list errors that to my eye are
> incorrect (and go away when I revert to revision 5252)
From eyeballing the code, the bug seems to be that my circularity checking
in list_merge() wasn’t done correctly. The below fixes a related error that
I can reproduce easily; could I ask you to apply it locally and tell me if
it fixes your error, too?
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1286903652 -3600
# Node ID be436ac36ba448c42ea9e6305fb6ad2952be6955
# Parent dcc34e28cd84cda4cdd5bfc3b58aef06c0da78c2
Don't share a counter when checking for circularity, list_merge().
src/ChangeLog addition:
2010-10-12 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (list_merge):
Circularity checking here needs to be done independently for each
list, they can't share a loop counter. Thank you for the bug
report, Robert Pluim!
tests/ChangeLog addition:
2010-10-12 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
Make sure circularity checking with #'merge is sane.
diff -r dcc34e28cd84 -r be436ac36ba4 src/ChangeLog
--- a/src/ChangeLog Sun Oct 10 12:32:38 2010 +0100
+++ b/src/ChangeLog Tue Oct 12 18:14:12 2010 +0100
＠＠ -1,3 +1,10 ＠＠
+2010-10-12 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (list_merge):
+ Circularity checking here needs to be done independently for each
+ list, they can't share a loop counter. Thank you for the bug
+ report, Robert Pluim!
+
2010-09-20 Aidan Kehoe <kehoea(a)parhasard.net>
* lisp.h (GET_DEFUN_LISP_OBJECT): Make the NEW_GC version of this
diff -r dcc34e28cd84 -r be436ac36ba4 src/fns.c
--- a/src/fns.c Sun Oct 10 12:32:38 2010 +0100
+++ b/src/fns.c Tue Oct 12 18:14:12 2010 +0100
＠＠ -2157,7 +2157,7 ＠＠
Lisp_Object l1, l2;
Lisp_Object tortoises[2];
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
- int looped = 0;
+ int l1_count = 0, l2_count = 0;
l1 = org_l1;
l2 = org_l2;
＠＠ -2203,37 +2203,56 ＠＠
tem = l1;
l1 = Fcdr (l1);
org_l1 = l1;
+
+ if (l1_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
+ {
+ if (l1_count & 1)
+ {
+ if (!CONSP (tortoises[0]))
+ {
+ mapping_interaction_error (Qmerge, tortoises[0]);
+ }
+
+ tortoises[0] = XCDR (tortoises[0]);
+ }
+
+ if (EQ (org_l1, tortoises[0]))
+ {
+ signal_circular_list_error (org_l1);
+ }
+ }
}
else
{
tem = l2;
l2 = Fcdr (l2);
org_l2 = l2;
- }
+
+ if (l2_count++ > CIRCULAR_LIST_SUSPICION_LENGTH)
+ {
+ if (l2_count & 1)
+ {
+ if (!CONSP (tortoises[1]))
+ {
+ mapping_interaction_error (Qmerge, tortoises[1]);
+ }
+
+ tortoises[1] = XCDR (tortoises[1]);
+ }
+
+ if (EQ (org_l2, tortoises[1]))
+ {
+ signal_circular_list_error (org_l2);
+ }
+ }
+ }
+
if (NILP (tail))
value = tem;
else
Fsetcdr (tail, tem);
+
tail = tem;
-
- if (++looped > CIRCULAR_LIST_SUSPICION_LENGTH)
- {
- if (looped & 1)
- {
- tortoises[0] = XCDR (tortoises[0]);
- tortoises[1] = XCDR (tortoises[1]);
- }
-
- if (EQ (org_l1, tortoises[0]))
- {
- signal_circular_list_error (org_l1);
- }
-
- if (EQ (org_l2, tortoises[1]))
- {
- signal_circular_list_error (org_l2);
- }
- }
}
}
diff -r dcc34e28cd84 -r be436ac36ba4 tests/ChangeLog
--- a/tests/ChangeLog Sun Oct 10 12:32:38 2010 +0100
+++ b/tests/ChangeLog Tue Oct 12 18:14:12 2010 +0100
＠＠ -1,3 +1,8 ＠＠
+2010-10-12 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el:
+ Make sure circularity checking with #'merge is sane.
+
2010-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
diff -r dcc34e28cd84 -r be436ac36ba4 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Sun Oct 10 12:32:38 2010 +0100
+++ b/tests/automated/lisp-tests.el Tue Oct 12 18:14:12 2010 +0100
＠＠ -2409,4 +2409,10 ＠＠
(Assert (not (eql '1/5 (read (prin1-to-string (intern "2/10")))))
"checking symbol named \"2/10\" not eql to ratio 1/5 on read"))
+(let* ((count 0)
+ (list (map-into (make-list 2048 nil) #'(lambda () (decf count))))
+ (expected (append list '(1))))
+ (Assert (equal expected (merge 'list list '(1) #'<))
+ "checking merge's circularity checks are sane"))
+
;;; end of lisp-tests.el
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 1 comments
[COMMIT] Warn at byte-compile in #'the if FORM constant & not TYPE; fix byte-compile-constp
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1286710358 -3600
# Node ID dcc34e28cd84cda4cdd5bfc3b58aef06c0da78c2
# Parent aa20a889ff1421e5a884e09bd57bc7f16b7d82d5
Warn at byte-compile in #'the if FORM constant & not TYPE; fix byte-compile-constp
2010-10-10 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are
also constant.
(byte-compile-initial-macro-environment): In #'the, if FORM is
constant and does not match TYPE, warn at byte-compile time.
diff -r aa20a889ff14 -r dcc34e28cd84 lisp/ChangeLog
--- a/lisp/ChangeLog Sun Oct 10 12:13:32 2010 +0100
+++ b/lisp/ChangeLog Sun Oct 10 12:32:38 2010 +0100
＠＠ -1,3 +1,10 ＠＠
+2010-10-10 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are
+ also constant.
+ (byte-compile-initial-macro-environment): In #'the, if FORM is
+ constant and does not match TYPE, warn at byte-compile time.
+
2010-10-10 Aidan Kehoe <kehoea(a)parhasard.net>
* backquote.el (bq-vector-contents, bq-list*): Remove; the former
diff -r aa20a889ff14 -r dcc34e28cd84 lisp/bytecomp.el
--- a/lisp/bytecomp.el Sun Oct 10 12:13:32 2010 +0100
+++ b/lisp/bytecomp.el Sun Oct 10 12:32:38 2010 +0100
＠＠ -505,6 +505,10 ＠＠
(cons 'progn body)))
(the .
,#'(lambda (type form)
+ (if (cl-const-expr-p form)
+ (or (eval (cl-make-type-test form type))
+ (byte-compile-warn
+ "%s is not of type %s" form type)))
(if byte-compile-delete-errors
form
(funcall (cdr (symbol-function 'the)) type form)))))
＠＠ -1391,7 +1395,7 ＠＠
(defmacro byte-compile-constp (form)
;; Returns non-nil if FORM is a constant.
- `(cond ((consp ,form) (eq (car ,form) 'quote))
+ `(cond ((consp ,form) (memq (car ,form) '(quote function)))
((symbolp ,form) (byte-compile-constant-symbol-p ,form))
(t)))
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Warn at byte-compile in #'the if FORM constant & not TYPE; fix byte-compile-constp
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 5282:dcc34e28cd84
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Oct 10 12:32:38 2010 +0100
files: lisp/ChangeLog lisp/bytecomp.el
description:
Warn at byte-compile in #'the if FORM constant & not TYPE; fix byte-compile-constp
2010-10-10 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are
also constant.
(byte-compile-initial-macro-environment): In #'the, if FORM is
constant and does not match TYPE, warn at byte-compile time.
diff -r aa20a889ff14 -r dcc34e28cd84 lisp/ChangeLog
--- a/lisp/ChangeLog Sun Oct 10 12:13:32 2010 +0100
+++ b/lisp/ChangeLog Sun Oct 10 12:32:38 2010 +0100
＠＠ -1,3 +1,10 ＠＠
+2010-10-10 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are
+ also constant.
+ (byte-compile-initial-macro-environment): In #'the, if FORM is
+ constant and does not match TYPE, warn at byte-compile time.
+
2010-10-10 Aidan Kehoe <kehoea(a)parhasard.net>
* backquote.el (bq-vector-contents, bq-list*): Remove; the former
diff -r aa20a889ff14 -r dcc34e28cd84 lisp/bytecomp.el
--- a/lisp/bytecomp.el Sun Oct 10 12:13:32 2010 +0100
+++ b/lisp/bytecomp.el Sun Oct 10 12:32:38 2010 +0100
＠＠ -505,6 +505,10 ＠＠
(cons 'progn body)))
(the .
,#'(lambda (type form)
+ (if (cl-const-expr-p form)
+ (or (eval (cl-make-type-test form type))
+ (byte-compile-warn
+ "%s is not of type %s" form type)))
(if byte-compile-delete-errors
form
(funcall (cdr (symbol-function 'the)) type form)))))
＠＠ -1391,7 +1395,7 ＠＠
(defmacro byte-compile-constp (form)
;; Returns non-nil if FORM is a constant.
- `(cond ((consp ,form) (eq (car ,form) 'quote))
+ `(cond ((consp ,form) (memq (car ,form) '(quote function)))
((symbolp ,form) (byte-compile-constant-symbol-p ,form))
(t)))
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Remove a couple of redundant functions, backquote.el
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1286709212 -3600
# Node ID aa20a889ff1421e5a884e09bd57bc7f16b7d82d5
# Parent 59a6419f75046951fcebc865c29222d1c21fe895
Remove a couple of redundant functions, backquote.el
2010-10-10 Aidan Kehoe <kehoea(a)parhasard.net>
* backquote.el (bq-vector-contents, bq-list*): Remove; the former
is equivalent to (append VECTOR nil), the latter to (list* ...).
(bq-process-2): Use (append VECTOR nil) instead of using
#'bq-vector-contents to convert to a list.
(bq-process-1): Now we use list* instead of bq-list
* subr.el (list*): Moved from cl.el, since it is now required to
be available the first time a backquoted form is encountered.
* cl.el (list*): Move to subr.el.
diff -r 59a6419f7504 -r aa20a889ff14 lisp/ChangeLog
--- a/lisp/ChangeLog Mon Sep 20 23:22:50 2010 +0100
+++ b/lisp/ChangeLog Sun Oct 10 12:13:32 2010 +0100
＠＠ -1,3 +1,14 ＠＠
+2010-10-10 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * backquote.el (bq-vector-contents, bq-list*): Remove; the former
+ is equivalent to (append VECTOR nil), the latter to (list* ...).
+ (bq-process-2): Use (append VECTOR nil) instead of using
+ #'bq-vector-contents to convert to a list.
+ (bq-process-1): Now we use list* instead of bq-list
+ * subr.el (list*): Moved from cl.el, since it is now required to
+ be available the first time a backquoted form is encountered.
+ * cl.el (list*): Move to subr.el.
+
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* test-harness.el (Check-Message):
diff -r 59a6419f7504 -r aa20a889ff14 lisp/backquote.el
--- a/lisp/backquote.el Mon Sep 20 23:22:50 2010 +0100
+++ b/lisp/backquote.el Sun Oct 10 12:13:32 2010 +0100
＠＠ -184,19 +184,10 ＠＠
;;; ----------------------------------------------------------------
-(defun bq-vector-contents (vec)
- (let ((contents nil)
- (n (length vec)))
- (while (> n 0)
- (setq n (1- n))
- (setq contents (cons (aref vec n) contents)))
- contents))
-
;;; This does the expansion from table 2.
(defun bq-process-2 (code)
(cond ((vectorp code)
- (let* ((dflag-d
- (bq-process-2 (bq-vector-contents code))))
+ (let* ((dflag-d (bq-process-2 (append code nil))))
(cons 'vector (bq-process-1 (car dflag-d) (cdr dflag-d)))))
((atom code)
(cond ((null code) (cons nil nil))
＠＠ -278,26 +269,7 ＠＠
(list 'quote thing))
((eq flag 'vector)
(list 'apply '(function vector) thing))
- (t (cons (cdr
- (assq flag
- '((cons . cons)
- (list* . bq-list*)
- (list . list)
- (append . append)
- (nconc . nconc))))
- thing))))
-
-;;; ----------------------------------------------------------------
-
-(defmacro bq-list* (&rest args)
- "Return a list of its arguments with last cons a dotted pair."
- (setq args (reverse args))
- (let ((result (car args)))
- (setq args (cdr args))
- (while args
- (setq result (list 'cons (car args) result))
- (setq args (cdr args)))
- result))
+ (t (cons flag thing))))
(provide 'backquote)
diff -r 59a6419f7504 -r aa20a889ff14 lisp/cl.el
--- a/lisp/cl.el Mon Sep 20 23:22:50 2010 +0100
+++ b/lisp/cl.el Sun Oct 10 12:13:32 2010 +0100
＠＠ -519,17 +519,7 ＠＠
;;; `last' is implemented as a C primitive, as of 1998-11
-(defun list* (arg &rest rest) ; See compiler macro in cl-macs.el
- "Return a new list with specified args as elements, cons'd to last arg.
-Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
-`(cons A (cons B (cons C D)))'."
- (cond ((not rest) arg)
- ((not (cdr rest)) (cons arg (car rest)))
- (t (let* ((n (length rest))
- (copy (copy-sequence rest))
- (last (nthcdr (- n 2) copy)))
- (setcdr last (car (cdr last)))
- (cons arg copy)))))
+;;; XEmacs: `list*' is in subr.el.
(defun ldiff (list sublist)
"Return a copy of LIST with the tail SUBLIST removed."
diff -r 59a6419f7504 -r aa20a889ff14 lisp/subr.el
--- a/lisp/subr.el Mon Sep 20 23:22:50 2010 +0100
+++ b/lisp/subr.el Sun Oct 10 12:13:32 2010 +0100
＠＠ -66,7 +66,20 ＠＠
(message "Unknown declaration %s" d)))))
(setq macro-declaration-function 'macro-declaration-function)
-
+
+;; XEmacs; this is here because we use it in backquote.el, so it needs to be
+;; available the first time a `(...) form is expanded.
+(defun list* (first &rest rest) ; See compiler macro in cl-macs.el
+ "Return a new list with specified args as elements, cons'd to last arg.
+Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
+`(cons A (cons B (cons C D)))'."
+ (cond ((not rest) first)
+ ((not (cdr rest)) (cons first (car rest)))
+ (t (let* ((n (length rest))
+ (copy (copy-sequence rest))
+ (last (nthcdr (- n 2) copy)))
+ (setcdr last (car (cdr last)))
+ (cons first copy)))))
;;;; Lisp language features.
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Remove a couple of redundant functions, backquote.el
14 years, 2 months
Aidan Kehoe
Aidan Kehoe
changeset: 5281:aa20a889ff14
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sun Oct 10 12:13:32 2010 +0100
files: lisp/ChangeLog lisp/backquote.el lisp/cl.el lisp/subr.el
description:
Remove a couple of redundant functions, backquote.el
2010-10-10 Aidan Kehoe <kehoea(a)parhasard.net>
* backquote.el (bq-vector-contents, bq-list*): Remove; the former
is equivalent to (append VECTOR nil), the latter to (list* ...).
(bq-process-2): Use (append VECTOR nil) instead of using
#'bq-vector-contents to convert to a list.
(bq-process-1): Now we use list* instead of bq-list
* subr.el (list*): Moved from cl.el, since it is now required to
be available the first time a backquoted form is encountered.
* cl.el (list*): Move to subr.el.
diff -r 59a6419f7504 -r aa20a889ff14 lisp/ChangeLog
--- a/lisp/ChangeLog Mon Sep 20 23:22:50 2010 +0100
+++ b/lisp/ChangeLog Sun Oct 10 12:13:32 2010 +0100
＠＠ -1,3 +1,14 ＠＠
+2010-10-10 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * backquote.el (bq-vector-contents, bq-list*): Remove; the former
+ is equivalent to (append VECTOR nil), the latter to (list* ...).
+ (bq-process-2): Use (append VECTOR nil) instead of using
+ #'bq-vector-contents to convert to a list.
+ (bq-process-1): Now we use list* instead of bq-list
+ * subr.el (list*): Moved from cl.el, since it is now required to
+ be available the first time a backquoted form is encountered.
+ * cl.el (list*): Move to subr.el.
+
2010-09-16 Aidan Kehoe <kehoea(a)parhasard.net>
* test-harness.el (Check-Message):
diff -r 59a6419f7504 -r aa20a889ff14 lisp/backquote.el
--- a/lisp/backquote.el Mon Sep 20 23:22:50 2010 +0100
+++ b/lisp/backquote.el Sun Oct 10 12:13:32 2010 +0100
＠＠ -184,19 +184,10 ＠＠
;;; ----------------------------------------------------------------
-(defun bq-vector-contents (vec)
- (let ((contents nil)
- (n (length vec)))
- (while (> n 0)
- (setq n (1- n))
- (setq contents (cons (aref vec n) contents)))
- contents))
-
;;; This does the expansion from table 2.
(defun bq-process-2 (code)
(cond ((vectorp code)
- (let* ((dflag-d
- (bq-process-2 (bq-vector-contents code))))
+ (let* ((dflag-d (bq-process-2 (append code nil))))
(cons 'vector (bq-process-1 (car dflag-d) (cdr dflag-d)))))
((atom code)
(cond ((null code) (cons nil nil))
＠＠ -278,26 +269,7 ＠＠
(list 'quote thing))
((eq flag 'vector)
(list 'apply '(function vector) thing))
- (t (cons (cdr
- (assq flag
- '((cons . cons)
- (list* . bq-list*)
- (list . list)
- (append . append)
- (nconc . nconc))))
- thing))))
-
-;;; ----------------------------------------------------------------
-
-(defmacro bq-list* (&rest args)
- "Return a list of its arguments with last cons a dotted pair."
- (setq args (reverse args))
- (let ((result (car args)))
- (setq args (cdr args))
- (while args
- (setq result (list 'cons (car args) result))
- (setq args (cdr args)))
- result))
+ (t (cons flag thing))))
(provide 'backquote)
diff -r 59a6419f7504 -r aa20a889ff14 lisp/cl.el
--- a/lisp/cl.el Mon Sep 20 23:22:50 2010 +0100
+++ b/lisp/cl.el Sun Oct 10 12:13:32 2010 +0100
＠＠ -519,17 +519,7 ＠＠
;;; `last' is implemented as a C primitive, as of 1998-11
-(defun list* (arg &rest rest) ; See compiler macro in cl-macs.el
- "Return a new list with specified args as elements, cons'd to last arg.
-Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
-`(cons A (cons B (cons C D)))'."
- (cond ((not rest) arg)
- ((not (cdr rest)) (cons arg (car rest)))
- (t (let* ((n (length rest))
- (copy (copy-sequence rest))
- (last (nthcdr (- n 2) copy)))
- (setcdr last (car (cdr last)))
- (cons arg copy)))))
+;;; XEmacs: `list*' is in subr.el.
(defun ldiff (list sublist)
"Return a copy of LIST with the tail SUBLIST removed."
diff -r 59a6419f7504 -r aa20a889ff14 lisp/subr.el
--- a/lisp/subr.el Mon Sep 20 23:22:50 2010 +0100
+++ b/lisp/subr.el Sun Oct 10 12:13:32 2010 +0100
＠＠ -66,7 +66,20 ＠＠
(message "Unknown declaration %s" d)))))
(setq macro-declaration-function 'macro-declaration-function)
-
+
+;; XEmacs; this is here because we use it in backquote.el, so it needs to be
+;; available the first time a `(...) form is expanded.
+(defun list* (first &rest rest) ; See compiler macro in cl-macs.el
+ "Return a new list with specified args as elements, cons'd to last arg.
+Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
+`(cons A (cons B (cons C D)))'."
+ (cond ((not rest) first)
+ ((not (cdr rest)) (cons first (car rest)))
+ (t (let* ((n (length rest))
+ (copy (copy-sequence rest))
+ (last (nthcdr (- n 2) copy)))
+ (setcdr last (car (cdr last)))
+ (cons first copy)))))
;;;; Lisp language features.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Recognize defun* and the like as function names
14 years, 2 months
Didier Verna
Didier Verna
xemacs-packages/xemacs-base/ChangeLog addition:
2010-10-06 Didier Verna <didier(a)xemacs.org>
* add-log.el (patch-to-change-log): Recognize defun* and the like
as function names.
XEmacs Packages source patch:
Diff command: cvs -q diff -u
Files affected: xemacs-packages/xemacs-base/add-log.el
Index: xemacs-packages/xemacs-base/add-log.el
===================================================================
RCS file: /cvsroot/xemacs/XEmacs/packages/xemacs-packages/xemacs-base/add-log.el,v
retrieving revision 1.26
diff -u -u -r1.26 add-log.el
--- xemacs-packages/xemacs-base/add-log.el 9 Feb 2010 17:25:54 -0000 1.26
+++ xemacs-packages/xemacs-base/add-log.el 6 Oct 2010 14:45:49 -0000
＠＠ -1099,7 +1099,7 ＠＠
(file-re2 "^\\+\\+\\+ \\(.*?\\)\\(\t\\|\n\\)")
(hunk-re "^＠＠ -[0-9]+,[0-9]+ \\+\\([0-9]+\\),\\([0-9]+\\) ＠＠")
(basename-re "\\`\\(.*\\)/\\(.*\\)\\'")
- (lisp-defun-re "(def[a-z-]* \\([^ \n]+\\)")
+ (lisp-defun-re "(def[a-z-]*\\* \\([^ \n]+\\)")
; (c-token-re "[][_a-zA-Z0-9]+")
; (ws-re "\\(\\s-\\|\n\\+\\)*")
; (c-multi-token-re (concat c-token-re "\\(" ws-re c-token-re "\\)*"))
--
Resistance is futile. You will be jazzimilated.
Scientific site: http://www.lrde.epita.fr/~didier
Music (Jazz) site: http://www.didierverna.com
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments