Changeset 875


Ignore:
Timestamp:
Sep 25, 2004, 9:08:23 PM (16 years ago)
Author:
gb
Message:

Fixes to COERCE-TO-FOREIGN-TYPE, from Randall Beer.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/examples/bridge.lisp

    r839 r875  
    623623
    624624(defmacro coerce-to-foreign-type (x ftype)
    625   (cond ((and (constantp x) (constantp ftype))
    626          (case ftype
    627            (:id (cond ((null x) `(%null-ptr))
    628                       ((stringp x) `(%make-nsstring ,x))
    629                       (t (coerce-to-address x))))
    630            (:char (coerce-to-bool x))
    631            (:single-float (coerce x 'single-float))
    632            (t x)))
    633         ((constantp ftype)
    634          (case ftype
    635            (:id `(coerce-to-address ,x))
    636            (:char `(coerce-to-bool ,x))
    637            (:single-float `(coerce ,x 'single-float))
    638            (t x)))
    639         (t `(case ,(if (atom ftype) ftype)
    640               (:id (coerce-to-address ,x))
    641               (:char (coerce-to-bool ,x))
    642               (:single-float (coerce ,x 'single-float))
    643               (t ,x)))))
    644 
     625   (cond ((and (constantp x) (constantp ftype))
     626          (case ftype
     627            (:id (if (null x) `(%null-ptr) (coerce-to-address x)))
     628            (:char (coerce-to-bool (eval x)))
     629            (t x)))
     630         ((constantp ftype)
     631          (case ftype
     632            (:id `(coerce-to-address ,x))
     633            (:char `(coerce-to-bool ,x))
     634            (t x)))
     635         (t `(case ,(if (atom ftype) ftype)
     636               (:id (coerce-to-address ,x))
     637               (:char (coerce-to-bool ,x))
     638               (t ,x)))))
    645639
    646640;;; Convert a foreign object X to T or NIL
Note: See TracChangeset for help on using the changeset viewer.