! 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? -- )
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
-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 )
: 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
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
[ 3 ] [ always-counter get ] unit-test
[ 1 ] [ error-counter get ] unit-test
-] with-scope
+] with-variables
{ } [ [ return ] with-return ] unit-test
! 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
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
-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
{ } [ 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
: 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
] 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
"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>>