From d1db5cd7f2462e615a205cc910cf07755d1fa428 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <matthias@benkard.de>
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