(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
    ((exact-integer? x) 'exact-integer)
    ((integer? x) 'integer)
    ((rational? x) 'rational)
    ((real? x) 'real)
    ((complex? x) 'complex)
    ((number? x) 'number)
    ((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 (subtypes type)
  (case type
    ((number) '(complex))
    ((complex) '(real))
    ((real) '(rational))
    ((rational) '(integer))
    ((integer) '(exact-integer))
    (else '())))