[plt-scheme] An interface wrapper using macros and interface->method-names

On Jun 2, 2004, at 8:54 PM, Matthias Felleisen wrote:

>  For list-related administrative tasks:
>  http://list.cs.brown.edu/mailman/listinfo/plt-scheme
>
>
> On Jun 2, 2004, at 6:05 PM, David Stigant wrote:
>
>> I've been trying to write a macro which will take an interface and 
>> create a class which forwards all calls to the interface's methods on 
>> to another implementation of that interface.  For example, given this 
>> interface:
>>  
>> (define ifoo<%> (interface () foo bar baz))
>
> The above defines ifoo<%> to be a run-time value of kind interface.
>
>>  I want my macro
>>  
>> (wrap ifoo<%>)
>
> This is trying to use a value, which doesn't exist yet, to create a 
> piece of syntax. Once this piece of syntax is compiled and run will 
> produce a value that co-exists with ifoo<%>.
>
>
> You can turn interfaces into quasi-syntactic things and simultaneously 
> create wrappers:
>
> (require-for-syntax (lib "class.ss"))
>
> (define-syntax (define-interface stx)
>   (syntax-case stx ()
>     [(_ iname (super-name ...) name ...)
>      (let ([iname-wraped
>             (datum->syntax-object
>              #'iname
>              (string->symbol
>               (string-append (symbol->string (syntax-e (syntax 
> iname))) "-wrapped")))])
>        #`(define-values (iname #,iname-wraped)
>            (let* ([ii (interface (super-name ...) name ...)]
>                   [cc (class* object% (ii)
>                         (super-new)
>                         (init-field (implementation #f))
>                         (define/public (switch-implementation i)
>                           ;; after some basic checks
>                           (set! implementation i))
>                         (define/public name (lambda (x) (send 
> implementation name x)))
>                         ...)])
>              (values ii cc))))]))
>
> (define-interface ifoo () foo bar baz)
>
> (define mumble (class object% (super-new) (define/public (foo x) 10)))
>
> (define fake (new ifoo-wrapped (implementation (new mumble))))
>
> (send fake foo 22)
>
> ; (send fake moo 33)
>
> NOTE: I don't understand why the class* inside the macro doesn't 
> signal an error for not satisfying the interface.
>


Apologies, it's obvious :-) -- Matthias, old and tired

(require-for-syntax (lib "class.ss"))

(define-syntax (define-interface stx)
   (syntax-case stx ()
     [(_ iname (super-name ...) name ...)
      (let ([iname-wrapped
             (datum->syntax-object
              #'iname
              (string->symbol
               (string-append (symbol->string (syntax-e (syntax iname))) 
"-wrapped")))])
        #`(define-values (iname #,iname-wrapped)
            (let* ([ii (interface (super-name ...) name ...)]
                   [cc (class* object% (ii) (init implementation)
                         (super-new)
                         (define (check-ii> i)
                           (if (and (object? i) (is-a? i ii))
                               i
                               (error '#,iname-wrapped "~e does not 
implement ~s" i iname)))
                         (field (the-implementation (check-ii> 
implementation)))
                         (define/public (switch-implementation i)
                           (set! the-implementation (check-ii> i)))
                         (define/public name (lambda (x) (send 
the-implementation name x)))
                         ...)])
              (values ii cc))))]))

(define-interface ifoo () foo bar baz)

(define mumble (class object% (super-new) (define/public (foo x) 10)))

(define fake (new ifoo-wrapped (implementation (new mumble))))

(send fake foo 22)

(send fake bar 33)