"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)
--
Marco Maggi
