guile-fslib/list-utils.scm

(library (list-utils)
  (export list-prefix?
          make-multiple-recursive-list-remover
          make-multiple-list-remover
          list-remove-multiple-recursive-equal
          list-remove-multiple-recursive-eqv
          list-remove-multiple-recursive-eq
          list-remove-multiple-equal
          list-remove-multiple-eqv
          list-remove-multiple-eq
          map-to-all-except-last)
  (import
   (except (rnrs base) let-values)
   (only (guile)
         lambda* λ)))


(define list-prefix?
  (λ (lst lst-prefix)
    (cond
     [(null? lst-prefix) #t]
     [(null? lst) #f]
     [else
      (cond
       [(equal? (car lst) (car lst-prefix))
        (list-prefix? (cdr lst) (cdr lst-prefix))]
       [else #f])])))


(define make-multiple-recursive-list-remover
  ;; multirember*-with-equal-proc
  (λ (equal-proc)
    (λ (lst unwanted)
      (let loop ([remaining-list lst])
        (cond
         [(null? remaining-list)
          '()]
         ;; case for finding the unwanted element in the list
         [(equal-proc (car remaining-list) unwanted)
          (loop (cdr remaining-list))]
         ;; case for handling nested lists
         [(pair? (car remaining-list))
          (cons (loop (car remaining-list))
                (loop (cdr remaining-list)))]
         [else
          (cons (car remaining-list)
                (loop (cdr remaining-list)))])))))


(define make-multiple-list-remover
  (λ (equal-proc)
    (λ (lst unwanted)
      (let loop ([remaining-list lst])
        (cond
         [(null? remaining-list)
          '()]
         [(equal-proc (car remaining-list) unwanted)
          (loop (cdr remaining-list))]
         [else
          (cons (car remaining-list)
                (loop (cdr remaining-list)))])))))


(define list-remove-multiple-recursive-equal
  (make-multiple-recursive-list-remover equal?))

(define list-remove-multiple-recursive-eqv
  (make-multiple-recursive-list-remover eqv?))

(define list-remove-multiple-recursive-eq
  (make-multiple-recursive-list-remover eq?))


(define list-remove-multiple-equal
  (make-multiple-list-remover equal?))

(define list-remove-multiple-eqv
  (make-multiple-list-remover eqv?))

(define list-remove-multiple-eq
  (make-multiple-list-remover eq?))


(define map-to-all-except-last
  (λ (proc lst)
    (cond
     [(null? lst) '()]
     [(null? (cdr lst)) lst]
     [else
      (cons (proc (car lst))
            (map-to-all-except-last proc (cdr lst)))])))