remove [let* ] and change [let ] to only establish a scope, leaving :> as the one true way of binding locals
Joe Groff
parent
8f0321a0b1
commit
c4e3c15c28
|
|
@ -9,10 +9,10 @@ M: >r/r>-in-lambda-error summary
|
|||
drop
|
||||
"Explicit retain stack manipulation is not permitted in lambda bodies" ;
|
||||
|
||||
ERROR: binding-form-in-literal-error ;
|
||||
ERROR: let-form-in-literal-error ;
|
||||
|
||||
M: binding-form-in-literal-error summary
|
||||
drop "[let and [let* not permitted inside literals" ;
|
||||
M: let-form-in-literal-error summary
|
||||
drop "[let not permitted inside literals" ;
|
||||
|
||||
ERROR: local-writer-in-literal-error ;
|
||||
|
||||
|
|
@ -27,7 +27,7 @@ M: local-word-in-literal-error summary
|
|||
ERROR: :>-outside-lambda-error ;
|
||||
|
||||
M: :>-outside-lambda-error summary
|
||||
drop ":> cannot be used outside of lambda expressions" ;
|
||||
drop ":> cannot be used outside of [let, [|, or :: forms" ;
|
||||
|
||||
ERROR: bad-local args obj ;
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ IN: locals.fry
|
|||
|
||||
! Support for mixing locals with fry
|
||||
|
||||
M: binding-form count-inputs body>> count-inputs ;
|
||||
M: let count-inputs body>> count-inputs ;
|
||||
|
||||
M: lambda count-inputs body>> count-inputs ;
|
||||
|
||||
|
|
@ -14,5 +14,5 @@ M: lambda deep-fry
|
|||
clone [ shallow-fry swap ] change-body
|
||||
[ [ vars>> length ] keep '[ _ _ mnswap @ ] , ] [ drop [ncurry] % ] 2bi ;
|
||||
|
||||
M: binding-form deep-fry
|
||||
M: let deep-fry
|
||||
clone [ fry '[ @ call ] ] change-body , ;
|
||||
|
|
|
|||
|
|
@ -8,29 +8,26 @@ HELP: [|
|
|||
{ $examples "See " { $link "locals-examples" } "." } ;
|
||||
|
||||
HELP: [let
|
||||
{ $syntax "[let | var-1 [ value-1... ]\n var-2 [ value-2... ]\n ... |\n body... ]" }
|
||||
{ $description "Evaluates each " { $snippet "value-n" } " form and binds its result to a new local variable named " { $snippet "var-n" } " lexically scoped to the " { $snippet "body" } ", then evaluates " { $snippet "body" } ". The " { $snippet "value-n" } " forms are evaluated in parallel, so a " { $snippet "value-n" } " form may not refer to previous " { $snippet "var-n" } " definitions inside the same " { $link POSTPONE: [let } " form, unlike " { $link POSTPONE: [let* } "." }
|
||||
{ $syntax "[let code :> var code :> var code... ]" }
|
||||
{ $description "Establishes a new lexical scope for local variable bindings. Variables bound with " { $link POSTPONE: :> } " within the body of the " { $snippet "[let" } " will be lexically scoped to the body of the " { $snippet "[let" } " form." }
|
||||
{ $examples "See " { $link "locals-examples" } "." } ;
|
||||
|
||||
HELP: [let*
|
||||
{ $syntax "[let* | var-1 [ value-1... ]\n var-2 [ value-2... ]\n ... |\n body... ]" }
|
||||
{ $description "Evaluates each " { $snippet "value-n" } " form and binds its result to a new local variable named " { $snippet "var-n" } " lexically scoped to the " { $snippet "body" } ", then evaluates " { $snippet "body" } ". The " { $snippet "value-n" } " forms are evaluated sequentially, so a " { $snippet "value-n" } " form may refer to previous " { $snippet "var-n" } " definitions inside the same " { $link POSTPONE: [let* } " form." }
|
||||
{ $examples "See " { $link "locals-examples" } "." } ;
|
||||
|
||||
{ POSTPONE: [let POSTPONE: [let* } related-words
|
||||
|
||||
HELP: :>
|
||||
{ $syntax ":> var" ":> var!" }
|
||||
{ $description "Binds the value on the top of the datastack to a new local variable named " { $snippet "var" } ", lexically scoped to the enclosing quotation or definition."
|
||||
$nl
|
||||
"If the " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), the new variable will be mutable. See " { $link "locals-mutable" } " for more information on mutable local bindings." }
|
||||
{ $notes
|
||||
"This syntax can only be used inside a " { $link POSTPONE: :: } " word, " { $link POSTPONE: [let } " or " { $link POSTPONE: [let* } " form, or inside a quotation literal inside one of those forms." }
|
||||
"This syntax can only be used inside a lexical scope established by a " { $link POSTPONE: :: } " definition, " { $link POSTPONE: [let } " form, or " { $link POSTPONE: [| } " quotation. Definition forms such as " { $link POSTPONE: : } " do not establish a lexical scope by themselves, nor is there a lexical scope available at the top level of source files or in the listener. To use local variable bindings in these situations, use " { $link POSTPONE: [let } " to provide a scope for them." }
|
||||
{ $examples "See " { $link "locals-examples" } "." } ;
|
||||
|
||||
{ POSTPONE: [let POSTPONE: :> } related-words
|
||||
|
||||
HELP: ::
|
||||
{ $syntax ":: word ( bindings... -- outputs... ) body... ;" }
|
||||
{ $description "Defines a word with named inputs; it reads datastack values into local variable bindings from left to right, then executes the body with those bindings in lexical scope." }
|
||||
{ $syntax ":: word ( vars... -- outputs... ) body... ;" }
|
||||
{ $description "Defines a word with named inputs; it reads datastack values into local variable bindings from left to right, then executes the body with those bindings in lexical scope."
|
||||
$nl
|
||||
"If any of the " { $snippet "vars" } "' names is followed by an exclamation point (" { $snippet "!" } "), that variable will be mutable. See " { $link "locals-mutable" } " for more information on mutable local bindings." }
|
||||
{ $notes "The names of the " { $snippet "outputs" } " do not affect the word's behavior. However, the compiler verifies that the stack effect accurately represents the number of outputs as with " { $link POSTPONE: : } " definitions." }
|
||||
{ $examples "See " { $link "locals-examples" } "." } ;
|
||||
|
||||
|
|
@ -38,21 +35,27 @@ HELP: ::
|
|||
|
||||
HELP: MACRO::
|
||||
{ $syntax "MACRO:: word ( bindings... -- outputs... ) body... ;" }
|
||||
{ $description "Defines a macro with named inputs; it reads datastack values into local variable bindings from left to right, then executes the body with those bindings in lexical scope." }
|
||||
{ $description "Defines a macro with named inputs; it reads datastack values into local variable bindings from left to right, then executes the body with those bindings in lexical scope."
|
||||
$nl
|
||||
"If any of the " { $snippet "vars" } "' names is followed by an exclamation point (" { $snippet "!" } "), that variable will be mutable. See " { $link "locals-mutable" } " for more information on mutable local bindings." }
|
||||
{ $examples "See " { $link "locals-examples" } "." } ;
|
||||
|
||||
{ POSTPONE: MACRO: POSTPONE: MACRO:: } related-words
|
||||
|
||||
HELP: MEMO::
|
||||
{ $syntax "MEMO:: word ( bindings... -- outputs... ) body... ;" }
|
||||
{ $description "Defines a macro with named inputs; it reads datastack values into local variable bindings from left to right, then executes the body with those bindings in lexical scope." }
|
||||
{ $description "Defines a memoized word with named inputs; it reads datastack values into local variable bindings from left to right, then executes the body with those bindings in lexical scope."
|
||||
$nl
|
||||
"If any of the " { $snippet "vars" } "' names is followed by an exclamation point (" { $snippet "!" } "), that variable will be mutable. See " { $link "locals-mutable" } " for more information on mutable local bindings." }
|
||||
{ $examples "See " { $link "locals-examples" } "." } ;
|
||||
|
||||
{ POSTPONE: MEMO: POSTPONE: MEMO:: } related-words
|
||||
|
||||
HELP: M::
|
||||
{ $syntax "M:: class generic ( bindings... -- outputs... ) body... ;" }
|
||||
{ $description "Defines a macro with named inputs; it reads datastack values into local variable bindings from left to right, then executes the body with those bindings in lexical scope." }
|
||||
{ $description "Defines a new method on " { $snippet "generic" } " for " { $snippet "class" } " with named inputs; it reads datastack values into local variable bindings from left to right, then executes the body with those bindings in lexical scope."
|
||||
$nl
|
||||
"If any of the " { $snippet "vars" } "' names is followed by an exclamation point (" { $snippet "!" } "), that variable will be mutable. See " { $link "locals-mutable" } " for more information on mutable local bindings." }
|
||||
{ $notes "The names of the " { $snippet "outputs" } " do not affect the word's behavior. However, the compiler verifies that the stack effect accurately represents the number of outputs as with " { $link POSTPONE: M: } " definitions." }
|
||||
{ $examples "See " { $link "locals-examples" } "." } ;
|
||||
|
||||
|
|
@ -70,14 +73,13 @@ IN: scratchpad
|
|||
"""2.0
|
||||
-3.0"""
|
||||
}
|
||||
{ $snippet "quadratic-roots" } " can also be expressed with " { $link POSTPONE: [let } ":"
|
||||
"If you wanted to perform the quadratic formula interactively from the listener, you could use " { $link POSTPONE: [let } " to provide a scope for the local variables:"
|
||||
{ $example """USING: locals math math.functions kernel ;
|
||||
IN: scratchpad
|
||||
:: quadratic-roots ( a b c -- x y )
|
||||
[let | disc [ b sq 4 a c * * - sqrt ] |
|
||||
b neg disc [ + ] [ - ] 2bi [ 2 a * / ] bi@
|
||||
] ;
|
||||
1.0 1.0 -6.0 quadratic-roots [ . ] bi@"""
|
||||
[let 1.0 :> a 1.0 :> b -6.0 :> c
|
||||
b sq 4 a c * * - sqrt :> disc
|
||||
b neg disc [ + ] [ - ] 2bi [ 2 a * / ] bi@
|
||||
] [ . ] bi@"""
|
||||
"""2.0
|
||||
-3.0"""
|
||||
}
|
||||
|
|
@ -200,11 +202,11 @@ $nl
|
|||
"One exception to the above rule is that array instances containing free local variables (that is, immutable local variables not referenced in a closure) do retain identity. This allows macros such as " { $link cond } " to recognize that the array is constant and expand at compile time." ;
|
||||
|
||||
ARTICLE: "locals-mutable" "Mutable locals"
|
||||
"In the list of bindings supplied to " { $link POSTPONE: :: } ", " { $link POSTPONE: [let } ", " { $link POSTPONE: [let* } " or " { $link POSTPONE: [| } ", a mutable binding may be introduced by suffixing its named with " { $snippet "!" } ". Mutable bindings are read by giving their name as usual; the suffix is not part of the binding's name. To write to a mutable binding, use the binding's name with the " { $snippet "!" } " suffix."
|
||||
"Whenever a local variable is bound using " { $link POSTPONE: :> } ", " { $link POSTPONE: :: } ", or " { $link POSTPONE: [| } ", the variable may be made mutable by suffixing its name with an exclamation point (" { $snippet "!" } ") when it is bound. The variable's value can be read by giving its name without the exclamation point as usual. To write to the variable, use its name with the " { $snippet "!" } " suffix."
|
||||
$nl
|
||||
"Mutable bindings are implemented in a manner similar to the ML language; each mutable binding is actually an immutable binding of a mutable cell (in Factor's case, a 1-element array); reading the binding automatically dereferences the array, and writing to the binding stores into the array."
|
||||
$nl
|
||||
"Writing to mutable locals in outer scopes is fully supported and has the expected semantics. See " { $link "locals-examples" } " for examples of mutable local variables in action." ;
|
||||
"Writing to mutable locals in outer scopes is fully supported and has full closure semantics. See " { $link "locals-examples" } " for examples of mutable local variables in action." ;
|
||||
|
||||
ARTICLE: "locals-fry" "Locals and fry"
|
||||
"Locals integrate with " { $link "fry" } " so that mixing locals with fried quotations gives intuitive results."
|
||||
|
|
@ -280,11 +282,10 @@ ARTICLE: "locals" "Lexical variables and closures"
|
|||
POSTPONE: MEMO::
|
||||
POSTPONE: MACRO::
|
||||
}
|
||||
"Lexical binding forms:"
|
||||
"Lexical scoping and binding forms:"
|
||||
{ $subsections
|
||||
POSTPONE: :>
|
||||
POSTPONE: [let
|
||||
POSTPONE: [let*
|
||||
POSTPONE: :>
|
||||
}
|
||||
"Quotation literals where the inputs are named local variables:"
|
||||
{ $subsections POSTPONE: [| }
|
||||
|
|
|
|||
|
|
@ -26,30 +26,30 @@ IN: locals.tests
|
|||
[ { 5 6 7 } ] [ { 1 2 3 } 4 map-test-2 ] unit-test
|
||||
|
||||
:: let-test ( c -- d )
|
||||
[let | a [ 1 ] b [ 2 ] | a b + c + ] ;
|
||||
[let 1 :> a 2 :> b a b + c + ] ;
|
||||
|
||||
[ 7 ] [ 4 let-test ] unit-test
|
||||
|
||||
:: let-test-2 ( a -- a )
|
||||
a [let | a [ ] | [let | b [ a ] | a ] ] ;
|
||||
a [let :> a [let a :> b a ] ] ;
|
||||
|
||||
[ 3 ] [ 3 let-test-2 ] unit-test
|
||||
|
||||
:: let-test-3 ( a -- a )
|
||||
a [let | a [ ] | [let | b [ [ a ] ] | [let | a [ 3 ] | b ] ] ] ;
|
||||
a [let :> a [let [ a ] :> b [let 3 :> a b ] ] ] ;
|
||||
|
||||
:: let-test-4 ( a -- b )
|
||||
a [let | a [ 1 ] b [ ] | a b 2array ] ;
|
||||
a [let 1 :> a :> b a b 2array ] ;
|
||||
|
||||
[ { 1 2 } ] [ 2 let-test-4 ] unit-test
|
||||
|
||||
:: let-test-5 ( a b -- b )
|
||||
a b [let | a [ ] b [ ] | a b 2array ] ;
|
||||
a b [let :> a :> b a b 2array ] ;
|
||||
|
||||
[ { 2 1 } ] [ 1 2 let-test-5 ] unit-test
|
||||
|
||||
:: let-test-6 ( a -- b )
|
||||
a [let | a [ ] b [ 1 ] | a b 2array ] ;
|
||||
a [let :> a 1 :> b a b 2array ] ;
|
||||
|
||||
[ { 2 1 } ] [ 2 let-test-6 ] unit-test
|
||||
|
||||
|
|
@ -71,8 +71,7 @@ IN: locals.tests
|
|||
[ 5 ] [ 2 "q" get call ] unit-test
|
||||
|
||||
:: write-test-2 ( -- q )
|
||||
[let | n! [ 0 ] |
|
||||
[| i | n i + dup n! ] ] ;
|
||||
[let 0 :> n! [| i | n i + dup n! ] ] ;
|
||||
|
||||
write-test-2 "q" set
|
||||
|
||||
|
|
@ -93,11 +92,11 @@ write-test-2 "q" set
|
|||
|
||||
[ ] [ 1 2 write-test-3 call ] unit-test
|
||||
|
||||
:: write-test-4 ( x! -- q ) [ [let | y! [ 0 ] | f x! ] ] ;
|
||||
:: write-test-4 ( x! -- q ) [ [let 0 :> y! f x! ] ] ;
|
||||
|
||||
[ ] [ 5 write-test-4 drop ] unit-test
|
||||
|
||||
:: let-let-test ( n -- n ) [let | n [ n 3 + ] | n ] ;
|
||||
:: let-let-test ( n -- n ) [let n 3 + :> n n ] ;
|
||||
|
||||
[ 13 ] [ 10 let-let-test ] unit-test
|
||||
|
||||
|
|
@ -135,9 +134,9 @@ M:: string lambda-generic ( a b -- c ) a b lambda-generic-2 ;
|
|||
|
||||
[ ] [ \ lambda-generic see ] unit-test
|
||||
|
||||
:: unparse-test-1 ( a -- ) [let | a! [ 3 ] | ] ;
|
||||
:: unparse-test-1 ( a -- ) [let 3 :> a! 4 :> b ] ;
|
||||
|
||||
[ "[let | a! [ 3 ] | ]" ] [
|
||||
[ "[let 3 :> a! 4 :> b ]" ] [
|
||||
\ unparse-test-1 "lambda" word-prop body>> first unparse
|
||||
] unit-test
|
||||
|
||||
|
|
@ -163,38 +162,6 @@ DEFER: xyzzy
|
|||
|
||||
[ 5 ] [ 10 xyzzy ] unit-test
|
||||
|
||||
:: let*-test-1 ( a -- b )
|
||||
[let* | b [ a 1 + ]
|
||||
c [ b 1 + ] |
|
||||
a b c 3array ] ;
|
||||
|
||||
[ { 1 2 3 } ] [ 1 let*-test-1 ] unit-test
|
||||
|
||||
:: let*-test-2 ( a -- b )
|
||||
[let* | b [ a 1 + ]
|
||||
c! [ b 1 + ] |
|
||||
a b c 3array ] ;
|
||||
|
||||
[ { 1 2 3 } ] [ 1 let*-test-2 ] unit-test
|
||||
|
||||
:: let*-test-3 ( a -- b )
|
||||
[let* | b [ a 1 + ]
|
||||
c! [ b 1 + ] |
|
||||
c 1 + c! a b c 3array ] ;
|
||||
|
||||
[ { 1 2 4 } ] [ 1 let*-test-3 ] unit-test
|
||||
|
||||
:: let*-test-4 ( a b -- c d )
|
||||
[let | a [ b ]
|
||||
b [ a ] |
|
||||
[let* | a' [ a ]
|
||||
a'' [ a' ]
|
||||
b' [ b ]
|
||||
b'' [ b' ] |
|
||||
a'' b'' ] ] ;
|
||||
|
||||
[ "xxx" "yyy" ] [ "yyy" "xxx" let*-test-4 ] unit-test
|
||||
|
||||
GENERIC: next-method-test ( a -- b )
|
||||
|
||||
M: integer next-method-test 3 + ;
|
||||
|
|
@ -209,11 +176,11 @@ M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ;
|
|||
|
||||
{ 3 0 } [| a b c | ] must-infer-as
|
||||
|
||||
[ ] [ 1 [let | a [ ] | ] ] unit-test
|
||||
[ ] [ 1 [let :> a ] ] unit-test
|
||||
|
||||
[ 3 ] [ 1 [let | a [ ] | 3 ] ] unit-test
|
||||
[ 3 ] [ 1 [let :> a 3 ] ] unit-test
|
||||
|
||||
[ ] [ 1 2 [let | a [ ] b [ ] | ] ] unit-test
|
||||
[ ] [ 1 2 [let :> a :> b ] ] unit-test
|
||||
|
||||
:: a-word-with-locals ( a b -- ) ;
|
||||
|
||||
|
|
@ -271,10 +238,10 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
|
|||
[ t ] [ 12 &&-test ] unit-test
|
||||
|
||||
:: let-and-cond-test-1 ( -- a )
|
||||
[let | a [ 10 ] |
|
||||
[let | a [ 20 ] |
|
||||
[let 10 :> a
|
||||
[let 20 :> a
|
||||
{
|
||||
{ [ t ] [ [let | c [ 30 ] | a ] ] }
|
||||
{ [ t ] [ [let 30 :> c a ] ] }
|
||||
} cond
|
||||
]
|
||||
] ;
|
||||
|
|
@ -284,8 +251,8 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
|
|||
[ 20 ] [ let-and-cond-test-1 ] unit-test
|
||||
|
||||
:: let-and-cond-test-2 ( -- pair )
|
||||
[let | A [ 10 ] |
|
||||
[let | B [ 20 ] |
|
||||
[let 10 :> A
|
||||
[let 20 :> B
|
||||
{ { [ t ] [ { A B } ] } } cond
|
||||
]
|
||||
] ;
|
||||
|
|
@ -298,7 +265,7 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
|
|||
[ { 10 20 } ] [ 10 20 [| a b | { a b } ] call ] unit-test
|
||||
[ { 10 20 30 } ] [ 10 20 30 [| a b c | { a b c } ] call ] unit-test
|
||||
|
||||
[ { 10 20 30 } ] [ [let | a [ 10 ] b [ 20 ] c [ 30 ] | { a b c } ] ] unit-test
|
||||
[ { 10 20 30 } ] [ [let 10 :> a 20 :> b 30 :> c { a b c } ] ] unit-test
|
||||
|
||||
[ V{ 10 20 30 } ] [ 10 20 30 [| a b c | V{ a b c } ] call ] unit-test
|
||||
|
||||
|
|
@ -418,7 +385,7 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
|
|||
[ 10 ] [ 10 [| A | { [ A ] } ] call first call ] unit-test
|
||||
|
||||
[
|
||||
"USING: locals fry math ; 1 '[ [let | A [ 10 ] | A _ + ] ]"
|
||||
"USING: locals fry math ; 1 '[ [let 10 :> A A _ + ] ]"
|
||||
eval( -- ) call
|
||||
] [ error>> >r/r>-in-fry-error? ] must-fail-with
|
||||
|
||||
|
|
@ -430,10 +397,7 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
|
|||
[ t ] [ 3 funny-macro-test ] unit-test
|
||||
[ f ] [ 2 funny-macro-test ] unit-test
|
||||
|
||||
! Some odd parser corner cases
|
||||
[ "USE: locals [let" eval( -- ) ] [ error>> unexpected-eof? ] must-fail-with
|
||||
[ "USE: locals [let |" eval( -- ) ] [ error>> unexpected-eof? ] must-fail-with
|
||||
[ "USE: locals [let | a" eval( -- ) ] [ error>> unexpected-eof? ] must-fail-with
|
||||
[ "USE: locals [|" eval( -- ) ] [ error>> unexpected-eof? ] must-fail-with
|
||||
|
||||
[ 25 ] [ 5 [| a | { [ a sq ] } cond ] call ] unit-test
|
||||
|
|
@ -449,11 +413,9 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
|
|||
|
||||
[ 3 ] [ 3 [| a | \ a ] call ] unit-test
|
||||
|
||||
[ "USE: locals [| | { [let | a [ 0 ] | a ] } ]" eval( -- ) ] must-fail
|
||||
[ "USE: locals [| | { [let 0 :> a a ] } ]" eval( -- ) ] must-fail
|
||||
|
||||
[ "USE: locals [| | { [let* | a [ 0 ] | a ] } ]" eval( -- ) ] must-fail
|
||||
|
||||
[ "USE: locals [| | [let | a! [ 0 ] | { a! } ] ]" eval( -- ) ] must-fail
|
||||
[ "USE: locals [| | [let 0 :> a! { a! } ] ]" eval( -- ) ] must-fail
|
||||
|
||||
[ "USE: locals [| | { :> a } ]" eval( -- ) ] must-fail
|
||||
|
||||
|
|
@ -466,13 +428,13 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
|
|||
[ 3 ] [ 2 [| | :> a! a 1 + a! a ] call ] unit-test
|
||||
|
||||
: fry-locals-test-1 ( -- n )
|
||||
[let | | 6 '[ [let | A [ 4 ] | A _ + ] ] call ] ;
|
||||
[let 6 '[ [let 4 :> A A _ + ] ] call ] ;
|
||||
|
||||
\ fry-locals-test-1 def>> must-infer
|
||||
[ 10 ] [ fry-locals-test-1 ] unit-test
|
||||
|
||||
:: fry-locals-test-2 ( -- n )
|
||||
[let | | 6 '[ [let | A [ 4 ] | A _ + ] ] call ] ;
|
||||
[let 6 '[ [let 4 :> A A _ + ] ] call ] ;
|
||||
|
||||
\ fry-locals-test-2 def>> must-infer
|
||||
[ 10 ] [ fry-locals-test-2 ] unit-test
|
||||
|
|
@ -490,18 +452,18 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
|
|||
] unit-test
|
||||
|
||||
[ 10 ] [
|
||||
[| | 0 '[ [let | A [ 10 ] | A _ + ] ] call ] call
|
||||
[| | 0 '[ [let 10 :> A A _ + ] ] call ] call
|
||||
] unit-test
|
||||
|
||||
! littledan found this problem
|
||||
[ "bar" ] [ [let | a [ [let | foo [ "bar" ] | foo ] ] | a ] ] unit-test
|
||||
[ 10 ] [ [let | a [ 10 ] | [let | b [ a ] | b ] ] ] unit-test
|
||||
[ "bar" ] [ [let [let "bar" :> foo foo ] :> a a ] ] unit-test
|
||||
[ 10 ] [ [let 10 :> a [let a :> b b ] ] ] unit-test
|
||||
|
||||
[ { \ + } ] [ [let | x [ \ + ] | { \ x } ] ] unit-test
|
||||
[ { \ + } ] [ [let \ + :> x { \ x } ] ] unit-test
|
||||
|
||||
[ { \ + 3 } ] [ [let | a [ 3 ] | { \ + a } ] ] unit-test
|
||||
[ { \ + 3 } ] [ [let 3 :> a { \ + a } ] ] unit-test
|
||||
|
||||
[ 3 ] [ [let | a [ \ + ] | 1 2 [ \ a execute ] ] call ] unit-test
|
||||
[ 3 ] [ [let \ + :> a 1 2 [ \ a execute ] ] call ] unit-test
|
||||
|
||||
! erg found this problem
|
||||
:: erg's-:>-bug ( n ? -- n ) ? [ n :> n n ] [ n :> b b ] if ;
|
||||
|
|
|
|||
|
|
@ -13,8 +13,6 @@ SYNTAX: [| parse-lambda over push-all ;
|
|||
|
||||
SYNTAX: [let parse-let over push-all ;
|
||||
|
||||
SYNTAX: [let* parse-let* over push-all ;
|
||||
|
||||
SYNTAX: :: (::) define-declared ;
|
||||
|
||||
SYNTAX: M:: (M::) define ;
|
||||
|
|
|
|||
|
|
@ -7,13 +7,11 @@ M: lambda expand-macros clone [ expand-macros ] change-body ;
|
|||
|
||||
M: lambda expand-macros* expand-macros literal ;
|
||||
|
||||
M: binding-form expand-macros
|
||||
clone
|
||||
[ [ expand-macros ] assoc-map ] change-bindings
|
||||
[ expand-macros ] change-body ;
|
||||
M: let expand-macros
|
||||
clone [ expand-macros ] change-body ;
|
||||
|
||||
M: binding-form expand-macros* expand-macros literal ;
|
||||
M: let expand-macros* expand-macros literal ;
|
||||
|
||||
M: lambda condomize? drop t ;
|
||||
|
||||
M: lambda condomize '[ @ ] ;
|
||||
M: lambda condomize '[ @ ] ;
|
||||
|
|
|
|||
|
|
@ -56,35 +56,8 @@ M: lambda-parser parse-quotation ( -- quotation )
|
|||
[ nip scan-object 2array ]
|
||||
} cond ;
|
||||
|
||||
: (parse-bindings) ( end -- )
|
||||
dup parse-binding dup [
|
||||
first2 [ make-local ] dip 2array ,
|
||||
(parse-bindings)
|
||||
] [ 2drop ] if ;
|
||||
|
||||
: with-bindings ( quot -- words assoc )
|
||||
'[
|
||||
in-lambda? on
|
||||
_ H{ } make-assoc
|
||||
] { } make swap ; inline
|
||||
|
||||
: parse-bindings ( end -- bindings vars )
|
||||
[ (parse-bindings) ] with-bindings ;
|
||||
|
||||
: parse-let ( -- form )
|
||||
"|" expect "|" parse-bindings
|
||||
(parse-lambda) <let> ?rewrite-closures ;
|
||||
|
||||
: parse-bindings* ( end -- words assoc )
|
||||
[
|
||||
namespace use-words
|
||||
(parse-bindings)
|
||||
namespace unuse-words
|
||||
] with-bindings ;
|
||||
|
||||
: parse-let* ( -- form )
|
||||
"|" expect "|" parse-bindings*
|
||||
(parse-lambda) <let*> ?rewrite-closures ;
|
||||
H{ } clone (parse-lambda) <let> ?rewrite-closures ;
|
||||
|
||||
: parse-locals ( -- effect vars assoc )
|
||||
complete-effect
|
||||
|
|
|
|||
|
|
@ -27,20 +27,12 @@ M: lambda pprint*
|
|||
|
||||
: pprint-let ( let word -- )
|
||||
pprint-word
|
||||
[ body>> ] [ bindings>> ] bi
|
||||
\ | pprint-word
|
||||
t <inset
|
||||
<block
|
||||
[ <block [ pprint-var ] dip pprint* block> ] assoc-each
|
||||
block>
|
||||
\ | pprint-word
|
||||
<block pprint-elements block>
|
||||
block>
|
||||
<block body>> pprint-elements block>
|
||||
\ ] pprint-word ;
|
||||
|
||||
M: let pprint* \ [let pprint-let ;
|
||||
|
||||
M: let* pprint* \ [let* pprint-let ;
|
||||
|
||||
M: def pprint*
|
||||
<block \ :> pprint-word local>> pprint-word block> ;
|
||||
dup local>> word?
|
||||
[ <block \ :> pprint-word local>> pprint-var block> ]
|
||||
[ pprint-tuple ] if ;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ locals.errors locals.types make quotations sequences vectors
|
|||
words ;
|
||||
IN: locals.rewrite.sugar
|
||||
|
||||
! Step 1: rewrite [| [let [let* into :> forms, turn
|
||||
! Step 1: rewrite [| into :> forms, turn
|
||||
! literals with locals in them into code which constructs
|
||||
! the literal after pushing locals on the stack
|
||||
|
||||
|
|
@ -73,7 +73,7 @@ M: quotation rewrite-element rewrite-sugar* ;
|
|||
|
||||
M: lambda rewrite-element rewrite-sugar* ;
|
||||
|
||||
M: binding-form rewrite-element binding-form-in-literal-error ;
|
||||
M: let rewrite-element let-form-in-literal-error ;
|
||||
|
||||
M: local rewrite-element , ;
|
||||
|
||||
|
|
@ -115,12 +115,5 @@ M: word rewrite-sugar*
|
|||
|
||||
M: object rewrite-sugar* , ;
|
||||
|
||||
: let-rewrite ( body bindings -- )
|
||||
[ quotation-rewrite % <def> , ] assoc-each
|
||||
quotation-rewrite % ;
|
||||
|
||||
M: let rewrite-sugar*
|
||||
[ body>> ] [ bindings>> ] bi let-rewrite ;
|
||||
|
||||
M: let* rewrite-sugar*
|
||||
[ body>> ] [ bindings>> ] bi let-rewrite ;
|
||||
body>> quotation-rewrite % ;
|
||||
|
|
|
|||
|
|
@ -8,16 +8,10 @@ TUPLE: lambda vars body ;
|
|||
|
||||
C: <lambda> lambda
|
||||
|
||||
TUPLE: binding-form bindings body ;
|
||||
|
||||
TUPLE: let < binding-form ;
|
||||
TUPLE: let body ;
|
||||
|
||||
C: <let> let
|
||||
|
||||
TUPLE: let* < binding-form ;
|
||||
|
||||
C: <let*> let*
|
||||
|
||||
TUPLE: quote local ;
|
||||
|
||||
C: <quote> quote
|
||||
|
|
|
|||
Loading…
Reference in New Issue