steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

factor: [let -> let[

locals-and-roots
Doug Coleman 2016-06-06 16:01:22 -07:00
parent b77e568759
commit 7003d7e735
45 changed files with 150 additions and 150 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
benchmarks/benchmark/fasta/fasta.factor
View File

@ -74,7 +74,7 @@ TYPED:: make-repeat-fasta ( k: fixnum len: fixnum alu: string -- k': fixnum )
: write-repeat-fasta ( n alu desc id -- )
write-description
[let
let[
:> alu
0 :> k!
[| len | k len alu make-repeat-fasta k! ] split-lines
@ -83,7 +83,7 @@ TYPED:: make-repeat-fasta ( k: fixnum len: fixnum alu: string -- k': fixnum )
: fasta ( n out -- )
homo-sapiens make-cumulative
IUB make-cumulative
[let
let[
:> ( n out IUB-chars IUB-floats homo-sapiens-chars homo-sapiens-floats )
initial-seed :> seed

4
core-locals.factor
View File

@ -18,7 +18,7 @@ use: delegate.private
<< forget: _ >>
<< forget: @ >>
<< forget: postpone\ [| >>
<< forget: postpone\ [let >>
<< forget: postpone\ let[ >>
<< forget: postpone\ IH{ >>
<< forget: postpone\ PROTOCOL: >>
<< forget: postpone\ CONSULT: >>
@ -47,7 +47,7 @@ SYNTAX: :>
SYNTAX: [| parse-lambda append! ;
SYNTAX: [let parse-let append! ;
SYNTAX: let[ parse-let append! ;
SYNTAX: MEMO[ parse-quotation dup infer memoize-quot suffix! ;

2
core/bootstrap/syntax.factor
View File

@ -117,7 +117,7 @@ in: bootstrap.syntax
"SBUF\""
"::" "M::" "MEMO:" "MEMO::" "MACRO:" "MACRO::" "IDENTITY-MEMO:" "IDENTITY-MEMO::" "TYPED:" "TYPED::"
":>" "[|" "[let" "MEMO["
":>" "[|" "let[" "MEMO["
"'["
"_"
"@"

4
core/locals/errors/errors.factor
View File

@ -12,7 +12,7 @@ M: >r/r>-in-lambda-error summary
ERROR: let-form-in-literal-error ;
M: let-form-in-literal-error summary
drop "[let not permitted inside literals" ;
drop "let[ not permitted inside literals" ;
ERROR: local-writer-in-literal-error ;
@ -22,7 +22,7 @@ M: local-writer-in-literal-error summary
ERROR: :>-outside-lambda-error ;
M: :>-outside-lambda-error summary
drop ":> cannot be used outside of [let, [|, or :: forms" ;
drop ":> cannot be used outside of let[, [|, or :: forms" ;
ERROR: bad-local args obj ;

18
core/locals/locals-docs.factor
View File

@ -7,14 +7,14 @@ HELP: \ [|
{ $description "A literal quotation with named variable bindings. When the quotation is " { $link call } "ed, it will take values off the datastack and place them into the bindings from left to right. The body may then refer to these bindings. The quotation may also bind to named variables in an enclosing scope to create a closure." }
{ $examples "See " { $link "locals-examples" } "." } ;
HELP: \ [let
{ $syntax "[let code :> var code :> var code... ]" }
{ $description "Establishes a new scope for lexical 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." }
HELP: \ let[
{ $syntax "let[ code :> var code :> var code... ]" }
{ $description "Establishes a new scope for lexical 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: \ :>
{ $syntax ":> var" ":> var!" ":> ( var-1 var-2 ... )" }
{ $description "Binds one or more new lexical variables. In the " { $snippet ":> var" } " form, the value on the top of the datastack is bound to a new lexical variable named " { $snippet "var" } " and is scoped to the enclosing quotation, " { $link postpone\ [let } " form, or " { $link postpone\ :: } " definition."
{ $description "Binds one or more new lexical variables. In the " { $snippet ":> var" } " form, the value on the top of the datastack is bound to a new lexical variable named " { $snippet "var" } " and is scoped to the enclosing quotation, " { $link postpone\ let[ } " form, or " { $link postpone\ :: } " definition."
$nl
"The " { $snippet ":> ( var-1 ... )" } " form binds multiple variables to the top values of the datastack in right to left order, with the last variable bound to the top of the datastack. These two snippets have the same effect:"
{ $code ":> c :> b :> a" }
@ -22,10 +22,10 @@ $nl
$nl
"If any " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), that new variable is mutable. See " { $link "locals-mutable" } " for more information." }
{ $notes
"This syntax can only be used inside a lexical scope established by a " { $link postpone\ :: } " definition, " { $link postpone\ [let } " form, or " { $link postpone\ [| } " quotation. Normal quotations have their own lexical scope only if they are inside an outer scope. Definition forms such as " { $link postpone\ : } " do not establish a lexical scope by themselves unless documented otherwise, nor is there a lexical scope available at the top level of source files or in the listener. " { $link postpone\ [let } " can be used to create a lexical scope where one is not otherwise available." }
"This syntax can only be used inside a lexical scope established by a " { $link postpone\ :: } " definition, " { $link postpone\ let[ } " form, or " { $link postpone\ [| } " quotation. Normal quotations have their own lexical scope only if they are inside an outer scope. Definition forms such as " { $link postpone\ : } " do not establish a lexical scope by themselves unless documented otherwise, nor is there a lexical scope available at the top level of source files or in the listener. " { $link postpone\ let[ } " can be used to create a lexical scope where one is not otherwise available." }
{ $examples "See " { $link "locals-examples" } "." } ;
{ postpone\ [let postpone\ :> } related-words
{ postpone\ let[ postpone\ :> } related-words
HELP: \ ::
{ $syntax ":: word ( vars... -- outputs... ) body... ;" }
@ -78,10 +78,10 @@ in: scratchpad
"2.0
-3.0"
}
"If you wanted to perform the quadratic formula interactively from the listener, you could use " { $link postpone\ [let } " to provide a scope for the variables:"
"If you wanted to perform the quadratic formula interactively from the listener, you could use " { $link postpone\ let[ } " to provide a scope for the variables:"
{ $example "USING: locals math math.functions kernel ;
in: scratchpad
[let 1.0 :> a 1.0 :> b -6.0 :> c
let[ 1.0 :> a 1.0 :> b -6.0 :> c
b sq 4 a c * * - sqrt :> disc
b neg disc [ + ] [ - ] 2bi [ 2 a * / ] bi@
] [ . ] bi@"
@ -289,7 +289,7 @@ ARTICLE: "locals" "Lexical variables"
}
"Lexical scoping and binding forms:"
{ $subsections
postpone\ [let
postpone\ let[
postpone\ :>
}
"Quotation literals where the inputs are bound to lexical variables:"

66
core/locals/locals-tests.factor
View File

@ -27,30 +27,30 @@ in: locals.tests
{ { 5 6 7 } } [ { 1 2 3 } 4 map-test-2 ] unit-test
:: let-test ( c -- d )
[let 1 :> a 2 :> b 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 a :> b a ] ] ;
a let[ :> a let[ a :> b a ] ] ;
{ 3 } [ 3 let-test-2 ] unit-test
:: let-test-3 ( a -- a )
a [let :> a [let [ a ] :> b [let 3 :> a b ] ] ] ;
a let[ :> a let[ [ a ] :> b let[ 3 :> a b ] ] ] ;
:: let-test-4 ( a -- b )
a [let 1 :> a :> 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 1 :> b a b 2array ] ;
a let[ :> a 1 :> b a b 2array ] ;
{ { 2 1 } } [ 2 let-test-6 ] unit-test
@ -72,7 +72,7 @@ in: locals.tests
{ 5 } [ 2 "q" get call ] unit-test
:: write-test-2 ( -- q )
[let 0 :> n! [| i | n i + dup n! ] ] ;
let[ 0 :> n! [| i | n i + dup n! ] ] ;
write-test-2 "q" set
@ -93,11 +93,11 @@ write-test-2 "q" set
{ } [ 1 2 write-test-3 call ] unit-test
:: write-test-4 ( x! -- q ) [ [let 0 :> y! f x! ] ] ;
:: write-test-4 ( x! -- q ) [ let[ 0 :> y! f x! ] ] ;
{ } [ 5 write-test-4 drop ] unit-test
:: let-let-test ( n -- n ) [let n 3 + :> n n ] ;
:: let-let-test ( n -- n ) let[ n 3 + :> n n ] ;
{ 13 } [ 10 let-let-test ] unit-test
@ -135,9 +135,9 @@ M:: string lambda-generic ( a b -- c ) a b lambda-generic-2 ;
{ } [ \ lambda-generic see ] unit-test
:: unparse-test-1 ( a -- ) [let 3 :> a! 4 :> b ] ;
:: unparse-test-1 ( a -- ) let[ 3 :> a! 4 :> b ] ;
{ "[let 3 :> a! 4 :> b ]" } [
{ "let[ 3 :> a! 4 :> b ]" } [
\ unparse-test-1 "lambda" word-prop body>> first unparse
] unit-test
@ -177,11 +177,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 -- ) ;
@ -239,10 +239,10 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
{ t } [ 12 &&-test ] unit-test
:: let-and-cond-test-1 ( -- a )
[let 10 :> a
[let 20 :> a
let[ 10 :> a
let[ 20 :> a
{
{ [ t ] [ [let 30 :> c a ] ] }
{ [ t ] [ let[ 30 :> c a ] ] }
} cond
]
] ;
@ -252,8 +252,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 10 :> A
[let 20 :> B
let[ 10 :> A
let[ 20 :> B
{ { [ t ] [ { A B } ] } } cond
]
] ;
@ -266,7 +266,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 10 :> a 20 :> b 30 :> c { 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
@ -388,7 +388,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 10 :> A A _ + ] ]"
"USING: locals fry math ; 1 '[ let[ 10 :> A A _ + ] ]"
eval( -- ) call
] [ error>> >r/r>-in-fry-error? ] must-fail-with
@ -400,7 +400,7 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
{ t } [ 3 funny-macro-test ] unit-test
{ f } [ 2 funny-macro-test ] unit-test
[ "use: locals [let" eval( -- ) ] [ error>> unexpected-eof? ] must-fail-with
[ "use: locals let[" 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
@ -416,9 +416,9 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
{ 3 } [ 3 [| a | \ a ] call ] unit-test
[ "use: locals [| | { [let 0 :> a a ] } ]" eval( -- ) ] must-fail
[ "use: locals [| | { let[ 0 :> a a ] } ]" eval( -- ) ] must-fail
[ "use: locals [| | [let 0 :> a! { a! } ] ]" eval( -- ) ] must-fail
[ "use: locals [| | let[ 0 :> a! { a! } ] ]" eval( -- ) ] must-fail
[ "use: locals [| | { :> a } ]" eval( -- ) ] must-fail
@ -431,13 +431,13 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
{ 3 } [ 2 [| | :> a! a 1 + a! a ] call ] unit-test
: fry-locals-test-1 ( -- n )
[let 6 '[ [let 4 :> A 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 4 :> A A _ + ] ] call ] ;
let[ 6 '[ let[ 4 :> A A _ + ] ] call ] ;
\ fry-locals-test-2 def>> must-infer
{ 10 } [ fry-locals-test-2 ] unit-test
@ -455,18 +455,18 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
] unit-test
{ 10 } [
[| | 0 '[ [let 10 :> A A _ + ] ] call ] call
[| | 0 '[ let[ 10 :> A A _ + ] ] call ] call
] unit-test
! littledan found this problem
{ "bar" } [ [let [let "bar" :> foo foo ] :> a a ] ] unit-test
{ 10 } [ [let 10 :> a [let a :> b b ] ] ] unit-test
{ "bar" } [ let[ let[ "bar" :> foo foo ] :> a a ] ] unit-test
{ 10 } [ let[ 10 :> a let[ a :> b b ] ] ] unit-test
{ { \ + } } [ [let \ + :> x { \ x } ] ] unit-test
{ { \ + } } [ let[ \ + :> x { \ x } ] ] unit-test
{ { \ + 3 } } [ [let 3 :> a { \ + 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 ;
@ -493,7 +493,7 @@ M: integer ed's-bug neg ;
{ t } [ \ ed's-test-case word-optimized? ] unit-test
! multiple bind
{ 3 1 2 } [ [let 1 2 3 :> ( a b c ) c a b ] ] unit-test
{ 3 1 2 } [ let[ 1 2 3 :> ( a b c ) c a b ] ] unit-test
! Test smart combinators and locals interaction
:: smart-combinator-locals ( a b c -- seq ) [ a b c ] output>array ;

2
core/modern/out/out-tests.factor
View File

@ -56,4 +56,4 @@ in: modern.out.tests
! lexable-paths [ transform-single-line-comment>hash-comment ] rewrite-paths
{ t }
[ "( a: ( quot: ( b -- c ) -- d ) -- e )" [ [ ] rewrite-string ] keep sequence= ] unit-test
[ "( a: ( quot: ( b -- c ) -- d ) -- e )" [ [ ] rewrite-string ] keep sequence= ] unit-test

2
core/syntax/syntax.factor
View File

@ -379,7 +379,7 @@ in: bootstrap.syntax
] define-core-syntax
"[|" [ parse-lambda append! ] define-core-syntax
"[let" [ parse-let append! ] define-core-syntax
"let[" [ parse-let append! ] define-core-syntax
"MEMO[" [ parse-quotation dup infer memoize-quot suffix! ] define-core-syntax
"'[" [ parse-quotation fry append! ] define-core-syntax
"IH{" [ \ } [ >identity-hashtable ] parse-literal ] define-core-syntax

2
demos/rosetta-code/n-queens/n-queens.factor
View File

@ -9,7 +9,7 @@ in: rosetta-code.n-queens
! solve the puzzle with a board of side NxN.
:: safe? ( board q -- ? )
[let q board nth :> x
let[ q board nth :> x
q iota [
x swap
[ board nth ] keep

2
demos/talks/galois-talk/galois-talk.factor
View File

@ -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 " { $snippet "[let*" } }
{ "Establish bindings with " { $link postpone\ let[ } " and " { $snippet "let[*" } }
"Mutable bindings with correct semantics"
{ "Named inputs for quotations with " { $link postpone\ [| } }
"Full closures"

2
demos/talks/google-tech-talk/google-tech-talk.factor
View File

@ -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 " { $snippet "[let*" } }
{ "Establish bindings with " { $link postpone\ let[ } " and " { $snippet "let[*" } }
"Mutable bindings with correct semantics"
{ "Named inputs for quotations with " { $link postpone\ [| } }
"Full closures"

2
demos/talks/vpri-talk/vpri-talk.factor
View File

@ -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 " { $snippet "[let*" } }
{ "Establish bindings with " { $link postpone\ let[ } " and " { $snippet "let[*" } }
"Mutable bindings with correct semantics"
{ "Named inputs for quotations with " { $link postpone\ [| } }
"Full closures"

2
ffi/mongodb/driver/driver.factor
View File

@ -163,7 +163,7 @@ M: mdb-collection create-collection ( collection -- )
[ "$cmd" = ] [ "system" head? ] bi or ;
: check-collection ( collection -- fq-collection )
[let
let[
mdb-instance :> instance
instance name>> :> instance-name
dup mdb-collection? [ name>> ] when

2
language/interpolate/interpolate-tests.factor
View File

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

2
language/io/encodings/gb18030/gb18030.factor
View File

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

2
language/io/launcher/unix/unix-tests.factor
View File

@ -133,7 +133,7 @@ in: io.launcher.unix.tests
! Killed processes were exiting with code 0 on FreeBSD
{ f } [
[let
let[
<promise> :> p
<promise> :> s

2
language/locals/prettyprint/prettyprint.factor
View File

@ -28,7 +28,7 @@ M: lambda pprint*
<block body>> pprint-elements block>
\ ] pprint-word ;
M: let pprint* \ [let pprint-let ;
M: let pprint* \ let[ pprint-let ;
M: def pprint*
dup local>> word?

2
language/models/product/product-tests.factor
View File

@ -27,7 +27,7 @@ TUPLE: an-observer { i integer } ;
M: an-observer model-changed nip [ 1 + ] change-i drop ;
{ 1 0 } [
[let
let[
1 <model> :> m1
2 <model> :> m2
{ m1 m2 } <product> :> c

6
language/peg/ebnf/ebnf.factor
View File

@ -429,7 +429,7 @@ M: ebnf-sequence build-locals ( code ast -- code )
drop
] [
[
"[let " %
"let[ " %
[
over ebnf-var? [
" " % # " over nth :> " %
@ -447,7 +447,7 @@ M: ebnf-sequence build-locals ( code ast -- code )
M: ebnf-var build-locals ( code ast -- code )
[
"[let dup :> " % name>> %
"let[ dup :> " % name>> %
" " %
%
" nip ]" %
@ -473,7 +473,7 @@ ERROR: bad-effect quot effect ;
! so we don't pollute the manifest qualified-vocabs
! and also so restarts don't add multiple times
qualified-vocabs length
"syntax" { "[let" ":>" } add-words-from
"syntax" { "let[" ":>" } add-words-from
"kernel" { "dup" "nip" "over" } add-words-from
"sequences" { "nth" } add-words-from
[ string-lines parse-lines ] dip

2
language/peg/peg.factor
View File

@ -608,7 +608,7 @@ PRIVATE>
ERROR: parse-failed input word ;
SYNTAX: \ PEG:
[let
let[
(:) :> ( word def effect )
[
[

2
libs/calendar/holidays/holidays.factor
View File

@ -15,7 +15,7 @@ SYNTAX: HOLIDAY:
parse-definition ( timestamp/n -- timestamp ) define-declared ;
SYNTAX: HOLIDAY-NAME:
[let scan-word "holiday" word-prop :> holidays scan-word :> name scan-object :> value
let[ scan-word "holiday" word-prop :> holidays scan-word :> name scan-object :> value
value name holidays set-at ] ;
>>

4
libs/colors/lab/lab.factor
View File

@ -14,7 +14,7 @@ M: laba >rgba >xyza >rgba ;
M: laba >xyza
[
[let
let[
[ l>> ] [ a>> ] [ b>> ] tri :> ( l a b )
l 16 + 116 / :> fy
a 500 / fy + :> fx
@ -53,7 +53,7 @@ M: rgba >laba >xyza >laba ;
M: xyza >laba
[
[let
let[
[ x>> wp_x / ] [ y>> wp_y / ] [ z>> wp_z / ] tri
[
dup xyz_epsilon >

8
libs/colors/lch/lch.factor
View File

@ -26,7 +26,7 @@ M: LCHuv >xyza >luva >xyza ;
M: LCHuv >luva
[
[let
let[
[ l>> ] [ c>> ] [ h>> ] tri :> ( l c h )
h deg>rad :> hr
@ -44,7 +44,7 @@ M: LCHuv >LCHuv ; inline
M: luva >LCHuv
[
[let
let[
[ l>> ] [ u>> ] [ v>> ] tri :> ( l u v )
v u fatan2 rad>deg
[ dup 360 > ] [ 360 - ] while
@ -64,7 +64,7 @@ M: LCHab >rgba >laba >rgba ;
M: LCHab >laba
[
[let
let[
[ l>> ] [ c>> ] [ h>> ] tri :> ( l c h )
h deg>rad :> hr
@ -82,7 +82,7 @@ M: LCHab >LCHab ; inline
M: laba >LCHab
[
[let
let[
[ l>> ] [ a>> ] [ b>> ] tri :> ( l a b )
b a fatan2 rad>deg
[ dup 360 > ] [ 360 - ] while

4
libs/colors/luv/luv.factor
View File

@ -23,7 +23,7 @@ M: luva >rgba >xyza >rgba ;
M: luva >xyza
[
[let
let[
wp_x wp_y wp_z xyz-to-uv :> ( u_wp v_wp )
[ l>> ] [ u>> ] [ v>> ] tri :> ( l u v )
@ -52,7 +52,7 @@ M: luva >luva ; inline
M: xyza >luva
[
[let
let[
wp_x wp_y wp_z xyz-to-uv :> ( u_wp v_wp )
[ x>> ] [ y>> ] [ z>> ] tri :> ( x_ y_ z_ )
x_ y_ z_ xyz-to-uv :> ( u_ v_ )

4
libs/colors/xyy/xyy.factor
View File

@ -14,7 +14,7 @@ M: xyYa >rgba
M: xyYa >xyza
[
[let
let[
[ x>> ] [ y>> ] [ Y>> ] tri :> ( x y Y )
x y / Y *
Y
@ -30,7 +30,7 @@ M: xyYa >xyYa ; inline
M: xyza >xyYa
[
[let
let[
[ x>> ] [ y>> ] [ z>> ] tri :> ( x y z )
x y z + +
[ x swap / ]

4
libs/colors/xyz/xyz.factor
View File

@ -26,7 +26,7 @@ PRIVATE>
M: xyza >rgba
[
[let
let[
[ x>> ] [ y>> ] [ z>> ] tri :> ( x y z )
x 3.2404542 * y -1.5371385 * z -0.4985314 * + +
x -0.9692660 * y 1.8760108 * z 0.0415560 * + +
@ -50,7 +50,7 @@ PRIVATE>
M: rgba >xyza
[
[let
let[
[ red>> ] [ green>> ] [ blue>> ] tri
[ invert-rgb-compand ] tri@ :> ( r g b )
r 0.4124564 * g 0.3575761 * b 0.1804375 * + +

2
libs/gml/macros/macros.factor
View File

@ -28,7 +28,7 @@ MACRO:: log-euler-op ( class def inputs -- quot )
class inputs def inputs '[ [ current-macro get [ _ boa save-euler-op ] [ _ ndrop ] if ] _ _ nbi ] ;
SYNTAX: LOG-GML:
[let
let[
(GML:) :> ( word name effect def )
name "-record" append create-word-in :> record-class

2
libs/gml/runtime/runtime.factor
View File

@ -189,7 +189,7 @@ SYNTAX: GML:
(GML:) define-gml-primitive ;
SYNTAX: GML::
[let
let[
scan-gml-name :> ( word name )
word [ parse-definition ] parse-locals-definition :> ( word def effect )
word name effect def define-gml-primitive

2
libs/images/loader/gtk/gtk.factor
View File

@ -27,7 +27,7 @@ os linux? [
[ gdk_pixbuf_get_n_channels ]
[ gdk_pixbuf_get_bits_per_sample ]
} cleave
[let :> ( pixels w h rowstride channels bps )
let[ :> ( pixels w h rowstride channels bps )
bps channels * 7 + 8 /i w * :> bytes-per-row
bytes-per-row rowstride =

8
libs/infix/infix-docs.factor
View File

@ -63,26 +63,26 @@ $nl
"You can access " { $vocab-link "sequences" } " inside infix expressions with the familiar " { $snippet "seq[index]" } " notation."
{ $example
"USING: arrays locals infix ;"
"[let { 1 2 3 4 } :> myarr [infix myarr[4/2]*3 infix] ] ."
"let[ { 1 2 3 4 } :> myarr [infix myarr[4/2]*3 infix] ] ."
"9"
}
$nl
"You can create sub-" { $vocab-link "sequences" } " inside infix expressions using " { $snippet "seq[from:to]" } " notation."
{ $example
"USING: arrays locals infix ;"
"[let \"foobar\" :> s [infix s[0:3] infix] ] ."
"let[ \"foobar\" :> s [infix s[0:3] infix] ] ."
"\"foo\""
}
$nl
"Additionally, you can step through " { $vocab-link "sequences" } " with " { $snippet "seq[from:to:step]" } " notation."
{ $example
"USING: arrays locals infix ;"
"[let \"reverse\" :> s [infix s[::-1] infix] ] ."
"let[ \"reverse\" :> s [infix s[::-1] infix] ] ."
"\"esrever\""
}
{ $example
"USING: arrays locals infix ;"
"[let \"0123456789\" :> s [infix s[::2] infix] ] ."
"let[ \"0123456789\" :> s [infix s[::2] infix] ] ."
"\"02468\""
}
;

34
libs/infix/infix-tests.factor
View File

@ -32,24 +32,24 @@ 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 1 :> a [infix -a infix] ] ] unit-test
{ -1 } [ let[ 1 :> a [infix -a infix] ] ] unit-test
{ char: f } [ [let "foo" :> s [infix s[0] infix] ] ] unit-test
{ char: r } [ [let "bar" :> s [infix s[-1] infix] ] ] unit-test
{ "foo" } [ [let "foobar" :> s [infix s[0:3] infix] ] ] unit-test
{ "foo" } [ [let "foobar" :> s [infix s[:3] infix] ] ] unit-test
{ "bar" } [ [let "foobar" :> s [infix s[-3:] infix] ] ] unit-test
{ "boof" } [ [let "foobar" :> s [infix s[-3::-1] infix] ] ] unit-test
{ "foobar" } [ [let "foobar" :> s [infix s[:] infix] ] ] unit-test
{ "foa" } [ [let "foobar" :> s [infix s[::2] infix] ] ] unit-test
{ "bar" } [ [let "foobar" :> s [infix s[-3:100] infix] ] ] unit-test
{ "foobar" } [ [let "foobar" :> s [infix s[-100:100] infix] ] ] unit-test
{ "olh" } [ [let "hello" :> s [infix s[4::-2] infix] ] ] unit-test
{ "rb" } [ [let "foobar" :> s [infix s[:1:-2] infix] ] ] unit-test
{ "foa" } [ [let "foobar" :> s [infix s[:-1:2] infix] ] ] unit-test
{ "rbo" } [ [let "foobar" :> s [infix s[::-2] infix] ] ] unit-test
{ "rbo" } [ [let "foobar" :> s [infix s[:0:-2] infix] ] ] unit-test
{ "rb" } [ [let "foobar" :> s [infix s[:-5:-2] infix] ] ] unit-test
{ char: f } [ let[ "foo" :> s [infix s[0] infix] ] ] unit-test
{ char: r } [ let[ "bar" :> s [infix s[-1] infix] ] ] unit-test
{ "foo" } [ let[ "foobar" :> s [infix s[0:3] infix] ] ] unit-test
{ "foo" } [ let[ "foobar" :> s [infix s[:3] infix] ] ] unit-test
{ "bar" } [ let[ "foobar" :> s [infix s[-3:] infix] ] ] unit-test
{ "boof" } [ let[ "foobar" :> s [infix s[-3::-1] infix] ] ] unit-test
{ "foobar" } [ let[ "foobar" :> s [infix s[:] infix] ] ] unit-test
{ "foa" } [ let[ "foobar" :> s [infix s[::2] infix] ] ] unit-test
{ "bar" } [ let[ "foobar" :> s [infix s[-3:100] infix] ] ] unit-test
{ "foobar" } [ let[ "foobar" :> s [infix s[-100:100] infix] ] ] unit-test
{ "olh" } [ let[ "hello" :> s [infix s[4::-2] infix] ] ] unit-test
{ "rb" } [ let[ "foobar" :> s [infix s[:1:-2] infix] ] ] unit-test
{ "foa" } [ let[ "foobar" :> s [infix s[:-1:2] infix] ] ] unit-test
{ "rbo" } [ let[ "foobar" :> s [infix s[::-2] infix] ] ] unit-test
{ "rbo" } [ let[ "foobar" :> s [infix s[:0:-2] infix] ] ] unit-test
{ "rb" } [ let[ "foobar" :> s [infix s[:-5:-2] infix] ] ] unit-test
INFIX:: foo ( x y -- z ) x**2-abs(y) ;

2
libs/xml/syntax/syntax-docs.factor
View File

@ -74,7 +74,7 @@ $nl
"Here is an example of the locals version:"
{ $example
"USING: locals urls xml.syntax xml.writer ;
[let
let[
3 :> number
f :> false
URL\" http://factorcode.org/\" :> url

2
libs/xml/syntax/syntax-tests.factor
View File

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

2
tools/pdf/layout/layout.factor
View File

@ -214,7 +214,7 @@ M: table-row pdf-render
{
[ drop ?line-break ]
[
[let
let[
over y>> :> start-y
over y>> :> max-y!
[

22
unmaintained/L-system/L-system.factor
View File

@ -38,9 +38,9 @@ DEFER: default-L-parser-values
:: Rx ( ANGLE -- Rx )
[let | ANGLE [ ANGLE deg>rad ] |
let[ | ANGLE [ ANGLE deg>rad ] |
[let | A [ ANGLE cos ]
let[ | A [ ANGLE cos ]
B [ ANGLE sin neg ]
C [ ANGLE sin ]
D [ ANGLE cos ] |
@ -53,9 +53,9 @@ DEFER: default-L-parser-values
:: Ry ( ANGLE -- Ry )
[let | ANGLE [ ANGLE deg>rad ] |
let[ | ANGLE [ ANGLE deg>rad ] |
[let | A [ ANGLE cos ]
let[ | A [ ANGLE cos ]
B [ ANGLE sin ]
C [ ANGLE sin neg ]
D [ ANGLE cos ] |
@ -68,9 +68,9 @@ DEFER: default-L-parser-values
:: Rz ( ANGLE -- Rz )
[let | ANGLE [ ANGLE deg>rad ] |
let[ | ANGLE [ ANGLE deg>rad ] |
[let | A [ ANGLE cos ]
let[ | A [ ANGLE cos ]
B [ ANGLE sin neg ]
C [ ANGLE sin ]
D [ ANGLE cos ] |
@ -304,7 +304,7 @@ TUPLE: <L-system> < gadget
[
STRING read-instruction
[let | REST [ ] NEXT [ ] |
let[ | REST [ ] NEXT [ ] |
NEXT 1 head RULES at NEXT or ACCUM push-all
@ -316,7 +316,7 @@ TUPLE: <L-system> < gadget
:: iterate-string ( STRING RULES -- string )
[let | ACCUM [ STRING length 10 * <sbuf> ] |
let[ | ACCUM [ STRING length 10 * <sbuf> ] |
STRING RULES ACCUM iterate-string-loop
@ -330,9 +330,9 @@ TUPLE: <L-system> < gadget
[
STRING read-instruction
[let | REST [ ] NEXT [ ] |
let[ | REST [ ] NEXT [ ] |
[let | COMMAND [ NEXT 1 head COMMANDS at ] |
let[ | COMMAND [ NEXT 1 head COMMANDS at ] |
COMMAND
[
@ -363,7 +363,7 @@ TUPLE: <L-system> < gadget
:: do-camera-look-at ( CAMERA -- )
[let | EYE [ CAMERA pos>> ]
let[ | EYE [ CAMERA pos>> ]
FOCUS [ CAMERA clone 1 step-turtle pos>> ]
UP [ CAMERA clone 90 pitch-up 1 step-turtle pos>> CAMERA pos>> v- ]
|

12
unmaintained/bubble-chamber/bubble-chamber.factor
View File

@ -104,12 +104,12 @@ DEFER: collision-theta
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: out-of-bounds? ( PARTICLE -- ? )
[let | X [ PARTICLE pos>> first ]
let[ | X [ PARTICLE pos>> first ]
Y [ PARTICLE pos>> second ]
WIDTH [ PARTICLE bubble-chamber>> size>> first ]
HEIGHT [ PARTICLE bubble-chamber>> size>> second ] |
[let | LEFT [ WIDTH neg ]
let[ | LEFT [ WIDTH neg ]
RIGHT [ WIDTH 2 * ]
BOTTOM [ HEIGHT neg ]
TOP [ HEIGHT 2 * ] |
@ -313,9 +313,9 @@ METHOD: collide ( <muon> -- )
METHOD: move ( <muon> -- )
[let | MUON [ ] |
let[ | MUON [ ] |
[let | WIDTH [ MUON bubble-chamber>> size>> first ] |
let[ | WIDTH [ MUON bubble-chamber>> size>> first ] |
MUON
@ -363,9 +363,9 @@ METHOD: collide ( <quark> -- )
METHOD: move ( <quark> -- )
[let | QUARK [ ] |
let[ | QUARK [ ] |
[let | WIDTH [ QUARK bubble-chamber>> size>> first ] |
let[ | WIDTH [ QUARK bubble-chamber>> size>> first ] |
QUARK

4
unmaintained/dns/cache/nx/nx.factor vendored
View File

@ -17,7 +17,7 @@ in: dns.cache.nx
: now ( -- seconds ) millis 1000.0 / round >integer ;
:: non-existent-name? ( NAME -- ? )
[let | TIME [ NAME nx-cache-at ] |
let[ | TIME [ NAME nx-cache-at ] |
{
{ [ TIME f = ] [ f ] }
{ [ TIME now <= ] [ NAME nx-cache-delete-at f ] }
@ -29,7 +29,7 @@ in: dns.cache.nx
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: cache-non-existent-name ( NAME TTL -- )
[let | TIME [ TTL now + ] | TIME NAME nx-cache-set-at ] ;
let[ | TIME [ TTL now + ] | TIME NAME nx-cache-set-at ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

6
unmaintained/dns/cache/rr/rr.factor vendored
View File

@ -29,14 +29,14 @@ TUPLE: <entry> time data ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: cache-get ( OBJ -- rrs/f )
[let | ENT [ OBJ cache-at ] |
let[ | ENT [ OBJ cache-at ] |
{
{ [ ENT f = ] [ f ] }
{ [ ENT expired? ] [ OBJ cache-delete f ] }
{
[ t ]
[
[let | NAME [ OBJ name>> ]
let[ | NAME [ OBJ name>> ]
TYPE [ OBJ type>> ]
CLASS [ OBJ class>> ]
TTL [ ENT time>> now - ] |
@ -53,7 +53,7 @@ TUPLE: <entry> time data ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: cache-add ( RR -- )
[let | ENT [ RR cache-at ]
let[ | ENT [ RR cache-at ]
TIME [ RR ttl>> now + ]
RDATA [ RR rdata>> ] |
{

24
unmaintained/dns/forwarding/forwarding.factor
View File

@ -10,24 +10,24 @@ in: dns.forwarding
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: query->rrs ( QUERY -- rrs/f )
[let | RRS [ QUERY cache-get ] |
let[ | RRS [ QUERY cache-get ] |
RRS
[ RRS ]
[
[let | NAME [ QUERY name>> ]
let[ | NAME [ QUERY name>> ]
TYPE [ QUERY type>> ]
CLASS [ QUERY class>> ] |
[let | RRS/CNAME [ T{ query f NAME CNAME CLASS } cache-get ] |
let[ | RRS/CNAME [ T{ query f NAME CNAME CLASS } cache-get ] |
RRS/CNAME f =
[ f ]
[
[let | RR/CNAME [ RRS/CNAME first ] |
let[ | RR/CNAME [ RRS/CNAME first ] |
[let | REAL-NAME [ RR/CNAME rdata>> ] |
let[ | REAL-NAME [ RR/CNAME rdata>> ] |
[let | RRS [
let[ | RRS [
T{ query f REAL-NAME TYPE CLASS } query->rrs
] |
@ -44,9 +44,9 @@ in: dns.forwarding
] ;
:: answer-from-cache ( MSG -- msg/f )
[let | QUERY [ MSG message-query ] |
let[ | QUERY [ MSG message-query ] |
[let | NX [ QUERY name>> non-existent-name? ]
let[ | NX [ QUERY name>> non-existent-name? ]
RRS [ QUERY query->rrs ] |
{
@ -66,7 +66,7 @@ in: dns.forwarding
! :: cache-message ( MSG -- msg )
! MSG rcode>> NAME-ERROR =
! [
! [let | NAME [ MSG message-query name>> ]
! let[ | NAME [ MSG message-query name>> ]
! TTL [ MSG message-soa ttl>> ] |
! NAME TTL cache-non-existent-name
! ]
@ -80,13 +80,13 @@ in: dns.forwarding
:: cache-message ( MSG -- msg )
MSG rcode>> NAME-ERROR =
[
[let | RR/SOA [ MSG
let[ | RR/SOA [ MSG
authority-section>>
[ type>> SOA = ] filter
dup empty? [ drop f ] [ first ] if ] |
RR/SOA
[
[let | NAME [ MSG message-query name>> ]
let[ | NAME [ MSG message-query name>> ]
TTL [ MSG message-soa ttl>> ] |
NAME TTL cache-non-existent-name
]
@ -111,7 +111,7 @@ in: dns.forwarding
:: start-server ( ADDR-SPEC SERVERS -- )
[let | SOCKET [ ADDR-SPEC <datagram> ] |
let[ | SOCKET [ ADDR-SPEC <datagram> ] |
[
SOCKET receive-packet

8
unmaintained/dns/resolver/resolver.factor
View File

@ -15,7 +15,7 @@ in: dns.resolver
with-disposal ;
:: send-receive-tcp ( BA SERVER -- ba )
[let | BA [ BA length 2 >be BA append ] |
let[ | BA [ BA length 2 >be BA append ] |
SERVER binary
[
T{ duration { second 3 } } input-stream get set-timeout
@ -24,7 +24,7 @@ in: dns.resolver
with-client ] ;
:: send-receive-server ( BA SERVER -- msg )
[let | RESULT [ BA SERVER send-receive-udp parse-message ] |
let[ | RESULT [ BA SERVER send-receive-udp parse-message ] |
RESULT tc>> 1 =
[ BA SERVER send-receive-tcp parse-message ]
[ RESULT ]
@ -34,7 +34,7 @@ in: dns.resolver
:: send-receive-servers ( BA SERVERS -- msg )
SERVERS empty? [ "send-receive-servers: servers list empty" throw ] when
[let | SERVER [ SERVERS random >dns-inet4 ] |
let[ | SERVER [ SERVERS random >dns-inet4 ] |
! if this throws an error ...
[ BA SERVER send-receive-server ]
! we try with the other servers...
@ -62,7 +62,7 @@ in: dns.resolver
: dns-ip4 ( name -- ips )
fully-qualified
[let | MSG [ A IN query boa query->message dns-servers ask-servers ] |
let[ | MSG [ A IN query boa query->message dns-servers ask-servers ] |
MSG rcode>> NO-ERROR =
[ MSG answer-section>> [ type>> A = ] filter [ rdata>> ] map ]
[ "dns-ip: rcode = " MSG rcode>> unparse append throw ]

2
unmaintained/easy-help/expand-markup/expand-markup.factor
View File

@ -30,7 +30,7 @@ in: easy-help.expand-markup
LINE contains-markup?
[
[let | N [ "{ $" LINE start ] |
let[ | N [ "{ $" LINE start ] |
LINE N head

6
unmaintained/frame-buffer/frame-buffer.factor
View File

@ -51,7 +51,7 @@ GENERIC: update-frame-buffer ( <frame-buffer> -- )
:: copy-row ( OLD NEW -- )
[let | LEN [ OLD NEW min-length ] |
let[ | LEN [ OLD NEW min-length ] |
OLD LEN head-slice 0 NEW copy ] ;
@ -76,14 +76,14 @@ M:: <frame-buffer> layout* ( FRAME-BUFFER -- )
{
[ FRAME-BUFFER [ rect-dim ] [ last-dim>> ] bi = not ]
[
[let | OLD-PIXELS [ FRAME-BUFFER pixels>> ]
let[ | OLD-PIXELS [ FRAME-BUFFER pixels>> ]
OLD-WIDTH [ FRAME-BUFFER last-dim>> first ] |
FRAME-BUFFER init-frame-buffer-pixels
FRAME-BUFFER update-last-dim
[let | NEW-PIXELS [ FRAME-BUFFER pixels>> ]
let[ | NEW-PIXELS [ FRAME-BUFFER pixels>> ]
NEW-WIDTH [ FRAME-BUFFER last-dim>> first ] |
OLD-PIXELS OLD-WIDTH NEW-PIXELS NEW-WIDTH copy-pixels ] ]

2
unmaintained/opengl-gadgets/gadgets.factor
View File

@ -88,7 +88,7 @@ M: texture-gadget ungraft* ( gadget -- )
pick [ render-bytes ] dip ;
:: four-corners ( dim -- )
[let* | w [ dim first ]
let[* | w [ dim first ]
h [ dim second ]
dim' [ dim dup 2^-bounds [ /f ] 2map ]
w' [ dim' first ]

2
unmaintained/peg-lexer/peg-lexer.factor
View File

@ -10,7 +10,7 @@ CONSULT: assoc-protocol lex-hash hash>> ;
: pos-or-0 ( neg? -- pos/0 ) dup 0 < [ drop 0 ] when ;
:: prepare-pos ( v i -- c l )
[let | n [ i v head-slice ] |
let[ | n [ i v head-slice ] |
v CHAR: \n n last-index -1 or 1 + -
n [ CHAR: \n = ] count 1 +
] ;

2
unmaintained/size-of/size-of.factor
View File

@ -41,7 +41,7 @@ Example:
:: size-of ( HEADERS TYPE -- n )
[let | C-FILE [ "size-of.c" temp-file ]
let[ | C-FILE [ "size-of.c" temp-file ]
EXE-FILE [ "size-of" temp-file ]
INCLUDES [ HEADERS [| FILE | { "#include <" FILE ">" } concat ] map ] |