summaryrefslogtreecommitdiffstats
path: root/tree.scm
diff options
context:
space:
mode:
authorJames LewisMoss <dres@debian.org>2001-07-27 23:45:29 -0400
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:29 -0800
commitf559c149c83da84d0b1c285f0298c84aec564af9 (patch)
treef1c91bcb9bb5e6dad87b643127c3f878d80d89ee /tree.scm
parentc394920caedf3dac1981bb6b10eeb47fd6e4bb21 (diff)
parent87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (diff)
downloadslib-f559c149c83da84d0b1c285f0298c84aec564af9.tar.gz
slib-f559c149c83da84d0b1c285f0298c84aec564af9.zip
Import Debian changes 2d2-1debian/2d2-1
slib (2d2-1) unstable; urgency=low * New upstream version * Revert back to free. Is now so. slib (2d1-1) unstable; urgency=low * New upstream version. * Move to non-free. FSF pointed out license doesn't allow modified versions to be distributed. * Get a complete list of copyrights that apply to the source into copyright file. * Remove setup for guile 1.3. * Remove postrm. Just calling install-info (lintian) Move install-info call to prerm since doc-base doesn't do install-info. slib (2c9-3) unstable; urgency=low * Change info location to section "The Algorithmic Language Scheme" to match up with where guile puts it's files. * Postinst is running slibconfig now. (Closes: #75891) slib (2c9-2) unstable; urgency=low * Stop installing slibconfig (for guile). * In postinst if /usr/sbin/slibconnfig exists call it (Close: #75843 #75891). slib (2c9-1) unstable; urgency=low * New upstream (Closes: #74760) * replace string-index with strsrch:string-index in http-cgi.scm. * Add doc-base support (Closes: #31163)
Diffstat (limited to 'tree.scm')
-rw-r--r--tree.scm53
1 files changed, 14 insertions, 39 deletions
diff --git a/tree.scm b/tree.scm
index f400d1b..e9bc999 100644
--- a/tree.scm
+++ b/tree.scm
@@ -1,21 +1,7 @@
;;"tree.scm" Implementation of COMMON LISP tree functions for Scheme
-; Copyright 1993, 1994 David Love (d.love@dl.ac.uk)
-;
-;Permission to copy this software, to redistribute it, and to use it
-;for any purpose is granted, subject to the following restrictions and
-;understandings.
-;
-;1. Any copy made of this software must include this copyright notice
-;in full.
-;
-;2. I have made no warrantee or representation that the operation of
-;this software will be error-free, and I am under no obligation to
-;provide any services, by way of maintenance, update, or otherwise.
-;
-;3. In conjunction with products arising from the use of this
-;material, there shall be no use of my name in any advertising,
-;promotional, or sales literature without prior written consent in
-;each case.
+;;; Author: Aubrey Jaffer
+;;;
+;;; This code is in the public domain.
;; Deep copy of the tree -- new one has all new pairs. (Called
;; tree-copy in Dybvig.)
@@ -27,34 +13,23 @@
;; Substitute occurrences of old equal? to new in tree.
;; Similar to tree walks in SICP without the internal define.
-(define (tree:subst new old tree)
- (let walk ((tree tree))
- (cond ((equal? old tree)
- new)
- ((pair? tree)
- (cons (walk (car tree))
- (walk (cdr tree))))
- (else tree))))
+(define (tree:subst new old tree . equ?)
+ (set! equ? (if (null? equ?) equal? (car equ?)))
+ (letrec ((walk (lambda (tree)
+ (cond ((equ? old tree) new)
+ ((pair? tree)
+ (cons (walk (car tree))
+ (walk (cdr tree))))
+ (else tree)))))
+ (walk tree)))
;; The next 2 aren't in CL. (Names from Dybvig)
(define (tree:substq new old tree)
- (let walk ((tree tree))
- (cond ((eq? old tree)
- new)
- ((pair? tree)
- (cons (walk (car tree))
- (walk (cdr tree))))
- (else tree))))
+ (tree:subst new old tree eq?))
(define (tree:substv new old tree)
- (let walk ((tree tree))
- (cond ((eqv? old tree)
- new)
- ((pair? tree)
- (cons (walk (car tree))
- (walk (cdr tree))))
- (else tree))))
+ (tree:subst new old tree eqv?))
(define copy-tree tree:copy-tree)
(define subst tree:subst)