cleanup some use of with-scope.
John Benediktsson
parent
6c8c5992a1
commit
1a73e79ef7
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -19,15 +19,14 @@ M: mock-responder call-responder*
|
|||
main-responder get call-responder
|
||||
write-response get ;
|
||||
|
||||
[
|
||||
<dispatcher>
|
||||
<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
|
||||
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>
|
||||
<dispatcher>
|
||||
"default" <mock-responder> >>default
|
||||
main-responder set
|
||||
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 ;
|
||||
|
|
|
|||
|
|
@ -41,8 +41,7 @@ yield
|
|||
[ datagram-client delete-file ] ignore-errors
|
||||
|
||||
[
|
||||
[
|
||||
datagram-server <local> <datagram> "d" set
|
||||
datagram-server <local> <datagram> "d" [
|
||||
|
||||
"Receive 1" print
|
||||
|
||||
|
|
@ -67,7 +66,7 @@ yield
|
|||
"Done" print
|
||||
|
||||
datagram-server delete-file
|
||||
] with-scope
|
||||
] with-variable
|
||||
] "Test" spawn drop
|
||||
|
||||
yield
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
] unit-test
|
||||
|
||||
[ { 1 2 3 4 5 } ] [
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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<< ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue