[gambit-list] Foreign object printers?

Mikael mikael.rcv at gmail.com
Wed Mar 20 16:09:57 EDT 2013


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://mailman.iro.umontreal.ca/pipermail/gambit-list/attachments/20130320/034c4e5b/attachment.htm>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: sexp_ext.scm
Type: application/octet-stream
Size: 4304 bytes
Desc: not available
URL: <http://mailman.iro.umontreal.ca/pipermail/gambit-list/attachments/20130320/034c4e5b/attachment.obj>


More information about the Gambit-list mailing list