From d1db5cd7f2462e615a205cc910cf07755d1fa428 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Sun, 3 Aug 2008 10:44:49 +0200 Subject: Split Sacla/share.lisp into two parts. --- Sacla/share-2.lisp | 11 +++++++++++ Sacla/share.lisp | 28 ++++++++-------------------- 2 files changed, 19 insertions(+), 20 deletions(-) create mode 100644 Sacla/share-2.lisp (limited to 'Sacla') diff --git a/Sacla/share-2.lisp b/Sacla/share-2.lisp new file mode 100644 index 0000000..a92010a --- /dev/null +++ b/Sacla/share-2.lisp @@ -0,0 +1,11 @@ +(defun proper-list-p (object) + (when (listp object) + (do ((fast object (cddr fast)) + (slow object (cdr slow))) + (nil) + (when (atom fast) + (return (null fast))) + (when (atom (cdr fast)) + (return (null (cdr fast)))) + (when (and (eq fast slow) (not (eq fast object))) + (return nil))))) diff --git a/Sacla/share.lisp b/Sacla/share.lisp index 8c9d3e1..b054699 100644 --- a/Sacla/share.lisp +++ b/Sacla/share.lisp @@ -46,18 +46,6 @@ (symbolp (cadr object)) (null (cddr object))))) -(defun proper-list-p (object) - (when (listp object) - (do ((fast object (cddr fast)) - (slow object (cdr slow))) - (nil) - (when (atom fast) - (return (null fast))) - (when (atom (cdr fast)) - (return (null (cdr fast)))) - (when (and (eq fast slow) (not (eq fast object))) - (return nil))))) - (defun proper-sequence-p (object) (or (vectorp object) (proper-list-p object))) @@ -174,11 +162,11 @@ append "Append onto list") -(defvar *message-prefix* "") -;; for debug -(defvar *error-function* #'error) -(defun error (datum &rest arguments) - (if (stringp datum) - (let ((format-control (concatenate 'string *message-prefix* datum))) - (apply *error-function* format-control arguments)) - (apply *error-function* datum arguments))) +;; (defvar *message-prefix* "") +;; ;; for debug +;; (defvar *error-function* #'error) +;; (defun error (datum &rest arguments) +;; (if (stringp datum) +;; (let ((format-control (concatenate 'string *message-prefix* datum))) +;; (apply *error-function* format-control arguments)) +;; (apply *error-function* datum arguments))) -- cgit v1.2.3