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 (/debug "loading utils.lisp!")
  20
  21 (defvar *newline* "
  22 ")
  23
  24 (defmacro concatf (variable &body form)
  25   `(setq ,variable (concat ,variable (progn ,@form))))
  26
  27 ;;; This couple of helper functions will be defined in both Common
  28 ;;; Lisp and in JSCL
  29 (defun ensure-list (x)
  30   (if (listp x)
  31       x
  32       (list x)))
  33
  34 (defun !reduce (func list initial-value)
  35   (let ((result initial-value))
  36     (dolist (element list result)
  37       (setq result (funcall func result element)))))
  38
  39 ;;; Concatenate a list of strings, with a separator
  40 (defun join (list &optional (separator ""))
  41   (if (null list)
  42       ""
  43       (!reduce (lambda (s o) (concat s separator o))
  44                (cdr list)
  45                (car list))))
  46
  47 (defun join-trailing (list &optional (separator ""))
  48   (if (null list)
  49       ""
  50       (concat (car list) separator (join-trailing (cdr list) separator))))
  51
  52 (defun mapconcat (func list)
  53   (join (mapcar func list)))
  54
  55 (defun vector-to-list (vector)
  56   (let ((list nil)
  57         (size (length vector)))
  58     (dotimes (i size (reverse list))
  59       (push (aref vector i) list))))
  60
  61 (defun list-to-vector (list)
  62   (let ((v (make-array (length list)))
  63         (i 0))
  64     (dolist (x list v)
  65       (aset v i x)
  66       (incf i))))
  67
  68 (defmacro awhen (condition &body body)
  69   `(let ((it ,condition))
  70      (when it ,@body)))
  71
  72 (defun integer-to-string (x)
  73   (cond
  74     ((zerop x)
  75      "0")
  76     ((minusp x)
  77      (concat "-" (integer-to-string (- 0 x))))
  78     (t
  79      (let ((digits nil))
  80        (while (not (zerop x))
  81          (push (mod x 10) digits)
  82          (setq x (truncate x 10)))
  83        (mapconcat (lambda (x) (string (digit-char x)))
  84                   digits)))))
  85
  86 (defun float-to-string (x)
  87   #+jscl (float-to-string x)
  88   #-jscl (format nil "~f" x))
  89
  90 (defun satisfies-test-p (x y &key key (test #'eql) testp (test-not #'eql) test-not-p)
  91   (when (and testp test-not-p)
  92     (error "Both test and test-not are set"))
  93   (let ((key-val (if key (funcall key y) y))
  94         (fn (if test-not-p (complement test-not) test)))
  95     (funcall fn x key-val)))
  96
  97
  98 (defun interleave (list element &optional after-last-p)
  99   (unless (null list)
 100     (with-collect
 101       (collect (car list))
 102       (dolist (x (cdr list))
 103         (collect element)
 104         (collect x))
 105       (when after-last-p
 106         (collect element)))))