X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fboot.lisp;h=59b97a0546d3a79f5f9a31142f742b9efae8aaea;hb=dcfa70bbdc04e0571e94b99f1a2c8e1ae3237f03;hp=e33051ca7308ef130bbb37d8f979a2752c78581e;hpb=35f9b78191116ec9c2304b6358396627be46c612;p=jscl.git diff --git a/src/boot.lisp b/src/boot.lisp index e33051c..59b97a0 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) @@ -143,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)) @@ -249,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 @@ -342,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))) @@ -383,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))) @@ -544,9 +523,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)))