diff options
Diffstat (limited to 'bindings/cl/meta.lisp')
-rw-r--r-- | bindings/cl/meta.lisp | 59 |
1 files changed, 0 insertions, 59 deletions
diff --git a/bindings/cl/meta.lisp b/bindings/cl/meta.lisp deleted file mode 100644 index 751a089..0000000 --- a/bindings/cl/meta.lisp +++ /dev/null @@ -1,59 +0,0 @@ -;; Copyright (c) 2009 Vitaly Mayatskikh <v.mayatskih@gmail.com> -;; -;; This file is part of 0MQ. -;; -;; 0MQ is free software; you can redistribute it and/or modify it under -;; the terms of the Lesser GNU General Public License as published by -;; the Free Software Foundation; either version 3 of the License, or -;; (at your option) any later version. -;; -;; 0MQ is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; Lesser GNU General Public License for more details. -;; -;; You should have received a copy of the Lesser GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -(in-package :zeromq) - -(define-condition error-again (error) - ((argument :reader error-again :initarg :argument)) - (:report (lambda (condition stream) - (write-string (convert-from-foreign - (%strerror (error-again condition)) - :string) - stream)))) - -(defmacro defcfun* (name-and-options return-type &body args) - (let* ((c-name (car name-and-options)) - (l-name (cadr name-and-options)) - (n-name (cffi::format-symbol t "%~A" l-name)) - (name (list c-name n-name)) - - (docstring (when (stringp (car args)) (pop args))) - (ret (gensym))) - (loop with opt - for i in args - unless (consp i) do (setq opt t) - else - collect i into args* - and if (not opt) collect (car i) into names - else collect (car i) into opts - and collect (list (car i) 0) into opts-init - end - finally (return - `(progn - (defcfun ,name ,return-type - ,@args*) - - (defun ,l-name (,@names &optional ,@opts-init) - ,docstring - (let ((,ret (,n-name ,@names ,@opts))) - (if ,(if (eq return-type :pointer) - `(zerop (pointer-address ,ret)) - `(not (zerop ,ret))) - (cond - ((eq *errno* isys:eagain) (error 'error-again :argument *errno*)) - (t (error (convert-from-foreign (%strerror *errno*) :string)))) - ,ret)))))))) |