diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor index 215b677e16..d449c0fc5b 100755 --- a/extra/benchmark/fasta/fasta.factor +++ b/extra/benchmark/fasta/fasta.factor @@ -81,7 +81,7 @@ HINTS: random fixnum ; write-description [let | k! [ 0 ] alu [ ] | [| len | k len alu make-repeat-fasta k! ] split-lines - ] with-locals ; inline + ] ; inline : fasta ( n out -- ) homo-sapiens make-cumulative @@ -103,7 +103,7 @@ HINTS: random fixnum ; drop ] with-file-writer - ] with-locals ; + ] ; : run-fasta 2500000 reverse-complement-in fasta ; diff --git a/extra/locals/locals-docs.factor b/extra/locals/locals-docs.factor index 96485825ff..961017f39e 100644 --- a/extra/locals/locals-docs.factor +++ b/extra/locals/locals-docs.factor @@ -2,15 +2,6 @@ USING: help.syntax help.markup kernel macros prettyprint memoize ; IN: locals - - HELP: [| { $syntax "[| bindings... | body... ]" } { $description "A lambda abstraction. When called, reads stack values into the bindings from left to right; the body may then refer to these bindings." } @@ -22,8 +13,7 @@ HELP: [| "3 5 adder call ." "8" } -} -$with-locals-note ; +} ; HELP: [let { $syntax "[let | binding1 [ value1... ]\n binding2 [ value2... ]\n ... |\n body... ]" } @@ -38,8 +28,7 @@ HELP: [let "6 { 36 14 } frobnicate ." "{ 36 2 }" } -} -$with-locals-note ; +} ; HELP: [let* { $syntax "[let* | binding1 [ value1... ]\n binding2 [ value2... ]\n ... |\n body... ]" } @@ -55,8 +44,7 @@ HELP: [let* "1 { 32 48 } frobnicate ." "{ 2 3 }" } -} -$with-locals-note ; +} ; { POSTPONE: [let POSTPONE: [let* } related-words @@ -75,10 +63,6 @@ HELP: [wlet } } ; -HELP: with-locals -{ $values { "form" "a quotation, lambda, let or wlet form" } { "quot" "a quotation" } } -{ $description "Performs closure conversion of a lexically-scoped form. All nested sub-forms are converted. This word must be applied to a " { $link POSTPONE: [| } ", " { $link POSTPONE: [let } " or " { $link POSTPONE: [wlet } " used in an ordinary definition, however forms in " { $link POSTPONE: :: } " and " { $link POSTPONE: MACRO:: } " definitions are automatically closure-converted and there is no need to use this word." } ; - HELP: :: { $syntax ":: word ( bindings... -- outputs... ) body... ;" } { $description "Defines a word with named inputs; it reads stack values into bindings from left to right, then executes the body with those bindings in lexical scope. Any " { $link POSTPONE: [| } ", " { $link POSTPONE: [let } " or " { $link POSTPONE: [wlet } " forms used in the body of the word definition are automatically closure-converted." } @@ -136,8 +120,6 @@ $nl { $subsection POSTPONE: :: } { $subsection POSTPONE: MEMO:: } { $subsection POSTPONE: MACRO:: } -"Explicit closure conversion outside of applicative word definitions:" -{ $subsection with-locals } "Lexical binding forms:" { $subsection POSTPONE: [let } { $subsection POSTPONE: [let* } diff --git a/extra/locals/locals-tests.factor b/extra/locals/locals-tests.factor index bb2fd9893c..5c3d2005a8 100755 --- a/extra/locals/locals-tests.factor +++ b/extra/locals/locals-tests.factor @@ -1,6 +1,6 @@ USING: locals math sequences tools.test hashtables words kernel namespaces arrays strings prettyprint io.streams.string parser -; +accessors ; IN: locals.tests :: foo ( a b -- a a ) a a ; @@ -55,7 +55,6 @@ IN: locals.tests [ 5 ] [ [let | a [ 3 ] | [wlet | func [ a + ] | 2 func ] ] - with-locals ] unit-test :: wlet-test-2 ( a b -- seq ) @@ -108,7 +107,7 @@ write-test-2 "q" set [ 10 20 ] [ - 20 10 [| a! | [| b! | a b ] ] with-locals call call + 20 10 [| a! | [| b! | a b ] ] call call ] unit-test :: write-test-3 ( a! -- q ) [| b | b a! ] ; @@ -170,16 +169,22 @@ M:: string lambda-generic ( a b -- c ) a b lambda-generic-2 ; [ ] [ \ lambda-generic see ] unit-test +:: unparse-test-1 ( a -- ) [let | a! [ ] | ] ; + [ "[let | a! [ ] | ]" ] [ - [let | a! [ ] | ] unparse + \ unparse-test-1 "lambda" word-prop body>> first unparse ] unit-test +:: unparse-test-2 ( -- ) [wlet | a! [ ] | ] ; + [ "[wlet | a! [ ] | ]" ] [ - [wlet | a! [ ] | ] unparse + \ unparse-test-2 "lambda" word-prop body>> first unparse ] unit-test +:: unparse-test-3 ( -- b ) [| a! | ] ; + [ "[| a! | ]" ] [ - [| a! | ] unparse + \ unparse-test-3 "lambda" word-prop body>> first unparse ] unit-test DEFER: xyzzy @@ -237,3 +242,7 @@ M: integer next-method-test 3 + ; M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ; [ 5 ] [ 1 next-method-test ] unit-test + +: no-with-locals-test { 1 2 3 } [| x | x 3 + ] map ; + +[ { 4 5 6 } ] [ no-with-locals-test ] unit-test diff --git a/extra/locals/locals.factor b/extra/locals/locals.factor index 031348fbe8..4b7ab8cdad 100755 --- a/extra/locals/locals.factor +++ b/extra/locals/locals.factor @@ -201,8 +201,11 @@ M: object local-rewrite* , ; : pop-locals ( assoc -- ) use get delete ; +SYMBOL: in-lambda? + : (parse-lambda) ( assoc end -- quot ) - parse-until >quotation swap pop-locals ; + t in-lambda? [ parse-until ] with-variable + >quotation swap pop-locals ; : parse-lambda ( -- lambda ) "|" parse-tokens make-locals dup push-locals @@ -283,24 +286,24 @@ M: wlet local-rewrite* CREATE-METHOD [ parse-locals-definition ] with-method-definition ; +: parsed-lambda ( form -- ) + in-lambda? get [ parsed ] [ lambda-rewrite over push-all ] if ; + PRIVATE> -: [| parse-lambda parsed ; parsing +: [| parse-lambda parsed-lambda ; parsing : [let scan "|" assert= parse-bindings -\ ] (parse-lambda) parsed ; parsing + \ ] (parse-lambda) parsed-lambda ; parsing : [let* scan "|" assert= parse-bindings* - >r \ ] parse-until >quotation parsed r> pop-locals ; - parsing + \ ] (parse-lambda) parsed-lambda ; parsing : [wlet scan "|" assert= parse-wbindings - \ ] (parse-lambda) parsed ; parsing - -MACRO: with-locals ( form -- quot ) lambda-rewrite ; + \ ] (parse-lambda) parsed-lambda ; parsing : :: (::) define ; parsing diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index 0ee7bf515f..c3252de500 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -324,7 +324,7 @@ M: ebnf-sequence build-locals ( code ast -- code ) ] 2each " | " % % - " ] with-locals" % + " ]" % ] "" make ] if ; @@ -334,7 +334,7 @@ M: ebnf-var build-locals ( code ast -- ) name>> % " [ dup ] " % " | " % % - " ] with-locals" % + " ]" % ] "" make ; M: object build-locals ( code ast -- )