Re: FFI support for disjoint types

[Ludovic Courtès]

Hello!

address@hidden (Ludovic Courtès) writes:

> (define-syntax define-wrapped-pointer-type
>   (lambda (stx)
>     (syntax-case stx ()
>       ((_ pred wrap unwrap print) ;; hygiene
>        (with-syntax ((type-name (datum->syntax #'pred (gensym)))
>                      (%wrap     (datum->syntax #'wrap (gensym))))
>          #'(begin
>              (define-record-type type-name
>                (%wrap pointer)
>                pred
>                (pointer unwrap))
>              (define wrap
>                ;; Use a weak hash table to preserve pointer identity, i.e.,
>                ;; PTR1 == PTR2 <-> (eq? (wrap PTR1) (wrap PTR2)).
>                (let ((ptr->obj (make-weak-value-hash-table)))
>                  (lambda (ptr)
>                    (or (hash-ref ptr->obj ptr)
>                        (let ((o (%wrap ptr)))
>                          (hash-set! ptr->obj ptr o)
>                          o)))))
>              (set-record-type-printer! type-name print))))
>       ((_ type-name print) ;; lazyness
>        (let* ((type-name*  (syntax->datum #'type-name))
>               (pred-name   (datum->syntax #'type-name
>                                           (symbol-append type-name* '?)))
>               (wrap-name   (datum->syntax #'type-name
>                                           (symbol-append 'wrap- type-name*)))
>               (%wrap-name  (datum->syntax #'type-name
>                                           (symbol-append '%wrap- type-name*)))
>               (unwrap-name (datum->syntax #'type-name
>                                           (symbol-append 'unwrap-
>                                                          type-name*))))
>          (with-syntax ((pred   pred-name)
>                        (wrap   wrap-name)
>                        (%wrap  %wrap-name)
>                        (unwrap unwrap-name))
>            #'(define-wrapped-pointer-type pred wrap unwrap print)))))))

I finally added the macro in (system foreign).

People looking for something similar with GOOPS capabilities can roll
their own.

Thanks,
Ludo’.