X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fboot.lisp;h=5f44fa688ce2d7f91bc257cc75e48a52074e0e34;hb=671a7d7ba8aa7bfae12d5eb254f184b2210a9c64;hp=78d8d080fb2cd42b1cf7c0eec9ffbd6fb499b630;hpb=e14753c04f867bc0fa82dd78f2d01ec140c2c72b;p=jscl.git diff --git a/src/boot.lisp b/src/boot.lisp index 78d8d08..5f44fa6 100644 --- 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))) @@ -384,81 +390,9 @@ (defun atom (x) (not (consp x))) -(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 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))) @@ -469,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) @@ -669,4 +550,3 @@ (defun error (fmt &rest args) (%throw (apply #'format nil fmt args))) -