Move with-datastack to contiinuations vocab, make it compile

diff --git a/core/combinators/combinators-docs.factor b/core/combinators/combinators-docs.factor
index c65c01d2abf23abad24f3059863bff309b2c2833..4f8efc499ff2c1be374877f6c2caaefb7dbd7ba0 100755 (executable)
--- a/core/combinators/combinators-docs.factor
+++ b/core/combinators/combinators-docs.factor
@@ -25,8 +25,6 @@ $nl
 $nl
 "A combinator which can help with implementing methods on " { $link hashcode* } ":"
 { $subsection recursive-hashcode }
-"An oddball combinator:"
-{ $subsection with-datastack }
 { $subsection "combinators-quot" }
 { $see-also "quotations" "dataflow" } ;
 
@@ -116,13 +114,6 @@ HELP: no-case
 { $description "Throws a " { $link no-case } " error." }
 { $error-description "Thrown by " { $link case } " if the object at the top of the stack does not match any case, and no default case is given." } ;
 
-HELP: with-datastack
-{ $values { "stack" sequence } { "quot" quotation } { "newstack" sequence } }
-{ $description "Executes the quotation with the given data stack contents, and outputs the new data stack after the word returns. The input sequence is not modified. Does not affect the data stack in surrounding code, other than consuming the two inputs and pushing the output." }
-{ $examples
-    { $example "USING: combinators math prettyprint ;" "{ 3 7 } [ + ] with-datastack ." "{ 10 }" }
-} ;
-
 HELP: recursive-hashcode
 { $values { "n" integer } { "obj" object } { "quot" "a quotation with stack effect " { $snippet "( n obj -- code )" } } { "code" integer } }
 { $description "A combinator used to implement methods for the " { $link hashcode* } " generic word. If " { $snippet "n" } " is less than or equal to zero, outputs 0, otherwise calls the quotation." } ;

diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor
index 10324224b6336ff53b36aaf427971b189be01e51..1cc64432cc672e5f4ace1ead4a9c0b546e737878 100755 (executable)
--- a/core/combinators/combinators.factor
+++ b/core/combinators/combinators.factor
@@ -138,12 +138,6 @@ ERROR: no-case ;
         [ drop linear-case-quot ]
     } cond ;
 
-! with-datastack
-: with-datastack ( stack quot -- newstack )
-    datastack >r
-    >r >array set-datastack r> call
-    datastack r> swap suffix set-datastack 2nip ; inline
-
 ! recursive-hashcode
 : recursive-hashcode ( n obj quot -- code )
     pick 0 <= [ 3drop 0 ] [ rot 1- -rot call ] if ; inline

diff --git a/core/continuations/continuations-docs.factor b/core/continuations/continuations-docs.factor
index f176e6ee19a95b093edcf0da0e6a5fcc0d55cea8..332e8eea671e8773d59f770eea9d9e33a3bd7314 100755 (executable)
--- a/core/continuations/continuations-docs.factor
+++ b/core/continuations/continuations-docs.factor
@@ -1,6 +1,6 @@
 USING: help.markup help.syntax kernel kernel.private
 continuations.private vectors arrays namespaces
-assocs words quotations lexer ;
+assocs words quotations lexer sequences ;
 IN: continuations
 
 ARTICLE: "errors-restartable" "Restartable errors"
@@ -77,6 +77,8 @@ $nl
 "Another two words resume continuations:"
 { $subsection continue }
 { $subsection continue-with }
+"Reflecting the datastack:"
+{ $subsection with-datastack }
 "Continuations serve as the building block for a number of higher-level abstractions, such as " { $link "errors" } " and " { $link "threads" } "."
 { $subsection "continuations.private" } ;
 
@@ -202,3 +204,10 @@ HELP: save-error
 { $values { "error" "an error" } }
 { $description "Called by the error handler to set the " { $link error } " and " { $link restarts } " global variables after an error was thrown." }
 $low-level-note ;
+
+HELP: with-datastack
+{ $values { "stack" sequence } { "quot" quotation } { "newstack" sequence } }
+{ $description "Executes the quotation with the given data stack contents, and outputs the new data stack after the word returns. The input sequence is not modified. Does not affect the data stack in surrounding code, other than consuming the two inputs and pushing the output." }
+{ $examples
+    { $example "USING: combinators math prettyprint ;" "{ 3 7 } [ + ] with-datastack ." "{ 10 }" }
+} ;

diff --git a/core/continuations/continuations-tests.factor b/core/continuations/continuations-tests.factor
index 7ff71cdd2daa00efdaa6628882d05beb7fa2620c..c292cf7691ca4a0c28d294102fd1dcfd996b0b41 100755 (executable)
--- a/core/continuations/continuations-tests.factor
+++ b/core/continuations/continuations-tests.factor
@@ -104,3 +104,7 @@ SYMBOL: error-counter
 [ ] [ [ return ] with-return ] unit-test
 
 [ { } [ ] attempt-all ] [ attempt-all-error? ] must-fail-with
+
+[ { 4 } ] [ { 2 2 } [ + ] with-datastack ] unit-test
+
+\ with-datastack must-infer

diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor
index 087661dff47587f94e8d5025c51800226e2852bd..f2cc0f74bacc22c79ca4caf59a55d2c725ae25b5 100755 (executable)
--- a/core/continuations/continuations.factor
+++ b/core/continuations/continuations.factor
@@ -109,6 +109,14 @@ SYMBOL: return-continuation
 : return ( -- )
     return-continuation get continue ;
 
+: with-datastack ( stack quot -- newstack )
+    [
+        [
+            [ [ { } like set-datastack ] dip call datastack ] dip
+            continue-with
+        ] 3 (throw)
+    ] callcc1 2nip ;
+
 GENERIC: compute-restarts ( error -- seq )
 
 <PRIVATE