1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
3 ;; Copyright (C) 2006, 2007 Stelian Ionescu
5 ;; This code is free software; you can redistribute it and/or
6 ;; modify it under the terms of the version 2.1 of
7 ;; the GNU Lesser General Public License as published by
8 ;; the Free Software Foundation, as clarified by the
9 ;; preamble found here:
10 ;; http://opensource.franz.com/preamble.html
12 ;; This program is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU Lesser General
18 ;; Public License along with this library; if not, write to the
19 ;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
20 ;; Boston, MA 02110-1301, USA
22 (in-package :iolib-utils
)
24 (defmacro define-constant
(name value
&optional doc
)
25 `(defconstant ,name
(if (boundp ',name
) (symbol-value ',name
) ,value
)
26 ,@(when doc
(list doc
))))
28 (defun %check-bounds
(sequence start end
)
29 (unless end
(setf end
(length sequence
)))
30 (when (> start end
) (error "~S ~S wrong sequence bounds" start end
))
33 (defmacro return-if
(block form
)
34 (let (($form$
(gensym "FORM-")))
35 `(let ((,$form$
,form
))
36 (when ,$form$
(return-from ,block
,$form$
)))))
38 (defun featurep (feature)
40 (symbol (consp (member feature
*features
* :test
#'eq
)))
41 (cons (ecase (first feature
)
42 ((or :or
) (some #'featurep
(rest feature
)))
43 ((and :and
) (every #'featurep
(rest feature
)))
44 ((not :not
) (and (third feature
) (error "Incorrect feature expression: ~S" feature
))
45 (not (featurep (second feature
))))))))
47 (export '(define-constant %check-bounds return-if featurep
))