From decdaf1e32f94a7830b90ae1b5a39c0910ea9a12 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 22 Apr 2008 16:29:20 -0500
Subject: [PATCH] Recursive fry

---
 extra/fry/fry-tests.factor |  4 ++++
 extra/fry/fry.factor       | 39 +++++++++++++++++++++++++-------------
 2 files changed, 30 insertions(+), 13 deletions(-)

diff --git a/extra/fry/fry-tests.factor b/extra/fry/fry-tests.factor
index 4d2c9fe1c8..7586e254b2 100755
--- a/extra/fry/fry-tests.factor
+++ b/extra/fry/fry-tests.factor
@@ -44,3 +44,7 @@ sequences ;
 : funny-dip '[ @ _ ] call ; inline
 
 [ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test
+
+[ { 1 2 3 } ] [
+    3 1 '[ , [ , + ] map ] call
+] unit-test
diff --git a/extra/fry/fry.factor b/extra/fry/fry.factor
index 6c20aac7f2..7621af6899 100755
--- a/extra/fry/fry.factor
+++ b/extra/fry/fry.factor
@@ -9,41 +9,54 @@ IN: fry
 : @ "Only valid inside a fry" throw ;
 : _ "Only valid inside a fry" throw ;
 
-DEFER: (fry)
+DEFER: (shallow-fry)
 
-: ((fry)) ( accum quot adder -- result )
-    >r [ ] swap (fry) r>
+: ((shallow-fry)) ( accum quot adder -- result )
+    >r [ ] swap (shallow-fry) r>
     append swap dup empty? [ drop ] [
         [ swap compose ] curry append
     ] if ; inline
 
-: (fry) ( accum quot -- result )
+: (shallow-fry) ( accum quot -- result )
     dup empty? [
         drop 1quotation
     ] [
         unclip {
-            { \ , [ [ curry ] ((fry)) ] }
-            { \ @ [ [ compose ] ((fry)) ] }
+            { \ , [ [ curry ] ((shallow-fry)) ] }
+            { \ @ [ [ compose ] ((shallow-fry)) ] }
 
             ! to avoid confusion, remove if fry goes core
-            { \ namespaces:, [ [ curry ] ((fry)) ] }
+            { \ namespaces:, [ [ curry ] ((shallow-fry)) ] }
 
-            [ swap >r suffix r> (fry) ]
+            [ swap >r suffix r> (shallow-fry) ]
         } case
     ] if ;
 
-: trivial-fry ( quot -- quot' ) [ ] swap (fry) ;
+: shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ;
 
-: fry ( quot -- quot' )
+: deep-fry ( quot -- quot' )
     { _ } last-split1 [
         [
-            trivial-fry %
+            shallow-fry %
             [ >r ] %
-            fry %
+            deep-fry %
             [ [ dip ] curry r> compose ] %
         ] [ ] make
     ] [
-        trivial-fry
+        shallow-fry
     ] if* ;
 
+: fry ( quot -- quot' )
+    [
+        [
+            dup callable? [
+                [
+                    [ { , namespaces:, @ } member? ] subset length
+                    \ , <repetition> %
+                ]
+                [ deep-fry % ] bi
+            ] [ namespaces:, ] if
+        ] each
+    ] [ ] make deep-fry ;
+
 : '[ \ ] parse-until fry over push-all ; parsing