Am Do., 8. Okt. 2020 um 21:20 Uhr schrieb Marc Nieper-Wißkirchen
<xxxxxx@nieper-wisskirchen.de>:

> For example, one objection against the many exported identifiers of
> the form TYPE-OPERATION (like vector-unfold or generator-map) is the
> duplication of similar identifiers. It would be enough to have general
> "procedures" unfold, map, etc., which takes as their first argument an
> expand-time value that selects the type (at expand-time). E.g.
>
> (map :vector PROC ARG)
>
> or
>
> (unfold :generator STOP? ...)
>
> One would implement (given that R7RS (large) becomes at least as
> expressive as R6RS) map, unfold, etc. as a macro, which checks whether
> the first argument carries a certain SRFI 213 property indicating that
> it specifies a type. If this is the case, the correct procedure is
> selected at expand-time. Otherwise, the first argument is evaluated.
> If it is runtime-type specifier the correct procedure is selected at
> runtime. Otherwise, we fall back to the usual behavior of, say, map or
> unfold.
>
> Finally, we need identifier syntax so that when the keywords map or
> unfold do not appear at head position, they evaluate to a proper
> procedure.

Here is some demonstration code:

;;; test-generics.scm

(import (except (scheme base) map)
        (scheme write)
        (generics))

(define (f x) (* x x))

(display (map f '(1 2 3)))
(newline)
(display (map :vector f #(1 2 3)))
(newline)
(display (let ((m map))
           (m f '(1 2 3))))
(newline)
(display (let ((m map))
           (m :vector f #(1 2 3))))
(newline)

;;; generics.sls

(library (generics)
  (export map :list :vector)
  (import (rename (scheme base) (map list-map))
          (scheme write)
          (srfi :211 syntax-case)
          (%generics))

  (define-syntax map
    (lambda (stx)
      (lambda (lookup)
        (syntax-case stx ()
          ((_ type arg* ...)
           (identifier? #'type)
           (cond
            ((lookup #'type #'type-key)
             => (lambda (name)
                  (case name
                    ((list)
                     #'(list-map arg* ...))
                    ((vector)
                     #'(vector-map arg* ...))
                    (else
                     (syntax-violation
                      'map "unsupported type" stx #'type)))))
            (else
             #'(list-map type arg* ...))))
          ((_ arg* ...)
           #'(list-map arg* ...))
          (_ #'%map))))))

;;; %generics.sls [Intenal library]

(library (%generics)
  (export %map type? type-name :list :vector type-key)
  (import (scheme base)
          (srfi :211 syntax-case)
          (srfi :213))

  (define-record-type <type>
    (make-type name)
    type?
    (name type-name))

  (define :list (make-type 'list))
  (define :vector (make-type 'vector))

  (define-syntax type-key
    (lambda (stx)
      (syntax-violation #f "invalid use of syntax" stx)))

  (define-property :list type-key 'list)
  (define-property :vector type-key 'vector)

  (define (%map type . args)
    (if (type? type)
        (case (type-name type)
          ((list)
           (apply map args))
          ((vector)
           (apply vector-map args))
          (else
           => (lambda (name)
                (error "map: unsupported type" name))))
        (apply map type args))))