[armedbear-cvs] r13115 - trunk/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Sat Jan  1 07:07:44 2011
New Revision: 13115

Log:
Add SOME-NESTED-BLOCK function to work with hierarchical block structures.

Modified:
   trunk/abcl/src/org/armedbear/lisp/jvm.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/jvm.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/jvm.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/jvm.lisp	Sat Jan  1 07:07:44 2011
@@ -574,6 +574,14 @@
                (eq name (block-name block)))
       (return block))))
 
+(defun some-nested-block (block predicate)
+  "Applies `predicate` recursively to the children of `block`,
+until predicate returns non-NIL, returning that value."
+  (some #'(lambda (b)
+	    (or (funcall predicate b)
+		(some-nested-block b predicate)))
+	(node-children block)))
+
 (defknown node-constant-p (t) boolean)
 (defun node-constant-p (object)
   (cond ((node-p object)