(module list mzscheme
  
  (require
   (lib "etc.ss")
   (lib "list.ss" "srfi" "1")
   (file "base.ss")
   )
  
  (provide
   (all-defined)
   )
  
  (define (list-delimit list delimiter)
    (if (null? list)
        null
        (let loop ([rest list])
          (if (null? (cdr rest))
              (cons (car rest) 
                    null)
              (cons (car rest) 
                    (cons delimiter
                          (loop (cdr rest))))))))
  
  (define char-iota
    (opt-lambda (count [start #\a])
      (let loop ([i 0] [curr (char->integer start)])
        (if (< i count)
            (cons (integer->char curr)
                  (loop (add1 i) (add1 curr)))
            null))))
  
  (define (tree-map fn tree)
    (let loop ([item tree])
      (cond
        [(list? item) (map loop item)]
        [(pair? item) (cons (loop (car item)) (loop (cdr item)))]
        [else (fn item)])))
  
  (define (tree-for-each fn tree)
    (let loop ([item tree])
      (cond
        [(list? item) 
         (for-each loop item)]
        [(pair? item)
         (loop (car item))
         (loop (cdr item))]
        [else 
         (fn item)])))
  
  ;; assoc-value : any1 (list-of (cons any1 any2)) -> any2
  ;;
  ;; Searches for a value by key in a list of key/value pairs
  ;; (an association list). If the key is not found, an exception
  ;; of type exn:list is raised.
  (define (assoc-value key alist)
    (let ([kvp (assoc key alist)])
      (if kvp
          (cdr kvp)
          (raise-exn exn:fail:unlib
            (format "Key ~a not found in ~a.~n" key alist)))))
  
  ;; assoc-value/default : any1 (list-of (cons any1 any2)) any2 -> any2
  ;;
  ;; Searches for a value by key in a list of key/value pairs
  ;; (an association list). If the key is not found, the default
  ;; value is returned instead.
  (define (assoc-value/default key alist default)
    (let ([kvp (assoc key alist)])
      (if kvp
          (cdr kvp)
          default)))

  ;; syntax alist-accessor : (list-of (cons any1 any2)) -> (any1 -> any2)
  ;;
  ;; Creates a procedure that can be used to retrieve a
  ;; value from an association list.
  ;;
  ;; See also: hash-table-accessor in hash-table.ss.
  (define-syntax (alist-accessor stx)
    (syntax-case stx ()
      [(_ alist)
       #'(lambda (key)
           (assoc-value key alist))]))
  
  ;; syntax alist-accessor/default : (list-of (cons any1 any2)) any2 -> (any1 -> any2)
  ;;
  ;; Creates a procedure that can be used to retrieve a
  ;; value from an association list.
  ;;
  ;; See also: hash-table-accessor/default in hash-table.ss.
  (define-syntax (alist-accessor/default stx)
    (syntax-case stx ()
      [(_ alist default)
       #'(lambda (key)
           (assoc-value/default key alist default))]))
  
  ;; alist-set : any1 any2 (list-of (cons any1 any2)) -> (list-of (cons any1 any2))
  ;;
  ;; Sets the value of key in alist. If key is not already in alist,
  ;; a new key/value pair is added to the end. The new list is returned
  (define (alist-set key value alist)
    (let* ([found #f]
           [new-alist
            (map
             (lambda (kvp)
               (if (equal? key (car kvp))
                   (begin
                     (set! found #t)
                     (cons (car kvp) value))
                   kvp))
             alist)])
      (if found
          new-alist
          (cons (cons key value) new-alist))))
  
  ;; syntax alist-mutator : (list-of (cons any1 any2)) -> (any1 any2 -> nothing)
  ;;
  ;; Creates a procedure that can be used to update alist.
  ;;
  ;; See also: hash-table-mutator in hash-table.ss.
  (define-syntax (alist-mutator stx)
    (syntax-case stx ()
      [(_ alist)
       #'(lambda (key val)
           (set! alist (alist-set key val alist)))]))
  
  ;; syntax alist-mutator/append : (list-of (cons any1 (list-of any2))) -> (any1 any2 -> nothing)
  ;;
  ;; Creates a procedure that can be used to update alist.
  ;; Rather than overwriting the values mapped to keys in the
  ;; list, the mutator appends new values to the end of existing
  ;; ones.
  ;;
  ;; See also: hash-table-mutator/append in hash-table.ss.
  (define-syntax (alist-mutator/append stx)
    (syntax-case stx ()
      [(_ alist)
       #'(lambda (key val)
           (let ([curr (assoc-value/default key alist null)])
             (set! alist (alist-set key (append curr (list val)) alist))))]))
  
  ;; alist-map : (any1 any2 -> any3) (list-of (cons any1 any2)) -> (list-of any3)
  ;;
  ;; Applies proc to each pair in alist. Proc must accept two arguments:
  ;; a key and a value. If any element of alist is not a pair, an exception
  ;; is thrown. A list of the results of proc is returned.
  (define (alist-map proc alist)
    (map
     (lambda (kvp)
       (if (pair? kvp)
           (proc (car kvp) (cdr kvp))
           (raise-exn
               exn:fail:unlib
             (format "alist-map: expected a pair: ~a" kvp))))
     alist))
  
  ;; alist-map : (any1 any2 -> any3) (list-of (cons any1 any2)) -> (list-of any3)
  ;;
  ;; Applies proc to each pair in alist for its side effects. Proc must accept
  ;; two arguments: a key and a value. If any element of alist is not a pair,
  ;; an exception is thrown.
  (define (alist-for-each proc alist)
    (for-each
     (lambda (kvp)
       (if (pair? kvp)
           (proc (car kvp) (cdr kvp))
           (raise-exn
               exn:fail:unlib
             (format "alist-for-each: expected a pair: ~a" kvp))))
     alist))
  
  )