X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fboot.lisp;h=10761131b13229d2bd612d5019ba55a8b6d694ee;hb=b2de12c4e1a6e77e7f3f22d056adcfeda79d085b;hp=4f22ec944c930be5dd4de26187b0b3957c953a76;hpb=c3b19b129a11f61ad6bbe17c04b6bff92c048f17;p=jscl.git diff --git a/src/boot.lisp b/src/boot.lisp index 4f22ec9..1076113 100644 --- a/src/boot.lisp +++ b/src/boot.lisp @@ -87,7 +87,7 @@ (defvar *gensym-counter* 0) (defun gensym (&optional (prefix "G")) (setq *gensym-counter* (+ *gensym-counter* 1)) - (make-symbol (concat-two prefix (integer-to-string *gensym-counter*)))) + (make-symbol (concat prefix (integer-to-string *gensym-counter*)))) (defun boundp (x) (boundp x)) @@ -95,24 +95,12 @@ (defun fboundp (x) (fboundp x)) -;; Basic functions -(defun = (x y) (= x y)) -(defun * (x y) (* x y)) -(defun / (x y) (/ x y)) -(defun 1+ (x) (+ x 1)) -(defun 1- (x) (- x 1)) -(defun zerop (x) (= x 0)) - -(defun truncate (x &optional (y 1)) - (floor (/ x y))) - (defun eq (x y) (eq x y)) (defun eql (x y) (eq x y)) (defun not (x) (if x nil t)) ;; Basic macros - (defmacro incf (place &optional (delta 1)) (multiple-value-bind (dummies vals newval setter getter) (get-setf-expansion place) @@ -264,18 +252,6 @@ ;;; Go on growing the Lisp language in Ecmalisp, with more high level ;;; utilities as well as correct versions of other constructions. -(defun + (&rest args) - (let ((r 0)) - (dolist (x args r) - (incf r x)))) - -(defun - (x &rest others) - (if (null others) - (- x) - (let ((r x)) - (dolist (y others r) - (decf r y))))) - (defun append-two (list1 list2) (if (null list1) list2 @@ -357,9 +333,6 @@ ((listp seq) (list-length seq)))) -(defun concat-two (s1 s2) - (concat-two s1 s2)) - (defmacro with-collect (&body body) (let ((head (gensym)) (tail (gensym))) @@ -398,15 +371,6 @@ (defun char< (x y) (< (char-code x) (char-code y))) -(defun integerp (x) - (and (numberp x) (= (floor x) x))) - -(defun floatp (x) - (and (numberp x) (not (integerp x)))) - -(defun plusp (x) (< 0 x)) -(defun minusp (x) (< x 0)) - (defun atom (x) (not (consp x))) @@ -529,6 +493,8 @@ (integer 'integerp) (cons 'consp) (symbol 'symbolp) + (function 'functionp) + (float 'floatp) (array 'arrayp) (string 'stringp) (atom 'atom) @@ -543,7 +509,7 @@ `(let ((,g!x ,x)) (typecase ,g!x ,@clausules - (t (error "~X fell through etypeacase expression." ,g!x)))))) + (t (error "~X fell through etypecase expression." ,g!x)))))) (defun notany (fn seq) (not (some fn seq))) @@ -559,9 +525,6 @@ (defun get-universal-time () (+ (get-unix-time) 2208988800)) -(defun concat (&rest strs) - (!reduce #'concat-two strs "")) - (defun values-list (list) (values-array (list-to-vector list)))