[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