diff --git a/big/big-util.scm b/big/big-util.scm index 4f540d7..c01035c 100644 --- a/big/big-util.scm +++ b/big/big-util.scm @@ -170,23 +170,34 @@ (define (delq thing list) (delete (lambda (x) (eq? x thing)) list)) -(define (delete pred in-list) - (let loop ((list in-list) (res '())) - (cond ((null? list) - in-list) - ((pred (car list)) - (append-reverse! res (cdr list))) - (else - (loop (cdr list) (cons (car list) res)))))) - (define (append-reverse! l1 l2) (let loop ((list l1) (res l2)) - (cond ((null? list) - res) - (else - (let ((next (cdr list))) - (set-cdr! list res) - (loop next list)))))) - + (if (pair? list) + (let ((next (cdr list))) + (set-cdr! list res) + (loop next list)) + res))) +;; This DELETE shares the longest tail of L that has no deleted elements. +;; If we had multi-continuation calls, this could be made more efficient. +(define (delete pred l) + (call-with-values (lambda () + ;; (recur l) returns L with (pred x) values deleted. + ;; It also returns a flag NO-DEL? if the returned value + ;; is EQ? to L, i.e. if it didn't delete anything. + (let recur ((l l)) + (if (pair? l) + (let ((x (car l)) + (tl (cdr l))) + (if (pred x) + (call-with-values (lambda () (recur tl)) + (lambda (ans no-del?) + (values ans #f))) ; Deleted X. + (call-with-values (lambda () (recur tl)) + (lambda (ans no-del?) + (if no-del? + (values l #t) + (values (cons x ans) #f)))))) + (values '() #t)))) + (lambda (ans no-del?) ans)))