diff --git a/core/fry/fry.factor b/core/fry/fry.factor index b71eb120d6..9b0746631b 100644 --- a/core/fry/fry.factor +++ b/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 -math.parser quotations sequences sequences.private sets -splitting words ; +USING: accessors assocs combinators kernel locals.backend +locals.parser locals.types math math.parser quotations sequences +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 ; \ No newline at end of file + 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 + [ number>string "_" append ] map [ make-locals ] with-compilation-unit + drop dup + ] keep ! { _ 1 2 3 _ } + [ [ \ _ eq? ] find-all keys ] keep + set-nths* 1quotation [ call ] curry ; + ]] \ No newline at end of file diff --git a/core/locals/fry/fry.factor b/core/locals/fry/fry.factor index b261b11880..abad49f4ff 100644 --- a/core/locals/fry/fry.factor +++ b/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: fryable fried \ No newline at end of file +INSTANCE: let fried \ No newline at end of file diff --git a/core/locals/macros/macros.factor b/core/locals/macros/macros.factor index 1f9525e5eb..edbd7d2aab 100644 --- a/core/locals/macros/macros.factor +++ b/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 ; \ No newline at end of file diff --git a/core/locals/rewrite/closures/closures.factor b/core/locals/rewrite/closures/closures.factor index 6b0e21a15a..9ab07352fc 100644 --- a/core/locals/rewrite/closures/closures.factor +++ b/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 % ] 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* , ; diff --git a/core/macros/expander/expander.factor b/core/macros/expander/expander.factor index 2c3bbf41e1..b0e7be26d0 100644 --- a/core/macros/expander/expander.factor +++ b/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 ; diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 98b5fe16f6..855a7fefbd 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -463,14 +463,14 @@ IN: bootstrap.syntax "q{{" [ - \ }} parse-until >quotation [ output>array ] curry - suffix! \ call suffix! + ! \ }} parse-until >quotation [ output>array ] curry + ! suffix! + \ }} parse-until >array suffix! ] define-core-syntax "{{" [ - \ }} - [ >quotation [ output>array ] curry [ call ] curry ] - [ parse-until ] dip call append! + \ }} parse-until + >quotation [ output>array ] curry append! ] define-core-syntax ] with-compilation-unit diff --git a/extra/modern/modern-tests.factor b/extra/modern/modern-tests.factor index c0718a81e2..08740d8d8e 100644 --- a/extra/modern/modern-tests.factor +++ b/extra/modern/modern-tests.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2017 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: modern modern.slices multiline tools.test ; +USING: kernel modern modern.out modern.slices multiline +sequences tools.test ; IN: modern.tests { f } [ "" upper-colon? ] unit-test diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index 83455a2af8..2792e69358 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -476,6 +476,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 ) [ [