diff --git a/basis/locals/locals-docs.factor b/basis/locals/locals-docs.factor index 961017f39e..b3b676c1cb 100644 --- a/basis/locals/locals-docs.factor +++ b/basis/locals/locals-docs.factor @@ -101,15 +101,27 @@ $nl ARTICLE: "locals-limitations" "Limitations of locals" "The first limitation is that the " { $link >r } " and " { $link r> } " words may not be used together with locals. Instead, use the " { $link dip } " combinator." $nl -"Another limitation is that closure conversion does not descend into arrays, hashtables or other types of literals. For example, the following does not work:" +"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:" { $code - ":: bad-cond-usage ( a -- ... )" + ":: good-cond-usage ( a -- ... )" " {" " { [ a 0 < ] [ ... ] }" " { [ a 0 > ] [ ... ] }" " { [ a 0 = ] [ ... ] }" " } cond ;" -} ; +} +"But not the following:" +{ $code + ": my-cond ( alist -- ) cond ; inline" + "" + ":: bad-cond-usage ( a -- ... )" + " {" + " { [ a 0 < ] [ ... ] }" + " { [ a 0 > ] [ ... ] }" + " { [ a 0 = ] [ ... ] }" + " } my-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" "The " { $vocab-link "locals" } " vocabulary implements lexical scope with full closures, both downward and upward. Mutable bindings are supported, including assignment to bindings in outer scope." diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor index 23a1ee9284..a37c429471 100755 --- a/basis/locals/locals-tests.factor +++ b/basis/locals/locals-tests.factor @@ -1,6 +1,7 @@ USING: locals math sequences tools.test hashtables words kernel namespaces arrays strings prettyprint io.streams.string parser -accessors generic eval ; +accessors generic eval combinators combinators.short-circuit +combinators.short-circuit.smart ; IN: locals.tests :: foo ( a b -- a a ) a a ; @@ -276,3 +277,42 @@ M:: sequence method-with-locals ( a -- y ) a reverse ; [ \ sequence \ method-with-locals method see ] with-string-writer method-definition = ] unit-test + +:: cond-test ( a b -- c ) + { + { [ a b < ] [ 3 ] } + { [ a b = ] [ 4 ] } + { [ a b > ] [ 5 ] } + } cond ; + +[ 3 ] [ 1 2 cond-test ] unit-test +[ 4 ] [ 2 2 cond-test ] unit-test +[ 5 ] [ 3 2 cond-test ] unit-test + +:: 0&&-test ( a -- ? ) + { [ a integer? ] [ a even? ] [ a 10 > ] } 0&& ; + +[ f ] [ 1.5 0&&-test ] unit-test +[ f ] [ 3 0&&-test ] unit-test +[ f ] [ 8 0&&-test ] unit-test +[ t ] [ 12 0&&-test ] unit-test + +:: &&-test ( a -- ? ) + { [ a integer? ] [ a even? ] [ a 10 > ] } && ; + +[ f ] [ 1.5 &&-test ] unit-test +[ f ] [ 3 &&-test ] unit-test +[ f ] [ 8 &&-test ] unit-test +[ t ] [ 12 &&-test ] unit-test + +:: wlet-&&-test ( a -- ? ) + [wlet | is-integer? [ a integer? ] + is-even? [ a even? ] + >10? [ a 10 > ] | + { [ is-integer? ] [ is-even? ] [ >10? ] } && + ] ; + +! [ 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 diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor index 77ee06793e..a0b667e44b 100755 --- a/basis/locals/locals.factor +++ b/basis/locals/locals.factor @@ -5,7 +5,8 @@ parser words 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 ; +locals.backend memoize macros.expander lexer +stack-checker.known-words ; IN: locals ! Inspired by @@ -42,7 +43,9 @@ PREDICATE: local < word "local?" word-prop ; : ( name -- word ) #! Create a local variable identifier - f dup t "local?" set-word-prop ; + f + dup t "local?" set-word-prop + dup { } { object } define-primitive ; PREDICATE: local-word < word "local-word?" word-prop ; @@ -52,15 +55,20 @@ PREDICATE: local-word < word "local-word?" word-prop ; PREDICATE: local-reader < word "local-reader?" word-prop ; : ( name -- word ) - f dup t "local-reader?" set-word-prop ; + f + dup t "local-reader?" set-word-prop + dup { } { object } define-primitive ; PREDICATE: local-writer < word "local-writer?" word-prop ; : ( reader -- word ) - dup name>> "!" append f - [ t "local-writer?" set-word-prop ] keep - [ "local-writer" set-word-prop ] 2keep - [ swap "local-reader" set-word-prop ] keep ; + dup name>> "!" append f { + [ nip { object } { } define-primitive ] + [ nip t "local-writer?" set-word-prop ] + [ swap "local-reader" set-word-prop ] + [ "local-writer" set-word-prop ] + [ nip ] + } 2cleave ; TUPLE: quote local ;