fantasy-vacation-planner/lib/alist-procs.scm

(library (lib alist-procs)
  (export alist-key-not-found-error-message
          alist-ref
          alist-nested-refs)
  (import (except (rnrs base) let-values map error)
          (only (guile)
                lambda* λ
                current-output-port
                call-with-output-string
                simple-format
                error)
          ;; alist procs
          (srfi srfi-1)
          ;; hash-tablesx
          (srfi srfi-69)))


(define alist-key-not-found-error-message
  (λ (alst key)
    (call-with-output-string
      (λ (string-port)
        (simple-format string-port
                       "could not find key ~s in alist ~a\n"
                       key
                       alst)))))


(define alist-ref
  (lambda* (alst
            key
            #:key
            (equality-test equal?)
            (default (λ ()
                       (error
                        (alist-key-not-found-error-message alst key)))))
    ;; (simple-format (current-output-port) "alist: ~a\n" alst)
    (cond
     [(null? alst) (default)]
     [else
      (let ([current (first alst)])
        (cond
         [(equality-test (first current) key)
          (cdr current)]
         [else
          (alist-ref (cdr alst)
                     key
                     #:equality-test equality-test
                     #:default default)]))])))


(define alist-nested-refs
  (lambda* (alst
            keys
            #:key
            (equality-test equal?)
            (default (λ ()
                       (error
                        (alist-key-not-found-error-message alst keys)))))
    (cond
     [(null? alst) (default)]
     [(null? keys) alst]
     [else
      (let ([current (first alst)] [key (first keys)])
        (cond
         [(equality-test (first current) key)
          (alist-nested-refs (cdr current)
                             (cdr keys)
                             #:equality-test equality-test
                             #:default default)]
         [else
          (alist-nested-refs (cdr alst)
                             keys
                             #:equality-test equality-test
                             #:default default)]))])))


;; (define first-elem-assoc?
;;   (λ (sth)
;;     (or (null? sth)
;;         (and
;;          ;; (not-null? sth)
;;          (pair? sth)
;;          (pair? (first sth))
;;          (not (proper-list? (first sth)))))))


;; (define alist->hash-table*
;;   (λ (alst)
;;     (cond
;;      []
;;      [])))