From 4f83a0317c38efaf3dc4168bba23bcb4d9c6ed3d Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sun, 11 Nov 2012 01:21:15 +0100 Subject: [PATCH] In cmpflet.lsp, child-p is now a standalone, non-recursive function --- src/cmp/cmpflet.lsp | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/cmp/cmpflet.lsp b/src/cmp/cmpflet.lsp index b70c2e9ef..80584d2e1 100644 --- a/src/cmp/cmpflet.lsp +++ b/src/cmp/cmpflet.lsp @@ -88,8 +88,16 @@ :args local-funs body-c1form (eq origin 'LABELS)) body-c1form))) +(defun child-function-p (presumed-parent fun) + (declare (si::c-local)) + (loop for real-parent = (fun-parent fun) + while real-parent + do (if (eq real-parent presumed-parent) + (return t) + (setf fun real-parent)))) + (defun compute-fun-closure-type (fun) - (labels + (flet ((closure-type (fun) (let ((closure nil)) ;; it will have a full closure if it refers external non-global variables @@ -101,7 +109,7 @@ (unless closure (setf closure 'LEXICAL))))) ;; ...or if it directly calls a function (dolist (f (fun-referenced-funs fun)) - (unless (child-p fun f) + (unless (child-function-p fun f) ;; .. which has a full closure (case (fun-closure f) (CLOSURE (setf closure 'CLOSURE)) @@ -112,12 +120,7 @@ (and (fun-var fun) (plusp (var-ref (fun-var fun))))) (setf closure 'CLOSURE))) - closure)) - (child-p (presumed-parent fun) - (let ((real-parent (fun-parent fun))) - (when real-parent - (or (eq real-parent presumed-parent) - (child-p real-parent presumed-parent)))))) + closure))) ;; This recursive algorithm is guaranteed to stop when functions ;; do not change. (let ((new-type (closure-type fun))