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

cleanup some use of with-scope.

db4
John Benediktsson 2012-07-19 13:55:34 -07:00
parent 6c8c5992a1
commit 1a73e79ef7
17 changed files with 52 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
basis/classes/struct/struct-tests.factor
View File

@ -161,36 +161,30 @@ STRUCT: struct-test-string-ptr
[ "S{ struct-test-foo { x 0 } { y 7654 } { z f } }" ]
[
[
boa-tuples? off
c-object-pointers? off
H{ { boa-tuples? f } { c-object-pointers? f } } [
struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer
] with-scope
] with-variables
] unit-test
[ "S@ struct-test-foo B{ 0 0 0 0 0 0 0 0 0 0 0 0 }" ]
[
[
c-object-pointers? on
H{ { c-object-pointers? t } } [
12 <byte-array> struct-test-foo memory>struct [ pprint ] with-string-writer
] with-scope
] with-variables
] unit-test
[ "S{ struct-test-foo f 0 7654 f }" ]
[
[
boa-tuples? on
c-object-pointers? off
H{ { boa-tuples? t } { c-object-pointers? f } } [
struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer
] with-scope
] with-variables
] unit-test
[ "S@ struct-test-foo f" ]
[
[
c-object-pointers? off
H{ { c-object-pointers? f } } [
f struct-test-foo memory>struct [ pprint ] with-string-writer
] with-scope
] with-variables
] unit-test
[ "USING: alien.c-types classes.struct ;

13
basis/help/html/html.factor
View File

@ -118,13 +118,12 @@ M: topic url-of topic>filename ;
all-topics [ '[ _ generate-help-file ] try ] each ;
: generate-help-files ( -- )
[
recent-searches off
recent-words off
recent-articles off
recent-vocabs off
(generate-help-files)
] with-scope ;
H{
{ recent-searches f }
{ recent-words f }
{ recent-articles f }
{ recent-vocabs f }
} [ (generate-help-files) ] with-variables ;
: generate-help ( -- )
"docs" cache-file

3
basis/help/markup/markup-tests.factor
View File

@ -5,7 +5,8 @@ FROM: namespaces => set ;
IN: help.markup.tests
: with-markup-test ( quot -- )
'[ f last-element set _ with-string-writer ] with-scope ; inline
[ f last-element ] dip
'[ _ with-string-writer ] with-variable ; inline
TUPLE: blahblah quux ;

26
basis/http/server/dispatchers/dispatchers-tests.factor
View File

@ -19,15 +19,14 @@ M: mock-responder call-responder*
main-responder get call-responder
write-response get ;
[
<dispatcher>
"foo" <mock-responder> "foo" add-responder
"bar" <mock-responder> "bar" add-responder
<dispatcher>
"foo" <mock-responder> "foo" add-responder
"bar" <mock-responder> "bar" add-responder
<dispatcher>
"123" <mock-responder> "123" add-responder
"default" <mock-responder> >>default
"baz" add-responder
main-responder set
"123" <mock-responder> "123" add-responder
"default" <mock-responder> >>default
"baz" add-responder
main-responder [
[ "foo" ] [
{ "foo" } main-responder get find-responder path>> nip
@ -46,15 +45,14 @@ M: mock-responder call-responder*
[ t ] [ "123" "baz/123" check-dispatch ] unit-test
[ t ] [ "123" "baz///123" check-dispatch ] unit-test
] with-scope
] with-variable
[
<dispatcher>
"default" <mock-responder> >>default
main-responder set
<dispatcher>
"default" <mock-responder> >>default
main-responder [
[ "/default" ] [ "/default" main-responder get find-responder drop ] unit-test
] with-scope
] with-variable
! Make sure path for default responder isn't chopped
TUPLE: path-check-responder ;

9
basis/io/backend/unix/unix-tests.factor
View File

@ -41,13 +41,12 @@ yield
[ datagram-client delete-file ] ignore-errors
[
[
datagram-server <local> <datagram> "d" set
datagram-server <local> <datagram> "d" [
"Receive 1" print
"d" get receive [ reverse ] dip
"Send 1" print
dup .
@ -56,7 +55,7 @@ yield
"Receive 2" print
"d" get receive [ " world" append ] dip
"Send 1" print
dup .
@ -67,7 +66,7 @@ yield
"Done" print
datagram-server delete-file
] with-scope
] with-variable
] "Test" spawn drop
yield

5
basis/io/files/info/unix/linux/linux.factor
View File

@ -56,10 +56,7 @@ frequency pass-number ;
} cleave ;
: parse-mtab ( -- array )
[
"/etc/mtab" utf8 <file-reader>
CHAR: \s delimiter set csv
] with-scope
CHAR: \s [ "/etc/mtab" utf8 file>csv ] with-delimiter
[ mtab-csv>mtab-entry ] map ;
M: linux file-systems

2
basis/math/matrices/elimination/elimination.factor
View File

@ -7,7 +7,7 @@ IN: math.matrices.elimination
SYMBOL: matrix
: with-matrix ( matrix quot -- )
[ swap matrix set call matrix get ] with-scope ; inline
matrix swap [ matrix get ] compose with-variable ; inline
: nth-row ( row# -- seq ) matrix get nth ;

2
basis/nmake/nmake.factor
View File

@ -4,7 +4,7 @@ USING: namespaces sequences math.parser kernel macros
generalizations sequences.generalizations locals ;
IN: nmake
SYMBOL: building-seq
SYMBOL: building-seq
: get-building-seq ( n -- seq )
building-seq get nth ;

4
basis/pack/pack-tests.factor
View File

@ -13,9 +13,7 @@ IN: pack.tests
] unit-test
[ B{ 1 2 0 3 0 0 4 0 0 0 5 0 0 0 0 0 0 0 } ] [
[
{ 1 2 3 4 5 } "cstiq" pack-le
] with-scope
{ 1 2 3 4 5 } "cstiq" pack-le
] unit-test
[ { 1 2 3 4 5 } ] [

11
basis/prettyprint/sections/sections.factor
View File

@ -354,15 +354,16 @@ M: block long-section ( block -- )
: make-pprint ( obj quot -- block manifest )
[
0 position set
H{ } clone pprinter-use set
V{ } clone recursion-check set
V{ } clone pprinter-stack set
0 position ,,
H{ } clone pprinter-use ,,
V{ } clone recursion-check ,,
V{ } clone pprinter-stack ,,
] H{ } make [
over <object
call
pprinter-block
pprinter-manifest
] with-scope ; inline
] with-variables ; inline
: with-pprint ( obj quot -- )
make-pprint drop do-pprint ; inline

2
basis/refs/refs-tests.factor
View File

@ -32,7 +32,7 @@ SYMBOLS: lion giraffe elephant rabbit ;
[ rabbit f ] [ rabbit <obj-ref> [ take ] keep get-ref ] unit-test
[ lion ] [ rabbit <obj-ref> dup [ drop lion ] change-ref get-ref ] unit-test
! var-refs
! var-refs
[ giraffe ] [ [ giraffe rabbit set rabbit <var-ref> get-ref ] with-scope ] unit-test
[ rabbit ]

5
basis/threads/threads-tests.factor
View File

@ -29,10 +29,9 @@ yield
:: spawn-namespace-test ( -- ? )
<promise> :> p gensym :> g
[
g "x" set
g "x" [
[ "x" get p fulfill ] "B" spawn drop
] with-scope
] with-variable
p ?promise g eq? ;
[ t ] [ spawn-namespace-test ] unit-test

2
basis/ui/render/render.factor
View File

@ -136,7 +136,7 @@ M: gadget draw-children
[ gadget-background ]
[ gadget-foreground ]
} cleave [
{
[ [ selected-gadgets set ] when* ]
[ [ selection-background set ] when* ]

5
extra/asn1/asn1.factor
View File

@ -193,10 +193,7 @@ TUPLE: tag value ;
: <tag> ( -- <tag> ) 4 tag boa ;
: with-ber ( quot -- )
[
<tag> tagnum set
call
] with-scope ; inline
[ <tag> tagnum ] dip with-variable ; inline
: set-tag ( value -- )
tagnum get value<< ;

2
extra/game/models/obj/obj.factor
View File

@ -4,7 +4,7 @@ USING: io io.encodings.ascii math.parser sequences splitting
kernel assocs io.files combinators math.order math namespaces
arrays sequences.deep accessors alien.c-types alien.data
game.models game.models.util gpu.shaders images game.models.loader
prettyprint specialized-arrays ;
prettyprint specialized-arrays make ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAYS: c:float c:uint ;
IN: game.models.obj

4
extra/model-viewer/model-viewer.factor
View File

@ -100,7 +100,7 @@ TUPLE: vbo
BGR >>component-order
ubyte-components >>component-type
B{ 0 0 0 } >>bitmap ;
: make-texture ( pathname alt -- texture )
swap [ nip load-image ] [ ] if*
[
@ -115,7 +115,7 @@ TUPLE: vbo
[
0 swap [ allocate-texture-image ] 3keep 2drop
] bi ;
: <model-buffers> ( models -- buffers )
[
{

4
extra/opencl/opencl.factor
View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.data arrays
byte-arrays combinators combinators.smart destructors
io.encodings.ascii io.encodings.string kernel libc locals math
namespaces opencl.ffi sequences shuffle specialized-arrays
io.encodings.ascii io.encodings.string kernel libc locals make
math namespaces opencl.ffi sequences shuffle specialized-arrays
variants ;
IN: opencl
SPECIALIZED-ARRAYS: void* char size_t ;