src/compat.lisp

   1 ;;; compat.lisp --- Create some definitions to fix CL compatibility
   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 ;;; Duplicate from boot.lisp by now
  20 (defmacro with-collect (&body body)
  21   (let ((head (gensym))
  22         (tail (gensym)))
  23     `(let* ((,head (cons 'sentinel nil))
  24             (,tail ,head))
  25        (flet ((collect (x)
  26                 (rplacd ,tail (cons x nil))
  27                 (setq ,tail (cdr ,tail))
  28                 x))
  29          ,@body)
  30        (cdr ,head))))
  31
  32 (defmacro while (condition &body body)
  33   `(do ()
  34        ((not ,condition))
  35      ,@body))
  36
  37 (defmacro eval-when-compile (&body body)
  38   `(eval-when (:compile-toplevel :load-toplevel :execute)
  39      ,@body))
  40
  41 (defun concat-two (s1 s2)
  42   (concatenate 'string s1 s2))
  43
  44 (defun aset (array idx value)
  45   (setf (aref array idx) value))
  46
  47 (eval-when-compile
  48   (defun concat (&rest strs)
  49     (apply #'concatenate 'string strs)))