core: Don't use with-scope. H{ } clone [ ] with-variables is the same thing and is more explicit.
parent
3c48141689
commit
9c4ed3ddae
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2008, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs classes classes.private
|
||||
classes.tuple classes.tuple.private continuations definitions
|
||||
generic hash-sets init kernel kernel.private math namespaces
|
||||
sequences sets source-files.errors vocabs words ;
|
||||
classes.tuple.private continuations definitions generic
|
||||
hash-sets init kernel kernel.private math namespaces sequences
|
||||
sets source-files.errors vocabs words ;
|
||||
IN: compiler.units
|
||||
|
||||
PRIMITIVE: modify-code-heap ( alist update-existing? reset-pics? -- )
|
||||
|
@ -184,24 +184,24 @@ M: nesting-observer definitions-changed
|
|||
PRIVATE>
|
||||
|
||||
: with-nested-compilation-unit ( quot -- )
|
||||
[
|
||||
HS{ } clone changed-definitions set
|
||||
HS{ } clone maybe-changed set
|
||||
HS{ } clone changed-effects set
|
||||
HS{ } clone outdated-generics set
|
||||
H{ } clone outdated-tuples set
|
||||
HS{ } clone new-words set
|
||||
H{ } clone
|
||||
HS{ } clone changed-definitions pick set-at
|
||||
HS{ } clone maybe-changed pick set-at
|
||||
HS{ } clone changed-effects pick set-at
|
||||
HS{ } clone outdated-generics pick set-at
|
||||
H{ } clone outdated-tuples pick set-at
|
||||
HS{ } clone new-words pick set-at [
|
||||
add-nesting-observer
|
||||
[
|
||||
remove-nesting-observer
|
||||
finish-compilation-unit
|
||||
] [ ] cleanup
|
||||
] with-scope ; inline
|
||||
] with-variables ; inline
|
||||
|
||||
: with-compilation-unit ( quot -- )
|
||||
[
|
||||
<definitions> new-definitions set
|
||||
<definitions> old-definitions set
|
||||
HS{ } clone forgotten-definitions set
|
||||
H{ } clone
|
||||
<definitions> new-definitions pick set-at
|
||||
<definitions> old-definitions pick set-at
|
||||
HS{ } clone forgotten-definitions pick set-at [
|
||||
with-nested-compilation-unit
|
||||
] with-scope ; inline
|
||||
] with-variables ; inline
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
USING: accessors arrays continuations debugger eval io kernel kernel.private
|
||||
math memory namespaces parser sequences system tools.test vectors words ;
|
||||
USING: accessors continuations debugger eval hashtables io
|
||||
kernel kernel.private math memory namespaces sequences
|
||||
tools.test vectors words ;
|
||||
IN: continuations.tests
|
||||
|
||||
: (callcc1-test) ( n obj -- n' obj )
|
||||
|
@ -15,10 +16,9 @@ IN: continuations.tests
|
|||
: callcc-namespace-test ( -- ? )
|
||||
[
|
||||
"test-cc" set
|
||||
5 "x" set
|
||||
[
|
||||
5 "x" [
|
||||
6 "x" set "test-cc" get continue
|
||||
] with-scope
|
||||
] with-variable
|
||||
] callcc0 "x" get 5 = ;
|
||||
|
||||
{ t } [ 10 callcc1-test 10 iota reverse >vector = ] unit-test
|
||||
|
@ -64,9 +64,9 @@ IN: continuations.tests
|
|||
SYMBOL: always-counter
|
||||
SYMBOL: error-counter
|
||||
|
||||
0 always-counter
|
||||
0 error-counter 2hashtable
|
||||
[
|
||||
0 always-counter set
|
||||
0 error-counter set
|
||||
|
||||
[ ] [ always-counter inc ] [ error-counter inc ] cleanup
|
||||
|
||||
|
@ -90,7 +90,7 @@ SYMBOL: error-counter
|
|||
|
||||
[ 3 ] [ always-counter get ] unit-test
|
||||
[ 1 ] [ error-counter get ] unit-test
|
||||
] with-scope
|
||||
] with-variables
|
||||
|
||||
{ } [ [ return ] with-return ] unit-test
|
||||
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2007, 2010 Doug Coleman, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs continuations init kernel make
|
||||
namespaces sequences sets ;
|
||||
USING: accessors continuations hashtables init kernel namespaces
|
||||
sequences sets ;
|
||||
IN: destructors
|
||||
|
||||
SYMBOL: disposables
|
||||
|
@ -82,13 +82,13 @@ PRIVATE>
|
|||
dup error-destructors get push ; inline
|
||||
|
||||
: with-destructors ( quot -- )
|
||||
[
|
||||
V{ } clone always-destructors set
|
||||
V{ } clone error-destructors set
|
||||
V{ } clone always-destructors
|
||||
V{ } clone error-destructors
|
||||
2hashtable [
|
||||
[ do-always-destructors ]
|
||||
[ do-error-destructors ]
|
||||
cleanup
|
||||
] with-scope ; inline
|
||||
] with-variables ; inline
|
||||
|
||||
[
|
||||
HS{ } clone disposables set-global
|
||||
|
|
|
@ -1,7 +1,6 @@
|
|||
USING: io.pathnames io.files.temp io.directories
|
||||
continuations math io.files.private kernel
|
||||
namespaces sequences system tools.test
|
||||
io.backend io.pathnames.private ;
|
||||
USING: continuations hashtables io.backend io.directories
|
||||
io.files.private io.files.temp io.pathnames kernel math
|
||||
namespaces system tools.test ;
|
||||
IN: io.pathnames.tests
|
||||
|
||||
{ "passwd" } [ "/etc/passwd" file-name ] unit-test
|
||||
|
@ -58,13 +57,12 @@ IN: io.pathnames.tests
|
|||
{ } [ 2 [ "touch-twice-test" temp-file touch-file ] times ] unit-test
|
||||
|
||||
! aum's bug
|
||||
[
|
||||
"." current-directory set
|
||||
".." "resource-path" set
|
||||
"." current-directory
|
||||
".." "resource-path" 2hashtable [
|
||||
[ "../core/bootstrap/stage2.factor" ]
|
||||
[ "resource:core/bootstrap/stage2.factor" absolute-path ]
|
||||
unit-test
|
||||
] with-scope
|
||||
] with-variables
|
||||
|
||||
{ t } [ cwd "misc" resource-path [ ] with-directory cwd = ] unit-test
|
||||
|
||||
|
|
|
@ -68,11 +68,11 @@ SYMBOL: current-source-file
|
|||
|
||||
: with-source-file ( name quot -- )
|
||||
! Should be called from inside with-compilation-unit.
|
||||
[
|
||||
H{ } clone source-files [
|
||||
[
|
||||
path>source-file
|
||||
[ current-source-file set ]
|
||||
[ definitions>> old-definitions set ] bi
|
||||
] dip
|
||||
[ wrap-source-file-error ] recover
|
||||
] with-scope ; inline
|
||||
] with-variable ; inline
|
||||
|
|
|
@ -81,10 +81,9 @@ IN: vectors.tests
|
|||
] unit-test
|
||||
|
||||
{ 0 } [
|
||||
[
|
||||
10 <vector> "x" set
|
||||
10 <vector> "x" [
|
||||
"x" get clone length
|
||||
] with-scope
|
||||
] with-variable
|
||||
] unit-test
|
||||
|
||||
{ f } [ 5 V{ } index ] unit-test
|
||||
|
|
|
@ -31,11 +31,11 @@ DEFER: plist-test
|
|||
"create-test" "scratchpad" lookup-word "testing" word-prop
|
||||
] unit-test
|
||||
|
||||
[
|
||||
H{ } clone [
|
||||
[ t ] [ \ array? "array?" "arrays" lookup-word = ] unit-test
|
||||
|
||||
[ ] [ [ "test-scope" "scratchpad" create-word drop ] with-compilation-unit ] unit-test
|
||||
] with-scope
|
||||
] with-variables
|
||||
|
||||
{ "test-scope" } [
|
||||
"test-scope" "scratchpad" lookup-word name>>
|
||||
|
|
Loading…
Reference in New Issue