Merge branch 'master' of git://factorcode.org/git/factor

basis/alien/fortran/fortran.factor

@@ -330,7 +330,7 @@ M: character-type (<fortran-result>)
     ] if-empty ;
 
 :: [fortran-invoke] ( [args>args] return library function parameters -- [args>args] quot ) 
-    return parameters fortran-sig>c-sig :> c-parameters :> c-return
+    return parameters fortran-sig>c-sig :> ( c-return c-parameters )
     function fortran-name>symbol-name :> c-function
     [args>args] 
     c-return library c-function c-parameters \ alien-invoke

basis/alien/parser/parser.factor

@@ -98,7 +98,7 @@ IN: alien.parser
     type-name current-vocab create :> type-word 
     type-word [ reset-generic ] [ reset-c-type ] bi
     void* type-word typedef
-    parameters return parse-arglist :> callback-effect :> types
+    parameters return parse-arglist :> ( types callback-effect )
     type-word callback-effect "callback-effect" set-word-prop
     type-word lib "callback-library" set-word-prop
     type-word return types lib library-abi callback-quot (( quot -- alien )) ;

basis/bitstreams/bitstreams.factor

@@ -113,7 +113,7 @@ PRIVATE>
 M:: lsb0-bit-writer poke ( value n bs -- )
     value n <widthed> :> widthed
     widthed
-    bs widthed>> #bits>> 8 swap - split-widthed :> remainder :> byte
+    bs widthed>> #bits>> 8 swap - split-widthed :> ( byte remainder )
     byte bs widthed>> |widthed :> new-byte
     new-byte #bits>> 8 = [
         new-byte bits>> bs bytes>> push
@@ -143,7 +143,7 @@ ERROR: not-enough-bits n bit-reader ;
     neg shift n bits ;
 
 :: adjust-bits ( n bs -- )
-    n 8 /mod :> #bits :> #bytes
+    n 8 /mod :> ( #bytes #bits )
     bs [ #bytes + ] change-byte-pos
     bit-pos>> #bits + dup 8 >= [
         8 - bs (>>bit-pos)

basis/calendar/calendar.factor

@@ -119,16 +119,16 @@ GENERIC: easter ( obj -- obj' )
 
 :: easter-month-day ( year -- month day )
     year 19 mod :> a
-    year 100 /mod :> c :> b
+    year 100 /mod :> ( b c )
-    b 4 /mod :> e :> d
+    b 4 /mod :> ( d e )
     b 8 + 25 /i :> f
     b f - 1 + 3 /i :> g
     19 a * b + d - g - 15 + 30 mod :> h
-    c 4 /mod :> k :> i
+    c 4 /mod :> ( i k )
     32 2 e * + 2 i * + h - k - 7 mod :> l
     a 11 h * + 22 l * + 451 /i :> m
 
-    h l + 7 m * - 114 + 31 /mod 1 + :> day :> month
+    h l + 7 m * - 114 + 31 /mod 1 + :> ( month day )
     month day ;
 
 M: integer easter ( year -- timestamp )

basis/channels/examples/examples.factor

@@ -25,12 +25,11 @@ IN: channels.examples
     ] 3keep filter ;
 
 :: (sieve) ( prime c -- )
-    [let | p [ c from ] 
+    c from :> p
-           newc [ <channel> ] |
+    <channel> :> newc
     p prime to
     [ newc p c filter ] "Filter" spawn drop
-        prime newc (sieve)
+    prime newc (sieve) ;
-    ] ;
 
 : sieve ( prime -- ) 
     #! Send prime numbers to 'prime' channel

basis/checksums/hmac/hmac.factor

@@ -24,7 +24,7 @@ PRIVATE>
 
 :: hmac-stream ( stream key checksum -- value )
     checksum initialize-checksum-state :> checksum-state
-    checksum key checksum-state init-key :> Ki :> Ko
+    checksum key checksum-state init-key :> ( Ko Ki )
     checksum-state Ki add-checksum-bytes
     stream add-checksum-stream get-checksum
     checksum initialize-checksum-state

basis/classes/struct/bit-accessors/bit-accessors.factor

@@ -10,7 +10,7 @@ IN: classes.struct.bit-accessors
     [ 2^ 1 - ] bi@ swap bitnot bitand ;
 
 :: manipulate-bits ( offset bits step-quot -- quot shift-amount offset' bits' )
-    offset 8 /mod :> start-bit :> i
+    offset 8 /mod :> ( i start-bit )
     start-bit bits + 8 min :> end-bit
     start-bit end-bit ones-between :> mask
     end-bit start-bit - :> used-bits

basis/compiler/cfg/intrinsics/alien/alien.factor

@@ -22,12 +22,10 @@ IN: compiler.cfg.intrinsics.alien
     ] [ emit-primitive ] if ;
 
 :: inline-alien ( node quot test -- )
-    [let | infos [ node node-input-infos ] |
+    node node-input-infos :> infos
     infos test call
     [ infos quot call ]
-        [ node emit-primitive ]
+    [ node emit-primitive ] if ; inline
-        if
-    ] ; inline
 
 : inline-alien-getter? ( infos -- ? )
     [ first class>> c-ptr class<= ]

basis/compiler/cfg/intrinsics/allot/allot.factor

@@ -43,17 +43,15 @@ IN: compiler.cfg.intrinsics.allot
     2 + cells array ^^allot ;
 
 :: emit-<array> ( node -- )
-    [let | len [ node node-input-infos first literal>> ] |
+    node node-input-infos first literal>> :> len
     len expand-<array>? [
-            [let | elt [ ds-pop ]
+        ds-pop :> elt
-                   reg [ len ^^allot-array ] |
+        len ^^allot-array :> reg
         ds-drop
         len reg array store-length
         len reg elt array store-initial-element
         reg ds-push
-            ]
+    ] [ node emit-primitive ] if ;
-        ] [ node emit-primitive ] if
-    ] ;
 
 : expand-(byte-array)? ( obj -- ? )
     dup integer? [ 0 1024 between? ] [ drop f ] if ;

basis/compiler/cfg/intrinsics/simd/simd.factor

@@ -156,18 +156,18 @@ MACRO: if-literals-match ( quots -- )
     [ [ ^^fill-vector ] [ ^^xor-vector ] bi ] if ;
 
 :: ((generate-compare-vector)) ( src1 src2 rep {cc,swap} -- dst )
-    {cc,swap} first2 :> swap? :> cc
+    {cc,swap} first2 :> ( cc swap? )
     swap?
     [ src2 src1 rep cc ^^compare-vector ]
     [ src1 src2 rep cc ^^compare-vector ] if ;
 
 :: (generate-compare-vector) ( src1 src2 rep orig-cc -- dst )
-    rep orig-cc %compare-vector-ccs :> not? :> ccs
+    rep orig-cc %compare-vector-ccs :> ( ccs not? )
 
     ccs empty?
     [ rep not? [ ^^fill-vector ] [ ^^zero-vector ] if ]
     [
-        ccs unclip :> first-cc :> rest-ccs
+        ccs unclip :> ( rest-ccs first-cc )
         src1 src2 rep first-cc ((generate-compare-vector)) :> first-dst
 
         rest-ccs first-dst

basis/compiler/cfg/intrinsics/slots/slots.factor

@@ -42,7 +42,7 @@ IN: compiler.cfg.intrinsics.slots
     first class>> immediate class<= not ;
 
 :: (emit-set-slot) ( infos -- )
-    3inputs :> slot :> obj :> src
+    3inputs :> ( src obj slot )
 
     slot infos second value-tag ^^tag-offset>slot :> slot
 
@@ -54,7 +54,7 @@ IN: compiler.cfg.intrinsics.slots
 :: (emit-set-slot-imm) ( infos -- )
     ds-drop
 
-    2inputs :> obj :> src
+    2inputs :> ( src obj )
 
     infos third literal>> :> slot
     infos second value-tag :> tag

basis/compiler/cfg/ssa/liveness/liveness.factor

@@ -121,10 +121,9 @@ PRIVATE>
 PRIVATE>
 
 :: live-out? ( vreg node -- ? )
-    [let | def [ vreg def-of ] |
+    vreg def-of :> def
     {
         { [ node def eq? ] [ vreg uses-of def only? not ] }
         { [ def node strictly-dominates? ] [ vreg node (live-out?) ] }
         [ f ]
-        } cond
+    } cond ;
-    ] ;

basis/compiler/tree/dead-code/recursive/recursive.factor

