From 4f8c2d331b77ec9f8836418207e60bd5d969d011 Mon Sep 17 00:00:00 2001 From: Andrea Griffini Date: Wed, 1 May 2013 21:30:09 +0200 Subject: [PATCH] fixed RETURN-FROM for FLET/LABELS and added a test case for correct handling of RETURN-FROM in recursive functions --- src/compiler.lisp | 10 +++++++--- tests/return-from.lisp | 20 ++++++++++++++++++++ 2 files changed, 27 insertions(+), 3 deletions(-) create mode 100644 tests/return-from.lisp diff --git a/src/compiler.lisp b/src/compiler.lisp index 96bd5b6..ada104e 100644 --- a/src/compiler.lisp +++ b/src/compiler.lisp @@ -647,8 +647,11 @@ (define-compilation flet (definitions &rest body) (let* ((fnames (mapcar #'car definitions)) - (fbody (mapcar #'cdr definitions)) - (cfuncs (mapcar #'compile-function-definition fbody)) + (cfuncs (mapcar (lambda (def) + (compile-lambda (cadr def) + `((block ,(car def) + ,@(cddr def))))) + definitions)) (*environment* (extend-lexenv (mapcar #'make-function-binding fnames) *environment* @@ -669,7 +672,8 @@ (js!selfcall (mapconcat (lambda (func) (code "var " (translate-function (car func)) - " = " (compile-lambda (cadr func) (cddr func)) + " = " (compile-lambda (cadr func) + `((block ,(car func) ,@(cddr func)))) ";" *newline*)) definitions) (ls-compile-block body t)))) diff --git a/tests/return-from.lisp b/tests/return-from.lisp new file mode 100644 index 0000000..0d423ff --- /dev/null +++ b/tests/return-from.lisp @@ -0,0 +1,20 @@ +(test (equal (flet ((foo () (return-from foo 42))) + (foo)) + 42)) + +(test (equal (let ((out (list))) + (labels ((zfoo (n rf i) + (if (> n 0) + (progn + (push (lambda () (return-from zfoo n)) rf) + (push n out) + (zfoo (1- n) rf i) + (push (- n) out)) + (progn + (push 999 out) + (funcall (nth i (reverse rf))) + (push -999 out))))) + (let ((rf (list))) + (zfoo 5 rf 3) + out))) + '(-5 -4 -3 999 1 2 3 4 5))) -- 1.7.10.4