[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