guile-fslib/list-utils.scm

(define-module (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))


(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)))])))