module/slib/tree.scm

   1 ;;"tree.scm" Implementation of COMMON LISP tree functions for Scheme
   2 ; Copyright 1993, 1994 David Love (d.love@dl.ac.uk)
   3 ;
   4 ;Permission to copy this software, to redistribute it, and to use it
   5 ;for any purpose is granted, subject to the following restrictions and
   6 ;understandings.
   7 ;
   8 ;1.  Any copy made of this software must include this copyright notice
   9 ;in full.
  10 ;
  11 ;2.  I have made no warrantee or representation that the operation of
  12 ;this software will be error-free, and I am under no obligation to
  13 ;provide any services, by way of maintenance, update, or otherwise.
  14 ;
  15 ;3.  In conjunction with products arising from the use of this
  16 ;material, there shall be no use of my name in any advertising,
  17 ;promotional, or sales literature without prior written consent in
  18 ;each case.
  19
  20 ;; Deep copy of the tree -- new one has all new pairs.  (Called
  21 ;; tree-copy in Dybvig.)
  22 (define (tree:copy-tree tree)
  23   (if (pair? tree)
  24       (cons (tree:copy-tree (car tree))
  25             (tree:copy-tree (cdr tree)))
  26       tree))
  27
  28 ;; Substitute occurrences of old equal? to new in tree.
  29 ;; Similar to tree walks in SICP without the internal define.
  30 (define (tree:subst new old tree)
  31   (let walk ((tree tree))
  32     (cond ((equal? old tree)
  33            new)
  34           ((pair? tree)
  35            (cons (walk (car tree))
  36                  (walk (cdr tree))))
  37           (else tree))))
  38
  39 ;; The next 2 aren't in CL.  (Names from Dybvig)
  40
  41 (define (tree:substq new old tree)
  42   (let walk ((tree tree))
  43     (cond ((eq? old tree)
  44            new)
  45           ((pair? tree)
  46            (cons (walk (car tree))
  47                  (walk (cdr tree))))
  48           (else tree))))
  49
  50 (define (tree:substv new old tree)
  51   (let walk ((tree tree))
  52     (cond ((eqv? old tree)
  53            new)
  54           ((pair? tree)
  55            (cons (walk (car tree))
  56                  (walk (cdr tree))))
  57           (else tree))))
  58
  59 (define copy-tree tree:copy-tree)
  60 (define subst tree:subst)
  61 (define substq tree:substq)
  62 (define substv tree:substv)