Pretty neat Marco. It worked on a few tricky examples I threw at it. Ed
On Thu, 2010-10-28 at 21:05 +0200, Marco Maggi wrote: > "Eduardo Cavazos" wrote: > > I recently used this to experiment with compile time > > dispatch: > > Mh, what about this (tested on Vicare, Mosh, Petite, > Ypsilon): > > (library (sublib) > (export lookup-identifier-property id-hash $property-tables) > (import (rnrs)) > > (define (id-hash id) > (assert (identifier? id)) > (symbol-hash (syntax->datum id))) > > (define $property-tables > (make-eq-hashtable)) > > (define (lookup-identifier-property subject key) > (assert (identifier? subject)) > (assert (symbol? key)) > (let ((table (hashtable-ref $property-tables key #f))) > (if table > (hashtable-ref table subject #f) > (assertion-violation 'lookup-identifier-property > "unknown property key" key)))) > ) > > (library (lib) > (export define-identifier-property lookup-identifier-property) > (import (rnrs) > (for (sublib) expand)) > > (define-syntax define-identifier-property > (lambda (stx) > (syntax-case stx () > ((_ ?subject ?key ?value) > (begin > (assert (identifier? #'?subject)) > (let ((key (syntax->datum #'?key))) > (assert (symbol? key)) > (let ((table (hashtable-ref $property-tables key #f))) > (unless table > (set! table (make-hashtable id-hash free-identifier=?)) > (hashtable-set! $property-tables key table)) > (hashtable-set! table #'?subject #'?value))) > #'(define dummy)))))) > ) > > ;;; the program > (import (rnrs) (lib)) > > (define-syntax doit > (lambda (stx) > (syntax-case stx () > ((_ ?id) > (begin > (write (syntax->datum (lookup-identifier-property #'?id 'type))) > (newline) > #'(begin #f)))))) > > (define a "ciao") > (define-identifier-property a type int) > (doit a) >
