X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Futils.lisp;h=6ab351d1f21fc9a780a442638e685eb9ee727011;hb=916539de6153df7b4f6838c5e03ef420a890256c;hp=20aa85573c35a2368d94911299532d0a0ce63939;hpb=4fe7f49a28d5df40cdad3bcdf959acab5f1c5e55;p=jscl.git diff --git a/src/utils.lisp b/src/utils.lisp index 20aa855..6ab351d 100644 --- a/src/utils.lisp +++ b/src/utils.lisp @@ -16,32 +16,30 @@ ;; You should have received a copy of the GNU General Public License ;; along with JSCL. If not, see . -(defvar *newline* (string (code-char 10))) +(/debug "loading utils.lisp!") (defmacro concatf (variable &body form) `(setq ,variable (concat ,variable (progn ,@form)))) ;;; This couple of helper functions will be defined in both Common -;;; Lisp and in Ecmalisp. +;;; Lisp and in JSCL (defun ensure-list (x) (if (listp x) x (list x))) -(defun !reduce (func list &key initial-value) - (if (null list) - initial-value - (!reduce func - (cdr list) - :initial-value (funcall func initial-value (car list))))) +(defun !reduce (func list initial-value) + (let ((result initial-value)) + (dolist (element list result) + (setq result (funcall func result element))))) ;;; Concatenate a list of strings, with a separator (defun join (list &optional (separator "")) (if (null list) "" - (!reduce (lambda (s o) (concat s separator o)) - (cdr list) - :initial-value (car list)))) + (!reduce (lambda (s o) (concat s separator o)) + (cdr list) + (car list)))) (defun join-trailing (list &optional (separator "")) (if (null list) @@ -84,4 +82,22 @@ (defun float-to-string (x) #+jscl (float-to-string x) - #+common-lisp (format nil "~f" x)) + #-jscl (format nil "~f" x)) + +(defun satisfies-test-p (x y &key key (test #'eql) testp (test-not #'eql) test-not-p) + (when (and testp test-not-p) + (error "Both test and test-not are set")) + (let ((key-val (if key (funcall key y) y)) + (fn (if test-not-p (complement test-not) test))) + (funcall fn x key-val))) + + +(defun interleave (list element &optional after-last-p) + (unless (null list) + (with-collect + (collect (car list)) + (dolist (x (cdr list)) + (collect element) + (collect x)) + (when after-last-p + (collect element)))))