core: fryable work.

core/fry/fry.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov, Eduardo Cavazos, Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators kernel locals.backend math
+USING: accessors assocs combinators kernel locals.backend
-math.parser quotations sequences sequences.private sets
+locals.parser locals.types math math.parser quotations sequences
-splitting words ;
+sequences.extras sequences.private sets splitting words ;
 IN: fry
 
 TUPLE: fryable quot ;
@@ -158,5 +158,32 @@ M: callable fry ( quot -- quot' )
         ] if
     ] map nip ;
 
+![[
 : fry-to-locals ( quot -- quot' )
-    check-fry mark-composes ;
+    check-fry mark-composes ;
+
+!    [ dup fryable? [ fry-to-lambda ] when ] map
+
+: fry-quotation ( quot -- quot' )
+    ;
+
+: fry-array ( array -- lambda )
+    ;
+
+: fry-anything ( obj -- obj' )
+    dup fryable? [
+        quot>> {
+            { [ dup quotation? [ fry-quotation ] }
+            { [ dup array? ] [ fry-array ] }
+        } cond
+    ] when ;
+
+: fry-to-lambda ( quot -- lambda )
+    [
+        [ fry-specifier? ] count
+        <iota> [ number>string "_" append ] map [ make-locals ] with-compilation-unit
+        drop dup
+    ] keep ! { _ 1 2 3 _ }
+    [ [ \ _ eq? ] find-all keys ] keep
+    set-nths* 1quotation <lambda> [ call ] curry ;
+    ]]

core/locals/fry/fry.factor

@@ -17,9 +17,5 @@ M: lambda fry
 M: let fry
     clone [ fry ] change-body ;
 
-M: fryable condomize? drop t ;
-M: fryable call quot>> call ;
-
 INSTANCE: lambda fried
-INSTANCE: let    fried
+INSTANCE: let    fried
-INSTANCE: fryable fried

core/locals/macros/macros.factor

@@ -15,3 +15,11 @@ M: let expand-macros* expand-macros literal ;
 M: lambda condomize? drop t ;
 
 M: lambda condomize [ call ] curry ;
+
+M: fryable expand-macros clone [ expand-macros ] change-quot ;
+
+M: fryable expand-macros* expand-macros literal ;
+
+M: fryable condomize? drop t ;
+
+M: fryable condomize [ call ] curry ;

core/locals/rewrite/closures/closures.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors fry kernel locals.rewrite.point-free
+USING: accessors arrays fry kernel locals.rewrite.point-free
 locals.rewrite.sugar locals.types macros.expander make
 quotations sequences sets words ;
 IN: locals.rewrite.closures
@@ -56,6 +56,16 @@ M: callable rewrite-closures*
     [ length \ curry <repetition> % ]
     tri ;
 
-M: fryable rewrite-closures* quot>> fry rewrite-closures* \ call , ;
+![[
+! M: fryable rewrite-closures* quot>> fry rewrite-closures* \ call , ;
+M: fryable rewrite-closures*
+    B
+    quot>> [
+        dup array? [ fry-to-lambda ] when
+    ] map
+    fry rewrite-closures* ;
+    ! dup array? [ fry-to-lambda ] [ fry ] if rewrite-closures* ;
+! M: fryable rewrite-closures* quot>> fry % \ call , ;
+]]
 
 M: object rewrite-closures* , ;

core/macros/expander/expander.factor

@@ -91,3 +91,6 @@ M: callable expand-macros*
 
 M: callable expand-macros ( quot -- quot' )
     [ begin [ expand-macros* ] each end ] [ ] make ;
+
+M: array expand-macros ( quot -- quot' )
+    [ begin [ expand-macros* ] each end ] [ ] make ;

core/syntax/syntax.factor

@@ -472,14 +472,14 @@ IN: bootstrap.syntax
 
 
     "q{{" [
-        \ }} parse-until >quotation [ output>array ] curry
+        ! \ }} parse-until >quotation [ output>array ] curry
-        <fryable> suffix! \ call suffix!
+        ! <fryable> suffix!
+        \ }} parse-until >array <fryable> suffix!
     ] define-core-syntax
 
     "{{" [
-        \ }}
+        \ }} parse-until
-        [ >quotation [ output>array ] curry [ call ] curry ]
+        >quotation [ output>array ] curry append!
-        [ parse-until ] dip call append!
     ] define-core-syntax
 
 ] with-compilation-unit

extra/sequences/extras/extras.factor

@@ -482,6 +482,12 @@ PRIVATE>
 : set-nths-unsafe ( value indices seq -- )
     swapd '[ _ swap _ set-nth-unsafe ] each ; inline
 
+: set-nths* ( values indices seq -- seq )
+    -rot [ pick set-nth ] 2each ; inline
+
+: set-nths-unsafe* ( values indices seq -- seq )
+    -rot [ pick set-nth-unsafe ] 2each ; inline
+
 : flatten1 ( obj -- seq )
     [
         [