From 6324b4dd651999b8f115cb9953f3f9d9c8ea7cba Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 21 Nov 2008 05:18:41 -0600 Subject: [PATCH] Fix some bugs in locals, throw a parse time error if usage of >r r> is detected --- basis/locals/locals-docs.factor | 4 ++-- basis/locals/locals-tests.factor | 24 +++++++++++++++++++- basis/locals/locals.factor | 38 +++++++++++++++++++++----------- 3 files changed, 50 insertions(+), 16 deletions(-) diff --git a/basis/locals/locals-docs.factor b/basis/locals/locals-docs.factor index 35e0536530..18488ed1dd 100644 --- a/basis/locals/locals-docs.factor +++ b/basis/locals/locals-docs.factor @@ -132,8 +132,8 @@ $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-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 +"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:" { $code ":: good-cond-usage ( a -- ... )" diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor index 04e077fc4f..60e40b9629 100644 --- a/basis/locals/locals-tests.factor +++ b/basis/locals/locals-tests.factor @@ -2,7 +2,7 @@ USING: locals math sequences tools.test hashtables words kernel namespaces arrays strings prettyprint io.streams.string parser accessors generic eval combinators combinators.short-circuit combinators.short-circuit.smart math.order math.functions -definitions compiler.units ; +definitions compiler.units fry ; IN: locals.tests :: foo ( a b -- a a ) a a ; @@ -286,6 +286,8 @@ M:: sequence method-with-locals ( a -- y ) a reverse ; { [ a b > ] [ 5 ] } } cond ; +\ cond-test must-infer + [ 3 ] [ 1 2 cond-test ] unit-test [ 4 ] [ 2 2 cond-test ] unit-test [ 5 ] [ 3 2 cond-test ] unit-test @@ -293,6 +295,8 @@ M:: sequence method-with-locals ( a -- y ) a reverse ; :: 0&&-test ( a -- ? ) { [ a integer? ] [ a even? ] [ a 10 > ] } 0&& ; +\ 0&&-test must-infer + [ f ] [ 1.5 0&&-test ] unit-test [ f ] [ 3 0&&-test ] unit-test [ f ] [ 8 0&&-test ] unit-test @@ -301,6 +305,8 @@ M:: sequence method-with-locals ( a -- y ) a reverse ; :: &&-test ( a -- ? ) { [ a integer? ] [ a even? ] [ a 10 > ] } && ; +\ &&-test must-infer + [ f ] [ 1.5 &&-test ] unit-test [ f ] [ 3 &&-test ] unit-test [ f ] [ 8 &&-test ] unit-test @@ -346,6 +352,10 @@ M:: sequence method-with-locals ( a -- y ) a reverse ; { 3 1 } [| from to seq | T{ slice f from to seq } ] must-infer-as +ERROR: punned-class x ; + +[ T{ punned-class f 3 } ] [ 3 [| a | T{ punned-class f a } ] call ] unit-test + :: literal-identity-test ( -- a b ) { } V{ } ; @@ -390,6 +400,18 @@ M:: integer lambda-method-forget-test ( a -- b ) ; [ { [ 10 ] } ] [ 10 [| A | { [ A ] } ] call ] unit-test +[ + "USING: locals fry math ; [ 0 '[ [let | A [ 10 ] | A _ + ] ] ]" eval +] [ error>> >r/r>-in-fry-error? ] must-fail-with + +:: (funny-macro-test) ( obj quot -- ? ) obj { quot } 1&& ; inline +: funny-macro-test ( n -- ? ) [ odd? ] (funny-macro-test) ; + +\ funny-macro-test must-infer + +[ t ] [ 3 funny-macro-test ] unit-test +[ f ] [ 2 funny-macro-test ] unit-test + ! :: wlet-&&-test ( a -- ? ) ! [wlet | is-integer? [ a integer? ] ! is-even? [ a even? ] diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor index 7de9d10436..1e205e10b0 100644 --- a/basis/locals/locals.factor +++ b/basis/locals/locals.factor @@ -6,12 +6,18 @@ 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 ; +locals.backend memoize macros.expander lexer classes summary ; 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" ; + > , ] } - { [ t ] [ free-vars* ] } - } cond ; +M: local-writer free-vars* "local-reader" word-prop , ; + +M: lexical free-vars* , ; + +M: quote free-vars* , ; M: object free-vars* drop ; -M: quotation free-vars* [ add-if-free ] each ; +M: quotation free-vars* [ free-vars* ] each ; -M: lambda free-vars* - [ vars>> ] [ body>> ] bi free-vars swap diff % ; +M: lambda free-vars* [ vars>> ] [ body>> ] bi free-vars swap diff % ; GENERIC: lambda-rewrite* ( obj -- ) @@ -201,6 +204,8 @@ M: special rewrite-literal? drop t ; M: array rewrite-literal? [ rewrite-literal? ] contains? ; +M: quotation rewrite-literal? [ rewrite-literal? ] contains? ; + M: hashtable rewrite-literal? drop t ; M: vector rewrite-literal? drop t ; @@ -215,17 +220,20 @@ GENERIC: rewrite-element ( obj -- ) [ rewrite-element ] each ; : rewrite-sequence ( seq -- ) - [ rewrite-elements ] [ length , ] [ , ] tri \ nsequence , ; + [ rewrite-elements ] [ length , ] [ 0 head , ] tri \ nsequence , ; 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 , ; M: tuple rewrite-element - [ tuple-slots rewrite-elements ] [ class , ] bi \ boa , ; + [ tuple-slots rewrite-elements ] [ class literalize , ] bi \ boa , ; M: local rewrite-element , ; @@ -243,6 +251,10 @@ M: tuple local-rewrite* rewrite-element ; M: hashtable local-rewrite* rewrite-element ; +M: word local-rewrite* + dup { >r r> } memq? + [ >r/r>-in-lambda-error ] [ call-next-method ] if ; + M: object lambda-rewrite* , ; M: object local-rewrite* , ;