From 935c0797c309b6c397a40903839fc7236ba47bf7 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 27 Oct 2009 21:50:31 -0500 Subject: [PATCH] update existing code for [let change --- basis/channels/examples/examples.factor | 11 +- .../cfg/intrinsics/alien/alien.factor | 10 +- .../cfg/intrinsics/allot/allot.factor | 20 +- .../compiler/cfg/ssa/liveness/liveness.factor | 13 +- .../tree/dead-code/recursive/recursive.factor | 41 ++-- .../tree/dead-code/simple/simple.factor | 15 +- .../known-words/known-words.factor | 11 +- basis/compiler/utilities/utilities.factor | 18 +- .../exchangers/exchangers-tests.factor | 34 ++- basis/concurrency/flags/flags-tests.factor | 43 ++-- basis/concurrency/locks/locks-tests.factor | 228 +++++++++--------- basis/core-text/core-text.factor | 45 ++-- basis/fry/fry-docs.factor | 4 +- basis/furnace/auth/providers/providers.factor | 28 +-- basis/interpolate/interpolate-tests.factor | 3 +- basis/io/encodings/gb18030/gb18030.factor | 5 +- basis/io/launcher/unix/unix-tests.factor | 17 +- basis/io/mmap/windows/windows.factor | 15 +- basis/io/monitors/macosx/macosx.factor | 9 +- .../io/sockets/secure/openssl/openssl.factor | 7 +- basis/lcs/lcs.factor | 10 +- basis/models/product/product-tests.factor | 11 +- .../hashtables/nodes/bitmap/bitmap.factor | 122 +++++----- .../nodes/collision/collision.factor | 58 +++-- .../hashtables/nodes/full/full.factor | 56 +++-- .../hashtables/nodes/leaf/leaf.factor | 7 +- .../known-words/known-words.factor | 20 +- basis/threads/threads-tests.factor | 13 +- basis/tools/walker/debug/debug.factor | 35 ++- basis/unicode/collation/collation.factor | 7 +- basis/unix/unix.factor | 23 +- .../windows/dinput/constants/constants.factor | 13 +- basis/xml/syntax/syntax-docs.factor | 12 +- basis/xml/syntax/syntax-tests.factor | 3 +- extra/benchmark/beust2/beust2.factor | 42 ++-- extra/benchmark/fasta/fasta.factor | 42 ++-- extra/benchmark/yuv-to-rgb/yuv-to-rgb.factor | 27 +-- extra/crypto/aes/aes.factor | 44 ++-- extra/crypto/passwd-md5/passwd-md5.factor | 43 ++-- extra/galois-talk/galois-talk.factor | 2 +- .../google-tech-talk/google-tech-talk.factor | 2 +- .../images/normalization/normalization.factor | 10 +- extra/infix/infix-docs.factor | 17 +- extra/infix/infix-tests.factor | 13 +- extra/infix/infix.factor | 11 - extra/jamshred/player/player.factor | 11 +- extra/jamshred/tunnel/tunnel.factor | 18 +- extra/mason/common/common.factor | 13 +- extra/mongodb/connection/connection.factor | 21 +- extra/mongodb/driver/driver.factor | 16 +- extra/mongodb/operations/operations.factor | 15 +- extra/project-euler/073/073.factor | 13 +- extra/project-euler/150/150.factor | 19 +- extra/ui/gadgets/alerts/alerts.factor | 15 +- extra/vpri-talk/vpri-talk.factor | 2 +- misc/Factor.tmbundle/Snippets/let.tmSnippet | 5 +- 56 files changed, 636 insertions(+), 732 deletions(-) diff --git a/basis/channels/examples/examples.factor b/basis/channels/examples/examples.factor index 99fa41cd40..4b48d7923c 100644 --- a/basis/channels/examples/examples.factor +++ b/basis/channels/examples/examples.factor @@ -25,12 +25,11 @@ IN: channels.examples ] 3keep filter ; :: (sieve) ( prime c -- ) - [let | p [ c from ] - newc [ ] | - p prime to - [ newc p c filter ] "Filter" spawn drop - prime newc (sieve) - ] ; + c from :> p + :> newc + p prime to + [ newc p c filter ] "Filter" spawn drop + prime newc (sieve) ; : sieve ( prime -- ) #! Send prime numbers to 'prime' channel diff --git a/basis/compiler/cfg/intrinsics/alien/alien.factor b/basis/compiler/cfg/intrinsics/alien/alien.factor index a37e100c3e..ad9b105767 100644 --- a/basis/compiler/cfg/intrinsics/alien/alien.factor +++ b/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 ] | - infos test call - [ infos quot call ] - [ node emit-primitive ] - if - ] ; inline + node node-input-infos :> infos + infos test call + [ infos quot call ] + [ node emit-primitive ] if ; : inline-alien-getter? ( infos -- ? ) [ first class>> c-ptr class<= ] diff --git a/basis/compiler/cfg/intrinsics/allot/allot.factor b/basis/compiler/cfg/intrinsics/allot/allot.factor index 8283299ea8..044b839f4d 100644 --- a/basis/compiler/cfg/intrinsics/allot/allot.factor +++ b/basis/compiler/cfg/intrinsics/allot/allot.factor @@ -43,17 +43,15 @@ IN: compiler.cfg.intrinsics.allot 2 + cells array ^^allot ; :: emit- ( node -- ) - [let | len [ node node-input-infos first literal>> ] | - len expand-? [ - [let | elt [ ds-pop ] - reg [ len ^^allot-array ] | - ds-drop - len reg array store-length - len reg elt array store-initial-element - reg ds-push - ] - ] [ node emit-primitive ] if - ] ; + node node-input-infos first literal>> :> len + len expand-? [ + ds-pop :> elt + 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 ; : expand-(byte-array)? ( obj -- ? ) dup integer? [ 0 1024 between? ] [ drop f ] if ; diff --git a/basis/compiler/cfg/ssa/liveness/liveness.factor b/basis/compiler/cfg/ssa/liveness/liveness.factor index 1ed6010dbe..7847de28fc 100644 --- a/basis/compiler/cfg/ssa/liveness/liveness.factor +++ b/basis/compiler/cfg/ssa/liveness/liveness.factor @@ -121,10 +121,9 @@ PRIVATE> PRIVATE> :: live-out? ( vreg node -- ? ) - [let | def [ vreg def-of ] | - { - { [ node def eq? ] [ vreg uses-of def only? not ] } - { [ def node strictly-dominates? ] [ vreg node (live-out?) ] } - [ f ] - } cond - ] ; + vreg def-of :> def + { + { [ node def eq? ] [ vreg uses-of def only? not ] } + { [ def node strictly-dominates? ] [ vreg node (live-out?) ] } + [ f ] + } cond ; diff --git a/basis/compiler/tree/dead-code/recursive/recursive.factor b/basis/compiler/tree/dead-code/recursive/recursive.factor index b0ab864c80..482d370947 100644 --- a/basis/compiler/tree/dead-code/recursive/recursive.factor +++ b/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 ] - live-outputs [ outputs filter-live ] | - new-live-outputs - live-outputs - live-outputs - new-live-outputs - drop-values - ] ; + inputs outputs filter-corresponding make-values :> new-live-outputs + outputs filter-live :> live-outputs + new-live-outputs + live-outputs + live-outputs + new-live-outputs + 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 ] - new-outputs [ shuffle out-d>> ] | - node new-outputs - [ [ label>> enter-recursive>> ] dip >>in-d drop ] [ >>in-d drop ] 2bi - shuffle - ] ; + node [ in-d>> ] [ label>> enter-out>> ] bi drop-dead-inputs :> shuffle + shuffle out-d>> :> new-outputs + node new-outputs + [ [ label>> enter-recursive>> ] dip >>in-d drop ] [ >>in-d drop ] 2bi + shuffle ; :: drop-recursive-outputs ( node -- shuffle ) - [let* | return [ node label>> return>> ] - new-inputs [ return in-d>> filter-live ] - new-outputs [ return [ in-d>> ] [ out-d>> ] bi filter-corresponding ] | - return - [ new-inputs >>in-d new-outputs >>out-d drop ] - [ drop-dead-outputs ] - bi - ] ; + node label>> return>> :> return + return in-d>> filter-live :> new-inputs + return [ in-d>> ] [ out-d>> ] bi filter-corresponding :> new-outputs + return + [ new-inputs >>in-d new-outputs >>out-d drop ] + [ drop-dead-outputs ] + bi ; M: #recursive remove-dead-code* ( node -- nodes ) [ drop-recursive-inputs ] diff --git a/basis/compiler/tree/dead-code/simple/simple.factor b/basis/compiler/tree/dead-code/simple/simple.factor index 5134a67a5b..f6165a44ab 100755 --- a/basis/compiler/tree/dead-code/simple/simple.factor +++ b/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 ] - live-outputs [ outputs filter-live ] | - new-outputs - live-outputs - outputs - new-outputs - drop-values - ] ; + outputs make-values :> new-outputs + outputs filter-live :> live-outputs + new-outputs + live-outputs + outputs + new-outputs + drop-values ; : drop-dead-outputs ( node -- #shuffle ) dup out-d>> drop-dead-values [ in-d>> >>out-d drop ] keep ; diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor index e21ab74cc2..5646dca3fb 100644 --- a/basis/compiler/tree/propagation/known-words/known-words.factor +++ b/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>> ] - i2 [ in2 value-info interval>> ] | - in1 i1 i2 op assumption is-in-interval - in2 i2 i1 op swap-comparison assumption is-in-interval - /\ - ] ; + in1 value-info interval>> :> i1 + 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--> diff --git a/basis/compiler/utilities/utilities.factor b/basis/compiler/utilities/utilities.factor index b6c6910e34..84080a73d7 100644 --- a/basis/compiler/utilities/utilities.factor +++ b/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 destination = [ source ] [ - [let | destination' [ destination assoc compress-path ] | - destination' destination = [ - destination' source assoc set-at - ] unless - destination' - ] - ] if - ] ; + source assoc at :> destination + source destination = [ source ] [ + destination assoc compress-path :> destination' + destination' destination = [ + destination' source assoc set-at + ] unless + destination' + ] if ; diff --git a/basis/concurrency/exchangers/exchangers-tests.factor b/basis/concurrency/exchangers/exchangers-tests.factor index a8214cf42f..c411aaea92 100644 --- a/basis/concurrency/exchangers/exchangers-tests.factor +++ b/basis/concurrency/exchangers/exchangers-tests.factor @@ -5,27 +5,25 @@ FROM: sequences => 3append ; IN: concurrency.exchangers.tests :: exchanger-test ( -- string ) - [let | - ex [ ] - c [ 2 ] - v1! [ f ] - v2! [ f ] - pr [ ] | + :> ex + 2 :> c + f :> v1! + f :> v2! + :> pr - [ - c await - v1 ", " v2 3append pr fulfill - ] "Awaiter" spawn drop + [ + c await + v1 ", " v2 3append pr fulfill + ] "Awaiter" spawn drop - [ - "Goodbye world" ex exchange v1! c count-down - ] "Exchanger 1" spawn drop + [ + "Goodbye world" ex exchange v1! c count-down + ] "Exchanger 1" spawn drop - [ - "Hello world" ex exchange v2! c count-down - ] "Exchanger 2" spawn drop + [ + "Hello world" ex exchange v2! c count-down + ] "Exchanger 2" spawn drop - pr ?promise - ] ; + pr ?promise ; [ "Hello world, Goodbye world" ] [ exchanger-test ] unit-test diff --git a/basis/concurrency/flags/flags-tests.factor b/basis/concurrency/flags/flags-tests.factor index 4fc00b71dd..8402a56631 100644 --- a/basis/concurrency/flags/flags-tests.factor +++ b/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 [ ] | - [ f raise-flag ] "Flag test" spawn drop - f lower-flag - f value>> - ] ; + :> f + [ f raise-flag ] "Flag test" spawn drop + f lower-flag + f value>> ; [ f ] [ flag-test-1 ] unit-test :: flag-test-2 ( -- ? ) - [let | f [ ] | - [ 1 seconds sleep f raise-flag ] "Flag test" spawn drop - f lower-flag - f value>> - ] ; + :> f + [ 1 seconds sleep f raise-flag ] "Flag test" spawn drop + f lower-flag + f value>> ; [ f ] [ flag-test-2 ] unit-test :: flag-test-3 ( -- val ) - [let | f [ ] | - f raise-flag - f value>> - ] ; + :> f + f raise-flag + f value>> ; [ t ] [ flag-test-3 ] unit-test :: flag-test-4 ( -- val ) - [let | f [ ] | - [ f raise-flag ] "Flag test" spawn drop - f wait-for-flag - f value>> - ] ; + :> f + [ f raise-flag ] "Flag test" spawn drop + f wait-for-flag + f value>> ; [ t ] [ flag-test-4 ] unit-test :: flag-test-5 ( -- val ) - [let | f [ ] | - [ 1 seconds sleep f raise-flag ] "Flag test" spawn drop - f wait-for-flag - f value>> - ] ; + :> f + [ 1 seconds sleep f raise-flag ] "Flag test" spawn drop + f wait-for-flag + f value>> ; [ t ] [ flag-test-5 ] unit-test diff --git a/basis/concurrency/locks/locks-tests.factor b/basis/concurrency/locks/locks-tests.factor index f199876fd0..c58d012b3f 100644 --- a/basis/concurrency/locks/locks-tests.factor +++ b/basis/concurrency/locks/locks-tests.factor @@ -4,57 +4,55 @@ threads sequences calendar accessors ; IN: concurrency.locks.tests :: lock-test-0 ( -- v ) - [let | v [ V{ } clone ] - c [ 2 ] | + V{ } clone :> v + 2 :> c - [ - yield - 1 v push - yield - 2 v push - c count-down - ] "Lock test 1" spawn drop + [ + yield + 1 v push + yield + 2 v push + c count-down + ] "Lock test 1" spawn drop - [ - yield - 3 v push - yield - 4 v push - c count-down - ] "Lock test 2" spawn drop + [ + yield + 3 v push + yield + 4 v push + c count-down + ] "Lock test 2" spawn drop - c await - v - ] ; + c await + v ; :: lock-test-1 ( -- v ) - [let | v [ V{ } clone ] - l [ ] - c [ 2 ] | + V{ } clone :> v + :> l + 2 :> c - [ - l [ - yield - 1 v push - yield - 2 v push - ] with-lock - c count-down - ] "Lock test 1" spawn drop + [ + l [ + yield + 1 v push + yield + 2 v push + ] with-lock + c count-down + ] "Lock test 1" spawn drop - [ - l [ - yield - 3 v push - yield - 4 v push - ] with-lock - c count-down - ] "Lock test 2" spawn drop + [ + l [ + yield + 3 v push + yield + 4 v push + ] with-lock + c count-down + ] "Lock test 2" spawn drop - c await - v - ] ; + c await + v ; [ V{ 1 3 2 4 } ] [ lock-test-0 ] unit-test [ V{ 1 2 3 4 } ] [ lock-test-1 ] unit-test @@ -80,98 +78,96 @@ IN: concurrency.locks.tests [ ] [ dup [ [ ] with-read-lock ] with-write-lock ] unit-test :: rw-lock-test-1 ( -- v ) - [let | l [ ] - c [ 1 ] - c' [ 1 ] - c'' [ 4 ] - v [ V{ } clone ] | + :> l + 1 :> c + 1 :> c' + 4 :> c'' + V{ } clone :> v - [ - l [ - 1 v push - c count-down - yield - 3 v push - ] with-read-lock - c'' count-down - ] "R/W lock test 1" spawn drop + [ + l [ + 1 v push + c count-down + yield + 3 v push + ] with-read-lock + c'' count-down + ] "R/W lock test 1" spawn drop - [ - c await - l [ - 4 v push - 1 seconds sleep - 5 v push - ] with-write-lock - c'' count-down - ] "R/W lock test 2" spawn drop + [ + c await + l [ + 4 v push + 1 seconds sleep + 5 v push + ] with-write-lock + c'' count-down + ] "R/W lock test 2" spawn drop - [ - c await - l [ - 2 v push - c' count-down - ] with-read-lock - c'' count-down - ] "R/W lock test 4" spawn drop + [ + c await + l [ + 2 v push + c' count-down + ] with-read-lock + c'' count-down + ] "R/W lock test 4" spawn drop - [ - c' await - l [ - 6 v push - ] with-write-lock - c'' count-down - ] "R/W lock test 5" spawn drop + [ + c' await + l [ + 6 v push + ] with-write-lock + c'' count-down + ] "R/W lock test 5" spawn drop - c'' await - v - ] ; + c'' await + v ; [ V{ 1 2 3 4 5 6 } ] [ rw-lock-test-1 ] unit-test :: rw-lock-test-2 ( -- v ) - [let | l [ ] - c [ 1 ] - c' [ 2 ] - v [ V{ } clone ] | + :> l + 1 :> c + 2 :> c' + V{ } clone :> v - [ - l [ - 1 v push - c count-down - 1 seconds sleep - 2 v push - ] with-write-lock - c' count-down - ] "R/W lock test 1" spawn drop + [ + l [ + 1 v push + c count-down + 1 seconds sleep + 2 v push + ] with-write-lock + c' count-down + ] "R/W lock test 1" spawn drop - [ - c await - l [ - 3 v push - ] with-read-lock - c' count-down - ] "R/W lock test 2" spawn drop + [ + c await + l [ + 3 v push + ] with-read-lock + c' count-down + ] "R/W lock test 2" spawn drop - c' await - v - ] ; + c' await + v ; [ V{ 1 2 3 } ] [ rw-lock-test-2 ] unit-test ! Test lock timeouts :: lock-timeout-test ( -- v ) - [let | l [ ] | - [ - l [ 1 seconds sleep ] with-lock - ] "Lock holder" spawn drop + :> l - [ - l 1/10 seconds [ ] with-lock-timeout - ] "Lock timeout-er" spawn-linked drop + [ + l [ 1 seconds sleep ] with-lock + ] "Lock holder" spawn drop - receive - ] ; + [ + l 1/10 seconds [ ] with-lock-timeout + ] "Lock timeout-er" spawn-linked drop + + receive ; [ lock-timeout-test ] [ thread>> name>> "Lock timeout-er" = diff --git a/basis/core-text/core-text.factor b/basis/core-text/core-text.factor index 3459b368f7..e431df9414 100644 --- a/basis/core-text/core-text.factor +++ b/basis/core-text/core-text.factor @@ -112,35 +112,34 @@ TUPLE: line < disposable line metrics image loc dim ; [ line new-disposable - [let* | open-font [ font cache-font ] - line [ string open-font font foreground>> |CFRelease ] + font cache-font :> open-font + string open-font font foreground>> |CFRelease :> line - rect [ line line-rect ] - (loc) [ rect origin>> CGPoint>loc ] - (dim) [ rect size>> CGSize>dim ] - (ext) [ (loc) (dim) v+ ] - loc [ (loc) [ floor ] map ] - ext [ (loc) (dim) [ + ceiling ] 2map ] - dim [ ext loc [ - >integer 1 max ] 2map ] - metrics [ open-font line compute-line-metrics ] | + line line-rect :> rect + rect origin>> CGPoint>loc :> (loc) + rect size>> CGSize>dim :> (dim) + (loc) (dim) v+ :> (ext) + (loc) [ floor ] map :> loc + (loc) (dim) [ + ceiling ] 2map :> ext + ext loc [ - >integer 1 max ] 2map :> dim + open-font line compute-line-metrics :> metrics - line >>line + line >>line - metrics >>metrics + metrics >>metrics - dim [ - { - [ font dim fill-background ] - [ loc dim line string fill-selection-background ] - [ loc set-text-position ] - [ [ line ] dip CTLineDraw ] - } cleave - ] make-bitmap-image >>image + dim [ + { + [ font dim fill-background ] + [ loc dim line string fill-selection-background ] + [ loc set-text-position ] + [ [ line ] dip CTLineDraw ] + } cleave + ] make-bitmap-image >>image - metrics loc dim line-loc >>loc + metrics loc dim line-loc >>loc - metrics metrics>dim >>dim - ] + metrics metrics>dim >>dim ] with-destructors ; M: line dispose* line>> CFRelease ; diff --git a/basis/fry/fry-docs.factor b/basis/fry/fry-docs.factor index 13b9e61632..9602933785 100644 --- a/basis/fry/fry-docs.factor +++ b/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" diff --git a/basis/furnace/auth/providers/providers.factor b/basis/furnace/auth/providers/providers.factor index 1933fc8c59..44374fb5a6 100644 --- a/basis/furnace/auth/providers/providers.factor +++ b/basis/furnace/auth/providers/providers.factor @@ -23,26 +23,24 @@ GENERIC: new-user ( user provider -- user/f ) ! Password recovery support :: issue-ticket ( email username provider -- user/f ) - [let | user [ username provider get-user ] | - user [ - user email>> length 0 > [ - user email>> email = [ - user - 256 random-bits >hex >>ticket - dup provider update-user - ] [ f ] if + username provider get-user :> user + user [ + user email>> length 0 > [ + user email>> email = [ + user + 256 random-bits >hex >>ticket + dup provider update-user ] [ f ] if ] [ f ] if - ] ; + ] [ f ] if ; :: claim-ticket ( ticket username provider -- user/f ) - [let | user [ username provider get-user ] | - user [ - user ticket>> ticket = [ - user f >>ticket dup provider update-user - ] [ f ] if + username provider get-user :> user + user [ + user ticket>> ticket = [ + user f >>ticket dup provider update-user ] [ f ] if - ] ; + ] [ f ] if ; ! For configuration diff --git a/basis/interpolate/interpolate-tests.factor b/basis/interpolate/interpolate-tests.factor index c15debd9b5..8f84da4ff7 100644 --- a/basis/interpolate/interpolate-tests.factor +++ b/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 diff --git a/basis/io/encodings/gb18030/gb18030.factor b/basis/io/encodings/gb18030/gb18030.factor index 2be709dbc9..1590684326 100644 --- a/basis/io/encodings/gb18030/gb18030.factor +++ b/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>> { @@ -57,7 +58,7 @@ TUPLE: range ufirst ulast bfirst blast ; [ 2drop ] } case ] [ drop ] if - ] each-element mapping ranges + ] each-element mapping ranges ] ; : unlinear ( num -- bytes ) diff --git a/basis/io/launcher/unix/unix-tests.factor b/basis/io/launcher/unix/unix-tests.factor index 852d8171e4..7fa7f4b2c6 100644 --- a/basis/io/launcher/unix/unix-tests.factor +++ b/basis/io/launcher/unix/unix-tests.factor @@ -125,14 +125,15 @@ concurrency.promises threads unix.process ; ! Killed processes were exiting with code 0 on FreeBSD [ f ] [ - [let | p [ ] - s [ ] | - [ - "sleep 1000" run-detached - [ p fulfill ] [ wait-for-process s fulfill ] bi - ] in-thread + [let + :> p + :> s + [ + "sleep 1000" run-detached + [ p fulfill ] [ wait-for-process s fulfill ] bi + ] in-thread - p ?promise handle>> 9 kill drop - s ?promise 0 = + p ?promise handle>> 9 kill drop + s ?promise 0 = ] ] unit-test diff --git a/basis/io/mmap/windows/windows.factor b/basis/io/mmap/windows/windows.factor index a2c1f972a6..e3e3116b59 100644 --- a/basis/io/mmap/windows/windows.factor +++ b/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 ] - hi [ length -32 shift 32 bits ] | - { "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 - ] ; + length 32 bits :> lo + 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 ; TUPLE: win32-mapped-file file mapping ; diff --git a/basis/io/monitors/macosx/macosx.factor b/basis/io/monitors/macosx/macosx.factor index 96f178fb79..e71fb2eca2 100644 --- a/basis/io/monitors/macosx/macosx.factor +++ b/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 mailbox macosx-monitor new-monitor - dup [ enqueue-notifications ] curry - path 1array 0 0 >>handle - ] ; + path normalize-path :> path + path mailbox macosx-monitor new-monitor + dup [ enqueue-notifications ] curry + path 1array 0 0 >>handle ; M: macosx-monitor dispose* handle>> dispose ; diff --git a/basis/io/sockets/secure/openssl/openssl.factor b/basis/io/sockets/secure/openssl/openssl.factor index 400a44ea02..f934842e8c 100644 --- a/basis/io/sockets/secure/openssl/openssl.factor +++ b/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 ] | - buf password len 1 + size min memcpy - len - ] + password strlen :> len + buf password len 1 + size min memcpy + len ] alien-callback ; : default-pasword ( ctx -- alien ) diff --git a/basis/lcs/lcs.factor b/basis/lcs/lcs.factor index aabd4bbafc..38920f5764 100644 --- a/basis/lcs/lcs.factor +++ b/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 [| i | - new length - [| j | i j matrix old new step loop-step ] each - ] each matrix ] ; inline + 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 PRIVATE> : levenshtein ( old new -- n ) diff --git a/basis/models/product/product-tests.factor b/basis/models/product/product-tests.factor index f52dc8a3b0..c26866e83b 100644 --- a/basis/models/product/product-tests.factor +++ b/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 ] - m2 [ 2 ] - c [ { m1 m2 } ] - o1 [ an-observer new ] - o2 [ an-observer new ] | + [let + 1 :> m1 + 2 :> m2 + { m1 m2 } :> c + an-observer new :> o1 + an-observer new :> o2 o1 m1 add-connection o2 m2 add-connection diff --git a/basis/persistent/hashtables/nodes/bitmap/bitmap.factor b/basis/persistent/hashtables/nodes/bitmap/bitmap.factor index 4c764eba93..eb8533c186 100644 --- a/basis/persistent/hashtables/nodes/bitmap/bitmap.factor +++ b/basis/persistent/hashtables/nodes/bitmap/bitmap.factor @@ -10,77 +10,71 @@ 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>> ] - bit [ hashcode shift bitpos ] - bitmap [ bitmap-node bitmap>> ] - nodes [ bitmap-node nodes>> ] | - bitmap bit bitand 0 eq? [ f ] [ - key hashcode - bit bitmap index nodes nth-unsafe - (entry-at) - ] if - ] ; + bitmap-node shift>> :> shift + hashcode shift bitpos :> bit + bitmap-node bitmap>> :> bitmap + bitmap-node nodes>> :> nodes + bitmap bit bitand 0 eq? [ f ] [ + key hashcode + bit bitmap index nodes nth-unsafe + (entry-at) + ] if ; M:: bitmap-node (new-at) ( shift value key hashcode bitmap-node -- node' added-leaf ) - [let* | shift [ bitmap-node shift>> ] - bit [ hashcode shift bitpos ] - bitmap [ bitmap-node bitmap>> ] - idx [ bit bitmap index ] - nodes [ bitmap-node nodes>> ] | - bitmap bit bitand 0 eq? [ - [let | new-leaf [ value key hashcode ] | - bitmap bit bitor - new-leaf idx nodes insert-nth + bitmap-node shift>> :> shift + hashcode shift bitpos :> bit + bitmap-node bitmap>> :> bitmap + bit bitmap index :> idx + bitmap-node nodes>> :> nodes + + bitmap bit bitand 0 eq? [ + value key hashcode :> new-leaf + bitmap bit bitor + new-leaf idx nodes insert-nth + shift + + new-leaf + ] [ + idx nodes nth :> n + shift radix-bits + value key hashcode n (new-at) :> new-leaf :> n' + n n' eq? [ + bitmap-node + ] [ + bitmap + n' idx nodes new-nth shift - new-leaf - ] - ] [ - [let | n [ idx nodes nth ] | - shift radix-bits + value key hashcode n (new-at) - [let | new-leaf [ ] n' [ ] | - n n' eq? [ - bitmap-node - ] [ - bitmap - n' idx nodes new-nth - shift - - ] if - new-leaf - ] - ] - ] if - ] ; + ] if + new-leaf + ] + ] if ; M:: bitmap-node (pluck-at) ( key hashcode bitmap-node -- node' ) - [let | bit [ hashcode bitmap-node shift>> bitpos ] - bitmap [ bitmap-node bitmap>> ] - nodes [ bitmap-node nodes>> ] - shift [ bitmap-node shift>> ] | - bit bitmap bitand 0 eq? [ bitmap-node ] [ - [let* | idx [ bit bitmap index ] - n [ idx nodes nth-unsafe ] - n' [ key hashcode n (pluck-at) ] | - n n' eq? [ - bitmap-node - ] [ - n' [ - bitmap - n' idx nodes new-nth - shift - - ] [ - bitmap bit eq? [ f ] [ - bitmap bit bitnot bitand - idx nodes remove-nth - shift - - ] if - ] if + hashcode bitmap-node shift>> bitpos :> bit + bitmap-node bitmap>> :> bitmap + bitmap-node nodes>> :> nodes + bitmap-node shift>> :> shift + bit bitmap bitand 0 eq? [ bitmap-node ] [ + bit bitmap index :> idx + idx nodes nth-unsafe :> n + key hashcode n (pluck-at) :> n' + n n' eq? [ + bitmap-node + ] [ + n' [ + bitmap + n' idx nodes new-nth + shift + + ] [ + bitmap bit eq? [ f ] [ + bitmap bit bitnot bitand + idx nodes remove-nth + shift + ] if - ] + ] if ] if - ] ; + ] if ; M: bitmap-node >alist% ( node -- ) nodes>> >alist-each% ; diff --git a/basis/persistent/hashtables/nodes/collision/collision.factor b/basis/persistent/hashtables/nodes/collision/collision.factor index 2ee4008f2b..b581fc711d 100644 --- a/basis/persistent/hashtables/nodes/collision/collision.factor +++ b/basis/persistent/hashtables/nodes/collision/collision.factor @@ -15,43 +15,39 @@ 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 ] | - idx [ - idx collision-node leaves>> smash [ - collision-node hashcode>> - - ] when - ] [ collision-node ] if - ] + key hashcode collision-node find-index drop :> idx + idx [ + idx collision-node leaves>> smash [ + collision-node hashcode>> + + ] 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 - [let | leaf-node [ ] idx [ ] | - idx [ - value leaf-node value>> = [ - collision-node f - ] [ - hashcode - value key hashcode - idx - collision-node leaves>> - new-nth - - f - ] if + key hashcode collision-node find-index :> leaf-node :> idx + idx [ + value leaf-node value>> = [ + collision-node f ] [ - [let | new-leaf-node [ value key hashcode ] | - hashcode - collision-node leaves>> - new-leaf-node - suffix - - new-leaf-node - ] + hashcode + value key hashcode + idx + collision-node leaves>> + new-nth + + f ] if - ] + ] [ + value key hashcode :> new-leaf-node + hashcode + collision-node leaves>> + new-leaf-node + suffix + + new-leaf-node + ] if ] [ shift collision-node value key hashcode make-bitmap-node ] if ; diff --git a/basis/persistent/hashtables/nodes/full/full.factor b/basis/persistent/hashtables/nodes/full/full.factor index 5c60c91dca..6adcc62862 100644 --- a/basis/persistent/hashtables/nodes/full/full.factor +++ b/basis/persistent/hashtables/nodes/full/full.factor @@ -8,39 +8,37 @@ 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>> ] - idx [ hashcode full-node shift>> mask ] - n [ idx nodes nth-unsafe ] | - shift radix-bits + value key hashcode n (new-at) - [let | new-leaf [ ] n' [ ] | - n n' eq? [ - full-node - ] [ - n' idx nodes new-nth shift - ] if - new-leaf - ] - ] ; + full-node nodes>> :> nodes + hashcode full-node shift>> mask :> idx + idx nodes nth-unsafe :> n + + shift radix-bits + value key hashcode n (new-at) :> new-leaf :> n' + n n' eq? [ + full-node + ] [ + n' idx nodes new-nth shift + ] if + new-leaf ; M:: full-node (pluck-at) ( key hashcode full-node -- node' ) - [let* | idx [ hashcode full-node shift>> mask ] - n [ idx full-node nodes>> nth ] - n' [ key hashcode n (pluck-at) ] | - n n' eq? [ - full-node + hashcode full-node shift>> mask :> idx + idx full-node nodes>> nth :> n + key hashcode n (pluck-at) :> n' + + n n' eq? [ + full-node + ] [ + n' [ + n' idx full-node nodes>> new-nth + full-node shift>> + ] [ - n' [ - n' idx full-node nodes>> new-nth - full-node shift>> - - ] [ - hashcode full-node shift>> bitpos bitnot full-bitmap-mask bitand - idx full-node nodes>> remove-nth - full-node shift>> - - ] if + hashcode full-node shift>> bitpos bitnot full-bitmap-mask bitand + idx full-node nodes>> remove-nth + full-node shift>> + ] if - ] ; + ] if ; M:: full-node (entry-at) ( key hashcode full-node -- node' ) key hashcode diff --git a/basis/persistent/hashtables/nodes/leaf/leaf.factor b/basis/persistent/hashtables/nodes/leaf/leaf.factor index 94174d5667..0a15ea6305 100644 --- a/basis/persistent/hashtables/nodes/leaf/leaf.factor +++ b/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 f ] if ] [ - [let | new-leaf [ value key hashcode ] | - hashcode leaf-node new-leaf 2array - new-leaf - ] + value key hashcode :> new-leaf + hashcode leaf-node new-leaf 2array + new-leaf ] if ] [ shift leaf-node value key hashcode make-bitmap-node ] if ; diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 8cddac5a75..7fad97c5aa 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -193,16 +193,16 @@ M: bad-executable summary \ load-local [ infer-load-local ] "special" set-word-prop : infer-get-local ( -- ) - [let* | n [ pop-literal nip 1 swap - ] - in-r [ n consume-r ] - out-d [ in-r first copy-value 1array ] - out-r [ in-r copy-values ] | - 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, - ] ; + pop-literal nip 1 swap - :> n + n consume-r :> in-r + in-r first copy-value 1array :> out-d + 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, ; \ get-local [ infer-get-local ] "special" set-word-prop diff --git a/basis/threads/threads-tests.factor b/basis/threads/threads-tests.factor index 610a664c7b..79aad20b85 100644 --- a/basis/threads/threads-tests.factor +++ b/basis/threads/threads-tests.factor @@ -32,13 +32,12 @@ yield [ [ 3 throw ] "A" suspend ] [ 3 = ] must-fail-with :: spawn-namespace-test ( -- ? ) - [let | p [ ] g [ gensym ] | - [ - g "x" set - [ "x" get p fulfill ] "B" spawn drop - ] with-scope - p ?promise g eq? - ] ; + :> p gensym :> g + [ + g "x" set + [ "x" get p fulfill ] "B" spawn drop + ] with-scope + p ?promise g eq? ; [ t ] [ spawn-namespace-test ] unit-test diff --git a/basis/tools/walker/debug/debug.factor b/basis/tools/walker/debug/debug.factor index 80113607d4..2ab74bf735 100644 --- a/basis/tools/walker/debug/debug.factor +++ b/basis/tools/walker/debug/debug.factor @@ -6,26 +6,25 @@ namespaces namespaces.private assocs accessors ; IN: tools.walker.debug :: test-walker ( quot -- data ) - [let | p [ ] | + :> p + [ + H{ } clone >n + [ - H{ } clone >n + p promise-fulfilled? + [ drop ] [ p fulfill ] if + 2drop + ] show-walker-hook set - [ - p promise-fulfilled? - [ drop ] [ p fulfill ] if - 2drop - ] show-walker-hook set + break - break + quot call + ] "Walker test" spawn drop - quot call - ] "Walker test" spawn drop + step-into-all + p ?promise + send-synchronous drop - step-into-all - p ?promise - send-synchronous drop - - p ?promise - variables>> walker-continuation swap at - value>> data>> - ] ; + p ?promise + variables>> walker-continuation swap at + value>> data>> ; diff --git a/basis/unicode/collation/collation.factor b/basis/unicode/collation/collation.factor index 5cab884b3c..ea0487c703 100755 --- a/basis/unicode/collation/collation.factor +++ b/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 ] | - str ducet key? dup - [ str i slice set-nth ] when - ] ; + i slice nth char suffix :> str + str ducet key? dup + [ str i slice set-nth ] when ; : add ( char -- ) dup blocked? [ 1string , ] [ diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index afe24905d6..11792d91a7 100644 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -48,18 +48,17 @@ ERROR: unix-error errno message ; ERROR: unix-system-call-error args errno message word ; MACRO:: unix-system-call ( quot -- ) - [let | n [ quot infer in>> ] - word [ quot first ] | - [ - n ndup quot call dup 0 < [ - drop - n narray - errno dup strerror - word unix-system-call-error - ] [ - n nnip - ] if - ] + quot infer in>> :> n + quot first :> word + [ + n ndup quot call dup 0 < [ + drop + n narray + errno dup strerror + word unix-system-call-error + ] [ + n nnip + ] if ] ; HOOK: open-file os ( path flags mode -- fd ) diff --git a/basis/windows/dinput/constants/constants.factor b/basis/windows/dinput/constants/constants.factor index 3c0509c49d..adbf29dfdd 100755 --- a/basis/windows/dinput/constants/constants.factor +++ b/basis/windows/dinput/constants/constants.factor @@ -56,13 +56,12 @@ M: array array-base-type first ; DIOBJECTDATAFORMAT ; :: make-DIOBJECTDATAFORMAT-array ( struct array -- alien ) - [let | alien [ array length malloc-DIOBJECTDATAFORMAT-array ] | - array [| args i | - struct args - i alien set-nth - ] each-index - alien - ] ; + array length malloc-DIOBJECTDATAFORMAT-array :> alien + array [| args i | + struct args + i alien set-nth + ] each-index + alien ; : ( dwFlags dwDataSize struct rgodf-array -- alien ) [ DIDATAFORMAT heap-size DIOBJECTDATAFORMAT heap-size ] 4 ndip diff --git a/basis/xml/syntax/syntax-docs.factor b/basis/xml/syntax/syntax-docs.factor index 9e0c50a37d..7c39af7b26 100644 --- a/basis/xml/syntax/syntax-docs.factor +++ b/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 | - number [ 3 ] - false [ f ] - url [ URL" http://factorcode.org/" ] - string [ "hello" ] - word [ \\ drop ] | +[let + 3 :> number [ 3 ] + f :> false [ f ] + URL" http://factorcode.org/" :> url + "hello" :> string + \\ drop :> world diff --git a/basis/xml/syntax/syntax-tests.factor b/basis/xml/syntax/syntax-tests.factor index 5c1669adb1..40c86237a7 100644 --- a/basis/xml/syntax/syntax-tests.factor +++ b/basis/xml/syntax/syntax-tests.factor @@ -54,8 +54,7 @@ XML-NS: foo http://blah.com y """ ] [ - [let* | a [ "one" ] c [ "two" ] x [ "y" ] - d [ [XML <-x-> XML] ] | + [let "one" :> a "two" :> c "y" :> x [XML <-x-> XML] :> d <-a-> /> <-d-> XML> pprint-xml>string diff --git a/extra/benchmark/beust2/beust2.factor b/extra/benchmark/beust2/beust2.factor index 14ebcb1c5b..92715dc9c7 100755 --- a/extra/benchmark/beust2/beust2.factor +++ b/extra/benchmark/beust2/beust2.factor @@ -7,25 +7,24 @@ IN: benchmark.beust2 :: (count-numbers) ( remaining first value used max listener: ( -- ) -- ? ) 10 first - iota [| i | - [let* | digit [ i first + ] - mask [ digit 2^ ] - value' [ i value + ] | - used mask bitand zero? [ - value max > [ t ] [ - remaining 1 <= [ - listener call f - ] [ - remaining 1 - - 0 - value' 10 * - used mask bitor - max - listener - (count-numbers) - ] if + i first + :> digit + digit 2^ :> mask + i value + :> value' + used mask bitand zero? [ + value max > [ t ] [ + remaining 1 <= [ + listener call f + ] [ + remaining 1 - + 0 + value' 10 * + used mask bitor + max + listener + (count-numbers) ] if - ] [ f ] if - ] + ] if + ] [ f ] if ] any? ; inline recursive :: count-numbers ( max listener -- ) @@ -33,9 +32,8 @@ IN: benchmark.beust2 inline :: beust ( -- ) - [let | i! [ 0 ] | - 5000000000 [ i 1 + i! ] count-numbers - i number>string " unique numbers." append print - ] ; + 0 :> i! + 5000000000 [ i 1 + i! ] count-numbers + i number>string " unique numbers." append print ; MAIN: beust diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor index 1ad769173b..4b15eaac7e 100755 --- a/extra/benchmark/fasta/fasta.factor +++ b/extra/benchmark/fasta/fasta.factor @@ -71,38 +71,34 @@ CONSTANT: homo-sapiens [ make-random-fasta ] 2curry split-lines ; inline :: make-repeat-fasta ( k len alu -- k' ) - [let | kn [ alu length ] | - len [ k + kn mod alu nth-unsafe ] "" map-as print - k len + - ] ; inline + alu length :> kn + len [ k + kn mod alu nth-unsafe ] "" map-as print + k len + ; inline : write-repeat-fasta ( n alu desc id -- ) write-description - [let | k! [ 0 ] alu [ ] | - [| len | k len alu make-repeat-fasta k! ] split-lines - ] ; inline + 0 :> k! :> alu + [| 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 [ ] - homo-sapiens-chars [ ] - IUB-floats [ ] - IUB-chars [ ] - out [ ] - n [ ] - seed [ initial-seed ] | + :> homo-sapiens-floats + :> homo-sapiens-chars + :> IUB-floats + :> IUB-chars + :> out + :> n + initial-seed :> seed - out ascii [ - n 2 * ALU "Homo sapiens alu" "ONE" write-repeat-fasta + 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 5 * IUB-chars IUB-floats "Homo sapiens frequency" "THREE" write-random-fasta - drop - ] with-file-writer - - ] ; + initial-seed + n 3 * homo-sapiens-chars homo-sapiens-floats "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 ; diff --git a/extra/benchmark/yuv-to-rgb/yuv-to-rgb.factor b/extra/benchmark/yuv-to-rgb/yuv-to-rgb.factor index bd13de32c7..024887991e 100644 --- a/extra/benchmark/yuv-to-rgb/yuv-to-rgb.factor +++ b/extra/benchmark/yuv-to-rgb/yuv-to-rgb.factor @@ -17,20 +17,19 @@ STRUCT: yuv_buffer { v void* } ; :: fake-data ( -- rgb yuv ) - [let* | w [ 1600 ] - h [ 1200 ] - buffer [ yuv_buffer ] - rgb [ w h * 3 * ] | - rgb buffer - w >>y_width - h >>y_height - h >>uv_height - w >>y_stride - 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 - ] ; + 1600 :> w + 1200 :> h + yuv_buffer :> buffer + w h * 3 * :> rgb + rgb buffer + w >>y_width + h >>y_height + h >>uv_height + w >>y_stride + 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 ; : clamp ( n -- n ) 255 min 0 max ; inline diff --git a/extra/crypto/aes/aes.factor b/extra/crypto/aes/aes.factor index 0807420266..a5a6709c6d 100644 --- a/extra/crypto/aes/aes.factor +++ b/extra/crypto/aes/aes.factor @@ -61,37 +61,33 @@ CONSTANT: AES_BLOCK_SIZE 16 bitor bitor bitor 32 bits ; :: set-t ( T i -- ) - [let* | - a1 [ i sbox nth ] - a2 [ a1 xtime ] - 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 - ] ; + i sbox nth :> a1 + a1 xtime :> a2 + a1 a2 bitxor :> a3 + 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 ; MEMO:: t-table ( -- array ) 1024 0 dup 256 [ set-t ] with each ; :: set-d ( D i -- ) - [let* | - a1 [ i inv-sbox nth ] - a2 [ a1 xtime ] - a4 [ a2 xtime ] - a8 [ a4 xtime ] - a9 [ a8 a1 bitxor ] - ab [ a9 a2 bitxor ] - ad [ a9 a4 bitxor ] - 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 - ] ; + i inv-sbox nth :> a1 + a1 xtime :> a2 + a2 xtime :> a4 + a4 xtime :> a8 + a8 a1 bitxor :> a9 + a9 a2 bitxor :> ab + a9 a4 bitxor :> ad + a8 a4 a2 bitxor bitxor :> ae + + 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 ; MEMO:: d-table ( -- array ) 1024 0 diff --git a/extra/crypto/passwd-md5/passwd-md5.factor b/extra/crypto/passwd-md5/passwd-md5.factor index 30650c1e40..f5219e7a3f 100644 --- a/extra/crypto/passwd-md5/passwd-md5.factor +++ b/extra/crypto/passwd-md5/passwd-md5.factor @@ -17,28 +17,29 @@ IN: crypto.passwd-md5 PRIVATE> :: passwd-md5 ( magic salt password -- bytes ) - [let* | final! [ password magic salt 3append - salt password tuck 3append md5 checksum-bytes - password length - [ 16 / ceiling swap concat ] keep - head-slice append - password [ length make-bits ] [ first ] bi - '[ CHAR: \0 _ ? ] "" map-as append - md5 checksum-bytes ] | - 1000 [ - "" swap - { - [ 0 bit? password final ? append ] - [ 3 mod 0 > [ salt append ] when ] - [ 7 mod 0 > [ password append ] when ] - [ 0 bit? final password ? append ] - } cleave md5 checksum-bytes final! - ] each + password magic salt 3append + salt password tuck 3append md5 checksum-bytes + password length + [ 16 / ceiling swap concat ] keep + head-slice append + password [ length make-bits ] [ first ] bi + '[ CHAR: \0 _ ? ] "" map-as append + md5 checksum-bytes :> final! - 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 ] ; + 1000 iota [ + "" swap + { + [ 0 bit? password final ? append ] + [ 3 mod 0 > [ salt append ] when ] + [ 7 mod 0 > [ password append ] when ] + [ 0 bit? final password ? append ] + } cleave md5 checksum-bytes final! + ] each + + 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 ; : parse-shadow-password ( string -- magic salt password ) "$" split harvest first3 [ "$" tuck 3append ] 2dip ; diff --git a/extra/galois-talk/galois-talk.factor b/extra/galois-talk/galois-talk.factor index 0d2a5a73d8..4c9c04ba8d 100644 --- a/extra/galois-talk/galois-talk.factor +++ b/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" diff --git a/extra/google-tech-talk/google-tech-talk.factor b/extra/google-tech-talk/google-tech-talk.factor index 5f33af04fe..02d0bedb2c 100644 --- a/extra/google-tech-talk/google-tech-talk.factor +++ b/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" diff --git a/extra/images/normalization/normalization.factor b/extra/images/normalization/normalization.factor index 0beaa1de1d..2bd7e6883f 100755 --- a/extra/images/normalization/normalization.factor +++ b/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>> ] - dst [ dst-order name>> ] | - bytes src length group - [ pad4 src dst permutation shuffle dst length head ] - map concat ] ; + src-order name>> :> src + dst-order name>> :> dst + bytes src length group + [ pad4 src dst permutation shuffle dst length head ] + map concat ; : (reorder-components) ( image src-order dest-order -- image ) [ permute ] 2curry change-bitmap ; diff --git a/extra/infix/infix-docs.factor b/extra/infix/infix-docs.factor index d99116424f..9b490a43d2 100644 --- a/extra/infix/infix-docs.factor +++ b/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:" @@ -77,7 +62,7 @@ $nl "You can access " { $vocab-link "sequences" } " inside infix expressions with the familiar " { $snippet "arr[index]" } " notation." { $example "USING: arrays 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:" diff --git a/extra/infix/infix-tests.factor b/extra/infix/infix-tests.factor index 5e3d5d67cb..c2b0d9d7b4 100644 --- a/extra/infix/infix-tests.factor +++ b/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 diff --git a/extra/infix/infix.factor b/extra/infix/infix.factor index ce19780058..4efecb5fcf 100644 --- a/extra/infix/infix.factor +++ b/extra/infix/infix.factor @@ -83,14 +83,3 @@ PRIVATE> SYNTAX: [infix "infix]" [infix-parse parsed \ call parsed ; - - - -SYNTAX: [infix| - "|" parse-bindings "infix]" parse-infix-locals - ?rewrite-closures over push-all ; diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor index e4c954d793..baeacd750b 100644 --- a/extra/jamshred/player/player.factor +++ b/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 ] - move-v [ d-to-move heading n*v ] | - move-v player location+ - heading player update-nearest-segment2 - d-left d-to-move - player ] ; + d-left distance min :> d-to-move + d-to-move heading n*v :> move-v + + move-v player location+ + heading player update-nearest-segment2 + d-left d-to-move - player ; : distance-to-move-freely ( player -- distance ) [ almost-to-collision ] diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor index 742f834622..f7eac9d02c 100644 --- a/extra/jamshred/tunnel/tunnel.factor +++ b/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>> ] | - cf next location>> v. cf location v. - cf heading v. / ] ; + current forward>> :> cf + cf next location>> v. cf location v. - cf heading v. / ; :: distance-to-next-segment-area ( current next location heading -- distance ) - [let | cf [ current forward>> ] - h [ next current half-way-between-oints ] | - cf h v. cf location v. - cf heading v. / ] ; + current forward>> :> cf + next current half-way-between-oints :> h + 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. ] - b [ v w v. 2 * ] - c [ w dup v. r sq - ] | - c b a quadratic max-real ] + v dup v. :> a + v w v. 2 * :> b + w dup v. r sq - :> c + c b a quadratic max-real ] if ; : sideways-heading ( oint segment -- v ) diff --git a/extra/mason/common/common.factor b/extra/mason/common/common.factor index 22e37f8a8c..7b5a0194d3 100755 --- a/extra/mason/common/common.factor +++ b/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 ] - scp-remote [ { username "@" host ":" temp } concat ] - scp [ scp-command get ] - ssh [ ssh-command get ] | - 5 [ { scp local scp-remote } short-running-process ] retry - 5 [ { ssh host "-l" username "mv" temp remote } short-running-process ] retry - ] ; + remote ".incomplete" append :> temp + { username "@" host ":" temp } concat :> scp-remote + scp-command get :> scp + 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 ; : eval-file ( file -- obj ) dup utf8 file-lines parse-fresh diff --git a/extra/mongodb/connection/connection.factor b/extra/mongodb/connection/connection.factor index 45cced5b3b..1d38aa38d5 100644 --- a/extra/mongodb/connection/connection.factor +++ b/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 ] - node2 [ mdb node1 remote>> - [ [ check-node ] keep ] - [ drop f ] if* ] - | node1 [ acc push ] when* - node2 [ acc push ] when* - mdb acc nodelist>table >>nodes drop - ] + [ + V{ } clone :> acc + mdb dup master-node [ check-node ] keep :> node1 + mdb node1 remote>> + [ [ check-node ] keep ] + [ drop f ] if* :> node2 + + node1 [ acc push ] when* + node2 [ acc push ] when* + mdb acc nodelist>table >>nodes drop ] with-destructors ; : mdb-open ( mdb -- mdb-connection ) @@ -143,4 +144,4 @@ PRIVATE> [ dispose f ] change-handle drop ; M: mdb-connection dispose - mdb-close ; \ No newline at end of file + mdb-close ; diff --git a/extra/mongodb/driver/driver.factor b/extra/mongodb/driver/driver.factor index 9538972582..b0242fd067 100644 --- a/extra/mongodb/driver/driver.factor +++ b/extra/mongodb/driver/driver.factor @@ -151,14 +151,14 @@ M: mdb-collection create-collection [ "$cmd" = ] [ "system" head? ] bi or ; : check-collection ( collection -- fq-collection ) - [let* | instance [ mdb-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 ] ; + 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 ; : fix-query-collection ( mdb-query -- mdb-query ) [ check-collection ] change-collection ; inline diff --git a/extra/mongodb/operations/operations.factor b/extra/mongodb/operations/operations.factor index d4ee789523..69b14cb967 100644 --- a/extra/mongodb/operations/operations.factor +++ b/extra/mongodb/operations/operations.factor @@ -106,14 +106,13 @@ USE: tools.walker write flush ; inline : build-query-object ( query -- selector ) - [let | selector [ H{ } clone ] | - { [ 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 - ] ; + H{ } clone :> selector + { [ 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 ; PRIVATE> diff --git a/extra/project-euler/073/073.factor b/extra/project-euler/073/073.factor index 8ab0b17190..b63a71946e 100644 --- a/extra/project-euler/073/073.factor +++ b/extra/project-euler/073/073.factor @@ -33,13 +33,12 @@ IN: project-euler.073 m + m denominator limit <= [ + counter 1 + + limit lo m (euler073) + limit m hi (euler073) + ] [ counter ] if ; PRIVATE> diff --git a/extra/project-euler/150/150.factor b/extra/project-euler/150/150.factor index a54b7d1db0..e6278a1e17 100644 --- a/extra/project-euler/150/150.factor +++ b/extra/project-euler/150/150.factor @@ -54,17 +54,16 @@ IN: project-euler.150 0 1000 [1,b] [ [ next ] replicate partial-sums ] map nip ; :: (euler150) ( m -- n ) - [let | table [ sums-triangle ] | - m [| x | - x 1 + [| y | - m x - [0,b) [| z | - x z + table nth-unsafe - [ y z + 1 + swap nth-unsafe ] - [ y swap nth-unsafe ] bi - - ] map partial-sum-infimum - ] map-infimum + sums-triangle :> table + m [| x | + x 1 + [| y | + m x - [0,b) [| z | + x z + table nth-unsafe + [ y z + 1 + swap nth-unsafe ] + [ y swap nth-unsafe ] bi - + ] map partial-sum-infimum ] map-infimum - ] ; + ] map-infimum ; HINTS: (euler150) fixnum ; diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor index 254e282139..70943e6674 100644 --- a/extra/ui/gadgets/alerts/alerts.factor +++ b/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