@@ -39,14 +39,13 @@ M: #enter-recursive remove-dead-code*
     2bi ;
 
 :: (drop-call-recursive-outputs) ( inputs outputs -- #shuffle )
-    [let* | new-live-outputs [ inputs outputs filter-corresponding make-values ]
+    inputs outputs filter-corresponding make-values :> new-live-outputs
-            live-outputs [ outputs filter-live ] |
+    outputs filter-live :> live-outputs
     new-live-outputs
     live-outputs
     live-outputs
     new-live-outputs
-        drop-values
+    drop-values ;
-    ] ;
 
 : drop-call-recursive-outputs ( node -- #shuffle )
     dup [ label>> return>> in-d>> ] [ out-d>> ] bi
@@ -60,22 +59,20 @@ M: #call-recursive remove-dead-code*
     tri 3array ;
 
 :: drop-recursive-inputs ( node -- shuffle )
-    [let* | shuffle [ node [ in-d>> ] [ label>> enter-out>> ] bi drop-dead-inputs ]
+    node [ in-d>> ] [ label>> enter-out>> ] bi drop-dead-inputs :> shuffle
-            new-outputs [ shuffle out-d>> ] |
+    shuffle out-d>> :> new-outputs
     node new-outputs
     [ [ label>> enter-recursive>> ] dip >>in-d drop ] [ >>in-d drop ] 2bi
-        shuffle
+    shuffle ;
-    ] ;
 
 :: drop-recursive-outputs ( node -- shuffle )
-    [let* | return [ node label>> return>> ]
+    node label>> return>> :> return
-            new-inputs [ return in-d>> filter-live ]
+    return in-d>> filter-live :> new-inputs
-            new-outputs [ return [ in-d>> ] [ out-d>> ] bi filter-corresponding ] |
+    return [ in-d>> ] [ out-d>> ] bi filter-corresponding :> new-outputs
     return
     [ new-inputs >>in-d new-outputs >>out-d drop ]
     [ drop-dead-outputs ]
-        bi
+    bi ;
-    ] ;
 
 M: #recursive remove-dead-code* ( node -- nodes )
     [ drop-recursive-inputs ]

basis/compiler/tree/dead-code/simple/simple.factor

@@ -71,14 +71,13 @@ M: #alien-indirect compute-live-values* nip look-at-inputs ;
     filter-corresponding zip #data-shuffle ; inline
 
 :: drop-dead-values ( outputs -- #shuffle )
-    [let* | new-outputs [ outputs make-values ]
+    outputs make-values :> new-outputs
-            live-outputs [ outputs filter-live ] |
+    outputs filter-live :> live-outputs
     new-outputs
     live-outputs
     outputs
     new-outputs
-        drop-values
+    drop-values ;
-    ] ;
 
 : drop-dead-outputs ( node -- #shuffle )
     dup out-d>> drop-dead-values [ in-d>> >>out-d drop ] keep ;

basis/compiler/tree/propagation/known-words/known-words.factor

@@ -159,12 +159,11 @@ IN: compiler.tree.propagation.known-words
 \ bitxor [ [ interval-bitxor ] [ integer-valued ] binary-op ] each-derived-op
 
 :: (comparison-constraints) ( in1 in2 op -- constraint )
-    [let | i1 [ in1 value-info interval>> ]
+    in1 value-info interval>> :> i1
-           i2 [ in2 value-info interval>> ] |
+    in2 value-info interval>> :> i2
     in1 i1 i2 op assumption is-in-interval
     in2 i2 i1 op swap-comparison assumption is-in-interval
-       /\
+    /\ ;
-    ] ;
 
 :: comparison-constraints ( in1 in2 out op -- constraint )
     in1 in2 op (comparison-constraints) out t-->

basis/compiler/utilities/utilities.factor

@@ -36,13 +36,11 @@ yield-hook [ [ ] ] initialize
 : penultimate ( seq -- elt ) [ length 2 - ] keep nth ;
 
 :: compress-path ( source assoc -- destination )
-    [let | destination [ source assoc at ] |
+    source assoc at :> destination
     source destination = [ source ] [
-            [let | destination' [ destination assoc compress-path ] |
+        destination assoc compress-path :> destination'
         destination' destination = [
             destination' source assoc set-at
         ] unless
         destination'
-            ]
+    ] if ;
-        ] if
-    ] ;

basis/concurrency/exchangers/exchangers-tests.factor

@@ -5,12 +5,11 @@ FROM: sequences => 3append ;
 IN: concurrency.exchangers.tests
 
 :: exchanger-test ( -- string )
-    [let |
+    <exchanger> :> ex
-        ex [ <exchanger> ]
+    2 <count-down> :> c
-        c [ 2 <count-down> ]
+    f :> v1!
-        v1! [ f ]
+    f :> v2!
-        v2! [ f ]
+    <promise> :> pr
-        pr [ <promise> ] |
 
     [
         c await
@@ -25,7 +24,6 @@ IN: concurrency.exchangers.tests
         "Hello world" ex exchange v2! c count-down
     ] "Exchanger 2" spawn drop
 
-        pr ?promise
+    pr ?promise ;
-    ] ;
 
 [ "Hello world, Goodbye world" ] [ exchanger-test ] unit-test

basis/concurrency/flags/flags-tests.factor

@@ -3,46 +3,41 @@ kernel threads locals accessors calendar ;
 IN: concurrency.flags.tests
 
 :: flag-test-1 ( -- val )
-    [let | f [ <flag> ] |
+    <flag> :> f
     [ f raise-flag ] "Flag test" spawn drop
     f lower-flag
-        f value>>
+    f value>> ;
-    ] ;
 
 [ f ] [ flag-test-1 ] unit-test
 
 :: flag-test-2 ( -- ? )
-    [let | f [ <flag> ] |
+    <flag> :> f
     [ 1 seconds sleep f raise-flag ] "Flag test" spawn drop
     f lower-flag
-        f value>>
+    f value>> ;
-    ] ;
 
 [ f ] [ flag-test-2 ] unit-test
 
 :: flag-test-3 ( -- val )
-    [let | f [ <flag> ] |
+    <flag> :> f
     f raise-flag
-        f value>>
+    f value>> ;
-    ] ;
 
 [ t ] [ flag-test-3 ] unit-test
 
 :: flag-test-4 ( -- val )
-    [let | f [ <flag> ] |
+    <flag> :> f
     [ f raise-flag ] "Flag test" spawn drop
     f wait-for-flag
-        f value>>
+    f value>> ;
-    ] ;
 
 [ t ] [ flag-test-4 ] unit-test
 
 :: flag-test-5 ( -- val )
-    [let | f [ <flag> ] |
+    <flag> :> f
     [ 1 seconds sleep f raise-flag ] "Flag test" spawn drop
     f wait-for-flag
-        f value>>
+    f value>> ;
-    ] ;
 
 [ t ] [ flag-test-5 ] unit-test
 

basis/concurrency/locks/locks-tests.factor

@@ -4,8 +4,8 @@ threads sequences calendar accessors ;
 IN: concurrency.locks.tests
 
 :: lock-test-0 ( -- v )
-    [let | v [ V{ } clone ]
+    V{ } clone :> v
-           c [ 2 <count-down> ] |
+    2 <count-down> :> c
 
     [
         yield
@@ -24,13 +24,12 @@ IN: concurrency.locks.tests
     ] "Lock test 2" spawn drop
 
     c await
-           v
+    v ;
-    ] ;
 
 :: lock-test-1 ( -- v )
-    [let | v [ V{ } clone ]
+    V{ } clone :> v
-           l [ <lock> ]
+    <lock> :> l
-           c [ 2 <count-down> ] |
+    2 <count-down> :> c
 
     [
         l [
@@ -53,8 +52,7 @@ IN: concurrency.locks.tests
     ] "Lock test 2" spawn drop
 
     c await
-           v
+    v ;
-    ] ;
 
 [ V{ 1 3 2 4 } ] [ lock-test-0 ] unit-test
 [ V{ 1 2 3 4 } ] [ lock-test-1 ] unit-test
@@ -80,11 +78,11 @@ IN: concurrency.locks.tests
 [ ] [ <rw-lock> dup [ [ ] with-read-lock ] with-write-lock ] unit-test
 
 :: rw-lock-test-1 ( -- v )
-    [let | l [ <rw-lock> ]
+    <rw-lock> :> l
-           c [ 1 <count-down> ]
+    1 <count-down> :> c
-           c' [ 1 <count-down> ]
+    1 <count-down> :> c'
-           c'' [ 4 <count-down> ]
+    4 <count-down> :> c''
-           v [ V{ } clone ] |
+    V{ } clone :> v
 
     [
         l [
@@ -124,16 +122,15 @@ IN: concurrency.locks.tests
     ] "R/W lock test 5" spawn drop
 
     c'' await
-           v
+    v ;
-    ] ;
 
 [ V{ 1 2 3 4 5 6 } ] [ rw-lock-test-1 ] unit-test
 
 :: rw-lock-test-2 ( -- v )
-    [let | l [ <rw-lock> ]
+    <rw-lock> :> l
-           c [ 1 <count-down> ]
+    1 <count-down> :> c
-           c' [ 2 <count-down> ]
+    2 <count-down> :> c'
-           v [ V{ } clone ] |
+    V{ } clone :> v
 
     [
         l [
@@ -154,14 +151,14 @@ IN: concurrency.locks.tests
     ] "R/W lock test 2" spawn drop
 
     c' await
-           v
+    v ;
-    ] ;
 
 [ V{ 1 2 3 } ] [ rw-lock-test-2 ] unit-test
 
 ! Test lock timeouts
 :: lock-timeout-test ( -- v )
-    [let | l [ <lock> ] |
+    <lock> :> l
+
     [
         l [ 1 seconds sleep ] with-lock
     ] "Lock holder" spawn drop
@@ -170,8 +167,7 @@ IN: concurrency.locks.tests
         l 1/10 seconds [ ] with-lock-timeout
     ] "Lock timeout-er" spawn-linked drop
 
-        receive
+    receive ;
-    ] ;
 
 [ lock-timeout-test ] [
     thread>> name>> "Lock timeout-er" =

basis/core-text/core-text.factor

@@ -112,17 +112,17 @@ TUPLE: line < disposable line metrics image loc dim ;
     [
         line new-disposable
 
-        [let* | open-font [ font cache-font ]
+        font cache-font :> open-font
-                line [ string open-font font foreground>> <CTLine> |CFRelease ]
+        string open-font font foreground>> <CTLine> |CFRelease :> line
 
-                rect [ line line-rect ]
+        line line-rect :> rect
-                (loc) [ rect origin>> CGPoint>loc ]
+        rect origin>> CGPoint>loc :> (loc)
-                (dim) [ rect size>> CGSize>dim ]
+        rect size>> CGSize>dim :> (dim)
-                (ext) [ (loc) (dim) v+ ]
+        (loc) (dim) v+ :> (ext)
-                loc [ (loc) [ floor ] map ]
+        (loc) [ floor ] map :> loc
-                ext [ (loc) (dim) [ + ceiling ] 2map ]
+        (loc) (dim) [ + ceiling ] 2map :> ext
-                dim [ ext loc [ - >integer 1 max ] 2map ]
+        ext loc [ - >integer 1 max ] 2map :> dim
-                metrics [ open-font line compute-line-metrics ] |
+        open-font line compute-line-metrics :> metrics
 
         line >>line
 
@@ -140,7 +140,6 @@ TUPLE: line < disposable line metrics image loc dim ;
         metrics loc dim line-loc >>loc
 
         metrics metrics>dim >>dim
-        ]
     ] with-destructors ;
 
 M: line dispose* line>> CFRelease ;

basis/cpu/ppc/ppc.factor

@@ -504,11 +504,11 @@ M: ppc %compare [ (%compare) ] 2dip %boolean ;
 M: ppc %compare-imm [ (%compare-imm) ] 2dip %boolean ;
 
 M:: ppc %compare-float-ordered ( dst src1 src2 cc temp -- )
-    src1 src2 cc negate-cc \ (%compare-float-ordered) (%compare-float) :> branch2 :> branch1
+    src1 src2 cc negate-cc \ (%compare-float-ordered) (%compare-float) :> ( branch1 branch2 )
     dst temp branch1 branch2 (%boolean) ;
 
 M:: ppc %compare-float-unordered ( dst src1 src2 cc temp -- )
-    src1 src2 cc negate-cc \ (%compare-float-unordered) (%compare-float) :> branch2 :> branch1
+    src1 src2 cc negate-cc \ (%compare-float-unordered) (%compare-float) :> ( branch1 branch2 )
     dst temp branch1 branch2 (%boolean) ;
 
 :: %branch ( label cc -- )
@@ -534,11 +534,11 @@ M:: ppc %compare-imm-branch ( label src1 src2 cc -- )
     branch2 [ label branch2 execute( label -- ) ] when ; inline
 
 M:: ppc %compare-float-ordered-branch ( label src1 src2 cc -- )
-    src1 src2 cc \ (%compare-float-ordered) (%compare-float) :> branch2 :> branch1
+    src1 src2 cc \ (%compare-float-ordered) (%compare-float) :> ( branch1 branch2 )
     label branch1 branch2 (%branch) ;
 
 M:: ppc %compare-float-unordered-branch ( label src1 src2 cc -- )
-    src1 src2 cc \ (%compare-float-unordered) (%compare-float) :> branch2 :> branch1
+    src1 src2 cc \ (%compare-float-unordered) (%compare-float) :> ( branch1 branch2 )
     label branch1 branch2 (%branch) ;
 
 : load-from-frame ( dst n rep -- )

basis/farkup/farkup.factor

@@ -114,8 +114,8 @@ DEFER: (parse-paragraph)
 
 :: (take-until) ( state delimiter accum -- string/f state' )
     state empty? [ accum "\n" join f ] [
-        state unclip-slice :> first :> rest
+        state unclip-slice :> ( rest first )
-        first delimiter split1 :> after :> before
+        first delimiter split1 :> ( before after )
         before accum push
         after [
             accum "\n" join

basis/fry/fry-docs.factor

@@ -68,10 +68,10 @@ ARTICLE: "fry.philosophy" "Fried quotation philosophy"
     "'[ [ _ key? ] all? ] filter"
     "[ [ key? ] curry all? ] curry filter"
 }
-"There is a mapping from fried quotations to lexical closures as defined in the " { $vocab-link "locals" } " vocabulary. Namely, a fried quotation is equivalent to a “let” form where each local binding is only used once, and bindings are used in the same order in which they are defined. The following two lines are equivalent:"
+"There is a mapping from fried quotations to lexical closures as defined in the " { $vocab-link "locals" } " vocabulary. Namely, a fried quotation is equivalent to a " { $snippet "[| | ]" } " form where each local binding is only used once, and bindings are used in the same order in which they are defined. The following two lines are equivalent:"
 { $code
     "'[ 3 _ + 4 _ / ]"
-    "[let | a [ ] b [ ] | [ 3 a + 4 b / ] ]"
+    "[| a b | 3 a + 4 b / ]"
 } ;
 
 ARTICLE: "fry" "Fried quotations"

basis/functors/functors.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays classes.mixin classes.parser
+USING: accessors arrays assocs classes.mixin classes.parser
 classes.singleton classes.tuple classes.tuple.parser
 combinators effects.parser fry functors.backend generic
 generic.parser interpolate io.streams.string kernel lexer
@@ -144,10 +144,31 @@ DEFER: ;FUNCTOR delimiter
 : pop-functor-words ( -- )
     functor-words unuse-words ;
 
+: (parse-bindings) ( end -- )
+    dup parse-binding dup [
+        first2 [ make-local ] dip 2array ,
+        (parse-bindings)
+    ] [ 2drop ] if ;
+
+: with-bindings ( quot -- words assoc )
+    '[
+        in-lambda? on
+        _ H{ } make-assoc
+    ] { } make swap ; inline
+
+: parse-bindings ( end -- words assoc )
+    [
+        namespace use-words
+        (parse-bindings)
+        namespace unuse-words
+    ] with-bindings ;
+
 : parse-functor-body ( -- form )
     push-functor-words
-    "WHERE" parse-bindings*
+    "WHERE" parse-bindings
-    [ \ ;FUNCTOR parse-until >quotation ] ((parse-lambda)) <let*> 1quotation
+    [ [ swap <def> suffix ] { } assoc>map concat ]
+    [ [ \ ;FUNCTOR parse-until >quotation ] ((parse-lambda)) ] bi*
+    [ ] append-as
     pop-functor-words ;
 
 : (FUNCTOR:) ( -- word def effect )

basis/furnace/auth/providers/providers.factor

@@ -23,7 +23,7 @@ GENERIC: new-user ( user provider -- user/f )
 ! Password recovery support
 
 :: issue-ticket ( email username provider -- user/f )
-    [let | user [ username provider get-user ] |
+    username provider get-user :> user
     user [
         user email>> length 0 > [
             user email>> email = [
@@ -32,17 +32,15 @@ GENERIC: new-user ( user provider -- user/f )
                 dup provider update-user
             ] [ f ] if
         ] [ f ] if
-        ] [ f ] if
+    ] [ f ] if ;
-    ] ;
 
 :: claim-ticket ( ticket username provider -- user/f )
-    [let | user [ username provider get-user ] |
+    username provider get-user :> user
     user [
         user ticket>> ticket = [
             user f >>ticket dup provider update-user
         ] [ f ] if
-        ] [ f ] if
+    ] [ f ] if ;
-    ] ;
 
 ! For configuration
 

basis/interpolate/interpolate-tests.factor

@@ -16,7 +16,8 @@ IN: interpolate.tests
 ] unit-test
 
 [ "Oops, I accidentally the whole economy..." ] [
-    [let | noun [ "economy" ] |
+    [let
+        "economy" :> noun
         [ I[ Oops, I accidentally the whole ${noun}...]I ] with-string-writer
     ]
 ] unit-test

basis/io/encodings/gb18030/gb18030.factor

@@ -48,7 +48,8 @@ TUPLE: range ufirst ulast bfirst blast ;
     ] dip set-at ;
 
 : xml>gb-data ( stream -- mapping ranges )
-    [let | mapping [ H{ } clone ] ranges [ V{ } clone ] |
+    [let
+        H{ } clone :> mapping V{ } clone :> ranges
         [
             dup contained? [ 
                 dup name>> main>> {

basis/io/launcher/unix/unix-tests.factor

@@ -125,8 +125,9 @@ concurrency.promises threads unix.process ;
 
 ! Killed processes were exiting with code 0 on FreeBSD
 [ f ] [
-    [let | p [ <promise> ]
+    [let 
-           s [ <promise> ] |
+        <promise> :> p
+        <promise> :> s
         [
             "sleep 1000" run-detached
             [ p fulfill ] [ wait-for-process s fulfill ] bi

basis/io/mmap/windows/windows.factor

@@ -12,14 +12,13 @@ IN: io.mmap.windows
     MapViewOfFile [ win32-error=0/f ] keep ;
 
 :: mmap-open ( path length access-mode create-mode protect access -- handle handle address )
-    [let | lo [ length 32 bits ]
+    length 32 bits :> lo
-           hi [ length -32 shift 32 bits ] |
+    length -32 shift 32 bits :> hi
     { "SeCreateGlobalPrivilege" "SeLockMemoryPrivilege" } [
         path access-mode create-mode 0 open-file |dispose
         dup handle>> f protect hi lo f create-file-mapping |dispose
         dup handle>> access 0 0 0 map-view-of-file
-        ] with-privileges
+    ] with-privileges ;
-    ] ;
 
 TUPLE: win32-mapped-file file mapping ;
 

basis/io/monitors/macosx/macosx.factor

@@ -11,11 +11,10 @@ TUPLE: macosx-monitor < monitor handle ;
     '[ first { +modify-file+ } _ queue-change ] each ;
 
 M:: macosx (monitor) ( path recursive? mailbox -- monitor )
-    [let | path [ path normalize-path ] |
+    path normalize-path :> path
     path mailbox macosx-monitor new-monitor
     dup [ enqueue-notifications ] curry
-        path 1array 0 0 <event-stream> >>handle
+    path 1array 0 0 <event-stream> >>handle ;
-    ] ;
 
 M: macosx-monitor dispose* handle>> dispose ;
 

basis/io/sockets/secure/openssl/openssl.factor

@@ -35,10 +35,9 @@ TUPLE: openssl-context < secure-context aliens sessions ;
     [| buf size rwflag password! |
         password [ B{ 0 } password! ] unless
 
-        [let | len [ password strlen ] |
+        password strlen :> len
         buf password len 1 + size min memcpy
         len
-        ]
     ] alien-callback ;
 
 : default-pasword ( ctx -- alien )

basis/io/sockets/unix/unix.factor

@@ -120,7 +120,7 @@ CONSTANT: packet-size 65536
 [ packet-size malloc receive-buffer set-global ] "io.sockets.unix" add-init-hook
 
 :: do-receive ( port -- packet sockaddr )
-    port addr>> empty-sockaddr/size :> len :> sockaddr
+    port addr>> empty-sockaddr/size :> ( sockaddr len )
     port handle>> handle-fd ! s
     receive-buffer get-global ! buf
     packet-size ! nbytes

basis/lcs/lcs.factor

@@ -25,11 +25,11 @@ IN: lcs
     [ [ + ] curry map ] with map ;
 
 :: run-lcs ( old new init step -- matrix )
-    [let | matrix [ old length 1 + new length 1 + init call ] |
+    old length 1 + new length 1 + init call :> matrix
     old length [| i |
         new length
         [| j | i j matrix old new step loop-step ] each
-        ] each matrix ] ; inline
+    ] each matrix ; inline
 PRIVATE>
 
 : levenshtein ( old new -- n )

basis/locals/errors/errors.factor

@@ -9,10 +9,10 @@ M: >r/r>-in-lambda-error summary
     drop
     "Explicit retain stack manipulation is not permitted in lambda bodies" ;
 
-ERROR: binding-form-in-literal-error ;
+ERROR: let-form-in-literal-error ;
 
-M: binding-form-in-literal-error summary
+M: let-form-in-literal-error summary
-    drop "[let, [let* and [wlet not permitted inside literals" ;
+    drop "[let not permitted inside literals" ;
 
 ERROR: local-writer-in-literal-error ;
 
@@ -27,7 +27,7 @@ M: local-word-in-literal-error summary
 ERROR: :>-outside-lambda-error ;
 
 M: :>-outside-lambda-error summary
-    drop ":> cannot be used outside of lambda expressions" ;
+    drop ":> cannot be used outside of [let, [|, or :: forms" ;
 
 ERROR: bad-local args obj ;
 

basis/locals/fry/fry.factor

@@ -6,7 +6,7 @@ IN: locals.fry
 
 ! Support for mixing locals with fry
 
-M: binding-form count-inputs body>> count-inputs ;
+M: let count-inputs body>> count-inputs ;
 
 M: lambda count-inputs body>> count-inputs ;
 
@@ -14,5 +14,5 @@ M: lambda deep-fry
     clone [ shallow-fry swap ] change-body
     [ [ vars>> length ] keep '[ _ _ mnswap @ ] , ] [ drop [ncurry] % ] 2bi ;
 
-M: binding-form deep-fry
+M: let deep-fry
     clone [ fry '[ @ call ] ] change-body , ;

basis/locals/locals-docs.factor

@@ -8,45 +8,30 @@ HELP: [|
 { $examples "See " { $link "locals-examples" } "." } ;
 
 HELP: [let
-{ $syntax "[let | var-1 [ value-1... ]\n        var-2 [ value-2... ]\n        ... |\n    body... ]" }
+{ $syntax "[let code :> var code :> var code... ]" }
-{ $description "Evaluates each " { $snippet "value-n" } " form and binds its result to a new local variable named " { $snippet "var-n" } " lexically scoped to the " { $snippet "body" } ", then evaluates " { $snippet "body" } ". The " { $snippet "value-n" } " forms are evaluated in parallel, so a " { $snippet "value-n" } " form may not refer to previous " { $snippet "var-n" } " definitions inside the same " { $link POSTPONE: [let } " form, unlike " { $link POSTPONE: [let* } "." }
+{ $description "Establishes a new lexical scope for local variable bindings. Variables bound with " { $link POSTPONE: :> } " within the body of the " { $snippet "[let" } " will be lexically scoped to the body of the " { $snippet "[let" } " form." }
 { $examples "See " { $link "locals-examples" } "." } ;
 
-HELP: [let*
-{ $syntax "[let* | var-1 [ value-1... ]\n        var-2 [ value-2... ]\n        ... |\n    body... ]" }
-{ $description "Evaluates each " { $snippet "value-n" } " form and binds its result to a new local variable named " { $snippet "var-n" } " lexically scoped to the " { $snippet "body" } ", then evaluates " { $snippet "body" } ". The " { $snippet "value-n" } " forms are evaluated sequentially, so a " { $snippet "value-n" } " form may refer to previous " { $snippet "var-n" } " definitions inside the same " { $link POSTPONE: [let* } " form." }
-{ $examples "See " { $link "locals-examples" } "." } ;
-
-{ POSTPONE: [let POSTPONE: [let* } related-words
-
-HELP: [wlet
-{ $syntax "[wlet | binding1 [ body1... ]\n        binding2 [ body2... ]\n        ... |\n     body... ]" }
-{ $description "Introduces a set of lexically-scoped non-recursive local functions. The bodies may not refer to other bindings within the same " { $link POSTPONE: [wlet } " form." }
-{ $examples
-    { $example
-        "USING: locals math prettyprint sequences ;"
-        "IN: scratchpad"
-        ":: quuxify ( n seq -- newseq )"
-        "    [wlet | add-n [| m | m n + ] |"
-        "        seq [ add-n ] map ] ;"
-        "2 { 1 2 3 } quuxify ."
-        "{ 3 4 5 }"
-    }
-} ;
-
 HELP: :>
-{ $syntax ":> var" ":> var!" }
+{ $syntax ":> var" ":> var!" ":> ( var-1 var-2 ... )" }
-{ $description "Binds the value on the top of the datastack to a new local variable named " { $snippet "var" } ", lexically scoped to the enclosing quotation or definition."
+{ $description "Binds one or more new local variables. In the " { $snippet ":> var" } " form, the value on the top of the datastack to a new local variable named " { $snippet "var" } ", lexically scoped to the enclosing quotation, " { $link POSTPONE: [let } " form, or " { $link POSTPONE: :: } " definition."
 $nl
-"If the " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), the new variable will be mutable. See " { $link "locals-mutable" } " for more information on mutable local bindings." }
+"The " { $snippet ":> ( var-1 ... )" } " form binds multiple local variables from the top of the datastack in left to right order. These two snippets would have the same effect:"
+{ $code ":> c :> b :> a" }
+{ $code ":> ( a b c )" }
+$nl
+"If any " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), that new variable will be mutable. See " { $link "locals-mutable" } " for more information on mutable local bindings." }
 { $notes
-    "This syntax can only be used inside a " { $link POSTPONE: :: } " word, " { $link POSTPONE: [let } ", " { $link POSTPONE: [let* } ",  or " { $link POSTPONE: [wlet } " form, or inside a quotation literal inside one of those forms."
+    "This syntax can only be used inside a lexical scope established by a " { $link POSTPONE: :: } " definition, " { $link POSTPONE: [let } " form, or " { $link POSTPONE: [| } " quotation. Definition forms such as " { $link POSTPONE: : } " do not establish a lexical scope by themselves, nor is there a lexical scope available at the top level of source files or in the listener. To use local variable bindings in these situations, use " { $link POSTPONE: [let } " to provide a scope for them." }
-}
 { $examples "See " { $link "locals-examples" } "." } ;
 
+{ POSTPONE: [let POSTPONE: :> } related-words
+
 HELP: ::
-{ $syntax ":: word ( bindings... -- outputs... ) body... ;" }
+{ $syntax ":: word ( vars... -- outputs... ) body... ;" }
-{ $description "Defines a word with named inputs; it reads datastack values into local variable bindings from left to right, then executes the body with those bindings in lexical scope." }
+{ $description "Defines a word with named inputs; it reads datastack values into local variable bindings from left to right, then executes the body with those bindings in lexical scope."
+$nl
+"If any of the " { $snippet "vars" } "' names is followed by an exclamation point (" { $snippet "!" } "), that variable will be mutable. See " { $link "locals-mutable" } " for more information on mutable local bindings." }
 { $notes "The names of the " { $snippet "outputs" } " do not affect the word's behavior. However, the compiler verifies that the stack effect accurately represents the number of outputs as with " { $link POSTPONE: : } " definitions." }
 { $examples "See " { $link "locals-examples" } "." } ;
 
@@ -54,21 +39,27 @@ HELP: ::
 
 HELP: MACRO::
 { $syntax "MACRO:: word ( bindings... -- outputs... ) body... ;" }
-{ $description "Defines a macro with named inputs; it reads datastack values into local variable bindings from left to right, then executes the body with those bindings in lexical scope." }
+{ $description "Defines a macro with named inputs; it reads datastack values into local variable bindings from left to right, then executes the body with those bindings in lexical scope."
+$nl
+"If any of the " { $snippet "vars" } "' names is followed by an exclamation point (" { $snippet "!" } "), that variable will be mutable. See " { $link "locals-mutable" } " for more information on mutable local bindings." }
 { $examples "See " { $link "locals-examples" } "." } ;
 
 { POSTPONE: MACRO: POSTPONE: MACRO:: } related-words
 
 HELP: MEMO::
 { $syntax "MEMO:: word ( bindings... -- outputs... ) body... ;" }
-{ $description "Defines a macro with named inputs; it reads datastack values into local variable bindings from left to right, then executes the body with those bindings in lexical scope." }
+{ $description "Defines a memoized word with named inputs; it reads datastack values into local variable bindings from left to right, then executes the body with those bindings in lexical scope."
+$nl
+"If any of the " { $snippet "vars" } "' names is followed by an exclamation point (" { $snippet "!" } "), that variable will be mutable. See " { $link "locals-mutable" } " for more information on mutable local bindings." }
 { $examples "See " { $link "locals-examples" } "." } ;
 
 { POSTPONE: MEMO: POSTPONE: MEMO:: } related-words
                                           
 HELP: M::
 { $syntax "M:: class generic ( bindings... -- outputs... ) body... ;" }
-{ $description "Defines a macro with named inputs; it reads datastack values into local variable bindings from left to right, then executes the body with those bindings in lexical scope." }
+{ $description "Defines a new method on " { $snippet "generic" } " for " { $snippet "class" } " with named inputs; it reads datastack values into local variable bindings from left to right, then executes the body with those bindings in lexical scope."
+$nl
+"If any of the " { $snippet "vars" } "' names is followed by an exclamation point (" { $snippet "!" } "), that variable will be mutable. See " { $link "locals-mutable" } " for more information on mutable local bindings." }
 { $notes "The names of the " { $snippet "outputs" } " do not affect the word's behavior. However, the compiler verifies that the stack effect accurately represents the number of outputs as with " { $link POSTPONE: M: } " definitions." }
 { $examples "See " { $link "locals-examples" } "." } ;
 
@@ -86,14 +77,13 @@ IN: scratchpad
 """2.0
 -3.0"""
 }
-{ $snippet "quadratic-roots" } " can also be expressed with " { $link POSTPONE: [let } ":"
+"If you wanted to perform the quadratic formula interactively from the listener, you could use " { $link POSTPONE: [let } " to provide a scope for the local variables:"
 { $example """USING: locals math math.functions kernel ;
 IN: scratchpad
-:: quadratic-roots ( a b c -- x y )
+[let 1.0 :> a 1.0 :> b -6.0 :> c
-    [let | disc [ b sq 4 a c * * - sqrt ] |
+    b sq 4 a c * * - sqrt :> disc
     b neg disc [ + ] [ - ] 2bi [ 2 a * / ] bi@
-    ] ;
+] [ . ] bi@"""
-1.0 1.0 -6.0 quadratic-roots [ . ] bi@"""
 """2.0
 -3.0"""
 }
@@ -216,11 +206,11 @@ $nl
 "One exception to the above rule is that array instances containing free local variables (that is, immutable local variables not referenced in a closure) do retain identity. This allows macros such as " { $link cond } " to recognize that the array is constant and expand at compile time." ;
 
 ARTICLE: "locals-mutable" "Mutable locals"
-"In the list of bindings supplied to " { $link POSTPONE: :: } ", " { $link POSTPONE: [let } ", " { $link POSTPONE: [let* } " or " { $link POSTPONE: [| } ", a mutable binding may be introduced by suffixing its named with " { $snippet "!" } ". Mutable bindings are read by giving their name as usual; the suffix is not part of the binding's name. To write to a mutable binding, use the binding's name with the " { $snippet "!" } " suffix."
+"Whenever a local variable is bound using " { $link POSTPONE: :> } ", " { $link POSTPONE: :: } ", or " { $link POSTPONE: [| } ", the variable may be made mutable by suffixing its name with an exclamation point (" { $snippet "!" } ") when it is bound. The variable's value can be read by giving its name without the exclamation point as usual. To write to the variable, use its name with the " { $snippet "!" } " suffix."
 $nl
 "Mutable bindings are implemented in a manner similar to the ML language; each mutable binding is actually an immutable binding of a mutable cell (in Factor's case, a 1-element array); reading the binding automatically dereferences the array, and writing to the binding stores into the array."
 $nl
-"Writing to mutable locals in outer scopes is fully supported and has the expected semantics. See " { $link "locals-examples" } " for examples of mutable local variables in action." ;
+"Writing to mutable locals in outer scopes is fully supported and has full closure semantics. See " { $link "locals-examples" } " for examples of mutable local variables in action." ;
 
 ARTICLE: "locals-fry" "Locals and fry"
 "Locals integrate with " { $link "fry" } " so that mixing locals with fried quotations gives intuitive results."
@@ -296,12 +286,10 @@ ARTICLE: "locals" "Lexical variables and closures"
     POSTPONE: MEMO::
     POSTPONE: MACRO::
 }
-"Lexical binding forms:"
+"Lexical scoping and binding forms:"
 { $subsections
-    POSTPONE: :>
     POSTPONE: [let
-    POSTPONE: [let*
+    POSTPONE: :>
-    POSTPONE: [wlet
 }
 "Quotation literals where the inputs are named local variables:"
 { $subsections POSTPONE: [| }

basis/locals/locals-tests.factor

@@ -26,58 +26,35 @@ IN: locals.tests
 [ { 5 6 7 } ] [ { 1 2 3 } 4 map-test-2 ] unit-test
 
 :: let-test ( c -- d )
-    [let | a [ 1 ] b [ 2 ] | a b + c + ] ;
+    [let 1 :> a 2 :> b a b + c + ] ;
 
 [ 7 ] [ 4 let-test ] unit-test
 
 :: let-test-2 ( a -- a )
-    a [let | a [ ] | [let | b [ a ] | a ] ] ;
+    a [let :> a [let a :> b a ] ] ;
 
 [ 3 ] [ 3 let-test-2 ] unit-test
 
 :: let-test-3 ( a -- a )
-    a [let | a [ ] | [let | b [ [ a ] ] | [let | a [ 3 ] | b ] ] ] ;
+    a [let :> a [let [ a ] :> b [let 3 :> a b ] ] ] ;
 
 :: let-test-4 ( a -- b )
-    a [let | a [ 1 ] b [ ] | a b 2array ] ;
+    a [let 1 :> a :> b a b 2array ] ;
 
 [ { 1 2 } ] [ 2 let-test-4 ] unit-test
 
 :: let-test-5 ( a b -- b )
-    a b [let | a [ ] b [ ] | a b 2array ] ;
+    a b [let :> a :> b a b 2array ] ;
 
 [ { 2 1 } ] [ 1 2 let-test-5 ] unit-test
 
 :: let-test-6 ( a -- b )
-    a [let | a [ ] b [ 1 ] | a b 2array ] ;
+    a [let :> a 1 :> b a b 2array ] ;
 
 [ { 2 1 } ] [ 2 let-test-6 ] unit-test
 
 [ -1 ] [ -1 let-test-3 call ] unit-test
 
-[ 5 ] [
-    [let | a [ 3 ] | [wlet | func [ a + ] | 2 func ] ]
-] unit-test
-
-:: wlet-test-2 ( a b -- seq )
-    [wlet | add-b [ b + ] |
-        a [ add-b ] map ] ;
-
-
-[ { 4 5 6 } ] [ { 2 3 4 } 2 wlet-test-2 ] unit-test
-    
-:: wlet-test-3 ( a -- b )
-    [wlet | add-a [ a + ] | [ add-a ] ]
-    [let | a [ 3 ] | a swap call ] ;
-
-[ 5 ] [ 2 wlet-test-3 ] unit-test
-
-:: wlet-test-4 ( a -- b )
-    [wlet | sub-a [| b | b a - ] |
-        3 sub-a ] ;
-
-[ -7 ] [ 10 wlet-test-4 ] unit-test
-
 :: write-test-1 ( n! -- q )
     [| i | n i + dup n! ] ;
 
@@ -94,8 +71,7 @@ IN: locals.tests
 [ 5 ] [ 2 "q" get call ] unit-test
 
 :: write-test-2 ( -- q )
-    [let | n! [ 0 ] |
+    [let 0 :> n! [| i | n i + dup n! ] ] ;
-        [| i | n i + dup n! ] ] ;
 
 write-test-2 "q" set
 
@@ -116,17 +92,11 @@ write-test-2 "q" set
 
 [ ] [ 1 2 write-test-3 call ] unit-test
 
-:: write-test-4 ( x! -- q ) [ [let | y! [ 0 ] | f x! ] ] ;
+:: write-test-4 ( x! -- q ) [ [let 0 :> y! f x! ] ] ;
 
 [ ] [ 5 write-test-4 drop ] unit-test
 
-! Not really a write test; just enforcing consistency
+:: let-let-test ( n -- n ) [let n 3 + :> n n ] ;
-:: write-test-5 ( x -- y )
-    [wlet | fun! [ x + ] | 5 fun! ] ;
-
-[ 9 ] [ 4 write-test-5 ] unit-test
-
-:: let-let-test ( n -- n ) [let | n [ n 3 + ] | n ] ;
 
 [ 13 ] [ 10 let-let-test ] unit-test
 
@@ -164,18 +134,12 @@ M:: string lambda-generic ( a b -- c ) a b lambda-generic-2 ;
 
 [ ] [ \ lambda-generic see ] unit-test
 
-:: unparse-test-1 ( a -- ) [let | a! [ 3 ] | ] ;
+:: unparse-test-1 ( a -- ) [let 3 :> a! 4 :> b ] ;
 
-[ "[let | a! [ 3 ] | ]" ] [
+[ "[let 3 :> a! 4 :> b ]" ] [
     \ unparse-test-1 "lambda" word-prop body>> first unparse
 ] unit-test
 
-:: unparse-test-2 ( -- ) [wlet | a! [ ] | ] ;
-
-[ "[wlet | a! [ ] | ]" ] [
-    \ unparse-test-2 "lambda" word-prop body>> first unparse
-] unit-test
-
 :: unparse-test-3 ( -- b ) [| a! | ] ;
 
 [ "[| a! | ]" ] [
@@ -198,38 +162,6 @@ DEFER: xyzzy
 
 [ 5 ] [ 10 xyzzy ] unit-test
 
-:: let*-test-1 ( a -- b )
-    [let* | b [ a 1 + ]
-            c [ b 1 + ] |
-        a b c 3array ] ;
-
-[ { 1 2 3 } ] [ 1 let*-test-1 ] unit-test
-
-:: let*-test-2 ( a -- b )
-    [let* | b [ a 1 + ]
-            c! [ b 1 + ] |
-        a b c 3array ] ;
-
-[ { 1 2 3 } ] [ 1 let*-test-2 ] unit-test
-
-:: let*-test-3 ( a -- b )
-    [let* | b [ a 1 + ]
-            c! [ b 1 + ] |
-        c 1 + c!  a b c 3array ] ;
-
-[ { 1 2 4 } ] [ 1 let*-test-3 ] unit-test
-
-:: let*-test-4 ( a b -- c d )
-    [let | a [ b ]
-           b [ a ] |
-        [let* | a'  [ a  ]
-                a'' [ a' ]
-                b'  [ b  ]
-                b'' [ b' ] |
-            a'' b'' ] ] ;
-
-[ "xxx" "yyy" ] [ "yyy" "xxx" let*-test-4 ] unit-test
-
 GENERIC: next-method-test ( a -- b )
 
 M: integer next-method-test 3 + ;
@@ -244,11 +176,11 @@ M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ;
 
 { 3 0 } [| a b c | ] must-infer-as
 
-[ ] [ 1 [let | a [ ] | ] ] unit-test
+[ ] [ 1 [let :> a ] ] unit-test
 
-[ 3 ] [ 1 [let | a [ ] | 3 ] ] unit-test
+[ 3 ] [ 1 [let :> a 3 ] ] unit-test
 
-[ ] [ 1 2 [let | a [ ] b [ ] | ] ] unit-test
+[ ] [ 1 2 [let :> a :> b ] ] unit-test
 
 :: a-word-with-locals ( a b -- ) ;
 
@@ -306,10 +238,10 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
 [ t ] [ 12 &&-test ] unit-test
 
 :: let-and-cond-test-1 ( -- a )
-    [let | a [ 10 ] |
+    [let 10 :> a
-        [let | a [ 20 ] |
+        [let 20 :> a
             {
-                { [ t ] [ [let | c [ 30 ] | a ] ] }
+                { [ t ] [ [let 30 :> c a ] ] }
             } cond
         ]
     ] ;
@@ -319,8 +251,8 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
 [ 20 ] [ let-and-cond-test-1 ] unit-test
 
 :: let-and-cond-test-2 ( -- pair )
-    [let | A [ 10 ] |
+    [let 10 :> A
-        [let | B [ 20 ] |
+        [let 20 :> B
             { { [ t ] [ { A B } ] } } cond
         ]
     ] ;
@@ -333,7 +265,7 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
 [ { 10 20    } ] [ 10 20    [| a b   | { a b   } ] call ] unit-test
 [ { 10 20 30 } ] [ 10 20 30 [| a b c | { a b c } ] call ] unit-test
 
-[ { 10 20 30 } ] [ [let | a [ 10 ] b [ 20 ] c [ 30 ] | { a b c } ] ] unit-test
+[ { 10 20 30 } ] [ [let 10 :> a 20 :> b 30 :> c { a b c } ] ] unit-test
 
 [ V{ 10 20 30 } ] [ 10 20 30 [| a b c | V{ a b c } ] call ] unit-test
 
@@ -453,7 +385,7 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
 [ 10 ] [ 10 [| A | { [ A ] } ] call first call ] unit-test
 
 [
-    "USING: locals fry math ; 1 '[ [let | A [ 10 ] | A _ + ] ]"
+    "USING: locals fry math ; 1 '[ [let 10 :> A A _ + ] ]"
     eval( -- ) call
 ] [ error>> >r/r>-in-fry-error? ] must-fail-with
     
@@ -465,10 +397,7 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
 [ t ] [ 3 funny-macro-test ] unit-test
 [ f ] [ 2 funny-macro-test ] unit-test
 
-! Some odd parser corner cases
 [ "USE: locals [let" eval( -- ) ] [ error>> unexpected-eof? ] must-fail-with
-[ "USE: locals [let |" eval( -- ) ] [ error>> unexpected-eof? ] must-fail-with
-[ "USE: locals [let | a" eval( -- ) ] [ error>> unexpected-eof? ] must-fail-with
 [ "USE: locals [|" eval( -- ) ] [ error>> unexpected-eof? ] must-fail-with
 
 [ 25 ] [ 5 [| a | { [ a sq ] } cond ] call ] unit-test
@@ -484,15 +413,9 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
 
 [ 3 ] [ 3 [| a | \ a ] call ] unit-test
 
-[ "USE: locals [| | { [let | a [ 0 ] | a ] } ]" eval( -- ) ] must-fail
+[ "USE: locals [| | { [let 0 :> a a ] } ]" eval( -- ) ] must-fail
 
-[ "USE: locals [| | { [wlet | a [ 0 ] | a ] } ]" eval( -- ) ] must-fail
+[ "USE: locals [| | [let 0 :> a! { 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
 
 [ "USE: locals [| | { :> a } ]" eval( -- ) ] must-fail
 
@@ -504,27 +427,14 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
 
 [ 3 ] [ 2 [| | :> a! a 1 + 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? ] } &&
-    ] ;
-
-\ wlet-&&-test def>> 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 ] ;
+    [let 6 '[ [let 4 :> A A _ + ] ] call ] ;
 
 \ fry-locals-test-1 def>> must-infer
 [ 10 ] [ fry-locals-test-1 ] unit-test
 
 :: fry-locals-test-2 ( -- n )
-    [let | | 6 '[ [let | A [ 4 ] | A _ + ] ] call ] ;
+    [let 6 '[ [let 4 :> A A _ + ] ] call ] ;
 
 \ fry-locals-test-2 def>> must-infer
 [ 10 ] [ fry-locals-test-2 ] unit-test
@@ -542,18 +452,18 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
 ] unit-test
 
 [ 10 ] [
-    [| | 0 '[ [let | A [ 10 ] | A _ + ] ] call ] call
+    [| | 0 '[ [let 10 :> A A _ + ] ] call ] call
 ] unit-test
 
 ! littledan found this problem
-[ "bar" ] [ [let | a [ [let | foo [ "bar" ] | foo ] ] | a ] ] unit-test
+[ "bar" ] [ [let [let "bar" :> foo foo ] :> a a ] ] unit-test
-[ 10 ] [ [let | a [ 10 ] | [let | b [ a ] | b ] ] ] unit-test
+[ 10 ] [ [let 10 :> a [let a :> b b ] ] ] unit-test
 
-[ { \ + } ] [ [let | x [ \ + ] | { \ x } ] ] unit-test
+[ { \ + } ] [ [let \ + :> x { \ x } ] ] unit-test
 
-[ { \ + 3 } ] [ [let | a [ 3 ] | { \ + a } ] ] unit-test
+[ { \ + 3 } ] [ [let 3 :> a { \ + a } ] ] unit-test
 
-[ 3 ] [ [let | a [ \ + ] | 1 2 [ \ a execute ] ] call ] unit-test
+[ 3 ] [ [let \ + :> a 1 2 [ \ a execute ] ] call ] unit-test
 
 ! erg found this problem
 :: erg's-:>-bug ( n ? -- n ) ? [ n :> n n ] [ n :> b b ] if ;
@@ -578,3 +488,6 @@ M: integer ed's-bug neg ;
    { [ a ed's-bug ] } && ;
 
 [ t ] [ \ ed's-test-case optimized? ] unit-test
+
+! multiple bind
+[ 3 1 2 ] [ [let 1 2 3 :> ( a b c ) c a b ] ] unit-test

basis/locals/locals.factor

@@ -7,16 +7,12 @@ IN: locals
 
 SYNTAX: :>
     scan locals get [ :>-outside-lambda-error ] unless*
-    [ make-local ] bind <def> suffix! ;
+    parse-def suffix! ;
 
 SYNTAX: [| parse-lambda append! ;
 
 SYNTAX: [let parse-let append! ;
 
-SYNTAX: [let* parse-let* append! ;
-
-SYNTAX: [wlet parse-wlet append! ;
-
 SYNTAX: :: (::) define-declared ;
 
 SYNTAX: M:: (M::) define ;

basis/locals/macros/macros.factor

@@ -7,12 +7,10 @@ M: lambda expand-macros clone [ expand-macros ] change-body ;
 
 M: lambda expand-macros* expand-macros literal ;
 
-M: binding-form expand-macros
+M: let expand-macros
-    clone
+    clone [ expand-macros ] change-body ;
-        [ [ expand-macros ] assoc-map ] change-bindings
-        [ expand-macros ] change-body ;
 
-M: binding-form expand-macros* expand-macros literal ;
+M: let expand-macros* expand-macros literal ;
 
 M: lambda condomize? drop t ;
 

basis/locals/parser/parser.factor

@@ -46,6 +46,12 @@ SYMBOL: locals
     (parse-lambda) <lambda>
     ?rewrite-closures ;
 
+: parse-multi-def ( locals -- multi-def )
+    ")" parse-tokens swap [ [ make-local ] map ] bind <multi-def> ;
+
+: parse-def ( name/paren locals -- def )
+    over "(" = [ nip parse-multi-def ] [ [ make-local ] bind <def> ] if ;
+
 M: lambda-parser parse-quotation ( -- quotation )
     H{ } clone (parse-lambda) ;
 
@@ -56,48 +62,8 @@ M: lambda-parser parse-quotation ( -- quotation )
         [ nip scan-object 2array ]
     } cond ;
 
-: (parse-bindings) ( end -- )
-    dup parse-binding dup [
-        first2 [ make-local ] dip 2array ,
-        (parse-bindings)
-    ] [ 2drop ] if ;
-
-: with-bindings ( quot -- words assoc )
-    '[
-        in-lambda? on
-        _ H{ } make-assoc
-    ] { } make swap ; inline
-
-: parse-bindings ( end -- bindings vars )
-    [ (parse-bindings) ] with-bindings ;
-
 : parse-let ( -- form )
-    "|" expect "|" parse-bindings
+    H{ } clone (parse-lambda) <let> ?rewrite-closures ;
-    (parse-lambda) <let> ?rewrite-closures ;
-
-: parse-bindings* ( end -- words assoc )
-    [
-        namespace use-words
-        (parse-bindings)
-        namespace unuse-words
-    ] with-bindings ;
-
-: parse-let* ( -- form )
-    "|" expect "|" parse-bindings*
-    (parse-lambda) <let*> ?rewrite-closures ;
-
-: (parse-wbindings) ( end -- )
-    dup parse-binding dup [
-        first2 [ make-local-word ] keep 2array ,
-        (parse-wbindings)
-    ] [ 2drop ] if ;
-
-: parse-wbindings ( end -- bindings vars )
-    [ (parse-wbindings) ] with-bindings ;
-
-: parse-wlet ( -- form )
-    "|" expect "|" parse-wbindings
-    (parse-lambda) <wlet> ?rewrite-closures ;
 
 : parse-locals ( -- effect vars assoc )
     complete-effect

basis/locals/prettyprint/prettyprint.factor

@@ -27,22 +27,17 @@ M: lambda pprint*
 
 : pprint-let ( let word -- )
     pprint-word
-    [ body>> ] [ bindings>> ] bi
+    <block body>> pprint-elements block>
-    \ | pprint-word
-    t <inset
-    <block
-    [ <block [ pprint-var ] dip pprint* block> ] assoc-each
-    block>
-    \ | pprint-word
-    <block pprint-elements block>
-    block>
     \ ] pprint-word ;
 
 M: let pprint* \ [let pprint-let ;
 
-M: wlet pprint* \ [wlet pprint-let ;
-
-M: let* pprint* \ [let* pprint-let ;
-
 M: def pprint*
-    <block \ :> pprint-word local>> pprint-word block> ;
+    dup local>> word?
+    [ <block \ :> pprint-word local>> pprint-var block> ]
+    [ pprint-tuple ] if ;
+
+M: multi-def pprint*
+    dup locals>> [ word? ] all?
+    [ <block \ :> pprint-word "(" text locals>> [ pprint-var ] each ")" text block> ]
+    [ pprint-tuple ] if ;

basis/locals/rewrite/sugar/sugar.factor

@@ -6,7 +6,7 @@ locals.errors locals.types make quotations sequences vectors
 words ;
 IN: locals.rewrite.sugar
 
-! Step 1: rewrite [| [let [let* [wlet into :> forms, turn
+! Step 1: rewrite [| into :> forms, turn
 ! literals with locals in them into code which constructs
 ! the literal after pushing locals on the stack
 
@@ -73,7 +73,7 @@ M: quotation rewrite-element rewrite-sugar* ;
 
 M: lambda rewrite-element rewrite-sugar* ;
 
-M: binding-form rewrite-element binding-form-in-literal-error ;
+M: let rewrite-element let-form-in-literal-error ;
 
 M: local rewrite-element , ;
 
@@ -104,6 +104,8 @@ M: tuple rewrite-sugar* rewrite-element ;
 
 M: def rewrite-sugar* , ;
 
+M: multi-def rewrite-sugar* locals>> <reversed> [ <def> , ] each ;
+
 M: hashtable rewrite-sugar* rewrite-element ;
 
 M: wrapper rewrite-sugar*
@@ -115,17 +117,5 @@ M: word rewrite-sugar*
 
 M: object rewrite-sugar* , ;
 
-: let-rewrite ( body bindings -- )
-    [ quotation-rewrite % <def> , ] assoc-each
-    quotation-rewrite % ;
-
 M: let rewrite-sugar*
-    [ body>> ] [ bindings>> ] bi let-rewrite ;
+    body>> quotation-rewrite % ;
-
-M: let* rewrite-sugar*
-    [ body>> ] [ bindings>> ] bi let-rewrite ;
-
-M: wlet rewrite-sugar*
-    [ body>> ] [ bindings>> ] bi
-    [ '[ _ ] ] assoc-map
-    let-rewrite ;

basis/locals/types/types.factor

@@ -8,20 +8,10 @@ TUPLE: lambda vars body ;
 
 C: <lambda> lambda
 
-TUPLE: binding-form bindings body ;
+TUPLE: let body ;
-
-TUPLE: let < binding-form ;
 
 C: <let> let
 
-TUPLE: let* < binding-form ;
-
-C: <let*> let*
-
-TUPLE: wlet < binding-form ;
-
-C: <wlet> wlet
-
 TUPLE: quote local ;
 
 C: <quote> quote
@@ -32,6 +22,10 @@ TUPLE: def local ;
 
 C: <def> def
 
+TUPLE: multi-def locals ;
+
+C: <multi-def> multi-def
+
 PREDICATE: local < word "local?" word-prop ;
 
 : <local> ( name -- word )

basis/math/matrices/matrices.factor

@@ -16,7 +16,7 @@ IN: math.matrices
 :: rotation-matrix3 ( axis theta -- matrix )
     theta cos :> c
     theta sin :> s
-    axis first3 :> z :> y :> x
+    axis first3 :> ( x y z )
     x sq 1.0 x sq - c * +     x y * 1.0 c - * z s * -   x z * 1.0 c - * y s * + 3array
     x y * 1.0 c - * z s * +   y sq 1.0 y sq - c * +     y z * 1.0 c - * x s * - 3array
     x z * 1.0 c - * y s * -   y z * 1.0 c - * x s * +   z sq 1.0 z sq - c * +   3array
@@ -25,14 +25,14 @@ IN: math.matrices
 :: rotation-matrix4 ( axis theta -- matrix )
     theta cos :> c
     theta sin :> s
-    axis first3 :> z :> y :> x
+    axis first3 :> ( x y z )
     x sq 1.0 x sq - c * +     x y * 1.0 c - * z s * -   x z * 1.0 c - * y s * +   0 4array
     x y * 1.0 c - * z s * +   y sq 1.0 y sq - c * +     y z * 1.0 c - * x s * -   0 4array
     x z * 1.0 c - * y s * -   y z * 1.0 c - * x s * +   z sq 1.0 z sq - c * +     0 4array
     { 0.0 0.0 0.0 1.0 } 4array ;
 
 :: translation-matrix4 ( offset -- matrix )
-    offset first3 :> z :> y :> x
+    offset first3 :> ( x y z )
     {
         { 1.0 0.0 0.0 x   }
         { 0.0 1.0 0.0 y   }
@@ -44,7 +44,7 @@ IN: math.matrices
     dup number? [ dup dup ] [ first3 ] if ;
 
 :: scale-matrix3 ( factors -- matrix )
-    factors >scale-factors :> z :> y :> x
+    factors >scale-factors :> ( x y z )
     {
         { x   0.0 0.0 }
         { 0.0 y   0.0 }
@@ -52,7 +52,7 @@ IN: math.matrices
     } ;
 
 :: scale-matrix4 ( factors -- matrix )
-    factors >scale-factors :> z :> y :> x
+    factors >scale-factors :> ( x y z )
     {
         { x   0.0 0.0 0.0 }
         { 0.0 y   0.0 0.0 }
@@ -64,7 +64,7 @@ IN: math.matrices
     [ recip ] map scale-matrix4 ;
 
 :: frustum-matrix4 ( xy-dim near far -- matrix )
-    xy-dim first2 :> y :> x
+    xy-dim first2 :> ( x y )
     near x /f :> xf
     near y /f :> yf
     near far + near far - /f :> zf

basis/math/primes/miller-rabin/miller-rabin.factor

@@ -8,7 +8,7 @@ IN: math.primes.miller-rabin
 
 :: (miller-rabin) ( n trials -- ? )
     n 1 - :> n-1
-    n-1 factor-2s :> s :> r
+    n-1 factor-2s :> ( r s )
     0 :> a!
     trials [
         drop

basis/math/vectors/conversion/conversion.factor

@@ -81,8 +81,8 @@ ERROR: bad-vconvert-input value expected-type ;
 PRIVATE>
 
 MACRO:: vconvert ( from-type to-type -- )
-    from-type new [ element-type ] [ byte-length ] bi :> from-length :> from-element
+    from-type new [ element-type ] [ byte-length ] bi :> ( from-element from-length )
-    to-type   new [ element-type ] [ byte-length ] bi :> to-length   :> to-element
+    to-type   new [ element-type ] [ byte-length ] bi :> ( to-element   to-length   )
     from-element heap-size :> from-size
     to-element   heap-size :> to-size   
 

basis/math/vectors/simd/simd-tests.factor

@@ -391,8 +391,8 @@ TUPLE: inconsistent-vector-test bool branch ;
     2dup = [ drop ] [ inconsistent-vector-test boa ] if ;
 
 :: test-vector-tests ( vector decl -- none? any? all? )
-    vector decl test-vector-tests-bool :> bool-all :> bool-any :> bool-none
+    vector decl test-vector-tests-bool :> ( bool-none bool-any bool-all )
-    vector decl test-vector-tests-branch :> branch-all :> branch-any :> branch-none
+    vector decl test-vector-tests-branch :> ( branch-none branch-any branch-all )
     
     bool-none branch-none ?inconsistent
     bool-any  branch-any  ?inconsistent

basis/models/product/product-tests.factor

@@ -27,11 +27,12 @@ TUPLE: an-observer { i integer } ;
 M: an-observer model-changed nip [ 1 + ] change-i drop ;
 
 [ 1 0 ] [
-    [let* | m1 [ 1 <model> ]
+    [let
-            m2 [ 2 <model> ]
+        1 <model> :> m1
-            c [ { m1 m2 } <product> ]
+        2 <model> :> m2
-            o1 [ an-observer new ]
+        { m1 m2 } <product> :> c
-            o2 [ an-observer new ] |
+        an-observer new :> o1
+        an-observer new :> o2
         
         o1 m1 add-connection
         o2 m2 add-connection

basis/opengl/opengl.factor

@@ -95,8 +95,8 @@ MACRO: all-enabled-client-state ( seq quot -- )
     #! We use GL_LINE_STRIP with a duplicated first vertex
     #! instead of GL_LINE_LOOP to work around a bug in Apple's
     #! X3100 driver.
-    loc first2 :> y :> x
+    loc first2 :> ( x y )
-    dim first2 :> h :> w
+    dim first2 :> ( w h )
     [
         x 0.5 +     y 0.5 +
         x w + 0.3 - y 0.5 +
@@ -115,8 +115,8 @@ MACRO: all-enabled-client-state ( seq quot -- )
     rect-vertices (gl-rect) ;
 
 :: (fill-rect-vertices) ( loc dim -- vertices )
-    loc first2 :> y :> x
+    loc first2 :> ( x y )
-    dim first2 :> h :> w
+    dim first2 :> ( w h )
     [
         x      y
         x w +  y

basis/opengl/textures/textures.factor

@@ -278,7 +278,7 @@ TUPLE: single-texture < disposable image dim loc texture-coords texture display-
     ] unless ;
 
 :: tex-image ( image bitmap -- )
-    image image-format :> type :> format :> internal-format
+    image image-format :> ( internal-format format type )
     GL_TEXTURE_2D 0 internal-format
     image dim>> adjust-texture-dim first2 0
     format type bitmap glTexImage2D ;

basis/peg/ebnf/ebnf.factor

@@ -445,16 +445,16 @@ M: ebnf-sequence build-locals ( code ast -- code )
       drop 
     ] [ 
       [
-        "FROM: locals => [let* ; FROM: sequences => nth ; [let* | " %
+        "FROM: locals => [let :> ; FROM: sequences => nth ; [let " %
-          dup length swap [
+          dup length [
-            dup ebnf-var? [
+            over ebnf-var? [
+              " " % # " over nth :> " %
               name>> % 
-              " [ " % # " over nth ] " %
             ] [
               2drop
             ] if
           ] 2each
-          " | " %
+          " " %
           %  
           " nip ]" %     
       ] "" make 
@@ -463,9 +463,9 @@ M: ebnf-sequence build-locals ( code ast -- code )
 
 M: ebnf-var build-locals ( code ast -- )
   [
-    "FROM: locals => [let* ; FROM: kernel => dup nip ; [let* | " %
+    "FROM: locals => [let :> ; FROM: kernel => dup nip ; [let " %
-    name>> % " [ dup ] " %
+    " dup :> " % name>> %
-    " | " %
+    " " %
     %  
     " nip ]" %     
   ] "" make ;

basis/peg/peg.factor

@@ -172,9 +172,7 @@ TUPLE: peg-head rule-id involved-set eval-set ;
   l lrstack get (setup-lr) ;
 
 :: lr-answer ( r p m -- ast )
-  [let* |
+    m ans>> head>> :> h
-          h [ m ans>> head>> ]
-        |
     h rule-id>> r rule-id eq? [
       m ans>> seed>> m (>>ans)
       m ans>> failed? [
@@ -184,14 +182,11 @@ TUPLE: peg-head rule-id involved-set eval-set ;
       ] if
     ] [
       m ans>> seed>>
-    ] if
+    ] if ; inline
-  ] ; inline
 
 :: recall ( r p -- memo-entry )
-  [let* |
+    p r rule-id memo :> m
-          m [ p r rule-id memo ]
+    p heads at :> h
-          h [ p heads at ]
-        |
     h [
       m r rule-id h involved-set>> h rule-id>> suffix member? not and [
         fail p memo-entry boa
@@ -207,15 +202,12 @@ TUPLE: peg-head rule-id involved-set eval-set ;
       ] if
     ] [
       m
-    ] if
+    ] if ; inline
-  ] ; inline
 
 :: apply-non-memo-rule ( r p -- ast )
-  [let* |
+    fail r rule-id f lrstack get left-recursion boa :> lr
-          lr  [ fail r rule-id f lrstack get left-recursion boa ]
+    lr lrstack set lr p memo-entry boa dup p r rule-id set-memo :> m
-          m   [ lr lrstack set lr p memo-entry boa dup p r rule-id set-memo ]
+    r eval-rule :> ans
-          ans [ r eval-rule ]
-        |
     lrstack get next>> lrstack set
     pos get m (>>pos)
     lr head>> [
@@ -226,8 +218,7 @@ TUPLE: peg-head rule-id involved-set eval-set ;
     ] [
       ans m (>>ans)
       ans
-    ] if
+    ] if ; inline
-  ] ; inline
 
 : apply-memo-rule ( r m -- ast )
   [ ans>> ] [ pos>> ] bi pos set
@@ -622,17 +613,16 @@ PRIVATE>
 ERROR: parse-failed input word ;
 
 SYNTAX: PEG:
-  (:)
+    [let
-  [let | effect [ ] def [ ] word [ ] |
+        (:) :> ( word def effect )
         [
           [
-        [let | compiled-def [ def call compile ] |
+            def call compile :> compiled-def
             [
               dup compiled-def compiled-parse
               [ ast>> ] [ word parse-failed ] ?if
             ]
             word swap effect define-declared
-        ]
           ] with-compilation-unit
         ] append!
     ] ;

basis/persistent/hashtables/nodes/bitmap/bitmap.factor

@@ -10,35 +10,33 @@ IN: persistent.hashtables.nodes.bitmap
 : index ( bit bitmap -- n ) [ 1 - ] dip bitand bit-count ; inline
 
 M:: bitmap-node (entry-at) ( key hashcode bitmap-node -- entry )
-    [let* | shift [ bitmap-node shift>> ]
+    bitmap-node shift>> :> shift
-            bit [ hashcode shift bitpos ]
+    hashcode shift bitpos :> bit
-            bitmap [ bitmap-node bitmap>> ]
+    bitmap-node bitmap>> :> bitmap
-            nodes [ bitmap-node nodes>> ] |
+    bitmap-node nodes>> :> nodes
     bitmap bit bitand 0 eq? [ f ] [
         key hashcode
         bit bitmap index nodes nth-unsafe
         (entry-at)
-        ] if
+    ] if ;
-    ] ;
 
 M:: bitmap-node (new-at) ( shift value key hashcode bitmap-node -- node' added-leaf )
-    [let* | shift [ bitmap-node shift>> ]
+    bitmap-node shift>> :> shift
-            bit [ hashcode shift bitpos ]
+    hashcode shift bitpos :> bit
-            bitmap [ bitmap-node bitmap>> ]
+    bitmap-node bitmap>> :> bitmap
-            idx [ bit bitmap index ]
+    bit bitmap index :> idx
-            nodes [ bitmap-node nodes>> ] |
+    bitmap-node nodes>> :> nodes
+
     bitmap bit bitand 0 eq? [
-            [let | new-leaf [ value key hashcode <leaf-node> ] |
+        value key hashcode <leaf-node> :> new-leaf
         bitmap bit bitor
         new-leaf idx nodes insert-nth
         shift
         <bitmap-node>
         new-leaf
-            ]
     ] [
-            [let | n [ idx nodes nth ] |
+        idx nodes nth :> n
-                shift radix-bits + value key hashcode n (new-at)
+        shift radix-bits + value key hashcode n (new-at) :> ( n' new-leaf )
-                [let | new-leaf [ ] n' [ ] |
         n n' eq? [
             bitmap-node
         ] [
@@ -48,20 +46,17 @@ M:: bitmap-node (new-at) ( shift value key hashcode bitmap-node -- node' added-l
             <bitmap-node>
         ] if
         new-leaf
-                ]
+    ] if ;
-            ]
-        ] if
-    ] ;
 
 M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' )
-    [let | bit [ hashcode bitmap-node shift>> bitpos ]
+    hashcode bitmap-node shift>> bitpos :> bit
-           bitmap [ bitmap-node bitmap>> ]
+    bitmap-node bitmap>> :> bitmap
-           nodes [ bitmap-node nodes>> ]
+    bitmap-node nodes>> :> nodes
-           shift [ bitmap-node shift>> ] |
+    bitmap-node shift>> :> shift
     bit bitmap bitand 0 eq? [ bitmap-node ] [
-            [let* | idx [ bit bitmap index ]
+        bit bitmap index :> idx
-                    n [ idx nodes nth-unsafe ]
+        idx nodes nth-unsafe :> n
-                    n' [ key hashcode n (pluck-at) ] |
+        key hashcode n (pluck-at) :> n'
         n n' eq? [
             bitmap-node
         ] [
@@ -79,8 +74,6 @@ M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' )
                 ] if
             ] if
         ] if
-            ]
+    ] if ;
-        ] if
-    ] ;
 
 M: bitmap-node >alist% ( node -- ) nodes>> >alist-each% ;

basis/persistent/hashtables/nodes/collision/collision.factor

@@ -15,20 +15,18 @@ M:: collision-node (entry-at) ( key hashcode collision-node -- leaf-node )
 
 M:: collision-node (pluck-at) ( key hashcode collision-node -- leaf-node )
     hashcode collision-node hashcode>> eq? [
-        [let | idx [ key hashcode collision-node find-index drop ] |
+        key hashcode collision-node find-index drop :> idx
         idx [
             idx collision-node leaves>> smash [
                 collision-node hashcode>>
                 <collision-node>
             ] when
         ] [ collision-node ] if
-        ]
     ] [ collision-node ] if ;
 
 M:: collision-node (new-at) ( shift value key hashcode collision-node -- node' added-leaf )
     hashcode collision-node hashcode>> eq? [
-        key hashcode collision-node find-index
+        key hashcode collision-node find-index :> ( idx leaf-node )
-        [let | leaf-node [ ] idx [ ] |
         idx [
             value leaf-node value>> = [
                 collision-node f
@@ -42,16 +40,14 @@ M:: collision-node (new-at) ( shift value key hashcode collision-node -- node' a
                 f
             ] if
         ] [
-                [let | new-leaf-node [ value key hashcode <leaf-node> ] |
+            value key hashcode <leaf-node> :> new-leaf-node
             hashcode
             collision-node leaves>>
             new-leaf-node
             suffix
             <collision-node>
             new-leaf-node
-                ]
         ] if
-        ]
     ] [
         shift collision-node value key hashcode make-bitmap-node
     ] if ;

basis/persistent/hashtables/nodes/full/full.factor

@@ -8,24 +8,23 @@ persistent.hashtables.nodes ;
 IN: persistent.hashtables.nodes.full
 
 M:: full-node (new-at) ( shift value key hashcode full-node -- node' added-leaf )
-    [let* | nodes [ full-node nodes>> ] 
+    full-node nodes>> :> nodes
-            idx [ hashcode full-node shift>> mask ]
+    hashcode full-node shift>> mask :> idx
-            n [ idx nodes nth-unsafe ] |
+    idx nodes nth-unsafe :> n
-        shift radix-bits + value key hashcode n (new-at)
+
-        [let | new-leaf [ ] n' [ ] |
+    shift radix-bits + value key hashcode n (new-at) :> ( n' new-leaf )
     n n' eq? [
         full-node
     ] [
         n' idx nodes new-nth shift <full-node>
     ] if
-            new-leaf
+    new-leaf ;
-        ]
-    ] ;
 
 M:: full-node (pluck-at) ( key hashcode full-node -- node' )
-    [let* | idx [ hashcode full-node shift>> mask ]
+    hashcode full-node shift>> mask :> idx
-            n [ idx full-node nodes>> nth ]
+    idx full-node nodes>> nth :> n
-            n' [ key hashcode n (pluck-at) ] |
+    key hashcode n (pluck-at) :> n'
+
     n n' eq? [
         full-node
     ] [
@@ -39,8 +38,7 @@ M:: full-node (pluck-at) ( key hashcode full-node -- node' )
             full-node shift>>
             <bitmap-node>
         ] if
-        ] if
+    ] if ;
-    ] ;
 
 M:: full-node (entry-at) ( key hashcode full-node -- node' )
     key hashcode

basis/persistent/hashtables/nodes/leaf/leaf.factor

@@ -19,10 +19,9 @@ M:: leaf-node (new-at) ( shift value key hashcode leaf-node -- node' added-leaf
             value leaf-node value>> =
             [ leaf-node f ] [ value key hashcode <leaf-node> f ] if
         ] [
-            [let | new-leaf [ value key hashcode <leaf-node> ] |
+            value key hashcode <leaf-node> :> new-leaf
             hashcode leaf-node new-leaf 2array <collision-node>
             new-leaf
-            ]
         ] if
     ] [ shift leaf-node value key hashcode make-bitmap-node ] if ;
 

basis/regexp/nfa/nfa.factor

@@ -46,7 +46,7 @@ GENERIC: nfa-node ( node -- start-state end-state )
     epsilon nfa-table get add-transition ;
 
 M:: star nfa-node ( node -- start end )
-    node term>> nfa-node :> s1 :> s0
+    node term>> nfa-node :> ( s0 s1 )
     next-state :> s2
     next-state :> s3
     s1 s0 epsilon-transition

basis/stack-checker/known-words/known-words.factor

@@ -192,17 +192,17 @@ M: bad-executable summary
 
 \ load-local [ infer-load-local ] "special" set-word-prop
 
-: infer-get-local ( -- )
+:: infer-get-local ( -- )
-    [let* | n [ pop-literal nip 1 swap - ]
+    pop-literal nip 1 swap - :> n
-            in-r [ n consume-r ]
+    n consume-r :> in-r
-            out-d [ in-r first copy-value 1array ]
+    in-r first copy-value 1array :> out-d
-            out-r [ in-r copy-values ] |
+    in-r copy-values :> out-r
+
     out-d output-d
     out-r output-r
     f out-d in-r out-r
     out-r in-r zip out-d first in-r first 2array suffix
-         #shuffle,
+    #shuffle, ;
-    ] ;
 
 \ get-local [ infer-get-local ] "special" set-word-prop
 

basis/threads/threads-tests.factor

@@ -32,13 +32,12 @@ yield
 [ [ 3 throw ] "A" suspend ] [ 3 = ] must-fail-with
 
 :: spawn-namespace-test ( -- ? )
-    [let | p [ <promise> ] g [ gensym ] |
+    <promise> :> p gensym :> g
     [
         g "x" set
         [ "x" get p fulfill ] "B" spawn drop
     ] with-scope
-        p ?promise g eq?
+    p ?promise g eq? ;
-    ] ;
 
 [ t ] [ spawn-namespace-test ] unit-test
 

basis/tools/walker/debug/debug.factor

@@ -6,7 +6,7 @@ namespaces namespaces.private assocs accessors ;
 IN: tools.walker.debug
 
 :: test-walker ( quot -- data )
-    [let | p [ <promise> ] |
+    <promise> :> p
     [
         H{ } clone >n
 
@@ -27,5 +27,4 @@ IN: tools.walker.debug
 
     p ?promise
     variables>> walker-continuation swap at
-        value>> data>>
+    value>> data>> ;
-    ] ;

basis/unicode/collation/collation.factor

@@ -76,10 +76,9 @@ ducet insert-helpers
     drop [ 0 ] unless* tail-slice ;
 
 :: ?combine ( char slice i -- ? )
-    [let | str [ i slice nth char suffix ] |
+    i slice nth char suffix :> str
     str ducet key? dup
-        [ str i slice set-nth ] when
+    [ str i slice set-nth ] when ;
-    ] ;
 
 : add ( char -- )
     dup blocked? [ 1string , ] [

basis/unix/unix.factor

@@ -48,8 +48,8 @@ ERROR: unix-error errno message ;
 ERROR: unix-system-call-error args errno message word ;
 
 MACRO:: unix-system-call ( quot -- )
-    [let | n [ quot infer in>> ]
+    quot infer in>> :> n
-           word [ quot first ] |
+    quot first :> word
     [
         n ndup quot call dup 0 < [
             drop
@@ -59,7 +59,6 @@ MACRO:: unix-system-call ( quot -- )
         ] [
             n nnip
         ] if
-        ]
     ] ;
 
 HOOK: open-file os ( path flags mode -- fd )

basis/windows/dinput/constants/constants.factor

@@ -56,13 +56,12 @@ M: array array-base-type first ;
     DIOBJECTDATAFORMAT <struct-boa> ;
 
 :: make-DIOBJECTDATAFORMAT-array ( struct array -- alien )
-    [let | alien [ array length malloc-DIOBJECTDATAFORMAT-array ] |
+    array length malloc-DIOBJECTDATAFORMAT-array :> alien
     array [| args i |
         struct args <DIOBJECTDATAFORMAT>
         i alien set-nth
     ] each-index
-        alien
+    alien ;
-    ] ;
 
 : <DIDATAFORMAT> ( dwFlags dwDataSize struct rgodf-array -- alien )
     [ DIDATAFORMAT heap-size DIOBJECTDATAFORMAT heap-size ] 4 ndip

basis/xml/syntax/syntax-docs.factor

@@ -74,12 +74,12 @@ $nl
 "Here is an example of the locals version:"
 { $example
 """USING: locals urls xml.syntax xml.writer ;
-[let |
+[let
-    number [ 3 ]
+    3 :> number
-    false [ f ]
+    f :> false
-    url [ URL" http://factorcode.org/" ]
+    URL" http://factorcode.org/" :> url
-    string [ "hello" ]
+    "hello" :> string
-    word [ \\ drop ] |
+    \\ drop :> word
     <XML
         <x
             number=<-number->

basis/xml/syntax/syntax-tests.factor

@@ -54,8 +54,7 @@ XML-NS: foo http://blah.com
   y
   <foo/>
 </x>""" ] [
-    [let* | a [ "one" ] c [ "two" ] x [ "y" ]
+    [let "one" :> a "two" :> c "y" :> x [XML <-x-> <foo/> XML] :> d
-           d [ [XML <-x-> <foo/> XML] ] |
         <XML
             <x> <-a-> <b val=<-c->/> <-d-> </x>
         XML> pprint-xml>string

extra/benchmark/beust2/beust2.factor

@@ -7,9 +7,9 @@ IN: benchmark.beust2
 
 :: (count-numbers) ( remaining first value used max listener: ( -- ) -- ? )
     10 first - iota [| i |
-        [let* | digit [ i first + ]
+        i first + :> digit
-                mask [ digit 2^ ]
+        digit 2^ :> mask
-                value' [ i value + ] |
+        i value + :> value'
         used mask bitand zero? [
             value max > [ t ] [
                 remaining 1 <= [
@@ -25,7 +25,6 @@ IN: benchmark.beust2
                 ] if
             ] if
         ] [ f ] if
-        ]
     ] any? ; inline recursive
 
 :: count-numbers ( max listener -- )
@@ -33,9 +32,8 @@ IN: benchmark.beust2
     inline
 
 :: beust ( -- )
-    [let | i! [ 0 ] |
+    0 :> i!
     5000000000 [ i 1 + i! ] count-numbers
-        i number>string " unique numbers." append print
+    i number>string " unique numbers." append print ;
-    ] ;
 
 MAIN: beust

extra/benchmark/fasta/fasta.factor

@@ -71,37 +71,35 @@ CONSTANT: homo-sapiens
     [ make-random-fasta ] 2curry split-lines ; inline
 
 :: make-repeat-fasta ( k len alu -- k' )
-    [let | kn [ alu length ] |
+    alu length :> kn
     len [ k + kn mod alu nth-unsafe ] "" map-as print
-        k len +
+    k len + ; inline
-    ] ; inline
 
 : write-repeat-fasta ( n alu desc id -- )
     write-description
-    [let | k! [ 0 ] alu [ ] |
+    [let
+        :> alu
+        0 :> k!
         [| len | k len alu make-repeat-fasta k! ] split-lines
     ] ; inline
 
 : fasta ( n out -- )
     homo-sapiens make-cumulative
     IUB make-cumulative
-    [let | homo-sapiens-floats [ ]
+    [let
-           homo-sapiens-chars [ ]
+        :> ( n out IUB-chars IUB-floats homo-sapiens-chars homo-sapiens-floats )
-           IUB-floats [ ]
+        initial-seed :> seed
-           IUB-chars [ ]
-           out [ ]
-           n [ ]
-           seed [ initial-seed ] |
 
         out ascii [
             n 2 * ALU "Homo sapiens alu" "ONE" write-repeat-fasta
 
             initial-seed
-            n 3 * homo-sapiens-chars homo-sapiens-floats "IUB ambiguity codes" "TWO" write-random-fasta
+            n 3 * homo-sapiens-chars homo-sapiens-floats
-            n 5 * IUB-chars IUB-floats "Homo sapiens frequency" "THREE" write-random-fasta
+            "IUB ambiguity codes" "TWO" write-random-fasta
+            n 5 * IUB-chars IUB-floats
+            "Homo sapiens frequency" "THREE" write-random-fasta
             drop
         ] with-file-writer
-
     ] ;
 
 : run-fasta ( -- ) 2500000 reverse-complement-in fasta ;

extra/benchmark/yuv-to-rgb/yuv-to-rgb.factor

@@ -17,10 +17,10 @@ STRUCT: yuv_buffer
     { v void* } ;
 
 :: fake-data ( -- rgb yuv )
-    [let* | w [ 1600 ]
+    1600 :> w
-            h [ 1200 ]
+    1200 :> h
-            buffer [ yuv_buffer <struct> ]
+    yuv_buffer <struct> :> buffer
-            rgb [ w h * 3 * <byte-array> ] |
+    w h * 3 * <byte-array> :> rgb
     rgb buffer
         w >>y_width
         h >>y_height
@@ -29,8 +29,7 @@ STRUCT: yuv_buffer
         w >>uv_stride
         w h * [ dup * ] B{ } map-as malloc-byte-array &free >>y
         w h * 2/ [ dup dup * * ] B{ } map-as malloc-byte-array &free >>u
-            w h * 2/ [ dup * dup * ] B{ } map-as malloc-byte-array &free >>v
+        w h * 2/ [ dup * dup * ] B{ } map-as malloc-byte-array &free >>v ;
-    ] ;
 
 : clamp ( n -- n )
     255 min 0 max ; inline

extra/crypto/aes/aes.factor

@@ -61,37 +61,33 @@ CONSTANT: AES_BLOCK_SIZE 16
     bitor bitor bitor 32 bits ;
 
 :: set-t ( T i -- )
-    [let* |
+    i sbox nth :> a1
-        a1 [ i sbox nth ]
+    a1 xtime :> a2
-        a2 [ a1 xtime ]
+    a1 a2 bitxor :> a3
-        a3 [ a1 a2 bitxor ] |
+
     a2 a1 a1 a3 ui32 i T set-nth
     a3 a2 a1 a1 ui32 i HEX: 100 + T set-nth
     a1 a3 a2 a1 ui32 i HEX: 200 + T set-nth
-            a1 a1 a3 a2 ui32 i HEX: 300 + T set-nth
+    a1 a1 a3 a2 ui32 i HEX: 300 + T set-nth ;
-        ] ;
-
 
 MEMO:: t-table ( -- array )
     1024 0 <array>
     dup 256 [ set-t ] with each ;
 
 :: set-d ( D i -- )
-    [let* |
+    i inv-sbox nth :> a1
-        a1 [ i inv-sbox nth ]
+    a1 xtime :> a2
-        a2 [ a1 xtime ]
+    a2 xtime :> a4
-        a4 [ a2 xtime ]
+    a4 xtime :> a8
-        a8 [ a4 xtime ]
+    a8 a1 bitxor :> a9
-        a9 [ a8 a1 bitxor ]
+    a9 a2 bitxor :> ab
-        ab [ a9 a2 bitxor ]
+    a9 a4 bitxor :> ad
-        ad [ a9 a4 bitxor ]
+    a8 a4 a2 bitxor bitxor :> ae
-        ae [ a8 a4 a2 bitxor bitxor ]
+
-        |
     ae a9 ad ab ui32 i D set-nth
     ab ae a9 ad ui32 i HEX: 100 + D set-nth
     ad ab ae a9 ui32 i HEX: 200 + D set-nth
-            a9 ad ab ae ui32 i HEX: 300 + D set-nth
+    a9 ad ab ae ui32 i HEX: 300 + D set-nth ;
-        ] ;
     
 MEMO:: d-table ( -- array )
     1024 0 <array>

extra/crypto/passwd-md5/passwd-md5.factor

@@ -17,15 +17,16 @@ IN: crypto.passwd-md5
 PRIVATE>
 
 :: passwd-md5 ( magic salt password -- bytes )
-    [let* | final! [ password magic salt 3append
+    password magic salt 3append
     salt password tuck 3append md5 checksum-bytes
     password length
     [ 16 / ceiling swap <repetition> concat ] keep
     head-slice append
     password [ length make-bits ] [ first ] bi
     '[ CHAR: \0 _ ? ] "" map-as append
-                md5 checksum-bytes ] |
+    md5 checksum-bytes :> final!
-        1000 [
+
+    1000 iota [
         "" swap
         {
             [ 0 bit? password final ? append ]
@@ -38,7 +39,7 @@ PRIVATE>
     magic salt "$" 3append
     { 12 0 6 13 1 7 14 2 8 15 3 9 5 4 10 } final nths 3 group
     [ first3 [ 16 shift ] [ 8 shift ] bi* + + 4 to64 ] map concat
-        11 final nth 2 to64 3append ] ;
+    11 final nth 2 to64 3append ;
         
 : parse-shadow-password ( string -- magic salt password )
     "$" split harvest first3 [ "$" tuck 3append ] 2dip ;

extra/decimals/decimals.factor

@@ -75,8 +75,8 @@ M: decimal before?
 
 :: D/ ( D1 D2 a -- D3 )
     D1 D2 guard-decimals 2drop
-    D1 >decimal< :> e1 :> m1
+    D1 >decimal< :> ( m1 e1 )
-    D2 >decimal< :> e2 :> m2
+    D2 >decimal< :> ( m2 e2 )
     m1 a 10^ *
     m2 /i
     

extra/galois-talk/galois-talk.factor

@@ -189,7 +189,7 @@ CONSTANT: galois-slides
     }
     { $slide "Locals and lexical scope"
         { "Define lambda words with " { $link POSTPONE: :: } }
-        { "Establish bindings with " { $link POSTPONE: [let } " and " { $link POSTPONE: [let* } }
+        { "Establish bindings with " { $link POSTPONE: [let } " and " { $snippet "[let*" } }
         "Mutable bindings with correct semantics"
         { "Named inputs for quotations with " { $link POSTPONE: [| } }
         "Full closures"

extra/google-tech-talk/google-tech-talk.factor

@@ -272,7 +272,7 @@ CONSTANT: google-slides
     }
     { $slide "Locals and lexical scope"
         { "Define lambda words with " { $link POSTPONE: :: } }
-        { "Establish bindings with " { $link POSTPONE: [let } " and " { $link POSTPONE: [let* } }
+        { "Establish bindings with " { $link POSTPONE: [let } " and " { $snippet "[let*" } }
         "Mutable bindings with correct semantics"
         { "Named inputs for quotations with " { $link POSTPONE: [| } }
         "Full closures"

extra/gpu/render/render.factor

@@ -332,13 +332,13 @@ DEFER: [bind-uniform-tuple]
     ] [
         { [ ] }
         name "." append 1array
-    ] if* :> name-prefixes :> quot-prefixes
+    ] if* :> ( quot-prefixes name-prefixes )
     type all-uniform-tuple-slots :> uniforms
 
     texture-unit quot-prefixes name-prefixes [| quot-prefix name-prefix |
         uniforms name-prefix [bind-uniform-tuple]
         quot-prefix prepend
-    ] 2map :> value-cleave :> texture-unit'
+    ] 2map :> ( texture-unit' value-cleave )
 
     texture-unit' 
     value>>-quot { value-cleave 2cleave } append ;
@@ -356,7 +356,7 @@ DEFER: [bind-uniform-tuple]
     } cond ;
 
 :: [bind-uniform-tuple] ( texture-unit uniforms prefix -- texture-unit' quot )
-    texture-unit uniforms [ prefix [bind-uniform] ] map :> uniforms-cleave :> texture-unit'
+    texture-unit uniforms [ prefix [bind-uniform] ] map :> ( texture-unit' uniforms-cleave )
 
     texture-unit'
     { uniforms-cleave 2cleave } >quotation ;

extra/images/normalization/normalization.factor

@@ -26,11 +26,11 @@ CONSTANT: fill-value 255
     ] B{ } map-as ;
 
 :: permute ( bytes src-order dst-order -- new-bytes )
-    [let | src [ src-order name>> ]
+    src-order name>> :> src
-           dst [ dst-order name>> ] |
+    dst-order name>> :> dst
     bytes src length group
     [ pad4 src dst permutation shuffle dst length head ]
-        map concat ] ;
+    map concat ;
 
 : (reorder-components) ( image src-order dest-order -- image )
     [ permute ] 2curry change-bitmap ;

extra/infix/infix-docs.factor

@@ -25,25 +25,10 @@ HELP: [infix
     }
 } ;
 
-HELP: [infix|
-{ $syntax "[infix| binding1 [ value1... ]\n        binding2 [ value2... ]\n        ... |\n    infix-expression infix]" }
-{ $description "Introduces a set of lexical bindings and evaluates the body as a snippet of infix code. The values are evaluated in parallel, and may not refer to other bindings within the same " { $link POSTPONE: [infix| } " form, as it is based on " { $link POSTPONE: [let } "." }
-{ $examples
-    { $example
-        "USING: infix prettyprint ;"
-        "IN: scratchpad"
-        "[infix| pi [ 3.14 ] r [ 12 ] | r*r*pi infix] ."
-        "452.16"
-    }
-} ;
-
-{ POSTPONE: [infix POSTPONE: [infix| } related-words
-
 ARTICLE: "infix" "Infix notation"
 "The " { $vocab-link "infix" } " vocabulary implements support for infix notation in Factor source code."
 { $subsections
     POSTPONE: [infix
-    POSTPONE: [infix|
 }
 $nl
 "The usual infix math operators are supported:"
@@ -76,8 +61,8 @@ $nl
 $nl
 "You can access " { $vocab-link "sequences" } " inside infix expressions with the familiar " { $snippet "arr[index]" } " notation."
 { $example
-    "USING: arrays infix ;"
+    "USING: arrays locals infix ;"
-    "[infix| myarr [ { 1 2 3 4 } ] | myarr[4/2]*3 infix] ."
+    "[let { 1 2 3 4 } :> myarr [infix myarr[4/2]*3 infix] ] ."
     "9"
 }
 "Please note: in Factor " { $emphasis "fixnums are sequences too." } " If you are not careful with sequence accesses you may introduce subtle bugs:"

extra/infix/infix-tests.factor

@@ -13,17 +13,6 @@ IN: infix.tests
      -5*
      0 infix] ] unit-test
 
-[ 452.16 ] [ [infix| r [ 12 ] pi [ 3.14 ] |
-    r*r*pi infix] ] unit-test
-[ 0 ] [ [infix| a [ 3 ] | 0 infix] ] unit-test
-[ 4/5 ] [ [infix| x [ 3 ] f [ 12 ] | f/(f+x) infix] ] unit-test
-[ 144 ] [ [infix| a [ 0 ] b [ 12 ] | b*b-a infix] ] unit-test
-
-[ 0 ] [ [infix| a [ { 0 1 2 3 } ] | a[0] infix] ] unit-test
-[ 0 ] [ [infix| a [ { 0 1 2 3 } ] | 3*a[0]*2*a[1] infix] ] unit-test
-[ 6 ] [ [infix| a [ { 0 1 2 3 } ] | a[0]+a[10%3]+a[3-1]+a[18/6] infix] ] unit-test
-[ -1 ] [ [infix| a [ { 0 1 2 3 } ] | -a[+1] infix] ] unit-test
-
 [ 0.0 ] [ [infix sin(0) infix] ] unit-test
 [ 10 ] [ [infix lcm(2,5) infix] ] unit-test
 [ 1.0 ] [ [infix +cos(-0*+3) infix] ] unit-test
@@ -42,4 +31,4 @@ IN: infix.tests
 [ t ] [ 5 \ stupid_function check-word ] unit-test
 [ 10 ] [ [infix stupid_function (0, 1, 2, 3, 4) infix] ] unit-test
 
-[ -1 ] [ [let | a [ 1 ] | [infix -a infix] ] ] unit-test
+[ -1 ] [ [let 1 :> a [infix -a infix] ] ] unit-test

extra/infix/infix.factor

@@ -83,14 +83,3 @@ PRIVATE>
 
 SYNTAX: [infix
     "infix]" [infix-parse suffix! \ call suffix! ;
-
-<PRIVATE
-
-: parse-infix-locals ( assoc end -- quot )
-    '[ _ [infix-parse prepare-operand ] ((parse-lambda)) ;
-
-PRIVATE>
-
-SYNTAX: [infix|
-    "|" parse-bindings "infix]" parse-infix-locals <let>
-    ?rewrite-closures append! ;

extra/jamshred/player/player.factor

@@ -101,11 +101,12 @@ CONSTANT: max-speed 30.0
     ] if ;
 
 :: move-player-on-heading ( d-left player distance heading -- d-left' player )
-    [let* | d-to-move [ d-left distance min ]
+    d-left distance min :> d-to-move
-            move-v [ d-to-move heading n*v ] |
+    d-to-move heading n*v :> move-v
+
     move-v player location+
     heading player update-nearest-segment2
-        d-left d-to-move - player ] ;
+    d-left d-to-move - player ;
 
 : distance-to-move-freely ( player -- distance )
     [ almost-to-collision ]

extra/jamshred/tunnel/tunnel.factor

@@ -107,13 +107,13 @@ CONSTANT: default-segment-radius 1
     } case ;
 
 :: distance-to-next-segment ( current next location heading -- distance )
-    [let | cf [ current forward>> ] |
+    current forward>> :> cf
-        cf next location>> v. cf location v. - cf heading v. / ] ;
+    cf next location>> v. cf location v. - cf heading v. / ;
 
 :: distance-to-next-segment-area ( current next location heading -- distance )
-    [let | cf [ current forward>> ]
+    current forward>> :> cf
-           h [ next current half-way-between-oints ] |
+    next current half-way-between-oints :> h
-        cf h v. cf location v. - cf heading v. / ] ;
+    cf h v. cf location v. - cf heading v. / ;
 
 : vector-to-centre ( seg loc -- v )
     over location>> swap v- swap forward>> proj-perp ;
@@ -138,10 +138,10 @@ CONSTANT: distant 1000
     v norm 0 = [
         distant
     ] [
-        [let* | a [ v dup v. ]
+        v dup v. :> a
-                b [ v w v. 2 * ]
+        v w v. 2 * :> b
-                c [ w dup v. r sq - ] |
+        w dup v. r sq - :> c
-            c b a quadratic max-real ]
+        c b a quadratic max-real
     ] if ;
 
 : sideways-heading ( oint segment -- v )

extra/mason/common/common.factor

@@ -33,13 +33,12 @@ M: unix really-delete-tree delete-tree ;
     '[ drop @ f ] attempt-all drop ; inline
 
 :: upload-safely ( local username host remote -- )
-    [let* | temp [ remote ".incomplete" append ]
+    remote ".incomplete" append :> temp
-            scp-remote [ { username "@" host ":" temp } concat ]
+    { username "@" host ":" temp } concat :> scp-remote
-            scp [ scp-command get ]
+    scp-command get :> scp
-            ssh [ ssh-command get ] |
+    ssh-command get :> ssh
     5 [ { scp local scp-remote } short-running-process ] retry
-        5 [ { ssh host "-l" username "mv" temp remote } short-running-process ] retry
+    5 [ { ssh host "-l" username "mv" temp remote } short-running-process ] retry ;
-    ] ;
 
 : eval-file ( file -- obj )
     dup utf8 file-lines parse-fresh

extra/math/matrices/simd/simd.factor

@@ -35,8 +35,8 @@ M: matrix4 new-sequence 2drop matrix4 (struct) ; inline
 
 :: 2map-columns ( a b quot -- c )
     [
-        a columns :> a4 :> a3 :> a2 :> a1
+        a columns :> ( a1 a2 a3 a4 )
-        b columns :> b4 :> b3 :> b2 :> b1
+        b columns :> ( b1 b2 b3 b4 )
 
         a1 b1 quot call
         a2 b2 quot call
@@ -61,8 +61,8 @@ TYPED: n/m4 ( a: float b: matrix4 -- c: matrix4 ) [ n/v ] with map-columns ;
 
 TYPED:: m4. ( a: matrix4 b: matrix4 -- c: matrix4 )
     [
-        a columns :> a4 :> a3 :> a2 :> a1
+        a columns :> ( a1 a2 a3 a4 )
-        b columns :> b4 :> b3 :> b2 :> b1
+        b columns :> ( b1 b2 b3 b4 )
 
         b1 first  a1 n*v :> c1a
         b2 first  a1 n*v :> c2a
@@ -86,7 +86,7 @@ TYPED:: m4. ( a: matrix4 b: matrix4 -- c: matrix4 )
     ] make-matrix4 ;
 
 TYPED:: m4.v ( m: matrix4 v: float-4 -- v': float-4 )
-    m columns :> m4 :> m3 :> m2 :> m1
+    m columns :> ( m1 m2 m3 m4 )
     
     v first  m1 n*v
     v second m2 n*v v+

extra/mongodb/connection/connection.factor

@@ -123,15 +123,16 @@ CONSTRUCTOR: mdb-connection ( instance -- mdb-connection ) ;
 PRIVATE>
 
 :: verify-nodes ( mdb -- )
-    [ [let* | acc [ V{ } clone ]
+    [
-              node1 [ mdb dup master-node [ check-node ] keep ]
+        V{ } clone :> acc
-              node2 [ mdb node1 remote>>
+        mdb dup master-node [ check-node ] keep :> node1
+        mdb node1 remote>>
         [ [ check-node ] keep ]
-                      [ drop f ] if*  ]
+        [ drop f ] if*  :> node2
-              | node1 [ acc push ] when*
+
+        node1 [ acc push ] when*
         node2 [ acc push ] when*
         mdb acc nodelist>table >>nodes drop 
-              ]
     ] with-destructors ; 
               
 : mdb-open ( mdb -- mdb-connection )

extra/mongodb/driver/driver.factor

@@ -151,14 +151,16 @@ M: mdb-collection create-collection
     [ "$cmd" = ] [ "system" head? ] bi or ;
 
 : check-collection ( collection -- fq-collection )
-    [let* | instance [ mdb-instance ]
+    [let
-            instance-name [ instance name>> ] |        
+        mdb-instance :> instance
+        instance name>> :> instance-name
         dup mdb-collection? [ name>> ] when
         "." split1 over instance-name =
         [ nip ] [ drop ] if
         [ ] [ reserved-namespace? ] bi
         [ instance (ensure-collection) ] unless
-        [ instance-name ] dip "." glue ] ; 
+        [ instance-name ] dip "." glue
+    ] ;
 
 : fix-query-collection ( mdb-query -- mdb-query )
     [ check-collection ] change-collection ; inline

extra/mongodb/operations/operations.factor

@@ -105,15 +105,14 @@ USE: tools.walker
     ! [ dump-to-file ] keep
     write flush ; inline
 
-: build-query-object ( query -- selector )
+:: build-query-object ( query -- selector )
-    [let | selector [ H{ } clone ] |
+    H{ } clone :> selector
-        { [ orderby>> [ "orderby" selector set-at ] when* ]
+    query { [ orderby>> [ "orderby" selector set-at ] when* ]
       [ explain>> [ "$explain" selector set-at ] when* ]
       [ hint>> [ "$hint" selector set-at ] when* ] 
       [ query>> "query" selector set-at ]
     } cleave
-        selector
+    selector ;
-    ] ;     
 
 PRIVATE>
 

extra/nurbs/nurbs.factor

@@ -60,7 +60,7 @@ TUPLE: nurbs-curve
 
 :: (eval-bases) ( curve t interval values order -- values' )
     order 2 - curve (knot-constants)>> nth :> all-knot-constants
-    interval order interval + all-knot-constants clip-range :> to :> from
+    interval order interval + all-knot-constants clip-range :> ( from to )
     from to all-knot-constants subseq :> knot-constants
     values { 0.0 } { 0.0 } surround 2 <clumps> :> bases
 

extra/project-euler/073/073.factor

@@ -33,13 +33,12 @@ IN: project-euler.073
 <PRIVATE
 
 :: (euler073) ( counter limit lo hi -- counter' )
-    [let | m [ lo hi mediant ] |
+    lo hi mediant :> m
     m denominator limit <= [
         counter 1 +
         limit lo m (euler073)
         limit m hi (euler073)
-        ] [ counter ] if
+    ] [ counter ] if ;
-    ] ;
 
 PRIVATE>
 

extra/project-euler/150/150.factor

@@ -54,7 +54,7 @@ IN: project-euler.150
     0 1000 [1,b] [ [ next ] replicate partial-sums ] map nip ;
 
 :: (euler150) ( m -- n )
-    [let | table [ sums-triangle ] |
+    sums-triangle :> table
     m [| x |
         x 1 + [| y |
             m x - [0,b) [| z |
@@ -63,8 +63,7 @@ IN: project-euler.150
                 [ y        swap nth-unsafe ] bi -
             ] map partial-sum-infimum
         ] map-infimum
-        ] map-infimum
+    ] map-infimum ;
-    ] ;
 
 HINTS: (euler150) fixnum ;
 

extra/reports/noise/noise.factor

@@ -81,8 +81,6 @@ M: wrapper noise wrapped>> noise ;
 
 M: let noise body>> noise ;
 
-M: wlet noise body>> noise ;
-
 M: lambda noise body>> noise ;
 
 M: object noise drop { 0 0 } ;

extra/sequences/product/product.factor

@@ -49,7 +49,7 @@ M: product-sequence nth
     product@ nths ;
 
 :: product-each ( sequences quot -- )
-    sequences start-product-iter :> lengths :> ns
+    sequences start-product-iter :> ( ns lengths )
     lengths [ 0 = ] any? [
         [ ns lengths end-product-iter? ]
         [ ns sequences nths quot call ns lengths product-iter ] until

extra/spider/spider.factor

@@ -69,12 +69,12 @@ fetched-in parsed-html links processed-in fetched-at ;
 
 :: fill-spidered-result ( spider spider-result -- )
     f spider-result url>> spider spidered>> set-at
-    [ spider-result url>> http-get ] benchmark :> fetched-in :> html :> headers
+    [ spider-result url>> http-get ] benchmark :> ( headers html fetched-in )
     [
         html parse-html
         spider currently-spidering>>
         over find-all-links normalize-hrefs
-    ] benchmark :> processed-in :> links :> parsed-html
+    ] benchmark :> ( parsed-html links processed-in )
     spider-result
         headers >>headers
         fetched-in >>fetched-in

extra/ui/gadgets/alerts/alerts.factor

@@ -12,12 +12,13 @@ IN: ui.gadgets.alerts
 : alert* ( str -- ) [ ] swap alert ;
 
 :: ask-user ( string -- model' )
-   [ [let | lbl  [ string <label>  T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
+    [
-            fldm [ <model-field*> ->% 1 ]
+        string <label>  T{ font { name "sans-serif" } { size 14 } } >>font dup , :> lbl
-            btn  [ "okay" <model-border-btn> ] |
+        <model-field*> ->% 1 :> fldm
+        "okay" <model-border-btn> :> btn
         btn -> [ fldm swap updates ]
                [ [ drop lbl close-window ] $> , ] bi
-   ] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
+    ] <vbox> { 161 86 } >>pref-dim "" open-window ;
 
 MACRO: ask-buttons ( buttons -- quot ) dup length [
       [ swap

extra/vpri-talk/vpri-talk.factor

@@ -209,7 +209,7 @@ CONSTANT: vpri-slides
     }
     { $slide "Locals and lexical scope"
         { "Define lambda words with " { $link POSTPONE: :: } }
-        { "Establish bindings with " { $link POSTPONE: [let } " and " { $link POSTPONE: [let* } }
+        { "Establish bindings with " { $link POSTPONE: [let } " and " { $snippet "[let*" } }
         "Mutable bindings with correct semantics"
         { "Named inputs for quotations with " { $link POSTPONE: [| } }
         "Full closures"

misc/Factor.tmbundle/Snippets/let.tmSnippet

@@ -3,10 +3,7 @@
 <plist version="1.0">
 <dict>
 	<key>content</key>
-	<string>
+	<string>[let $0 ]</string>
-   [let | $1 [ $2 ] $3|
-      $0
-   ]</string>
 	<key>name</key>
 	<string>let</string>
 	<key>scope</key>

misc/fuel/fuel-syntax.el

@@ -272,7 +272,7 @@
     ("\\(\n\\| \\);\\_>" (1 ">b"))
     ;; Let and lambda:
     ("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))
-    ("\\(\\[\\)\\(let\\|wlet\\|let\\*\\)\\( \\|$\\)" (1 "(]"))
+    ("\\(\\[\\)\\(let\\|let\\*\\)\\( \\|$\\)" (1 "(]"))
     ("\\(\\[\\)\\(|\\) +[^|]* \\(|\\)" (1 "(]") (2 "(|") (3 ")|"))
     (" \\(|\\) " (1 "(|"))
     (" \\(|\\)$" (1 ")"))