[gambit-list] Foreign object printers?

Jason Felice jason.m.felice at gmail.com
Thu Mar 21 09:38:43 EDT 2013


Thanks Marc & Mikael!

I put a not to myself to put this into the first "release" of the objc
bridge, which is coming along swimingly right now since I discovered that
libffi on iOS issues were resolved (and not as bad as I had heard to begin
with).  Deleted a bunch of code, and now it's pretty simple.

-Jason



On Wed, Mar 20, 2013 at 4:09 PM, Mikael <mikael.rcv at gmail.com> wrote:

> Here's a module that delivers this.
>
> Use:
>
> (ffi-write-transformer-add!
>  'name-of-your-ffi-type
>  (lambda (v)
> `(name-of-constructor-procedure-to-create-an-instance-of-this-ffi-type
>                 [ arguments needed to constructor to produce an instance
> exactly like
>                the one in the v variable ])))
>
>
> so you do sth like
>
> (ffi-write-transformer-add!
>  'jasons-2d-coord
>  (lambda (v) `(make-jason-2d-coord ,(jason-2d-coord-x v)
> ,(jason-2d-coord-y v)))
>
>
> REPL interaction now looks like
>
> > (make-jason-2d-coord 10 20)
> #.(make-jason-2d-coord 10 20)
> >
>
>
> (rather than #<foreign jason-2d-coord #x1234567>)
>
> Brgds
>
>
> 2013/3/18 Marc Feeley <feeley at iro.umontreal.ca>
>
>>
>> On 2013-03-17, at 7:25 PM, Jason Felice <jason.m.felice at gmail.com> wrote:
>>
>> > Is there a way to register or implement a printer for a specific
>> foreign type?
>> >
>> > -Jason
>>
>> The Scheme printer (that is used for the implementation of write,
>> display, pretty-print, and print) is bound to the global variable ##wr,
>> which can be assigned.  By redefining ##wr it is possible to intercept the
>> printing of all objects, and to filter out the foreign objects.
>>
>> Here's some sample code.  This approach could be integrated with a macro
>> to define C structs or classes so that a printer for that type is
>> automatically created.
>>
>> Marc
>>
>>
>> (include "~~lib/_gambit#.scm")
>>
>> (define foreign-writers (make-table))
>>
>> (define (write-foreign we obj)
>>   (case (macro-writeenv-style we)
>>     ((mark)
>>      (##wr-mark we obj))
>>     (else
>>      (let ((tags (##foreign-tags obj)))
>>        (if (##pair? tags)
>>            ((table-ref foreign-writers (##car tags) ##wr-foreign) we obj)
>>            (##wr-foreign we obj))))))
>>
>> (let ((old-wr ##wr))
>>   (set! ##wr
>>         (lambda (we obj)
>>           (if (##foreign? obj)
>>               (write-foreign we obj)
>>               (old-wr we obj)))))
>>
>> (c-declare #<<end-of-c-declare
>>
>> #include <stdlib.h>
>>
>> typedef struct { int x, y; } point;
>>
>> point *make_point( int x, int y ) {
>>   point *p = ___CAST(point*, malloc(sizeof(point)));
>>   p->x = x;
>>   p->y = y;
>> }
>>
>> int point_x( point* p ) { return p->x; }
>> int point_y( point* p ) { return p->y; }
>>
>> end-of-c-declare
>> )
>>
>> (c-define-type point "point")
>> (c-define-type point* (pointer point))
>>
>> (define make-point (c-lambda (int int) point* "make_point"))
>> (define point-x (c-lambda (point*) int "point_x"))
>> (define point-y (c-lambda (point*) int "point_y"))
>>
>> (define p (make-point 11 22))
>>
>> (pp p) ;; prints: #<point* #2 0x1006064d0>
>>
>> (table-set!
>>  foreign-writers
>>  'point*
>>  (lambda (we obj)
>>    (##wr-str we "{")
>>    (##wr we (point-x obj))
>>    (##wr-str we ",")
>>    (##wr we (point-y obj))
>>    (##wr-str we "}")))
>>
>> (pp p) ;; prints: {11,22}
>>
>> _______________________________________________
>> Gambit-list mailing list
>> Gambit-list at iro.umontreal.ca
>> https://webmail.iro.umontreal.ca/mailman/listinfo/gambit-list
>>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://webmail.iro.umontreal.ca/pipermail/gambit-list/attachments/20130321/58515344/attachment.html 


More information about the Gambit-list mailing list