added DISPOSABLE-CENTRAL: to extra/central

diff --git a/extra/central/central-docs.factor b/extra/central/central-docs.factor
index f6a0ba5957d1a418e61fedeebb36597989dd62f4..458f528c536050df96aba97d45993c8d5e43185a 100644 (file)
--- a/extra/central/central-docs.factor
+++ b/extra/central/central-docs.factor
@@ -1,4 +1,4 @@
-USING: central help.markup help.syntax ;
+USING: central destructors help.markup help.syntax ;
 
 HELP: CENTRAL:
 { $description
@@ -7,4 +7,10 @@ HELP: CENTRAL:
     { $snippet "with-symbol" } ".  This is a middle ground between excessive "
     "stack manipulation and full-out locals, meant to solve the case where "
     "one object is operated on by several related words."
+} ;
+
+HELP: DISPOSABLE-CENTRAL:
+{ $description
+    "Like " { $link POSTPONE: CENTRAL: } ", but generates " { $snippet "with-" }
+    " words that are wrapped in a " { $link with-disposal } "."
 } ;
\ No newline at end of file

diff --git a/extra/central/central-tests.factor b/extra/central/central-tests.factor
index 576a1fac97b3cbb5ac38312094b2af9f4ff03d18..3dbcbf32fcc76ce09f45a0f6fa1d910caad51ef5 100644 (file)
--- a/extra/central/central-tests.factor
+++ b/extra/central/central-tests.factor
@@ -1,7 +1,19 @@
-USING: central tools.test ;
+USING: accessors central destructors kernel math tools.test ;
 
 IN: scratchpad
 
 CENTRAL: test-central
 
-[ 3 ] [ 3 [ test-central ] with-test-central ] unit-test
\ No newline at end of file
+[ 3 ] [ 3 [ test-central ] with-test-central ] unit-test
+
+TUPLE: test-disp-cent value disposed ;
+
+! A phony destructor that adds 1 to the value so we can make sure it got called.
+M: test-disp-cent dispose* dup value>> 1+ >>value drop ;
+
+DISPOSABLE-CENTRAL: t-d-c
+
+: test-t-d-c ( -- n )
+    test-disp-cent new 3 >>value [ t-d-c ] with-t-d-c value>> ;
+
+[ 4 ] [ test-t-d-c ] unit-test
\ No newline at end of file

diff --git a/extra/central/central.factor b/extra/central/central.factor
index df100f2e5bf34e4ce881be18514f93ac0b056d86..f7175141dda5e7c618d62a55e2b4aca7de37b04b 100644 (file)
--- a/extra/central/central.factor
+++ b/extra/central/central.factor
@@ -1,16 +1,28 @@
-USING: kernel lexer namespaces parser sequences words ;
+USING: destructors kernel lexer namespaces parser sequences words ;
 
 IN: central
 
 : define-central-getter ( word -- )
     dup [ get ] curry (( -- obj )) define-declared ;
 
-: define-central-setter ( word with-word -- )
-    [ with-variable ] with (( object quot -- )) define-declared ;
+: define-centrals ( str -- getter setter )
+    [ create-in dup define-central-getter ]
+    [ "with-" prepend create-in dup make-inline ] bi ;
+
+: central-setter-def ( word with-word -- with-word quot )
+    [ with-variable ] with ;
+
+: disposable-setter-def ( word with-word -- with-word quot )
+    [ pick [ drop with-variable ] with-disposal ] with ;
+
+: declare-central ( with-word quot -- ) (( object quot -- )) define-declared ;
 
 : define-central ( word-name -- )
-    [ create-in dup define-central-getter ] keep
-    "with-" prepend create-in [ define-central-setter ] keep
-    make-inline ;
+    define-centrals central-setter-def declare-central ;
+
+: define-disposable-central ( word-name -- )
+    define-centrals disposable-setter-def declare-central ;
+
+SYNTAX: CENTRAL: ( -- ) scan define-central ;
 
-SYNTAX: CENTRAL: ( -- ) scan define-central ;
\ No newline at end of file
+SYNTAX: DISPOSABLE-CENTRAL: ( -- ) scan define-disposable-central ;
\ No newline at end of file