guile-examples/shell/guile-shell/list-helpers.scm

(library (list-helpers)
  (export remove-consecutive-duplicates
          take-indices
          take-range
          unique)
  (import (except (rnrs base) error)
          (only (guile)
                lambda* λ
                sort)
          ;; lists
          (srfi srfi-1)
          ;; function contracts
          (contract)
          (ice-9 exceptions))


  (define-with-contract remove-consecutive-duplicates
    (require (pair? lst)
             (procedure? eq-test))
    (ensure (pair? <?>))
    (lambda* (lst #:key (eq-test eq?))
      "Remove consecutive duplicates with regards to EQ-TEST from LST."
      (cons (car lst)
            (let iter ([lst° (cdr lst)] [prev (car lst)])
              (cond
               [(null? lst°) '()]
               [(eq-test (car lst°) prev)
                (iter (cdr lst°) prev)]
               [else
                (cons (car lst°)
                      (iter (cdr lst°)
                            (car lst°)))])))))


  (define-with-contract unique
    (require (pair? lst)
             (procedure? less))
    (ensure (pair? lst))
    (lambda* (lst #:key (eq-test eq?) (less <))
      "Return a list of unique elements of LST. Depends on LESS being
suitable to compare elements of LST to sort LST, before duplicates are
removed from it. EQ-TEST can be specified to check, whether elements
are equal."
      (remove-consecutive-duplicates (sort lst less)
                                     #:eq-test eq-test)))


  (define-with-contract take-indices
    (require (>= (car indices) 0)
             (integer? (car indices)))
    (ensure (or (null? <?>)
                (pair? <?>)))
    (λ (lst indices)
      "Take elements at the indices INDICES from LST and return them as a
new list."
      (let iter ([lst° lst]
                 [indices° (unique indices #:eq-test = #:less <)]
                 [index° 0])
        (cond
         [(null? indices°) '()]
         [(= (car indices°) index°)
          (cons (car lst°)
                (iter (cdr lst°)
                      (cdr indices°)
                      (+ index° 1)))]
         [else
          (iter (cdr lst°)
                indices°
                (+ index° 1))]))))


  (define-with-contract take-range
    (require (integer? start)
             (integer? end)
             (>= start 0)
             (<= start end)
             (or (null? lst)
                 (pair? lst)))
    (ensure (or (null? <?>)
                (pair? <?>)))
    (λ (lst start end)
      "Take a range of elements from LST. The range starts at index START
and ends at index END."
      (let iter ([lst° lst] [index° 0])
        (cond
         [(null? lst) '()]
         [(= index° start)
          (guard (con [(eq? (exception-kind con) 'wrong-type-arg)
                       (raise-exception
                        (make-exception
                         (make-exception-with-message "out of bounds index")
                         (make-exception-with-irritants (list lst start end))
                         (make-exception-with-origin 'take-range)))])
            (take lst° (+ (- end start) 1)))]
         [else
          (iter (cdr lst°)
                (+ index° 1))])))))