Changeset 4366
- Timestamp:
- 10/14/03 16:00:51 (19 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/j/src/org/armedbear/lisp/subst.lisp
r2729 r4366 2 2 ;;; 3 3 ;;; Copyright (C) 2003 Peter Graves 4 ;;; $Id: subst.lisp,v 1. 3 2003-07-02 18:35:33piso Exp $4 ;;; $Id: subst.lisp,v 1.4 2003-10-14 16:00:51 piso Exp $ 5 5 ;;; 6 6 ;;; This program is free software; you can redistribute it and/or … … 29 29 (t (funcall test ,item ,key-tmp)))))) 30 30 31 (defun %subst (new old tree key test testp test-not notp) 32 (cond ((satisfies-the-test old tree) new) 33 ((atom tree) tree) 34 (t (let ((car (%subst new old (car tree) key test testp test-not notp)) 35 (cdr (%subst new old (cdr tree) key test testp test-not notp))) 36 (if (and (eq car (car tree)) 37 (eq cdr (cdr tree))) 38 tree 39 (cons car cdr)))))) 40 31 41 (defun subst (new old tree &key key (test #'eql testp) (test-not nil notp)) 32 (labels ((s (subtree) 33 (cond ((satisfies-the-test old subtree) new) 34 ((atom subtree) subtree) 35 (t (let ((car (s (car subtree))) 36 (cdr (s (cdr subtree)))) 37 (if (and (eq car (car subtree)) 38 (eq cdr (cdr subtree))) 39 subtree 40 (cons car cdr))))))) 41 (s tree))) 42 (%subst new old tree key test testp test-not notp)) 43 44 (defun %subst-if (new test tree key) 45 (cond ((funcall test (apply-key key tree)) new) 46 ((atom tree) tree) 47 (t (let ((car (%subst-if new test (car tree) key)) 48 (cdr (%subst-if new test (cdr tree) key))) 49 (if (and (eq car (car tree)) 50 (eq cdr (cdr tree))) 51 tree 52 (cons car cdr)))))) 42 53 43 54 (defun subst-if (new test tree &key key) 44 (labels ((s (subtree) 45 (cond ((funcall test (apply-key key subtree)) new) 46 ((atom subtree) subtree) 47 (t (let ((car (s (car subtree))) 48 (cdr (s (cdr subtree)))) 49 (if (and (eq car (car subtree)) 50 (eq cdr (cdr subtree))) 51 subtree 52 (cons car cdr))))))) 53 (s tree))) 55 (%subst-if new test tree key)) 56 57 (defun %subst-if-not (new test tree key) 58 (cond ((not (funcall test (apply-key key tree))) new) 59 ((atom tree) tree) 60 (t (let ((car (%subst-if-not new test (car tree) key)) 61 (cdr (%subst-if-not new test (cdr tree) key))) 62 (if (and (eq car (car tree)) 63 (eq cdr (cdr tree))) 64 tree 65 (cons car cdr)))))) 54 66 55 67 (defun subst-if-not (new test tree &key key) 56 (labels ((s (subtree) 57 (cond ((not (funcall test (apply-key key subtree))) new) 58 ((atom subtree) subtree) 59 (t (let ((car (s (car subtree))) 60 (cdr (s (cdr subtree)))) 61 (if (and (eq car (car subtree)) 62 (eq cdr (cdr subtree))) 63 subtree 64 (cons car cdr))))))) 65 (s tree))) 68 (%subst-if-not new test tree key)) 66 69 67 70 (defun nsubst (new old tree &key key (test #'eql testp) (test-not nil notp))
Note: See TracChangeset
for help on using the changeset viewer.