chicken-users
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Chicken-users] Another patch for bind 1.5.2


From: Daniel Leslie
Subject: [Chicken-users] Another patch for bind 1.5.2
Date: Sun, 30 Mar 2014 15:01:17 -0700

This adds support for public fields in C++ classes. Woefully untested.

IE:
echo "class foo { public: float a, b; };" | chicken-bind - -o -

Produces:
;;; GENERATED BY CHICKEN-BIND FROM -

(begin
  (begin (declare (hide g0)) (define-class <foo> (<c++-object>) ()))
  (begin
    (define g0 (foreign-lambda void "delete " (c-pointer "foo")))
    (define-method (destructor (this <foo>)) (g0 (slot-value this 'this))))
  (define foo-a
    (getter-with-setter
      (foreign-lambda* float (((c-pointer "foo") s)) "return(s->a);")
      (foreign-lambda*
        float
        (((c-pointer "foo") s) (float x))
        "return(s->a = x);")))
  (define foo-b
    (getter-with-setter
      (foreign-lambda* float (((c-pointer "foo") s)) "return(s->b);")
      (foreign-lambda*
        float
        (((c-pointer "foo") s) (float x))
        "return(s->b = x);")))
  (begin
    (declare (hide g1))
    (define g1 (foreign-lambda (c-pointer "foo") "new foo"))
    (define-method
      (constructor (this <foo>) initargs)
      (set! (slot-value this 'this) (##sys#apply g1 initargs)))))

;;; END OF FILE

Patch follows:

diff bind-translator.scm ../t/bind/bind-translator.scm
720,729c720,721
<        [(('id str) . more)
<         (process-member-field-def name rtype (string->symbol str) cb)
<         (let field-loop ([more more])
<           (match more
<              [(('id str) . more)
<               (process-member-field-def name rtype (string->symbol str) cb)
<               (field-loop more)]
<              [('comma . more) (field-loop more)]
<              [_ (parse-member-body more)])
<           )]
---
>        [(('id str) . (or (('op "=") . _) ()))
>         #f]                ; member variables are ignored
732,744d723
< (define (process-member-field-def name rtype sym cb)
<   (let ([getter (fix-name (string-append (->string name) "-" (->string sym)))])
<     (let ((g (foreign-transformer
<           `(,(rename (if cb 'foreign-safe-lambda* 'foreign-lambda*))
<         ,rtype (((c-pointer ,name) s))
<         (-> s ,sym)) rename))
<       (s (foreign-transformer
<           `(,(rename (if cb 'foreign-safe-lambda* 'foreign-lambda*))
<         ,rtype (((c-pointer ,name) s) (,rtype x))
<         (= (-> s ,sym) x)) rename)))
<       (emit
<        `(,(rename 'define) ,getter (,(rename 'getter-with-setter) ,g ,s))))))
<


-Dan

reply via email to

[Prev in Thread] Current Thread [Next in Thread]