From 891bf697719528f622001f96230f353d30e10f59 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 8 Oct 1993 09:03:43 +0000 Subject: [PATCH] Modify RB-TREE->ALIST, RB-TREE/KEY-LIST, and RB-TREE/DATUM-LIST to be iterative rather than recursive. Previously they were recursive with a stack depth proportional to the length of the result; since balanced trees are designed for use with very large collections this was disastrous. --- v7/src/runtime/rbtree.scm | 33 +++++++++++++++++++++++++-------- 1 file changed, 25 insertions(+), 8 deletions(-) diff --git a/v7/src/runtime/rbtree.scm b/v7/src/runtime/rbtree.scm index 392588ca3..557fac073 100644 --- a/v7/src/runtime/rbtree.scm +++ b/v7/src/runtime/rbtree.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: rbtree.scm,v 1.3 1993/10/07 06:03:46 cph Exp $ +$Id: rbtree.scm,v 1.4 1993/10/08 09:03:43 cph Exp $ Copyright (c) 1993 Massachusetts Institute of Technology @@ -319,24 +319,41 @@ MIT in each case. |# (define (rb-tree->alist tree) (guarantee-rb-tree tree 'RB-TREE->ALIST) - (let loop ((node (first-node tree))) + (let ((node (first-node tree))) (if node - (cons (cons (node-key node) (node-datum node)) - (loop (next-node node))) + (let ((result (list (cons (node-key node) (node-datum node))))) + (let loop ((node (next-node node)) (prev result)) + (if node + (let ((pair (list (cons (node-key node) (node-datum node))))) + (set-cdr! prev pair) + (loop (next-node node) pair)))) + result) '()))) (define (rb-tree/key-list tree) (guarantee-rb-tree tree 'RB-TREE/KEY-LIST) - (let loop ((node (first-node tree))) + (let ((node (first-node tree))) (if node - (cons (node-key node) (loop (next-node node))) + (let ((result (list (node-key node)))) + (let loop ((node (next-node node)) (prev result)) + (if node + (let ((pair (list (node-key node)))) + (set-cdr! prev pair) + (loop (next-node node) pair)))) + result) '()))) (define (rb-tree/datum-list tree) (guarantee-rb-tree tree 'RB-TREE/DATUM-LIST) - (let loop ((node (first-node tree))) + (let ((node (first-node tree))) (if node - (cons (node-datum node) (loop (next-node node))) + (let ((result (list (node-datum node)))) + (let loop ((node (next-node node)) (prev result)) + (if node + (let ((pair (list (node-datum node)))) + (set-cdr! prev pair) + (loop (next-node node) pair)))) + result) '()))) (define (first-node tree) -- 2.25.1