(define (%make-derived-SAHP desc)
  (let ((proc (lambda (arg1 . arg-rest)
                (call-SAHP desc (type-of arg1) (cons arg1 arg-rest)))))
    (extend-procedure proc desc)))

(define (make-new-SAHP)
  (%make-derived-SAHP
   (make-SAHP-descriptor (make-symbol-mapping)
                         (make-parameter (make-symbol-mapping))
                         (make-hash-table))))

(define (SAHP? x)
  (and (extended-procedure? x)
       (SAHP-descriptor? (extract-SAHP-descriptor x))))

(define extract-SAHP-descriptor procedure-data)

(define (type-of x)
  (cond
    ((fixnum? x) 'fixnum)
    ((bignum? x) 'bignum)
    ((flonum? x) 'flonum)
    ((cplxnum? x) 'cplxnum)
    ((ratnum? x) 'ratnum)
    ((boolean? x) 'boolean)
    ((char? x) 'char)
    ((null? x) 'null)
    ((pair? x) 'pair)
    ((procedure? x) 'procedure)
    ((symbol? x) 'symbol)
    ((bytevector? x) 'bytevector)
    ((eof-object? x) 'eof-object)
    ((port? x) 'port)
    ((string? x) 'string)
    ((vector? x) 'vector)
    ((record-instance? x) (record-instance-type x))
    (else (error "cannot derive type of" x))))

(define all-exact-integers
  '(fixnum bignum))

(define all-exact-rationals
  `(,all-exact-integers ratnum))

(define all-reals
  `(,all-exact-rationals flonum))

(define all-complex
  `(,all-reals cplxnum))

(define all-numbers all-complex)