syscalls/designators.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- FFI designators.
   4 ;;;
   5
   6 (in-package :iolib.syscalls)
   7
   8 ;;;; Type Designators
   9
  10 (defmacro define-designator (name cffi-type &body type-clauses)
  11   (let ((type `(quote (or ,@(mapcar #'car type-clauses))))
  12         (ctype (format-symbol t "~A-DESIGNATOR" name)))
  13     `(progn
  14        (deftype ,name () ,type)
  15        (defun ,name (,name)
  16          (etypecase ,name
  17            ,@type-clauses))
  18        (define-foreign-type ,ctype ()
  19          ()
  20          (:simple-parser ,ctype)
  21          (:actual-type ,cffi-type))
  22        (defmethod expand-to-foreign (value (type ,ctype))
  23          `(convert-to-foreign
  24            (let ((,',name ,value))
  25              (etypecase ,',name ,@',type-clauses))
  26            ,',cffi-type)))))
  27
  28 (declaim (inline native-namestring))
  29 (defun native-namestring (pathname)
  30   (cffi-sys:native-namestring pathname))
  31
  32 ;;; NATIVE-NAMESTRING should take care of complaining when FILENAME
  33 ;;; is wild but I don't think it does on all Lisps, so let's check it
  34 ;;; explicitly.
  35 (define-designator filename :string
  36   (pathname (when (wild-pathname-p filename)
  37               (system-error "Pathname is wild: ~S." filename))
  38             (native-namestring (translate-logical-pathname filename)))
  39   (string filename))
  40
  41 (define-designator pointer-or-nil :pointer
  42   (null (null-pointer))
  43   (foreign-pointer pointer-or-nil))
  44
  45 (define-designator bool :int
  46   (null 0)
  47   (t    1))