From 414b602168939c53317c364f6eb3d30fde5a7cca Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Sat, 23 Feb 2019 03:21:00 +0000 Subject: [PATCH] Fix recursion in n-ary append. --- src/runtime/list.scm | 28 +++++++++++++++++++--------- tests/runtime/test-list.scm | 8 ++------ 2 files changed, 21 insertions(+), 15 deletions(-) diff --git a/src/runtime/list.scm b/src/runtime/list.scm index 384c5f133..8ba44ebcc 100644 --- a/src/runtime/list.scm +++ b/src/runtime/list.scm @@ -561,14 +561,19 @@ USA. (make-arity-dispatched-procedure (named-lambda (append self . lists) self - (let recur ((lists lists)) - (if (pair? lists) ; Recursion limited by number of args. - (%append-2 (car lists) (recur (cdr lists))) - '()))) + (if (pair? lists) + (let recur ((lists lists)) + ;; Recursion limited by number of arguments. + (let ((list0 (car lists)) + (lists (cdr lists))) + (if (pair? lists) + (%append-2 list0 (recur lists)) + list0))) + '())) (lambda () '()) (lambda (l) l) %append-2)) - + (define (%append-2! l1 l2) (if (pair? l1) (begin (set-cdr! (last-pair l1) l2) @@ -580,10 +585,15 @@ USA. (make-arity-dispatched-procedure (named-lambda (append! self . lists) self - (let recur ((lists lists)) - (if (pair? lists) ; Recursion limited by number of args. - (%append-2! (car lists) (recur (cdr lists))) - '()))) + (if (pair? lists) + (let recur ((lists lists)) + ;; Recursion limited by number of arguments. + (let ((list0 (car lists)) + (lists (cdr lists))) + (if (pair? lists) + (%append-2! list0 (recur lists)) + list0))) + '())) (lambda () '()) (lambda (l) l) %append-2!)) diff --git a/tests/runtime/test-list.scm b/tests/runtime/test-list.scm index 22120405b..c03819561 100644 --- a/tests/runtime/test-list.scm +++ b/tests/runtime/test-list.scm @@ -40,17 +40,13 @@ USA. (lambda () (assert-equal (append 'x) 'x) (assert-equal (append '(x) 'y) '(x . y)) - (expect-error - (lambda () - (assert-equal (append '(x) '(y) 'z) '(x y . z)))))) + (assert-equal (append '(x) '(y) 'z) '(x y . z)))) (define-test 'append!-dotted (lambda () (assert-equal (append! 'x) 'x) (assert-equal (append! (list 'x) 'y) '(x . y)) - (expect-error - (lambda () - (assert-equal (append! (list 'x) (list 'y) 'z) '(x y . z)))))) + (assert-equal (append! (list 'x) (list 'y) 'z) '(x y . z)))) (define-test 'map-long (lambda () -- 2.25.1