src/enum.lisp

   1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; enum.lisp --- Defining foreign constants as Lisp keywords.
   4 ;;;
   5 ;;; Copyright (C) 2005, James Bielman  <jamesjb@jamesjb.com>
   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 #:cffi)
  29
  30 ;;;# Foreign Constants as Lisp Keywords
  31 ;;;
  32 ;;; This module defines the DEFCENUM macro, which provides an
  33 ;;; interface for defining a type and associating a set of integer
  34 ;;; constants with keyword symbols for that type.
  35 ;;;
  36 ;;; The keywords are automatically translated to the appropriate
  37 ;;; constant for the type by a type translator when passed as
  38 ;;; arguments or a return value to a foreign function.
  39
  40 (defclass foreign-enum (foreign-typedef)
  41   ((keyword-values
  42     :initform (make-hash-table)
  43     :reader keyword-values)
  44    (value-keywords
  45     :initform (make-hash-table :test 'equal)
  46     :reader value-keywords))
  47   (:documentation "Describes a foreign enumerated type."))
  48
  49 (defun notice-foreign-enum (type-name base-type values)
  50   "Defines TYPE-NAME to be a foreign enum type."
  51   (let ((type (make-instance 'foreign-enum :name type-name
  52                              :actual-type (find-foreign-type base-type))))
  53     (loop for (keyword value) in values
  54           do (setf (gethash keyword (keyword-values type)) value)
  55              (setf (gethash value (value-keywords type)) keyword))
  56     (setf (find-foreign-type type-name) type)))
  57
  58 ;;; These two functions could be good canditates for compiler macros
  59 ;;; when the value or keyword is constant.  I am not going to bother
  60 ;;; until someone has a serious performance need to do so though.
  61 (defun foreign-enum-value (type keyword)
  62   "Return the numeric value of KEYWORD as enum TYPE."
  63   (check-type type symbol)
  64   (check-type keyword keyword)
  65   (let ((type-obj (find-foreign-type type)))
  66     (when (or (null type-obj) (not (typep type-obj 'foreign-enum)))
  67       (error "~S is not a foreign enum type." type))
  68     (or (gethash keyword (keyword-values type-obj))
  69         (error "~S is not defined as a keyword for enum type ~S."
  70                keyword type))))
  71
  72 (defun foreign-enum-keyword (type value)
  73   "Return the keyword value of a numer VALUE as enum TYPE."
  74   (check-type type symbol)
  75   (check-type value integer)
  76   (let ((type-obj (find-foreign-type type)))
  77     (when (or (null type-obj) (not (typep type-obj 'foreign-enum)))
  78       (error "~S is not a foreign enum type." type))
  79     (or (gethash value (value-keywords type-obj))
  80         (error "~S is not defined as a value for enum type ~S."
  81                value type))))
  82
  83 (defmacro defcenum (name &body values)
  84   "Define an foreign enumerated type."
  85   `(eval-when (:compile-toplevel :load-toplevel :execute)
  86      (notice-foreign-enum ',name :int ',values)
  87      (define-type-translator ,name :in (arg result-var)
  88        (declare (ignore result-var))
  89        (values `(if (keywordp ,arg)
  90                     (foreign-enum-value ',',name ,arg)
  91                     ,arg)
  92                nil))
  93      (define-type-translator ,name :result (arg result-var)
  94        (declare (ignore result-var))
  95        (values `(foreign-enum-keyword ',',name ,arg) nil))))