Implemented string<

[jscl.git] / src / boot.lisp

diff --git a/src/boot.lisp b/src/boot.lisp
index 45bf307..5f44fa6 100644 (file)
--- a/src/boot.lisp
+++ b/src/boot.lisp
@@ -92,6 +92,9 @@
 (defun boundp (x)
   (boundp x))
 
+(defun fboundp (x)
+  (fboundp x))
+
 ;; Basic functions
 (defun = (x y) (= x y))
 (defun * (x y) (* x y))
@@ -372,6 +375,9 @@
 (defun char= (x y)
   (eql x y))
 
+(defun char< (x y)
+  (< (char-code x) (char-code y)))
+
 (defun integerp (x)
   (and (numberp x) (= (floor x) x)))
 
@@ -381,81 +387,12 @@
 (defun plusp (x) (< 0 x))
 (defun minusp (x) (< x 0))
 
-(defmacro doseq ((elt seq &optional index) &body body)
-  (let* ((nseq (gensym "seq"))
-         (i (or index (gensym "i")))
-         (list-body (if index
-                        `(let ((,i -1))
-                           (dolist (,elt ,nseq)
-                             (incf ,i)
-                             ,@body))
-                        `(dolist (,elt ,nseq)
-                           ,@body))))
-    `(let ((,nseq ,seq))
-       (if (listp ,nseq)
-           ,list-body
-           (dotimes (,i (length ,nseq))
-             (let ((,elt (aref ,nseq ,i)))
-               ,@body))))))
-
-(defun find (item seq &key key (test #'eql))
-  (if key
-      (doseq (x seq)
-        (when (funcall test (funcall key x) item)
-          (return x)))
-      (doseq (x seq)
-        (when (funcall test x item)
-          (return x)))))
-
-(defun remove (x seq)
-  (cond
-    ((null seq)
-     nil)
-    ((listp seq)
-     (let* ((head (cons nil nil))
-            (tail head))
-       (doseq (elt seq)
-         (unless (eql x elt)
-           (let ((new (list elt)))
-             (rplacd tail new)
-             (setq tail new))))
-       (cdr head)))
-    (t
-     (let (vector)
-       (doseq (elt seq index)
-         (if (eql x elt)
-             ;; Copy the beginning of the vector only when we find an element
-             ;; that does not match.
-             (unless vector
-               (setq vector (make-array 0))
-               (dotimes (i index)
-                 (vector-push-extend (aref seq i) vector)))
-             (when vector
-               (vector-push-extend elt vector))))
-       (or vector seq)))))
-
-(defun remove-if (func list)
-  (cond
-    ((null list)
-     nil)
-    ((funcall func (car list))
-     (remove-if func (cdr list)))
-    (t
-     ;;
-     (cons (car list) (remove-if func (cdr list))))))
-
-(defun remove-if-not (func list)
-  (cond
-    ((null list)
-     nil)
-    ((funcall func (car list))
-     (cons (car list) (remove-if-not func (cdr list))))
-    (t
-     (remove-if-not func (cdr list)))))
+(defun atom (x)
+  (not (consp x)))
 
 (defun alpha-char-p (x)
   (or (<= (char-code #\a) (char-code x) (char-code #\z))
-      (<= (char-code #\Z) (char-code x) (char-code #\Z))))
+      (<= (char-code #\A) (char-code x) (char-code #\Z))))
 
 (defun digit-char-p (x)
   (if (and (<= (char-code #\0) (char-code x) (char-code #\9)))
@@ -466,59 +403,6 @@
   (and (<= 0 weight 9)
        (char "0123456789" weight)))
 
-(defun subseq (seq a &optional b)
-  (if b
-      (slice seq a b)
-      (slice seq a)))
-
-(defmacro do-sequence (iteration &body body)
-  (let ((seq (gensym))
-        (index (gensym)))
-    `(let ((,seq ,(second iteration)))
-       (cond
-         ;; Strings
-         ((stringp ,seq)
-          (let ((,index 0))
-            (dotimes (,index (length ,seq))
-              (let ((,(first iteration)
-                     (char ,seq ,index)))
-                ,@body))))
-         ;; Lists
-         ((listp ,seq)
-          (dolist (,(first iteration) ,seq)
-            ,@body))
-         (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)
-      (return-from some t))))
-
-(defun every (function seq)
-  (do-sequence (elt seq)
-    (unless (funcall function elt)
-      (return-from every nil)))
-  t)
-
-(defun position (elt sequence)
-  (let ((pos 0))
-    (do-sequence (x seq)
-      (when (eq elt x)
-        (return))
-      (incf pos))
-    pos))
-
 (defun equal (x y)
   (cond
     ((eql x y) t)
@@ -666,4 +550,3 @@
 
 (defun error (fmt &rest args)
   (%throw (apply #'format nil fmt args)))
-