X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fboot.lisp;h=ab043a92354e68672b81c443e7e66ace0f874d1c;hb=68cd2db6542fa3442d46b0331ecf8be8f86c09c2;hp=5112039775bc669c68586494c0e15e18971c1252;hpb=7709a56a5467d8d78e1a2d86588be7dd60de3679;p=jscl.git

diff --git a/src/boot.lisp b/src/boot.lisp
index 5112039..ab043a9 100644
--- a/src/boot.lisp
+++ b/src/boot.lisp
@@ -254,7 +254,7 @@
             (append (cdr list1) list2))))
 
 (defun append (&rest lists)
-  (!reduce #'append-two lists))
+  (!reduce #'append-two lists nil))
 
 (defun revappend (list1 list2)
   (while list1
@@ -282,7 +282,7 @@
     (setq assignments (reverse assignments))
     ;;
     `(let ,(mapcar #'cdr assignments)
-       (setq ,@(!reduce #'append (mapcar #'butlast assignments))))))
+       (setq ,@(!reduce #'append (mapcar #'butlast assignments) nil)))))
 
 (defmacro do (varlist endlist &body body)
   `(block nil
@@ -374,11 +374,6 @@
 (defun atom (x)
   (not (consp x)))
 
-(defun find (item list &key key (test #'eql))
-  (dolist (x list)
-    (when (funcall test (funcall key x) item)
-      (return x))))
-
 (defun remove (x list)
   (cond
     ((null list)
@@ -407,6 +402,10 @@
     (t
      (remove-if-not func (cdr list)))))
 
+(defun alpha-char-p (x)
+  (or (<= (char-code #\a) (char-code x) (char-code #\z))
+      (<= (char-code #\Z) (char-code x) (char-code #\Z))))
+
 (defun digit-char-p (x)
   (if (and (<= (char-code #\0) (char-code x) (char-code #\9)))
       (- (char-code x) (char-code #\0))
@@ -417,13 +416,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))
@@ -444,6 +439,16 @@
          (t
           (error "type-error!"))))))
 
+(defun find (item sequence &key (key #'identity) (test #'eql))
+  (do-sequence (x sequence)
+    (when (funcall test (funcall key x) item)
+      (return x))))
+
+(defun find-if (predicate sequence &key (key #'identity))
+  (do-sequence (x sequence)
+    (when (funcall predicate (funcall key x))
+      (return x))))
+
 (defun some (function seq)
   (do-sequence (elt seq)
     (when (funcall function elt)
@@ -463,11 +468,6 @@
       (incf pos))
     pos))
 
-(defun string (x)
-  (cond ((stringp x) x)
-        ((symbolp x) (symbol-name x))
-        (t (char-to-string x))))
-
 (defun equal (x y)
   (cond
     ((eql x y) t)
@@ -475,19 +475,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)
@@ -533,7 +524,7 @@
                 `(,value)
                 `(setq ,place ,value)
                 place))
-      (let ((place (ls-macroexpand-1 place)))
+      (let ((place (!macroexpand-1 place)))
         (let* ((access-fn (car place))
                (expander (cdr (assoc access-fn *setf-expanders*))))
           (when (null expander)
@@ -554,7 +545,7 @@
     ((null (cdr pairs))
      (error "Odd number of arguments to setf."))
     ((null (cddr pairs))
-     (let ((place (ls-macroexpand-1 (first pairs)))
+     (let ((place (!macroexpand-1 (first pairs)))
            (value (second pairs)))
        (multiple-value-bind (vars vals store-vars writer-form)
            (get-setf-expansion place)
@@ -608,7 +599,7 @@
   (+ (get-unix-time) 2208988800))
 
 (defun concat (&rest strs)
-  (!reduce #'concat-two strs :initial-value ""))
+  (!reduce #'concat-two strs ""))
 
 (defun values-list (list)
   (values-array (list-to-vector list)))
@@ -618,3 +609,4 @@
 
 (defun error (fmt &rest args)
   (%throw (apply #'format nil fmt args)))
+