X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fboot.lisp;h=7605a2968ef46c2073138461bed39313b157bac4;hb=03fcd04876ff098055a8313d65fb1bef7bb57a5d;hp=e25d70fe7ff5301a9816b211462cf902f084a45b;hpb=d6435f07a86f9df5db3195ffe7c8fc3f9a246ee3;p=jscl.git diff --git a/src/boot.lisp b/src/boot.lisp index e25d70f..7605a29 100644 --- a/src/boot.lisp +++ b/src/boot.lisp @@ -95,23 +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) @@ -142,6 +131,21 @@ ,@(cdr newval)) ,setter)))) +(defmacro pushnew (x place &rest keys &key key test test-not) + (declare (ignore key test test-not)) + (multiple-value-bind (dummies vals newval setter getter) + (get-setf-expansion place) + (let ((g (gensym)) + (v (gensym))) + `(let* ((,g ,x) + ,@(mapcar #'list dummies vals) + ,@(cdr newval) + (,v ,getter)) + (if (member ,g ,v ,@keys) + ,v + (let ((,(car newval) (cons ,g ,getter))) + ,setter)))))) + (defmacro dolist ((var list &optional result) &body body) (let ((g!list (gensym))) (unless (symbolp var) (error "`~S' is not a symbol." var)) @@ -248,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 @@ -382,15 +374,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)))