features.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
 (HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
 (DIR) Log
 (DIR) Files
 (DIR) Refs
 (DIR) Tags
 (DIR) README
 (DIR) LICENSE
       ---
       features.lisp (3965B)
       ---
            1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
            2 ;;;
            3 ;;; features.lisp --- CFFI-specific features (DEPRECATED).
            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.  CFFI-FEATURES is now
           38 ;;; deprecated and this code will stay here for a while for backwards
           39 ;;; compatibility purposes, to be removed in a future release.
           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
          107         #+cffi-sys::no-long-long no-long-long
          108         #+cffi-sys::flat-namespace flat-namespace
          109         #+cffi-sys::no-foreign-funcall no-foreign-funcall
          110         #+cffi-sys::no-stdcall no-stdcall
          111         ))