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@iro.umontreal.ca>

On 2013-03-17, at 7:25 PM, Jason Felice <jason.m.felice@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@iro.umontreal.ca
https://webmail.iro.umontreal.ca/mailman/listinfo/gambit-list