diff options
| -rw-r--r-- | Sacla/share-2.lisp | 11 | ||||
| -rw-r--r-- | Sacla/share.lisp | 28 |
2 files changed, 19 insertions, 20 deletions
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))) |