src/utils.lisp

   1 ;;; utils.lisp ---
   2
   3 ;; Copyright (C) 2012, 2013 David Vazquez
   4 ;; Copyright (C) 2012 Raimon Grau
   5
   6 ;; This program 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 ;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (defvar *newline* (string (code-char 10)))
  20
  21 (defmacro concatf (variable &body form)
  22   `(setq ,variable (concat ,variable (progn ,@form))))
  23
  24 ;;; This couple of helper functions will be defined in both Common
  25 ;;; Lisp and in Ecmalisp.
  26 (defun ensure-list (x)
  27   (if (listp x)
  28       x
  29       (list x)))
  30
  31 (defun !reduce (func list &key initial-value)
  32   (if (null list)
  33       initial-value
  34       (!reduce func
  35                (cdr list)
  36                :initial-value (funcall func initial-value (car list)))))
  37
  38 ;;; Concatenate a list of strings, with a separator
  39 (defun join (list &optional (separator ""))
  40   (cond
  41     ((null list)
  42      "")
  43     ((null (cdr list))
  44      (car list))
  45     (t
  46      (concat (car list)
  47              separator
  48              (join (cdr list) separator)))))
  49
  50 (defun join-trailing (list &optional (separator ""))
  51   (if (null list)
  52       ""
  53       (concat (car list) separator (join-trailing (cdr list) separator))))
  54
  55 (defun mapconcat (func list)
  56   (join (mapcar func list)))
  57
  58 (defun vector-to-list (vector)
  59   (let ((list nil)
  60         (size (length vector)))
  61     (dotimes (i size (reverse list))
  62       (push (aref vector i) list))))
  63
  64 (defun list-to-vector (list)
  65   (let ((v (make-array (length list)))
  66         (i 0))
  67     (dolist (x list v)
  68       (aset v i x)
  69       (incf i))))
  70
  71 (defmacro awhen (condition &body body)
  72   `(let ((it ,condition))
  73      (when it ,@body)))
  74
  75 (defun integer-to-string (x)
  76   (cond
  77     ((zerop x)
  78      "0")
  79     ((minusp x)
  80      (concat "-" (integer-to-string (- 0 x))))
  81     (t
  82      (let ((digits nil))
  83        (while (not (zerop x))
  84          (push (mod x 10) digits)
  85          (setq x (truncate x 10)))
  86        (mapconcat (lambda (x) (string (digit-char x)))
  87                   digits)))))
  88
  89 (defun float-to-string (x)
  90   #+jscl (float-to-string x)
  91   #+common-lisp (format nil "~f" x))