Here's a module that delivers this.<div><br></div><div>Use:</div><div><br></div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><font face="courier new, monospace">(ffi-write-transformer-add!</font></div>

<div><font face="courier new, monospace"> 'name-of-your-ffi-type  </font></div><div><font face="courier new, monospace"> (lambda (v) `(name-of-constructor-procedure-to-create-an-instance-of-this-ffi-type</font></div>
<div>
<font face="courier new, monospace">               [ arguments needed to constructor to produce an instance exactly like</font></div><div><font face="courier new, monospace">               the one in the v variable ])))</font></div>

</blockquote><div><div><br></div><div>so you do sth like</div><div><br></div></div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><div><font face="courier new, monospace">(ffi-write-transformer-add!</font></div>

<div><font face="courier new, monospace"> 'jasons-2d-coord</font></div><div><font face="courier new, monospace"> (lambda (v) `(make-jason-2d-coord ,(jason-2d-coord-x v) ,(jason-2d-coord-y v)))</font></div></div></blockquote>

<div><div><br></div><div>REPL interaction now looks like</div><div><br></div></div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><div><font face="courier new, monospace">> (make-jason-2d-coord 10 20)</font></div>

</div><div><div><font face="courier new, monospace">#.(make-jason-2d-coord 10 20)</font></div></div><div><div><font face="courier new, monospace">></font></div></div></blockquote><div><div><br></div><div>(rather than <font face="courier new, monospace">#<foreign jason-2d-coord #x1234567></font>)</div>

<div><br></div><div>Brgds</div><div><br></div><br><div class="gmail_quote">2013/3/18 Marc Feeley <span dir="ltr"><<a href="mailto:feeley@iro.umontreal.ca" target="_blank">feeley@iro.umontreal.ca</a>></span><br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">

<div class="im"><br>
On 2013-03-17, at 7:25 PM, Jason Felice <<a href="mailto:jason.m.felice@gmail.com">jason.m.felice@gmail.com</a>> wrote:<br>
<br>
> Is there a way to register or implement a printer for a specific foreign type?<br>
><br>
> -Jason<br>
<br>
</div>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.<br>


<br>
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.<br>
<br>
Marc<br>
<br>
<br>
(include "~~lib/_gambit#.scm")<br>
<br>
(define foreign-writers (make-table))<br>
<br>
(define (write-foreign we obj)<br>
  (case (macro-writeenv-style we)<br>
    ((mark)<br>
     (##wr-mark we obj))<br>
    (else<br>
     (let ((tags (##foreign-tags obj)))<br>
       (if (##pair? tags)<br>
           ((table-ref foreign-writers (##car tags) ##wr-foreign) we obj)<br>
           (##wr-foreign we obj))))))<br>
<br>
(let ((old-wr ##wr))<br>
  (set! ##wr<br>
        (lambda (we obj)<br>
          (if (##foreign? obj)<br>
              (write-foreign we obj)<br>
              (old-wr we obj)))))<br>
<br>
(c-declare #<<end-of-c-declare<br>
<br>
#include <stdlib.h><br>
<br>
typedef struct { int x, y; } point;<br>
<br>
point *make_point( int x, int y ) {<br>
  point *p = ___CAST(point*, malloc(sizeof(point)));<br>
  p->x = x;<br>
  p->y = y;<br>
}<br>
<br>
int point_x( point* p ) { return p->x; }<br>
int point_y( point* p ) { return p->y; }<br>
<br>
end-of-c-declare<br>
)<br>
<br>
(c-define-type point "point")<br>
(c-define-type point* (pointer point))<br>
<br>
(define make-point (c-lambda (int int) point* "make_point"))<br>
(define point-x (c-lambda (point*) int "point_x"))<br>
(define point-y (c-lambda (point*) int "point_y"))<br>
<br>
(define p (make-point 11 22))<br>
<br>
(pp p) ;; prints: #<point* #2 0x1006064d0><br>
<br>
(table-set!<br>
 foreign-writers<br>
 'point*<br>
 (lambda (we obj)<br>
   (##wr-str we "{")<br>
   (##wr we (point-x obj))<br>
   (##wr-str we ",")<br>
   (##wr we (point-y obj))<br>
   (##wr-str we "}")))<br>
<br>
(pp p) ;; prints: {11,22}<br>
<br>
_______________________________________________<br>
Gambit-list mailing list<br>
<a href="mailto:Gambit-list@iro.umontreal.ca">Gambit-list@iro.umontreal.ca</a><br>
<a href="https://webmail.iro.umontreal.ca/mailman/listinfo/gambit-list" target="_blank">https://webmail.iro.umontreal.ca/mailman/listinfo/gambit-list</a><br>
</blockquote></div><br></div>