diff --git a/extra/central/central-docs.factor b/extra/central/central-docs.factor index f6a0ba5957..458f528c53 100644 --- 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 576a1fac97..3dbcbf32fc 100644 --- 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 df100f2e5b..f7175141dd 100644 --- 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 ; -SYNTAX: CENTRAL: ( -- ) scan define-central ; \ No newline at end of file +: define-disposable-central ( word-name -- ) + define-centrals disposable-setter-def declare-central ; + +SYNTAX: CENTRAL: ( -- ) scan define-central ; + +SYNTAX: DISPOSABLE-CENTRAL: ( -- ) scan define-disposable-central ; \ No newline at end of file