[gambit-list] Generic functions with Gambit
Marc Feeley
feeley at iro.umontreal.ca
Tue Mar 20 18:54:59 EDT 2012
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))
More information about the Gambit-list
mailing list