projects
/
jscl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Merge pull request #117 from Ferada/small-fixes
[jscl.git]
/
src
/
boot.lisp
diff --git
a/src/boot.lisp
b/src/boot.lisp
index
4f22ec9
..
1076113
100644
(file)
--- 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))
(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))
(defun boundp (x)
(boundp x))
@@
-95,24
+95,12
@@
(defun fboundp (x)
(fboundp x))
(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
(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)
(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.
;;; 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
(defun append-two (list1 list2)
(if (null list1)
list2
@@
-357,9
+333,6
@@
((listp seq)
(list-length seq))))
((listp seq)
(list-length seq))))
-(defun concat-two (s1 s2)
- (concat-two s1 s2))
-
(defmacro with-collect (&body body)
(let ((head (gensym))
(tail (gensym)))
(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 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)))
(defun atom (x)
(not (consp x)))
@@
-529,6
+493,8
@@
(integer 'integerp)
(cons 'consp)
(symbol 'symbolp)
(integer 'integerp)
(cons 'consp)
(symbol 'symbolp)
+ (function 'functionp)
+ (float 'floatp)
(array 'arrayp)
(string 'stringp)
(atom 'atom)
(array 'arrayp)
(string 'stringp)
(atom 'atom)
@@
-543,7
+509,7
@@
`(let ((,g!x ,x))
(typecase ,g!x
,@clausules
`(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)))
(defun notany (fn seq)
(not (some fn seq)))
@@
-559,9
+525,6
@@
(defun get-universal-time ()
(+ (get-unix-time) 2208988800))
(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)))
(defun values-list (list)
(values-array (list-to-vector list)))