From 6286f9637926fb03fda33427b3c8cd268e262116 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 9 Dec 2008 01:04:22 -0600 Subject: [PATCH] :> now works --- basis/locals/errors/errors.factor | 9 ++++++ basis/locals/locals-docs.factor | 29 +++++++++++++++++++ basis/locals/locals-tests.factor | 10 +++++++ basis/locals/locals.factor | 9 ++++-- basis/locals/parser/parser.factor | 19 +++++++----- .../rewrite/point-free/point-free.factor | 7 ++--- 6 files changed, 69 insertions(+), 14 deletions(-) diff --git a/basis/locals/errors/errors.factor b/basis/locals/errors/errors.factor index 9f9c2beecc..95c8357939 100644 --- a/basis/locals/errors/errors.factor +++ b/basis/locals/errors/errors.factor @@ -24,8 +24,17 @@ ERROR: local-word-in-literal-error ; M: local-word-in-literal-error summary drop "Local words not permitted inside literals" ; +ERROR: :>-outside-lambda-error ; + +M: :>-outside-lambda-error summary + drop ":> cannot be used outside of lambda expressions" ; + ERROR: bad-lambda-rewrite output ; M: bad-lambda-rewrite summary drop "You have found a bug in locals. Please report." ; +ERROR: bad-local args obj ; + +M: bad-local summary + drop "You have bound a bug in locals. Please report." ; diff --git a/basis/locals/locals-docs.factor b/basis/locals/locals-docs.factor index 89314aadc5..e9e1bfa16a 100644 --- a/basis/locals/locals-docs.factor +++ b/basis/locals/locals-docs.factor @@ -63,6 +63,33 @@ HELP: [wlet } } ; +HELP: :> +{ $syntax ":> binding" } +{ $description "Introduces a new binding, lexically scoped to the enclosing quotation or definition." } +{ $notes + "Lambda and let forms are really just syntax sugar for " { $link POSTPONE: :> } "." + $nl + "Lambdas desugar as follows:" + { $code + "[| a b | a b + b / ]" + "[ :> b :> a a b + b / ]" + } + "Let forms desugar as follows:" + { $code + "[|let | x [ 10 random ] | { x x } ]" + "10 random :> x { x x }" + } +} +{ $examples + { $code + "USING: locals math kernel ;" + "IN: scratchpad" + ":: quadratic ( a b c -- x y )" + " b sq 4 a c * * - sqrt :> disc" + " b neg disc [ + ] [ - ] 2bi [ 2 a * / ] bi@ ;" + } +} ; + HELP: :: { $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." } @@ -209,6 +236,8 @@ $nl { $subsection POSTPONE: [wlet } "Lambda abstractions:" { $subsection POSTPONE: [| } +"Lightweight binding form:" +{ $subsection POSTPONE: :> } "Additional topics:" { $subsection "locals-literals" } { $subsection "locals-mutable" } diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor index f13c1d57fa..b5c201a5d9 100644 --- a/basis/locals/locals-tests.factor +++ b/basis/locals/locals-tests.factor @@ -441,6 +441,16 @@ M:: integer lambda-method-forget-test ( a -- b ) ; [ "USE: locals [| | [wlet | a [ 0 ] | { a } ] ]" eval ] must-fail +[ "USE: locals [| | { :> a } ]" eval ] must-fail + +[ "USE: locals 3 :> a" eval ] must-fail + +[ 3 ] [ 3 [| | :> a a ] call ] unit-test + +[ 3 ] [ 3 [| | :> a! a ] call ] unit-test + +[ 3 ] [ 2 [| | :> a! a 1+ a! a ] call ] 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 2060222472..f745f6243f 100644 --- a/basis/locals/locals.factor +++ b/basis/locals/locals.factor @@ -1,10 +1,13 @@ ! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos. ! See http://factorcode.org/license.txt for BSD license. -USING: lexer locals.parser locals.types macros memoize parser -sequences vocabs vocabs.loader words kernel ; +USING: lexer macros memoize parser sequences vocabs +vocabs.loader words kernel namespaces locals.parser locals.types +locals.errors ; IN: locals -: :> scan parsed ; parsing +: :> + scan locals get [ :>-outside-lambda-error ] unless* + [ make-local ] bind parsed ; parsing : [| parse-lambda parsed-lambda ; parsing diff --git a/basis/locals/parser/parser.factor b/basis/locals/parser/parser.factor index 5b2e7c3eeb..e6ab6c003c 100644 --- a/basis/locals/parser/parser.factor +++ b/basis/locals/parser/parser.factor @@ -20,6 +20,8 @@ IN: locals.parser [ [ dup name>> set ] [ ] [ ] tri ] dip "local-word-def" set-word-prop ; +SYMBOL: locals + : push-locals ( assoc -- ) use get push ; @@ -29,11 +31,16 @@ IN: locals.parser SYMBOL: in-lambda? : (parse-lambda) ( assoc end -- quot ) - t in-lambda? [ parse-until ] with-variable - >quotation swap pop-locals ; + [ + in-lambda? on + over locals set + over push-locals + parse-until >quotation + swap pop-locals + ] with-scope ; : parse-lambda ( -- lambda ) - "|" parse-tokens make-locals dup push-locals + "|" parse-tokens make-locals \ ] (parse-lambda) ; : parse-binding ( end -- pair/f ) @@ -52,15 +59,14 @@ SYMBOL: in-lambda? : parse-bindings ( end -- bindings vars ) [ [ (parse-bindings) ] H{ } make-assoc - dup push-locals ] { } make swap ; : parse-bindings* ( end -- words assoc ) [ [ namespace push-locals - (parse-bindings) + namespace pop-locals ] { } make-assoc ] { } make swap ; @@ -73,13 +79,12 @@ SYMBOL: in-lambda? : parse-wbindings ( end -- bindings vars ) [ [ (parse-wbindings) ] H{ } make-assoc - dup push-locals ] { } make swap ; : parse-locals ( -- vars assoc ) "(" expect ")" parse-effect word [ over "declared-effect" set-word-prop ] when* - in>> [ dup pair? [ first ] when ] map make-locals dup push-locals ; + in>> [ dup pair? [ first ] when ] map make-locals ; : parse-locals-definition ( word -- word quot ) parse-locals \ ; (parse-lambda) diff --git a/basis/locals/rewrite/point-free/point-free.factor b/basis/locals/rewrite/point-free/point-free.factor index 1741bf044f..bd322bfff3 100644 --- a/basis/locals/rewrite/point-free/point-free.factor +++ b/basis/locals/rewrite/point-free/point-free.factor @@ -1,14 +1,13 @@ ! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays fry kernel locals.backend locals.types -math quotations sequences words combinators make ; +USING: accessors arrays fry kernel math quotations sequences +words combinators make locals.backend locals.types +locals.errors ; IN: locals.rewrite.point-free ! Step 3: rewrite locals usage within a single quotation into ! retain stack manipulation -ERROR: bad-local args obj ; - : local-index ( args obj -- n ) 2dup '[ unquote _ eq? ] find drop dup [ 2nip ] [ drop bad-local ] if ;