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 ))