Re: Functional record "setters", a different approach

[ludo@gnu.org (Ludovic Courtès)]

Mark H Weaver <mhw@netris.org> skribis:

> +        ((_ check? struct-expr ((getter . rest) expr) ...)
> +         ;;
> +         ;; FIXME: Improve compile-time error reporting:
> +         ;;   1. report an error if any getter-path is a
> +         ;;      prefix of any other getter-path.
> +         ;;   2. report an error if the initial getters
> +         ;;      do not all belong to the same record type.
> +         ;;
> +         ;; forest : (tree ...)
> +         ;;   tree : (getter (rest . expr) ...)
> +         (let ((forest
> +                (fold (lambda (g r e forest)
> +                        (cond ((find (lambda (tree)
> +                                       (free-identifier=? g (car tree)))
> +                                     forest)
> +                               => (lambda (tree)
> +                                    (cons (cons g (cons (cons r e)
> +                                                        (cdr tree)))
> +                                          (delq tree forest))))
> +                              (else (cons (list g (cons r e))
> +                                          forest))))
> +                      '()
> +                      #'(getter ...)
> +                      #'(rest ...)
> +                      #'(expr ...))))

BTW this will need some more comments ;-), and perhaps splitting in
several functions for clarity.  Using SRFI-1 alists and ‘match’ may help
as well.  WDYT?

(I often find myself avoiding occurrences of ‘car’, ‘cdr’ & co. in my
code these days.)

FWIW I was using this approach to represent the tree of accessors:

    (define (field-tree fields)
      ;; Given FIELDS, a list of field-accessor-lists, return a tree
      ;; that groups together FIELDS by prefix.  Example:
      ;;   FIELDS:  ((f1 f2 f3) (f1 f4))
      ;;   RESULT:  ((f1 (f2 (f3)) (f4)))
      (define (insert obj tree)
        (match obj
          ((head tail ...)
           (let ((sub (or (assoc-ref tree head) '())))
             (cons (cons head (insert tail sub))
                   (alist-delete head tree))))
          (()
           tree)))

      (fold-right insert '() fields))

Thanks,
Ludo’.