:> now works

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." ;

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" }

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? ]

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
+USING: lexer macros memoize parser sequences vocabs
-sequences vocabs vocabs.loader words kernel ;
+vocabs.loader words kernel namespaces locals.parser locals.types
+locals.errors ;
 IN: locals
 
-: :> scan <local> <def> parsed ; parsing
+: :>
+    scan locals get [ :>-outside-lambda-error ] unless*
+    [ make-local ] bind <def> parsed ; parsing
 
 : [| parse-lambda parsed-lambda ; parsing
 

basis/locals/parser/parser.factor

@@ -20,6 +20,8 @@ IN: locals.parser
     [ <local-word> [ 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) <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) <lambda>

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
+USING: accessors arrays fry kernel math quotations sequences
-math quotations sequences words combinators make ;
+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 ;