with-locals no longer necessary
parent
9633bda052
commit
26aa656123
|
@ -81,7 +81,7 @@ HINTS: random fixnum ;
|
||||||
write-description
|
write-description
|
||||||
[let | k! [ 0 ] alu [ ] |
|
[let | k! [ 0 ] alu [ ] |
|
||||||
[| len | k len alu make-repeat-fasta k! ] split-lines
|
[| len | k len alu make-repeat-fasta k! ] split-lines
|
||||||
] with-locals ; inline
|
] ; inline
|
||||||
|
|
||||||
: fasta ( n out -- )
|
: fasta ( n out -- )
|
||||||
homo-sapiens make-cumulative
|
homo-sapiens make-cumulative
|
||||||
|
@ -103,7 +103,7 @@ HINTS: random fixnum ;
|
||||||
drop
|
drop
|
||||||
] with-file-writer
|
] with-file-writer
|
||||||
|
|
||||||
] with-locals ;
|
] ;
|
||||||
|
|
||||||
: run-fasta 2500000 reverse-complement-in fasta ;
|
: run-fasta 2500000 reverse-complement-in fasta ;
|
||||||
|
|
||||||
|
|
|
@ -2,15 +2,6 @@ USING: help.syntax help.markup kernel macros prettyprint
|
||||||
memoize ;
|
memoize ;
|
||||||
IN: locals
|
IN: locals
|
||||||
|
|
||||||
<PRIVATE
|
|
||||||
|
|
||||||
: $with-locals-note
|
|
||||||
drop {
|
|
||||||
"This form must appear either in a word defined by " { $link POSTPONE: :: } " or " { $link POSTPONE: MACRO:: } ", or alternatively, " { $link with-locals } " must be called on the top-level form of the word to perform closure conversion."
|
|
||||||
} $notes ;
|
|
||||||
|
|
||||||
PRIVATE>
|
|
||||||
|
|
||||||
HELP: [|
|
HELP: [|
|
||||||
{ $syntax "[| bindings... | body... ]" }
|
{ $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." }
|
{ $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 ."
|
"3 5 adder call ."
|
||||||
"8"
|
"8"
|
||||||
}
|
}
|
||||||
}
|
} ;
|
||||||
$with-locals-note ;
|
|
||||||
|
|
||||||
HELP: [let
|
HELP: [let
|
||||||
{ $syntax "[let | binding1 [ value1... ]\n binding2 [ value2... ]\n ... |\n body... ]" }
|
{ $syntax "[let | binding1 [ value1... ]\n binding2 [ value2... ]\n ... |\n body... ]" }
|
||||||
|
@ -38,8 +28,7 @@ HELP: [let
|
||||||
"6 { 36 14 } frobnicate ."
|
"6 { 36 14 } frobnicate ."
|
||||||
"{ 36 2 }"
|
"{ 36 2 }"
|
||||||
}
|
}
|
||||||
}
|
} ;
|
||||||
$with-locals-note ;
|
|
||||||
|
|
||||||
HELP: [let*
|
HELP: [let*
|
||||||
{ $syntax "[let* | binding1 [ value1... ]\n binding2 [ value2... ]\n ... |\n body... ]" }
|
{ $syntax "[let* | binding1 [ value1... ]\n binding2 [ value2... ]\n ... |\n body... ]" }
|
||||||
|
@ -55,8 +44,7 @@ HELP: [let*
|
||||||
"1 { 32 48 } frobnicate ."
|
"1 { 32 48 } frobnicate ."
|
||||||
"{ 2 3 }"
|
"{ 2 3 }"
|
||||||
}
|
}
|
||||||
}
|
} ;
|
||||||
$with-locals-note ;
|
|
||||||
|
|
||||||
{ POSTPONE: [let POSTPONE: [let* } related-words
|
{ 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: ::
|
HELP: ::
|
||||||
{ $syntax ":: word ( bindings... -- outputs... ) body... ;" }
|
{ $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." }
|
{ $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: :: }
|
||||||
{ $subsection POSTPONE: MEMO:: }
|
{ $subsection POSTPONE: MEMO:: }
|
||||||
{ $subsection POSTPONE: MACRO:: }
|
{ $subsection POSTPONE: MACRO:: }
|
||||||
"Explicit closure conversion outside of applicative word definitions:"
|
|
||||||
{ $subsection with-locals }
|
|
||||||
"Lexical binding forms:"
|
"Lexical binding forms:"
|
||||||
{ $subsection POSTPONE: [let }
|
{ $subsection POSTPONE: [let }
|
||||||
{ $subsection POSTPONE: [let* }
|
{ $subsection POSTPONE: [let* }
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: locals math sequences tools.test hashtables words kernel
|
USING: locals math sequences tools.test hashtables words kernel
|
||||||
namespaces arrays strings prettyprint io.streams.string parser
|
namespaces arrays strings prettyprint io.streams.string parser
|
||||||
;
|
accessors ;
|
||||||
IN: locals.tests
|
IN: locals.tests
|
||||||
|
|
||||||
:: foo ( a b -- a a ) a a ;
|
:: foo ( a b -- a a ) a a ;
|
||||||
|
@ -55,7 +55,6 @@ IN: locals.tests
|
||||||
|
|
||||||
[ 5 ] [
|
[ 5 ] [
|
||||||
[let | a [ 3 ] | [wlet | func [ a + ] | 2 func ] ]
|
[let | a [ 3 ] | [wlet | func [ a + ] | 2 func ] ]
|
||||||
with-locals
|
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
:: wlet-test-2 ( a b -- seq )
|
:: wlet-test-2 ( a b -- seq )
|
||||||
|
@ -108,7 +107,7 @@ write-test-2 "q" set
|
||||||
|
|
||||||
[ 10 20 ]
|
[ 10 20 ]
|
||||||
[
|
[
|
||||||
20 10 [| a! | [| b! | a b ] ] with-locals call call
|
20 10 [| a! | [| b! | a b ] ] call call
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
:: write-test-3 ( a! -- q ) [| b | b a! ] ;
|
:: 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
|
[ ] [ \ lambda-generic see ] unit-test
|
||||||
|
|
||||||
|
:: unparse-test-1 ( a -- ) [let | a! [ ] | ] ;
|
||||||
|
|
||||||
[ "[let | a! [ ] | ]" ] [
|
[ "[let | a! [ ] | ]" ] [
|
||||||
[let | a! [ ] | ] unparse
|
\ unparse-test-1 "lambda" word-prop body>> first unparse
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
:: unparse-test-2 ( -- ) [wlet | a! [ ] | ] ;
|
||||||
|
|
||||||
[ "[wlet | a! [ ] | ]" ] [
|
[ "[wlet | a! [ ] | ]" ] [
|
||||||
[wlet | a! [ ] | ] unparse
|
\ unparse-test-2 "lambda" word-prop body>> first unparse
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
:: unparse-test-3 ( -- b ) [| a! | ] ;
|
||||||
|
|
||||||
[ "[| a! | ]" ] [
|
[ "[| a! | ]" ] [
|
||||||
[| a! | ] unparse
|
\ unparse-test-3 "lambda" word-prop body>> first unparse
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
DEFER: xyzzy
|
DEFER: xyzzy
|
||||||
|
@ -237,3 +242,7 @@ M: integer next-method-test 3 + ;
|
||||||
M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ;
|
M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ;
|
||||||
|
|
||||||
[ 5 ] [ 1 next-method-test ] unit-test
|
[ 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
|
||||||
|
|
|
@ -201,8 +201,11 @@ M: object local-rewrite* , ;
|
||||||
: pop-locals ( assoc -- )
|
: pop-locals ( assoc -- )
|
||||||
use get delete ;
|
use get delete ;
|
||||||
|
|
||||||
|
SYMBOL: in-lambda?
|
||||||
|
|
||||||
: (parse-lambda) ( assoc end -- quot )
|
: (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-lambda ( -- lambda )
|
||||||
"|" parse-tokens make-locals dup push-locals
|
"|" parse-tokens make-locals dup push-locals
|
||||||
|
@ -283,24 +286,24 @@ M: wlet local-rewrite*
|
||||||
CREATE-METHOD
|
CREATE-METHOD
|
||||||
[ parse-locals-definition ] with-method-definition ;
|
[ parse-locals-definition ] with-method-definition ;
|
||||||
|
|
||||||
|
: parsed-lambda ( form -- )
|
||||||
|
in-lambda? get [ parsed ] [ lambda-rewrite over push-all ] if ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: [| parse-lambda parsed ; parsing
|
: [| parse-lambda parsed-lambda ; parsing
|
||||||
|
|
||||||
: [let
|
: [let
|
||||||
scan "|" assert= parse-bindings
|
scan "|" assert= parse-bindings
|
||||||
\ ] (parse-lambda) <let> parsed ; parsing
|
\ ] (parse-lambda) <let> parsed-lambda ; parsing
|
||||||
|
|
||||||
: [let*
|
: [let*
|
||||||
scan "|" assert= parse-bindings*
|
scan "|" assert= parse-bindings*
|
||||||
>r \ ] parse-until >quotation <let*> parsed r> pop-locals ;
|
\ ] (parse-lambda) <let*> parsed-lambda ; parsing
|
||||||
parsing
|
|
||||||
|
|
||||||
: [wlet
|
: [wlet
|
||||||
scan "|" assert= parse-wbindings
|
scan "|" assert= parse-wbindings
|
||||||
\ ] (parse-lambda) <wlet> parsed ; parsing
|
\ ] (parse-lambda) <wlet> parsed-lambda ; parsing
|
||||||
|
|
||||||
MACRO: with-locals ( form -- quot ) lambda-rewrite ;
|
|
||||||
|
|
||||||
: :: (::) define ; parsing
|
: :: (::) define ; parsing
|
||||||
|
|
||||||
|
|
|
@ -324,7 +324,7 @@ M: ebnf-sequence build-locals ( code ast -- code )
|
||||||
] 2each
|
] 2each
|
||||||
" | " %
|
" | " %
|
||||||
%
|
%
|
||||||
" ] with-locals" %
|
" ]" %
|
||||||
] "" make
|
] "" make
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
|
@ -334,7 +334,7 @@ M: ebnf-var build-locals ( code ast -- )
|
||||||
name>> % " [ dup ] " %
|
name>> % " [ dup ] " %
|
||||||
" | " %
|
" | " %
|
||||||
%
|
%
|
||||||
" ] with-locals" %
|
" ]" %
|
||||||
] "" make ;
|
] "" make ;
|
||||||
|
|
||||||
M: object build-locals ( code ast -- )
|
M: object build-locals ( code ast -- )
|
||||||
|
|
Loading…
Reference in New Issue