reduce number of empty quotations generated by fry

diff --git a/basis/fry/fry-tests.factor b/basis/fry/fry-tests.factor
index e3e912993145a5b15c295c521668f630fa6dc318..10d9b282adef77dd86f16b034dfd107385160da1 100644 (file)
--- 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 42518528dc942038f0e04ced60b4b53a660183e9..abcba82205ad3e1e0c141abfcf746281a8d816c1 100644 (file)
--- 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 30336c45e952870a0b24114c3011691e0bc5ba36..a2a1a6c17820ea684203978cdba1e4544b9694fc 100644 (file)
--- 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 ;