alien,stack-checker.alien: new word with-callback

Since callbacks aren't automatically deallocated this word intends to
make sure "inline" callbacks are.

basis/stack-checker/alien/alien.factor

@@ -105,10 +105,7 @@ TUPLE: alien-callback-params < alien-node-params xt ;
     infer-return ;
 
 : callback-xt ( word -- alien )
-    callbacks get [
-        dup "stack-cleanup" word-prop <callback>
-        [ callback-destructor new-disposable callback<< ] keep
-    ] cache ;
+    callbacks get [ dup "stack-cleanup" word-prop <callback> ] cache ;
 
 : callback-bottom ( params -- )
     "( callback )" <uninterned-word> >>xt

core/alien/alien-docs.factor

@@ -65,7 +65,11 @@ HELP: free-callback
 { $description "Releases the callback heap memory allocated for an alien callback. " }
 { $warning "If the callback is invoked (either from C or Factor) after it has been freed, then Factor may crash." } ;
 
-{ <callback> free-callback } related-words
+HELP: with-callback
+{ $values { "alien" alien } { "quot" quotation } }
+{ $description "Calls the quotation with an alien value on the stack which is supposed to be a callback. Resources for the callback is guaranteed to be released afterwards." } ;
+
+{ <callback> free-callback unregister-and-free-callback with-callback } related-words
 
 HELP: alien-address
 { $values { "c-ptr" c-ptr } { "addr" "a non-negative integer" } }

core/alien/alien.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2004, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs byte-arrays byte-vectors continuations.private
-destructors init kernel kernel.private math namespaces sequences ;
+USING: accessors assocs byte-arrays byte-vectors continuations
+continuations.private destructors init kernel kernel.private math namespaces
+sequences ;
 IN: alien
 
 BUILTIN: alien { underlying c-ptr read-only initial: f } expired ;
@@ -111,15 +112,6 @@ SYMBOL: callbacks
     current-callback
     [ 2drop call ] [ swap call( callback -- ) drop ] 3bi ; inline
 
-! Used by stack-checker.alien to register destructors for callbacks.
-TUPLE: callback-destructor callback ;
-
-: delete-values ( value assoc -- )
-    [ rot drop = not ] with assoc-filter! drop ;
-
-M: callback-destructor dispose ( disposable -- )
-    callback>> [ callbacks get delete-values ] [ free-callback ] bi ;
-
 ! A utility for defining global variables that are recompiled in
 ! every session
 TUPLE: expiry-check object alien ;
@@ -127,8 +119,17 @@ TUPLE: expiry-check object alien ;
 : recompute-value? ( check -- ? )
     dup [ alien>> expired? ] [ drop t ] if ;
 
+: delete-values ( value assoc -- )
+    [ rot drop = not ] with assoc-filter! drop ;
+
 PRIVATE>
 
+: unregister-and-free-callback ( alien -- )
+    [ callbacks get delete-values ] [ free-callback ] bi ;
+
+: with-callback ( alien quot -- )
+    over [ unregister-and-free-callback ] curry [ ] cleanup ; inline
+
 : initialize-alien ( symbol quot -- )
     swap dup get-global dup recompute-value?
     [ drop [ call dup 31337 <alien> expiry-check boa ] dip set-global ]