From f329c5194251744af1e55b9e6040e5a6da2cabec Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 23 Apr 2003 07:03:48 +0000 Subject: [PATCH] * gnus-clfns.el (coerce, copy-list, merge, string, subseq): Comment out those compiler macros. (mapc): Make it comeback. --- ChangeLog | 6 ++ lisp/ChangeLog | 5 ++ lisp/gnus-clfns.el | 226 ++++++++++++++++++++++++++++------------------------ 3 files changed, 131 insertions(+), 106 deletions(-) diff --git a/ChangeLog b/ChangeLog index df0b1d3..4832f07 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2003-04-23 Katsumi Yamaoka + + * lisp/gnus-clfns.el (coerce, copy-list, merge, string, subseq): + Comment out those compiler macros. + (mapc): Make it comeback. + 2003-04-22 Reiner Steib * make.bat: Flag as binary to ensure DOS line terminators. Delete diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 989e4e7..c4de774 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2003-04-23 Katsumi Yamaoka + + * dgnushack.el (merge, copy-list): Remove compiler macros. + (butlast): Add a compiler macro. + 2003-04-22 Paul Jarc * gnus-util.el (gnus-merge): Added "type" argument to match CL diff --git a/lisp/gnus-clfns.el b/lisp/gnus-clfns.el index 191db6d..db33634 100644 --- a/lisp/gnus-clfns.el +++ b/lisp/gnus-clfns.el @@ -1,6 +1,6 @@ ;;; gnus-clfns.el --- compiler macros for emulating cl functions -;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Kastsumi Yamaoka ;; Keywords: cl, compile @@ -36,8 +36,7 @@ (require 'pym) (define-compiler-macro butlast (&whole form x &optional n) - (if (and (fboundp 'butlast) - (subrp (symbol-function 'butlast))) + (if (>= emacs-major-version 21) form (if n `(let ((x ,x) @@ -61,39 +60,38 @@ (setcdr (nthcdr (- m 2) x) nil) x)))))) - (define-compiler-macro coerce (&whole form x type) - (if (and (fboundp 'coerce) - (subrp (symbol-function 'coerce))) - form - `(let ((x ,x) - (type ,type)) - (cond ((eq type 'list) (if (listp x) x (append x nil))) - ((eq type 'vector) (if (vectorp x) x (vconcat x))) - ((eq type 'string) (if (stringp x) x (concat x))) - ((eq type 'array) (if (arrayp x) x (vconcat x))) - ((and (eq type 'character) (stringp x) (= (length x) 1)) - (aref x 0)) - ((and (eq type 'character) (symbolp x) - (= (length (symbol-name x)) 1)) - (aref (symbol-name x) 0)) - ((eq type 'float) (float x)) - ((typep x type) x) - (t (error "Can't coerce %s to type %s" x type)))))) +;; (define-compiler-macro coerce (&whole form x type) +;; (if (and (fboundp 'coerce) +;; (subrp (symbol-function 'coerce))) +;; form +;; `(let ((x ,x) +;; (type ,type)) +;; (cond ((eq type 'list) (if (listp x) x (append x nil))) +;; ((eq type 'vector) (if (vectorp x) x (vconcat x))) +;; ((eq type 'string) (if (stringp x) x (concat x))) +;; ((eq type 'array) (if (arrayp x) x (vconcat x))) +;; ((and (eq type 'character) (stringp x) (= (length x) 1)) +;; (aref x 0)) +;; ((and (eq type 'character) (symbolp x) +;; (= (length (symbol-name x)) 1)) +;; (aref (symbol-name x) 0)) +;; ((eq type 'float) (float x)) +;; ((typep x type) x) +;; (t (error "Can't coerce %s to type %s" x type)))))) - (define-compiler-macro copy-list (&whole form list) - (if (and (fboundp 'copy-list) - (subrp (symbol-function 'copy-list))) - form - `(let ((list ,list)) - (if (consp list) - (let ((res nil)) - (while (consp list) (push (pop list) res)) - (prog1 (nreverse res) (setcdr res list))) - (car list))))) +;; (define-compiler-macro copy-list (&whole form list) +;; (if (and (fboundp 'copy-list) +;; (subrp (symbol-function 'copy-list))) +;; form +;; `(let ((list ,list)) +;; (if (consp list) +;; (let ((res nil)) +;; (while (consp list) (push (pop list) res)) +;; (prog1 (nreverse res) (setcdr res list))) +;; (car list))))) (define-compiler-macro last (&whole form x &optional n) - (if (and (fboundp 'last) - (subrp (symbol-function 'last))) + (if (>= emacs-major-version 20) form (if n `(let* ((x ,x) @@ -113,32 +111,48 @@ (pop x)) x)))) - (define-compiler-macro merge (&whole form type seq1 seq2 pred &rest keys) - (if (and (fboundp 'merge) - (subrp (symbol-function 'merge))) + (define-compiler-macro mapc (&whole form fn seq &rest rest) + (if (>= emacs-major-version 21) form - `(let ((type ,type) - (seq1 ,seq1) - (seq2 ,seq2) - (pred ,pred)) - (or (listp seq1) (setq seq1 (append seq1 nil))) - (or (listp seq2) (setq seq2 (append seq2 nil))) - (let ((res nil)) - (while (and seq1 seq2) - (if (funcall pred (car seq2) (car seq1)) - (push (pop seq2) res) - (push (pop seq1) res))) - (coerce (nconc (nreverse res) seq1 seq2) type))))) + (if rest + `(let* ((fn ,fn) + (seq ,seq) + (args (list seq ,@rest)) + (m (apply (function min) (mapcar (function length) args))) + (n 0)) + (while (< n m) + (apply fn (mapcar (function (lambda (arg) (nth n arg))) args)) + (setq n (1+ n))) + seq) + `(let ((seq ,seq)) + (mapcar ,fn seq) + seq)))) - (define-compiler-macro string (&whole form &rest args) - (if (and (fboundp 'string) - (subrp (symbol-function 'string))) - form - (list 'concat (cons 'list args)))) +;; (define-compiler-macro merge (&whole form type seq1 seq2 pred &rest keys) +;; (if (and (fboundp 'merge) +;; (subrp (symbol-function 'merge))) +;; form +;; `(let ((type ,type) +;; (seq1 ,seq1) +;; (seq2 ,seq2) +;; (pred ,pred)) +;; (or (listp seq1) (setq seq1 (append seq1 nil))) +;; (or (listp seq2) (setq seq2 (append seq2 nil))) +;; (let ((res nil)) +;; (while (and seq1 seq2) +;; (if (funcall pred (car seq2) (car seq1)) +;; (push (pop seq2) res) +;; (push (pop seq1) res))) +;; (coerce (nconc (nreverse res) seq1 seq2) type))))) - (defun-maybe string (&rest args) - "Concatenate all the argument characters and make the result a string." - (concat args)) +;; (define-compiler-macro string (&whole form &rest args) +;; (if (>= emacs-major-version 20) +;; form +;; (list 'concat (cons 'list args)))) + +;; (defun-maybe string (&rest args) +;; "Concatenate all the argument characters and make the result a string." +;; (concat args)) (define-compiler-macro string-to-list (&whole form string) (cond ((fboundp 'string-to-list) @@ -167,56 +181,56 @@ (setq l (cons c l))) (nreverse l))) - (define-compiler-macro subseq (&whole form seq start &optional end) - (if (and (fboundp 'subseq) - (subrp (symbol-function 'subseq))) - form - (if end - `(let ((seq ,seq) - (start ,start) - (end ,end)) - (if (stringp seq) - (substring seq start end) - (let (len) - (if (< end 0) - (setq end (+ end (setq len (length seq))))) - (if (< start 0) - (setq start (+ start (or len (setq len (length seq)))))) - (cond ((listp seq) - (if (> start 0) - (setq seq (nthcdr start seq))) - (let ((res nil)) - (while (>= (setq end (1- end)) start) - (push (pop seq) res)) - (nreverse res))) - (t - (let ((res (make-vector (max (- end start) 0) nil)) - (i 0)) - (while (< start end) - (aset res i (aref seq start)) - (setq i (1+ i) - start (1+ start))) - res)))))) - `(let ((seq ,seq) - (start ,start)) - (if (stringp seq) - (substring seq start) - (let (len) - (if (< start 0) - (setq start (+ start (or len (setq len (length seq)))))) - (cond ((listp seq) - (if (> start 0) - (setq seq (nthcdr start seq))) - (copy-sequence seq)) - (t - (let* ((end (or len (length seq))) - (res (make-vector (max (- end start) 0) nil)) - (i 0)) - (while (< start end) - (aset res i (aref seq start)) - (setq i (1+ i) - start (1+ start))) - res))))))))) +;; (define-compiler-macro subseq (&whole form seq start &optional end) +;; (if (and (fboundp 'subseq) +;; (subrp (symbol-function 'subseq))) +;; form +;; (if end +;; `(let ((seq ,seq) +;; (start ,start) +;; (end ,end)) +;; (if (stringp seq) +;; (substring seq start end) +;; (let (len) +;; (if (< end 0) +;; (setq end (+ end (setq len (length seq))))) +;; (if (< start 0) +;; (setq start (+ start (or len (setq len (length seq)))))) +;; (cond ((listp seq) +;; (if (> start 0) +;; (setq seq (nthcdr start seq))) +;; (let ((res nil)) +;; (while (>= (setq end (1- end)) start) +;; (push (pop seq) res)) +;; (nreverse res))) +;; (t +;; (let ((res (make-vector (max (- end start) 0) nil)) +;; (i 0)) +;; (while (< start end) +;; (aset res i (aref seq start)) +;; (setq i (1+ i) +;; start (1+ start))) +;; res)))))) +;; `(let ((seq ,seq) +;; (start ,start)) +;; (if (stringp seq) +;; (substring seq start) +;; (let (len) +;; (if (< start 0) +;; (setq start (+ start (or len (setq len (length seq)))))) +;; (cond ((listp seq) +;; (if (> start 0) +;; (setq seq (nthcdr start seq))) +;; (copy-sequence seq)) +;; (t +;; (let* ((end (or len (length seq))) +;; (res (make-vector (max (- end start) 0) nil)) +;; (i 0)) +;; (while (< start end) +;; (aset res i (aref seq start)) +;; (setq i (1+ i) +;; start (1+ start))) +;; res))))))))) ) ;; A tool for the developers. -- 1.7.10.4