external/cffi.darcs/src/features.lisp

   1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; features.lisp --- CFFI-specific features.
   4 ;;;
   5 ;;; Copyright (C) 2006-2007, Luis Oliveira  <loliveira@common-lisp.net>
   6 ;;;
   7 ;;; Permission is hereby granted, free of charge, to any person
   8 ;;; obtaining a copy of this software and associated documentation
   9 ;;; files (the "Software"), to deal in the Software without
  10 ;;; restriction, including without limitation the rights to use, copy,
  11 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
  12 ;;; of the Software, and to permit persons to whom the Software is
  13 ;;; furnished to do so, subject to the following conditions:
  14 ;;;
  15 ;;; The above copyright notice and this permission notice shall be
  16 ;;; included in all copies or substantial portions of the Software.
  17 ;;;
  18 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  19 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  20 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  21 ;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  22 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  23 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  24 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  25 ;;; DEALINGS IN THE SOFTWARE.
  26 ;;;
  27
  28 (in-package #:cl-user)
  29
  30 (eval-when (:compile-toplevel :load-toplevel :execute)
  31   (pushnew :cffi *features*))
  32
  33 ;;; CFFI-SYS backends take care of pushing the appropriate features to
  34 ;;; *features*.  See each cffi-*.lisp file.
  35 ;;;
  36 ;;; Not anymore, I think we should use TRIVIAL-FEATURES for the
  37 ;;; platform features instead.  Less pain.  And maybe the
  38 ;;; CFFI-specific features should be in the CFFI-SYS package,
  39 ;;; unexported?  This is here now for backwards compatibility.
  40
  41 (defpackage #:cffi-features
  42   (:use #:cl)
  43   (:export
  44    #:cffi-feature-p
  45
  46    ;; Features related to the CFFI-SYS backend.  Why no-*?  This
  47    ;; reflects the hope that these symbols will go away completely
  48    ;; meaning that at some point all lisps will support long-longs,
  49    ;; the foreign-funcall primitive, etc...
  50    #:no-long-long
  51    #:no-foreign-funcall
  52    #:no-stdcall
  53    #:flat-namespace
  54
  55    ;; Only SCL supports long-double...
  56    ;;#:no-long-double
  57
  58    ;; Features related to the operating system.
  59    ;; More should be added.
  60    #:darwin
  61    #:unix
  62    #:windows
  63
  64    ;; Features related to the processor.
  65    ;; More should be added.
  66    #:ppc32
  67    #:x86
  68    #:x86-64
  69    #:sparc
  70    #:sparc64
  71    #:hppa
  72    #:hppa64))
  73
  74 (in-package #:cffi-features)
  75
  76 (defun cffi-feature-p (feature-expression)
  77   "Matches a FEATURE-EXPRESSION against those symbols in *FEATURES*
  78 that belong to the CFFI-FEATURES package."
  79   (when (eql feature-expression t)
  80     (return-from cffi-feature-p t))
  81   (let ((features-package (find-package '#:cffi-features)))
  82     (flet ((cffi-feature-eq (name feature-symbol)
  83              (and (eq (symbol-package feature-symbol) features-package)
  84                   (string= name (symbol-name feature-symbol)))))
  85       (etypecase feature-expression
  86         (symbol
  87          (not (null (member (symbol-name feature-expression) *features*
  88                             :test #'cffi-feature-eq))))
  89         (cons
  90          (ecase (first feature-expression)
  91            (:and (every #'cffi-feature-p (rest feature-expression)))
  92            (:or  (some #'cffi-feature-p (rest feature-expression)))
  93            (:not (not (cffi-feature-p (cadr feature-expression))))))))))
  94
  95 ;;; for backwards compatibility
  96 (mapc (lambda (sym) (pushnew sym *features*))
  97       '(#+darwin darwin
  98         #+unix unix
  99         #+windows windows
 100         #+ppc ppc32
 101         #+x86 x86
 102         #+x86-64 x86-64
 103         #+sparc sparc
 104         #+sparc64 sparc64
 105         #+hppa hppa
 106         #+hppa64 hppa64))