steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fixing some problems with the locals implementation: 

- Smart combinators now work with wlet words
- Expansion no longer usees >r/r>
- Hook into fry so that fry and locals can work as expected
- Document limitations of locals with macros in more detail, remove mention of >r/r> limitation since those two words are going away anyway
db4
Slava Pestov 2008-11-27 21:55:46 -06:00
parent a3231c5a4e
commit a729e72b7e
3 changed files with 163 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
basis/locals/locals-docs.factor
View File

@ -1,5 +1,5 @@
USING: help.syntax help.markup kernel macros prettyprint
memoize combinators arrays ;
memoize combinators arrays generalizations ;
IN: locals
HELP: [|
@ -131,10 +131,40 @@ $nl
$nl
"Unlike some languages such as Python and Java, writing to mutable locals in outer scopes is fully supported and has the expected semantics." ;
ARTICLE: "locals-fry" "Locals and fry"
"Locals integrate with " { $link "fry" } " so that mixing locals with fried quotations gives intuitive results."
$nl
"Recall that the following two code snippets are equivalent:"
{ $code "'[ sq _ + ]" }
{ $code "[ [ sq ] dip + ] curry" }
"The semantics of " { $link dip } " and " { $link curry } " are such that the first example behaves as if the top of the stack as ``inserted'' in the ``hole'' in the quotation's second element."
$nl
"Conceptually, " { $link curry } " is defined so that the following two code snippets are equivalent:"
{ $code "3 [ - ] curry" }
{ $code "[ 3 - ]" }
"With lambdas, " { $link curry } " behaves differently. Rather than prepending an element, it fills in named parameters from right to left. The following two snippets are equivalent:"
{ $code "3 [| a b | a b - ] curry" }
{ $code "[| a | a 3 - ]" }
"Because of this, the behavior of fry changes when applied to a lambda, to ensure that conceptually, fry behaves as with quotations. So the following snippets are no longer equivalent:"
{ $code "'[ [| a | _ a - ] ]" }
{ $code "'[ [| a | a - ] curry ] call" }
"Instead, the first line above expands into something like the following:"
{ $code "[ [ swap [| a | a - ] ] curry call ]" }
"This ensures that the fried value appears ``underneath'' the local variable " { $snippet "a" } " when the quotation calls."
$nl
"The precise behavior is the following. When frying a lambda, a stack shuffle (" { $link mnswap } ") is prepended to the lambda so that the " { $snippet "m" } " curried values, which start off at the top of the stack, are transposed with the " { $snippet "n" } " inputs to the lambda." ;
ARTICLE: "locals-limitations" "Limitations of locals"
"The first limitation is also shared by " { $vocab-link "fry" } ": the " { $link >r } " and " { $link r> } " words may not be used together with locals. Instead, use the " { $link dip } " combinator. An error is thrown at parse time if an attempt is made to use " { $link >r } " and " { $link r> } " inside a lambda body:"
{ $subsection >r/r>-in-lambda-error }
"Another limitation concerns combinators implemented as macros. Locals can only be used with such combinators if the input array immediately precedes the combinator call. For example, the following will work:"
"There are two main limitations of the current locals implementation, and both concern macros."
{ $heading "Macro expansions with free variables" }
"The expansion of a macro cannot reference local variables bound in the outer scope. For example, the following macro is invalid:"
{ $code "MACRO:: twice ( quot -- ) [ quot call quot call ] ;" }
"The following is fine, though:"
{ $code "MACRO:: twice ( quot -- ) quot quot '[ @ @ ] ;" }
{ $heading "Static stack effect inference and macros" }
"Recall that a macro will only expand at compile-time, and the word containing it will only get a static stack effect, if all inputs to the macro are literal. When locals are used, there is an additional restriction; the literals must immediately precede the macro call, lexically."
$nl
"For example, all of the following three examples are equivalent semantically, but only the first will have a static stack effect and compile with the optimizing compiler:"
{ $code
":: good-cond-usage ( a -- ... )"
" {"
@ -143,7 +173,7 @@ ARTICLE: "locals-limitations" "Limitations of locals"
" { [ a 0 = ] [ ... ] }"
" } cond ;"
}
"But not the following:"
"The following two will not, and will run slower as a result:"
{ $code
": my-cond ( alist -- ) cond ; inline"
""
@ -154,6 +184,14 @@ ARTICLE: "locals-limitations" "Limitations of locals"
" { [ a 0 = ] [ ... ] }"
" } my-cond ;"
}
{ $code
":: bad-cond-usage ( a -- ... )"
" {"
" { [ a 0 < ] [ ... ] }"
" { [ a 0 > ] [ ... ] }"
" { [ a 0 = ] [ ... ] }"
" } swap swap cond ;"
}
"The reason is that locals are rewritten into stack code at parse time, whereas macro expansion is performed later during compile time. To circumvent this problem, the " { $vocab-link "macros.expander" } " vocabulary is used to rewrite simple macro usages prior to local transformation, however "{ $vocab-link "macros.expander" } " does not deal with more complicated cases where the literal inputs to the macro do not immediately precede the macro call in the source." ;
ARTICLE: "locals" "Local variables and lexical closures"
@ -174,6 +212,7 @@ $nl
"Additional topics:"
{ $subsection "locals-literals" }
{ $subsection "locals-mutable" }
{ $subsection "locals-fry" }
{ $subsection "locals-limitations" }
"Locals complement dynamically scoped variables implemented in the " { $vocab-link "namespaces" } " vocabulary." ;

61
basis/locals/locals-tests.factor
View File

@ -398,7 +398,7 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
[ ] [ [ { integer lambda-method-forget-test } forget ] with-compilation-unit ] unit-test
[ { [ 10 ] } ] [ 10 [| A | { [ A ] } ] call ] unit-test
[ 10 ] [ 10 [| A | { [ A ] } ] call first call ] unit-test
[
"USING: locals fry math ; [ 0 '[ [let | A [ 10 ] | A _ + ] ] ]" eval
@ -431,14 +431,53 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
[ 3 ] [ 3 [| a | \ a ] call ] unit-test
! :: wlet-&&-test ( a -- ? )
! [wlet | is-integer? [ a integer? ]
! is-even? [ a even? ]
! >10? [ a 10 > ] |
! { [ is-integer? ] [ is-even? ] [ >10? ] } &&
! ] ;
[ "USE: locals [| | { [let | a [ 0 ] | a ] } ]" eval ] must-fail
! [ f ] [ 1.5 wlet-&&-test ] unit-test
! [ f ] [ 3 wlet-&&-test ] unit-test
! [ f ] [ 8 wlet-&&-test ] unit-test
! [ t ] [ 12 wlet-&&-test ] unit-test
[ "USE: locals [| | { [wlet | a [ 0 ] | a ] } ]" eval ] must-fail
[ "USE: locals [| | { [let* | a [ 0 ] | a ] } ]" eval ] must-fail
[ "USE: locals [| | [let | a! [ 0 ] | { a! } ] ]" eval ] must-fail
[ "USE: locals [| | [wlet | a [ 0 ] | { a } ] ]" eval ] must-fail
:: wlet-&&-test ( a -- ? )
[wlet | is-integer? [ a integer? ]
is-even? [ a even? ]
>10? [ a 10 > ] |
{ [ is-integer? ] [ is-even? ] [ >10? ] } &&
] ;
\ wlet-&&-test must-infer
[ f ] [ 1.5 wlet-&&-test ] unit-test
[ f ] [ 3 wlet-&&-test ] unit-test
[ f ] [ 8 wlet-&&-test ] unit-test
[ t ] [ 12 wlet-&&-test ] unit-test
: fry-locals-test-1 ( -- n )
[let | | 6 '[ [let | A [ 4 ] | A _ + ] ] call ] ;
\ fry-locals-test-1 must-infer
[ 10 ] [ fry-locals-test-1 ] unit-test
:: fry-locals-test-2 ( -- n )
[let | | 6 '[ [let | A [ 4 ] | A _ + ] ] call ] ;
\ fry-locals-test-2 must-infer
[ 10 ] [ fry-locals-test-2 ] unit-test
[ 1 ] [ 3 4 [| | '[ [ _ swap - ] call ] call ] call ] unit-test
[ -1 ] [ 3 4 [| | [| a | a - ] call ] call ] unit-test
[ -1 ] [ 3 4 [| | [| a | a - ] curry call ] call ] unit-test
[ -1 ] [ 3 4 [| a | a - ] curry call ] unit-test
[ 1 ] [ 3 4 [| | '[ [| a | _ a - ] call ] call ] call ] unit-test
[ -1 ] [ 3 4 [| | '[ [| a | a _ - ] call ] call ] call ] unit-test
[ { 1 2 3 4 } ] [
1 3 2 4
[| | '[ [| a b | a _ b _ 4array ] call ] call ] call
] unit-test
[ 10 ] [
[| | 0 '[ [let | A [ 10 ] | A _ + ] ] call ] call
] unit-test

110
basis/locals/locals.factor
View File

@ -6,18 +6,36 @@ quotations debugger macros arrays macros splitting combinators
prettyprint.backend definitions prettyprint hashtables
prettyprint.sections sets sequences.private effects
effects.parser generic generic.parser compiler.units accessors
locals.backend memoize macros.expander lexer classes summary ;
locals.backend memoize macros.expander lexer classes summary fry
fry.private ;
IN: locals
! Inspired by
! http://cat-language.googlecode.com/svn/trunk/CatPointFreeForm.cs
ERROR: >r/r>-in-lambda-error ;
M: >r/r>-in-lambda-error summary
drop
"Explicit retain stack manipulation is not permitted in lambda bodies" ;
ERROR: binding-form-in-literal-error ;
M: binding-form-in-literal-error summary
drop "[let, [let* and [wlet not permitted inside literals" ;
ERROR: local-writer-in-literal-error ;
M: local-writer-in-literal-error summary
drop "Local writer words not permitted inside literals" ;
ERROR: local-word-in-literal-error ;
M: local-word-in-literal-error summary
drop "Local words not permitted inside literals" ;
ERROR: bad-lambda-rewrite output ;
M: bad-lambda-rewrite summary
drop "You have found a bug in locals. Please report." ;
<PRIVATE
TUPLE: lambda vars body ;
@ -87,45 +105,40 @@ C: <quote> quote
: read-local-quot ( obj args -- quot )
local-index 1+ [ get-local ] curry ;
: localize-writer ( obj args -- quot )
>r "local-reader" word-prop r>
GENERIC# localize 1 ( obj args -- quot )
M: local localize read-local-quot ;
M: quote localize [ local>> ] dip read-local-quot ;
M: local-word localize read-local-quot [ call ] append ;
M: local-reader localize read-local-quot [ local-value ] append ;
M: local-writer localize
[ "local-reader" word-prop ] dip
read-local-quot [ set-local-value ] append ;
: localize ( obj args -- quot )
{
{ [ over local? ] [ read-local-quot ] }
{ [ over quote? ] [ >r local>> r> read-local-quot ] }
{ [ over local-word? ] [ read-local-quot [ call ] append ] }
{ [ over local-reader? ] [ read-local-quot [ local-value ] append ] }
{ [ over local-writer? ] [ localize-writer ] }
{ [ over \ lambda eq? ] [ 2drop [ ] ] }
{ [ t ] [ drop 1quotation ] }
} cond ;
M: object localize drop 1quotation ;
UNION: special local quote local-word local-reader local-writer ;
: load-locals-quot ( args -- quot )
[
[ ]
] [
[ [ ] ] [
dup [ local-reader? ] contains? [
<reversed> [
local-reader? [ 1array >r ] [ >r ] ?
] map concat
] [
length [ load-locals ] curry >quotation
] if
dup [ local-reader? [ 1array ] [ ] ? ] map spread>quot
] [ [ ] ] if swap length [ load-locals ] curry append
] if-empty ;
: drop-locals-quot ( args -- quot )
[ [ ] ] [ length [ drop-locals ] curry ] if-empty ;
: point-free-body ( quot args -- newquot )
>r but-last-slice r> [ localize ] curry map concat ;
[ but-last-slice ] dip '[ _ localize ] map concat ;
: point-free-end ( quot args -- newquot )
over peek special?
[ dup drop-locals-quot >r >r peek r> localize r> append ]
[ dup drop-locals-quot [ [ peek ] dip localize ] dip append ]
[ dup drop-locals-quot nip swap peek suffix ]
if ;
@ -227,9 +240,6 @@ GENERIC: rewrite-element ( obj -- )
M: array rewrite-element
dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;
M: quotation rewrite-element
dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;
M: vector rewrite-element rewrite-sequence ;
M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
@ -237,12 +247,22 @@ M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
M: tuple rewrite-element
[ tuple-slots rewrite-elements ] [ class literalize , ] bi \ boa , ;
M: quotation rewrite-element local-rewrite* ;
M: lambda rewrite-element local-rewrite* ;
M: binding-form rewrite-element binding-form-in-literal-error ;
M: local rewrite-element , ;
M: local-reader rewrite-element , ;
M: local-writer rewrite-element
local-writer-in-literal-error ;
M: local-word rewrite-element
local-word-in-literal-error ;
M: word rewrite-element literalize , ;
M: wrapper rewrite-element
@ -278,8 +298,9 @@ M: object local-rewrite* , ;
: make-locals ( seq -- words assoc )
[ [ make-local ] map ] H{ } make-assoc ;
: make-local-word ( name -- word )
<local-word> dup dup name>> set ;
: make-local-word ( name def -- word )
[ <local-word> [ dup name>> set ] [ ] [ ] tri ] dip
"local-word-def" set-word-prop ;
: push-locals ( assoc -- )
use get push ;
@ -328,7 +349,7 @@ SYMBOL: in-lambda?
: (parse-wbindings) ( -- )
parse-binding [
first2 >r make-local-word r> 2array ,
first2 [ make-local-word ] keep 2array ,
(parse-wbindings)
] when* ;
@ -340,7 +361,7 @@ SYMBOL: in-lambda?
: let-rewrite ( body bindings -- )
<reversed> [
>r 1array r> spin <lambda> [ call ] curry compose
[ 1array ] dip spin <lambda> '[ @ @ ]
] assoc-each local-rewrite* \ call , ;
M: let local-rewrite*
@ -351,7 +372,7 @@ M: let* local-rewrite*
M: wlet local-rewrite*
[ body>> ] [ bindings>> ] bi
[ [ ] curry ] assoc-map
[ '[ _ ] ] assoc-map
let-rewrite ;
: parse-locals ( -- vars assoc )
@ -359,11 +380,6 @@ M: wlet local-rewrite*
word [ over "declared-effect" set-word-prop ] when*
in>> [ dup pair? [ first ] when ] map make-locals dup push-locals ;
ERROR: bad-lambda-rewrite output ;
M: bad-lambda-rewrite summary
drop "You have found a bug in locals. Please report." ;
: parse-locals-definition ( word -- word quot )
"(" expect parse-locals \ ; (parse-lambda) <lambda>
2dup "lambda" set-word-prop
@ -431,7 +447,7 @@ M: lambda pprint*
\ | pprint-word
t <inset
<block
[ <block >r pprint-var r> pprint* block> ] assoc-each
[ <block [ pprint-var ] dip pprint* block> ] assoc-each
block>
\ | pprint-word
<block pprint-elements block>
@ -497,3 +513,15 @@ M: lambda-method synopsis*
method-stack-effect effect>string comment. ;
PRIVATE>
! Locals and fry
M: binding-form count-inputs body>> count-inputs ;
M: lambda count-inputs body>> count-inputs ;
M: lambda deep-fry
clone [ shallow-fry swap ] change-body
[ [ vars>> length ] keep '[ _ _ mnswap @ ] , ] [ drop [ncurry] % ] 2bi ;
M: binding-form deep-fry
clone [ fry '[ @ call ] ] change-body , ;