Changeset 4366


Ignore:
Timestamp:
10/14/03 16:00:51 (18 years ago)
Author:
piso
Message:

SUBST, SUBST-IF, SUBST-IF-NOT: refactored to get rid of LABELS.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/subst.lisp

    r2729 r4366  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: subst.lisp,v 1.3 2003-07-02 18:35:33 piso Exp $
     4;;; $Id: subst.lisp,v 1.4 2003-10-14 16:00:51 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    2929             (t (funcall test ,item ,key-tmp))))))
    3030
     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
    3141(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))))))
    4253
    4354(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))))))
    5466
    5567(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))
    6669
    6770(defun nsubst (new old tree &key key (test #'eql testp) (test-not nil notp))
Note: See TracChangeset for help on using the changeset viewer.