Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / fry / fry.factor

diff --git a/basis/fry/fry.factor b/basis/fry/fry.factor
index ac036f58ad261ad45cc5b5979d3f3c3d994e73d1..fd029cc329f8c61551ca0149e7ed1b1787398c99 100644 (file)
--- a/basis/fry/fry.factor
+++ b/basis/fry/fry.factor
@@ -25,13 +25,8 @@ M: >r/r>-in-fry-error summary
     "Explicit retain stack manipulation is not permitted in fried quotations" ;
 
 : check-fry ( quot -- quot )
-    dup { >r r> load-locals get-local drop-locals } intersect
-    empty? [ >r/r>-in-fry-error ] unless ;
-
-: shallow-fry ( quot -- quot' )
-    check-fry
-    [ dup \ @ = [ drop [ _ call ] ] [ 1array ] if ] map concat
-    { _ } split [ length 1- [ncurry] ] [ spread>quot ] bi prefix ;
+    dup { load-local load-locals get-local drop-locals } intersect
+    [ >r/r>-in-fry-error ] unless-empty ;
 
 PREDICATE: fry-specifier < word { _ @ } memq? ;
 
@@ -41,15 +36,21 @@ M: callable count-inputs [ count-inputs ] sigma ;
 M: fry-specifier count-inputs drop 1 ;
 M: object count-inputs drop 0 ;
 
+GENERIC: deep-fry ( obj -- )
+
+: shallow-fry ( quot -- quot' curry# )
+    check-fry
+    [ [ deep-fry ] each ] [ ] make
+    [ dup \ @ = [ drop [ _ call ] ] [ 1array ] if ] map concat
+    { _ } split [ spread>quot ] [ length 1 - ] bi ;
+
 PRIVATE>
 
-: fry ( quot -- quot' )
-    [
-        [
-            dup callable? [
-                [ count-inputs \ _ <repetition> % ] [ fry % ] bi
-            ] [ , ] if
-        ] each
-    ] [ ] make shallow-fry ;
+: fry ( quot -- quot' ) shallow-fry [ncurry] swap prefix ;
+
+M: callable deep-fry
+    [ count-inputs \ _ <repetition> % ] [ fry % ] bi ;
+
+M: object deep-fry , ;
 
-: '[ \ ] parse-until fry over push-all ; parsing
+SYNTAX: '[ parse-quotation fry over push-all ;