type-encodings.lisp

   1 (in-package :objcffi)
   2
   3 ;;; TODO
   4 ;; doesnt support arrays yet,
   5 ;; see (%list-ivars (%objc_getClass "NSConcreteFileHandle"))
   6
   7 ;; Table based on
   8 ;; http://developer.apple.com/documentation/Cocoa/Conceptual/ObjectiveC/Articles/chapter_5_section_7.html
   9 (defparameter *type-encodings*
  10   '(;; Basic CFFI types
  11     (:char "c")
  12     (:unsigned-char "C")
  13     (:uchar "C")
  14     (:short "s")
  15     (:unsigned-short "S")
  16     (:ushort "S")
  17     (:int "i")
  18     (:unsigned-int "I")
  19     (:uint "I")
  20     (:long "l")
  21     (:unsigned-long "L")
  22     (:ulong "L")
  23     (:long-long "q")
  24     (:llong "q")
  25     (:unsigned-long-long "Q")
  26     (:ullong "Q")
  27     (:float "f")
  28     (:double "d")
  29     (:long-double "d") ;; test this on all platforms, unknown on ppc
  30     (:void "v")
  31     (:pointer "^v")
  32     (:string "*")
  33
  34     ;; Objective C types
  35     (id "@")
  36     (SEL ":")
  37     (BOOL "c")
  38     (IMP "^?")
  39     (Class "#")
  40     (:unknown "?" 4))) ;; this size may be implementation specific
  41
  42 (defparameter *method-encodings*
  43   '((#\r :const)
  44     (#\n :in)
  45     (#\N :inout)
  46     (#\o :out)
  47     (#\O :bycopy)
  48     (#\R :byref)
  49     (#\V :oneway)))
  50
  51 (defun-with-types get-method-types ((class class-name :objc-class)
  52                                     (selector selector-name :objc-selector)
  53                                     &optional instance-method)
  54   (let ((method (funcall (if instance-method #'%class_getInstanceMethod #'%class_getClassMethod)
  55                          class selector)))
  56     (if (cffi:null-pointer-p method)
  57         (error "Class \"~a\" does not have the ~:[class~;instance~] method \"~a\""
  58                (if (cffi:null-pointer-p class) "<NULL>" class-name)
  59                instance-method selector-name)
  60         (values (cffi:foreign-slot-value method 'objc_method 'method_types)
  61                 method))))
  62
  63 (defun encode-struct (struct)
  64   (format nil "{~a}"
  65           (apply #'concatenate 'string
  66                  (second struct) "=" (mapcar #'encode-type (cddr struct)))))
  67
  68 (defun encode-type (type)
  69   (let ((encoding (assoc type *type-encodings*)))
  70     (cond ((eq type :void) (second encoding))
  71           ((and (listp type) (eq (first type) :struct)) (encode-struct type))
  72           (t (values (string (second encoding))
  73                      (or (third encoding)
  74                          (cffi:foreign-type-size type)))))))
  75
  76 (defun encode-method-type (return-type parameters)
  77   (apply #'concatenate 'string
  78          (encode-type return-type) "@:" (mapcar #'encode-type parameters)))
  79
  80
  81 (defun decode-type (type-string)
  82   (if (char= #\^ (elt type-string 0)) :pointer
  83       (first (find type-string *type-encodings* :key #'second :test #'string=))))
  84
  85 (defun decode-struct-from-method-type (stream)
  86   (let ((name ())
  87         (types ()))
  88     (do ((char (read-char stream) (read-char stream)))
  89         ((char= #\= char))
  90       (push char name))
  91
  92     (when (char= (peek-char nil stream) #\")
  93       (read-char stream)
  94       (loop while (char/= #\" (read-char stream))))
  95
  96     (labels ((read-until-end ()
  97                (do ((char (read-char stream) (read-char stream)))
  98                    ((char= #\} char)
  99                     (push char types))
 100                  (push char types)
 101                  (when (char= #\{ char)
 102                    (read-until-end)))))
 103       (read-until-end))
 104     (list* :struct
 105            (coerce (reverse name) 'string)
 106            (decode-method-types (coerce (reverse types) 'string)))))
 107
 108 (defun decode-method-types (method-types)
 109   (let ((types ()))
 110     (with-input-from-string (s method-types)
 111       (do* ((token (read-char s) (read-char s nil :eof)))
 112            ((eq token :eof))
 113         (let ((objc-name (find (string token) *type-encodings*
 114                                :key #'second :test #'string=)))
 115           (cond (objc-name
 116                  (push (first objc-name) types))
 117                 ((char= token #\^)
 118                  (push :pointer types)
 119                  (read-char s nil))
 120                  ((char= token #\{)
 121                  (push (decode-struct-from-method-type s) types))
 122                 ((char= token #\")
 123                  (loop while (char/= #\" (read-char s))))))))
 124     (reverse types)))