Add TEST-NOT keyword argument to TREE-EQUAL
[jscl.git] / src / utils.lisp
1 ;;; utils.lisp ---
2
3 ;; Copyright (C) 2012, 2013 David Vazquez
4 ;; Copyright (C) 2012 Raimon Grau
5
6 ;; JSCL is free software: you can redistribute it and/or
7 ;; modify it under the terms of the GNU General Public License as
8 ;; published by the Free Software Foundation, either version 3 of the
9 ;; License, or (at your option) any later version.
10 ;;
11 ;; JSCL is distributed in the hope that it will be useful, but
12 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14 ;; General Public License for more details.
15 ;;
16 ;; You should have received a copy of the GNU General Public License
17 ;; along with JSCL.  If not, see <http://www.gnu.org/licenses/>.
18
19 (defvar *newline* "
20 ")
21
22 (defmacro concatf (variable &body form)
23   `(setq ,variable (concat ,variable (progn ,@form))))
24
25 ;;; This couple of helper functions will be defined in both Common
26 ;;; Lisp and in JSCL
27 (defun ensure-list (x)
28   (if (listp x)
29       x
30       (list x)))
31
32 (defun !reduce (func list initial-value)
33   (let ((result initial-value))
34     (dolist (element list result)
35       (setq result (funcall func result element)))))
36
37 ;;; Concatenate a list of strings, with a separator
38 (defun join (list &optional (separator ""))
39   (if (null list)
40       ""
41       (!reduce (lambda (s o) (concat s separator o))
42                (cdr list)
43                (car list))))
44
45 (defun join-trailing (list &optional (separator ""))
46   (if (null list)
47       ""
48       (concat (car list) separator (join-trailing (cdr list) separator))))
49
50 (defun mapconcat (func list)
51   (join (mapcar func list)))
52
53 (defun vector-to-list (vector)
54   (let ((list nil)
55         (size (length vector)))
56     (dotimes (i size (reverse list))
57       (push (aref vector i) list))))
58
59 (defun list-to-vector (list)
60   (let ((v (make-array (length list)))
61         (i 0))
62     (dolist (x list v)
63       (aset v i x)
64       (incf i))))
65
66 (defmacro awhen (condition &body body)
67   `(let ((it ,condition))
68      (when it ,@body)))
69
70 (defun integer-to-string (x)
71   (cond
72     ((zerop x)
73      "0")
74     ((minusp x)
75      (concat "-" (integer-to-string (- 0 x))))
76     (t
77      (let ((digits nil))
78        (while (not (zerop x))
79          (push (mod x 10) digits)
80          (setq x (truncate x 10)))
81        (mapconcat (lambda (x) (string (digit-char x)))
82                   digits)))))
83
84 (defun float-to-string (x)
85   #+jscl (float-to-string x)
86   #-jscl (format nil "~f" x))
87
88 (defun satisfies-test-p (x y &key key (test #'eql) testp (test-not #'eql) test-not-p)
89   (when (and testp test-not-p)
90     (error "Both test and test-not are set"))
91   (let ((key-val (if key (funcall key y) y))
92         (fn (if test-not-p (complement test-not) test)))
93     (funcall fn x key-val)))