WIP: Strings as array of characters implementation

[jscl.git] / src / boot.lisp

diff --git a/src/boot.lisp b/src/boot.lisp
index 71b98ff..19e077e 100644 (file)
--- a/src/boot.lisp
+++ b/src/boot.lisp
@@ -191,11 +191,13 @@
                    clausules)))))
 
 (defmacro ecase (form &rest clausules)
-  `(case ,form
-     ,@(append
-        clausules
-        `((t
-           (error "ECASE expression failed."))))))
+  (let ((g!form (gensym)))
+    `(let ((,g!form ,form))
+       (case ,g!form
+         ,@(append
+            clausules
+            `((t
+               (error "ECASE expression failed for the object `~S'." ,g!form))))))))
 
 (defmacro and (&rest forms)
   (cond
@@ -415,13 +417,9 @@
        (char "0123456789" weight)))
 
 (defun subseq (seq a &optional b)
-  (cond
-    ((stringp seq)
-     (if b
-         (slice seq a b)
-         (slice seq a)))
-    (t
-     (error "Unsupported argument."))))
+  (if b
+      (slice seq a b)
+      (slice seq a)))
 
 (defmacro do-sequence (iteration &body body)
   (let ((seq (gensym))
@@ -466,6 +464,13 @@
         ((symbolp x) (symbol-name x))
         (t (char-to-string x))))
 
+(defun string= (s1 s2)
+  (let ((n (length s1)))
+    (when (= (length s2) n)
+      (dotimes (i n t)
+        (unless (char= (char s1 i) (char s2 i))
+          (return-from string= nil))))))
+
 (defun equal (x y)
   (cond
     ((eql x y) t)
@@ -473,19 +478,10 @@
      (and (consp y)
           (equal (car x) (car y))
           (equal (cdr x) (cdr y))))
-    ((arrayp x)
-     (and (arrayp y)
-          (let ((n (length x)))
-            (when (= (length y) n)
-              (dotimes (i n)
-                (unless (equal (aref x i) (aref y i))
-                  (return-from equal nil)))
-              t))))
+    ((stringp x)
+     (and (stringp y) (string= x y)))
     (t nil)))
 
-(defun string= (s1 s2)
-  (equal s1 s2))
-
 (defun fdefinition (x)
   (cond
     ((functionp x)
@@ -493,7 +489,7 @@
     ((symbolp x)
      (symbol-function x))
     (t
-     (error "Invalid function"))))
+     (error "Invalid function `~S'." x))))
 
 (defun disassemble (function)
   (write-line (lambda-code (fdefinition function)))
@@ -507,7 +503,7 @@
        (oget func "docstring")))
     (variable
      (unless (symbolp x)
-       (error "Wrong argument type! it should be a symbol"))
+       (error "The type of documentation `~S' is not a symbol." type))
      (oget x "vardoc"))))
 
 (defmacro multiple-value-bind (variables value-from &body body)
@@ -540,7 +536,7 @@
 
 (defmacro define-setf-expander (access-fn lambda-list &body body)
   (unless (symbolp access-fn)
-    (error "ACCESS-FN must be a symbol."))
+    (error "ACCESS-FN `~S' must be a symbol." access-fn))
   `(progn (push (cons ',access-fn (lambda ,lambda-list ,@body))
                 *setf-expanders*)
           ',access-fn))
@@ -616,4 +612,3 @@
 
 (defun error (fmt &rest args)
   (%throw (apply #'format nil fmt args)))
-