From 8466d8cfa486fb30d1755c4261b781135083787b Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:29 -0800 Subject: Import Upstream version 3a1 --- tree.scm | 69 +++++++++++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 53 insertions(+), 16 deletions(-) (limited to 'tree.scm') diff --git a/tree.scm b/tree.scm index e9bc999..ae29a52 100644 --- a/tree.scm +++ b/tree.scm @@ -5,15 +5,39 @@ ;; Deep copy of the tree -- new one has all new pairs. (Called ;; tree-copy in Dybvig.) -(define (tree:copy-tree tree) - (if (pair? tree) - (cons (tree:copy-tree (car tree)) - (tree:copy-tree (cdr tree))) - tree)) + +;;@code{(require 'tree)} +;;@ftindex tree +;; +;;These are operations that treat lists a representations of trees. ;; 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 . equ?) + +;; substq and substv aren't in CL. (Names from Dybvig) + +;;@args new old tree +;;@args new old tree equ? +;;@code{subst} makes a copy of @3, substituting @1 for +;;every subtree or leaf of @3 which is @code{equal?} to @2 +;;and returns a modified tree. The original @3 is unchanged, but +;;may share parts with the result. +;; +;;@code{substq} and @code{substv} are similar, but test against @2 +;;using @code{eq?} and @code{eqv?} respectively. If @code{subst} is +;;called with a fourth argument, @var{equ?} is the equality predicate. +;; +;;Examples: +;;@lisp +;;(substq 'tempest 'hurricane '(shakespeare wrote (the hurricane))) +;; @result{} (shakespeare wrote (the tempest)) +;;(substq 'foo '() '(shakespeare wrote (twelfth night))) +;; @result{} (shakespeare wrote (twelfth night . foo) . foo) +;;(subst '(a . cons) '(old . pair) +;; '((old . spice) ((old . shoes) old . pair) (old . pair))) +;; @result{} ((old . spice) ((old . shoes) a . cons) (a . cons)) +;;@end lisp +(define (subst new old tree . equ?) (set! equ? (if (null? equ?) equal? (car equ?))) (letrec ((walk (lambda (tree) (cond ((equ? old tree) new) @@ -22,16 +46,29 @@ (walk (cdr tree)))) (else tree))))) (walk tree))) - -;; The next 2 aren't in CL. (Names from Dybvig) - -(define (tree:substq new old tree) +(define (substq new old tree) (tree:subst new old tree eq?)) - -(define (tree:substv new old tree) +(define (substv new old tree) (tree:subst new old tree eqv?)) -(define copy-tree tree:copy-tree) -(define subst tree:subst) -(define substq tree:substq) -(define substv tree:substv) +;;@body +;;Makes a copy of the nested list structure @1 using new pairs and +;;returns it. All levels are copied, so that none of the pairs in the +;;tree are @code{eq?} to the original ones -- only the leaves are. +;; +;;Example: +;;@lisp +;;(define bar '(bar)) +;;(copy-tree (list bar 'foo)) +;; @result{} ((bar) foo) +;;(eq? bar (car (copy-tree (list bar 'foo)))) +;; @result{} #f +;;@end lisp +(define (copy-tree tree) + (if (pair? tree) + (cons (tree:copy-tree (car tree)) + (tree:copy-tree (cdr tree))) + tree)) + +(define tree:copy-tree copy-tree) +(define tree:subst subst) -- cgit v1.2.3