On 2012-03-20, at 4:52 PM, Nathan Sorenson wrote:
I see you dispatch via cond:
(define (type-identifier obj) (cond ((number? obj) 'number) ((string? obj) 'string) ((symbol? obj) 'symbol) ((boolean? obj) 'boolean) ((null? obj) 'null) ((pair? obj) 'pair) ((vector? obj) 'vector) ((procedure? obj) 'procedure) (else 'other)))
When I was writing the Clojure->Gambit polymorphic dispatch I reached immediately for case and branched on the numerical value of the type/subtype id assuming I'd get fast constant time dispatch. This cond as you've written would be a linear search, would it not? Or is Gambit able to see that these predicates can be dispatched to in constant time via type tag info?
Yes it would be a linear search. As I said, the code can be optimized in various ways. I wrote it that way so that it would be understandable.
Below is a more efficient version of the procedure type-identifier which uses the ##type and ##subtype low-level primitives (these respectively extract the low tag bits of the reference, and the tag bits in memory allocated objects). For added speed, the procedure type-tag could be used directly (to give a numerical identifier). For multiple dispatch the numerical identifiers could be combined with addition and multiplication to construct a single type signature identifier which indexes a method *vector*. I guess that would work well for 1 and 2 parameter generic functions (beyond that the method vector would be too big to be practical). Moreover, support for user defined types and classes is an added complexity.
Marc
(include "~~lib/_gambit#.scm")
(define (type-identifier obj) (vector-ref type-identifier-vector (type-tag obj)))
(define (type-tag obj) (let ((t (##type obj))) (cond ((fx= t (macro-type-fixnum)) 32) ((fx= t (macro-type-special)) (cond ((null? obj) 33) ((char? obj) 34) ((boolean? obj) 35) (else 36))) (else (##subtype obj)))))
(define type-identifier-vector ;; NOTE: the assignment of tags to types may be different in future versions of Gambit '#(vector pair ratnum cpxnum structure boxvalues meroon jazz symbol keyword frame continuation promise weak procedure return type16 type17 foreign string s8vector u8vector s16vector u16vector s32vector u32vector f32vector s64vector u64vector f64vector flonum bignum fixnum null char boolean other))
(pp (map (lambda (obj) (list obj (type-identifier obj))) (list '#(11 22) '(11 22) 1/2 1+2i (open-input-string "") (box 11) (values 11 22) 'foo foo: (continuation-capture (lambda (k) k)) (delay 10) (make-will (cons 11 22) pp) (lambda (x) x) "hello" (s8vector) (u8vector) (s16vector) (u16vector) (s32vector) (u32vector) (f32vector) (s64vector) (u64vector) (f64vector) 3.14 12345678901234567890 11 '() #\x #t (void))))
;; output: ;; ;; ((#(11 22) vector) ;; ((11 22) pair) ;; (1/2 ratnum) ;; (1+2i cpxnum) ;; (#<input-port #2 (string)> structure) ;; (#&11 boxvalues) ;; (#<unknown> boxvalues) ;; (foo symbol) ;; (foo: keyword) ;; (#<continuation #3> continuation) ;; (#<promise #4> promise) ;; (#<will #5> weak) ;; (#<procedure #6> procedure) ;; ("hello" string) ;; (#s8() s8vector) ;; (#u8() u8vector) ;; (#s16() s16vector) ;; (#u16() u16vector) ;; (#s32() s32vector) ;; (#u32() u32vector) ;; (#f32() f32vector) ;; (#s64() s64vector) ;; (#u64() u64vector) ;; (#f64() f64vector) ;; (3.14 flonum) ;; (12345678901234567890 bignum) ;; (11 fixnum) ;; (() null) ;; (#\x char) ;; (#t boolean) ;; (#!void other))