From 00c8351d5f968b1f0dd5d2c5be387b8b6bd89137 Mon Sep 17 00:00:00 2001 From: stibear Date: Tue, 11 Feb 2014 16:40:59 +0900 Subject: [PATCH] implemented Deleting --- piclib/srfi/1.scm | 39 +++++++++++++++++++++++++++++++++++++-- 1 file changed, 37 insertions(+), 2 deletions(-) diff --git a/piclib/srfi/1.scm b/piclib/srfi/1.scm index a3f7f587..addd8ac1 100644 --- a/piclib/srfi/1.scm +++ b/piclib/srfi/1.scm @@ -367,13 +367,13 @@ (if (null? clists) (let rec ((clist clist) (acc '())) (if (null? clist) - (reverse acc) + (reverse! acc) (rec (cdr clist) (cons (f (car clist)) acc)))) (let rec ((clists (cons clist clists)) (acc '())) (if (every pair? clists) (rec (map cdr clists) (cons* (apply f (map car clists)) acc)) - (reverse acc))))) + (reverse! acc))))) (define (pair-for-each f clist . clists) (if (null? clist) @@ -562,11 +562,46 @@ ;; # Deleting ;; delete delete-duplicates ;; delete! delete-duplicates! + (define (delete x list . =) + (let ((= (if (null? =) equal? (car =)))) + (remove (lambda (a) (= x a)) list))) + + (define (delete! x list . =) + (let ((= (if (null? =) equal? (car =)))) + (remove! (lambda (a) (= x a)) list))) + + (define (delete-duplicates list . =) + (let ((= (if (null? =) equal? (car =)))) + (let rec ((list list)) + (if (null? list) + list + (let* ((x (car list)) + (rest (cdr list)) + (deleted (rec (delete x list =)))) + (if (eq? rest deleted) list (cons x deleted))))))) + + (define (delete-duplicates! list . =) + (let ((= (if (null? =) equal? (car =)))) + (let rec ((list list)) + (if (null? list) + list + (let* ((x (car list)) + (rest (cdr list)) + (deleted (rec (delete! x list =)))) + (if (eq? rest deleted) list (cons x deleted))))))) + + (export delete delete-duplicates + delete! delete-duplicates!) ;; # Association lists ;; assoc assq assv ;; alist-cons alist-copy ;; alist-delete alist-delete! + (define (alist-cons key datum alist) + (cons (cons key datum) alist)) + + (define ) + (export assoc assq assv) ;; # Set operations on lists