From cbf2a2131f6f48184a214f649d49f99afdcbd34f Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 7 Nov 2009 14:38:06 -0600
Subject: [PATCH] reduce number of empty quotations generated by fry

---
 basis/fry/fry-tests.factor  |  2 ++
 basis/fry/fry.factor        | 55 ++++++++++++++++++++++++-------------
 basis/locals/fry/fry.factor |  2 +-
 3 files changed, 39 insertions(+), 20 deletions(-)

diff --git a/basis/fry/fry-tests.factor b/basis/fry/fry-tests.factor
index e3e9129931..10d9b282ad 100644
--- a/basis/fry/fry-tests.factor
+++ b/basis/fry/fry-tests.factor
@@ -10,6 +10,8 @@ SYMBOLS: a b c d e f g h ;
 [ [ 1 2 ] ] [ [ 1 ] [ 2 ] '[ @ @ ] ] unit-test
 
 [ [ 1 2 a ] ] [ 1 2 '[ _ _ a ] ] unit-test
+[ [ 1 2 ] ] [ 1 2 '[ _ _ ] ] unit-test
+[ [ a 1 2 ] ] [ 1 2 '[ a _ _ ] ] unit-test
 [ [ 1 2 a ] ] [ [ 1 ] [ 2 ] '[ @ @ a ] ] unit-test
 [ [ 1 a 2 b ] ] [ 1 2 '[ _ a _ b ] ] unit-test
 [ [ 1 a 2 b ] ] [ 1 [ 2 ] '[ _ a @ b ] ] unit-test
diff --git a/basis/fry/fry.factor b/basis/fry/fry.factor
index 42518528dc..abcba82205 100644
--- a/basis/fry/fry.factor
+++ b/basis/fry/fry.factor
@@ -29,30 +29,14 @@ PREDICATE: fried-callable < callable
     count-inputs 0 > ;
 INSTANCE: fried-callable fried
 
-: convert-curry ( quot -- quot' )
-    [ [ [ ] curry compose ] ] [
-        dup first \ @ =
-        [ rest >quotation \ compose \ compose [ ] 3sequence ]
-        [ >quotation \ curry \ compose [ ] 3sequence ] if
-    ] if-empty ;
-
-: convert-curries ( seq -- seq' )
-    unclip-slice [ [ convert-curry ] map ] [ >quotation 1quotation ] bi* prefix ;
-
-: shallow-fry ( quot -- quot' )
-    check-fry
-    [ dup \ @ = [ drop [ _ @ ] ] [ 1quotation ] if ] map concat
-    { _ } split convert-curries
-    spread>quot ;
-
-: [ncurry] ( quot n -- quot )
+: [ncurry] ( n -- quot )
     {
         { 0 [ [ ] ] }
         { 1 [ [ curry ] ] }
         { 2 [ [ 2curry ] ] }
         { 3 [ [ 3curry ] ] }
-        [ \ curry <repetition> ]
-    } case curry ;
+        [ \ curry <repetition> >quotation ]
+    } case ;
 
 : [ndip] ( quot n -- quot' )
     {
@@ -63,6 +47,39 @@ INSTANCE: fried-callable fried
         [ [ \ dip [ ] 2sequence ] times ]
     } case ;
 
+: (make-curry) ( tail quot -- quot' )
+    swap [ncurry] curry [ compose ] compose ;
+
+: make-compose ( consecutive quot -- consecutive quot' )
+    [
+        [ [ ] ]
+        [ [ncurry] ] if-zero
+    ] [
+        [ [ compose ] ]
+        [ [ compose compose ] curry ] if-empty
+    ] bi* compose
+    0 swap ;
+
+: make-curry ( consecutive quot -- consecutive' quot' )
+    [ 1 + ] dip
+    [ [ ] ] [ (make-curry) 0 swap ] if-empty ;
+
+: convert-curry ( consecutive quot -- consecutive' quot' )
+    [ [ ] make-curry ] [
+        dup first \ @ =
+        [ rest >quotation make-compose ]
+        [ >quotation make-curry ] if
+    ] if-empty ;
+
+: convert-curries ( seq -- tail seq' )
+    unclip-slice [ 0 swap [ convert-curry ] map ] [ >quotation 1quotation ] bi* prefix ;
+
+: shallow-fry ( quot -- quot' )
+    check-fry
+    [ dup \ @ = [ drop [ _ @ ] ] [ 1quotation ] if ] map concat
+    { _ } split convert-curries
+    spread>quot swap [ [ ] (make-curry) compose ] unless-zero ;
+
 DEFER: dredge-fry
 
 TUPLE: dredge-fry-state
diff --git a/basis/locals/fry/fry.factor b/basis/locals/fry/fry.factor
index 30336c45e9..a2a1a6c178 100644
--- a/basis/locals/fry/fry.factor
+++ b/basis/locals/fry/fry.factor
@@ -12,7 +12,7 @@ M: lambda count-inputs body>> count-inputs ;
 M: lambda fry
     clone [ [ count-inputs ] [ fry ] bi ] change-body
     [ [ vars>> length ] keep '[ _ _ mnswap _ call ] ]
-    [ drop [ncurry] [ call ] compose ] 2bi ;
+    [ drop [ncurry] curry [ call ] compose ] 2bi ;
 
 M: let fry
     clone [ fry ] change-body ;