with-return

core/continuations/continuations-tests.factor

@@ -117,3 +117,5 @@ T{ dispose-dummy } "b" set
 [ { "a" "b" } [ get ] map dispose-each ] [ 3 = ] must-fail-with
 
 [ t ] [ "b" get disposed?>> ] unit-test
+
+[ ] [ [ return ] with-return ] unit-test

core/continuations/continuations.factor

@@ -101,6 +101,14 @@ PRIVATE>
 : continue ( continuation -- )
     f swap continue-with ;
 
+SYMBOL: return-continuation
+
+: with-return ( quot -- )
+    [ [ return-continuation set ] prepose callcc0 ] with-scope ; inline
+
+: return ( -- )
+    return-continuation get continue ;
+
 GENERIC: compute-restarts ( error -- seq )
 
 <PRIVATE

core/prettyprint/sections/sections.factor

@@ -15,9 +15,9 @@ SYMBOL: pprinter-stack
 SYMBOL: pprinter-in
 SYMBOL: pprinter-use
 
-TUPLE: pprinter last-newline line-count end-printing indent ;
+TUPLE: pprinter last-newline line-count indent ;
 
-: <pprinter> ( -- pprinter ) 0 1 f 0 pprinter boa ;
+: <pprinter> ( -- pprinter ) 0 1 0 pprinter boa ;
 
 : record-vocab ( word -- )
     word-vocabulary [ dup pprinter-use get set-at ] when* ;
@@ -34,7 +34,7 @@ TUPLE: pprinter last-newline line-count end-printing indent ;
     ] [
         pprinter get (>>last-newline)
         line-limit? [
-            "..." write pprinter get end-printing>> continue
+            "..." write pprinter get return
         ] when
         pprinter get [ 1+ ] change-line-count drop
         nl do-indent
@@ -275,9 +275,8 @@ M: colon unindent-first-line? drop t ;
         [
             dup style>> [
                 [
-                    >r pprinter get (>>end-printing) r>
                     short-section
-                ] curry callcc0
+                ] curry with-return
             ] with-nesting
         ] if-nonempty
     ] with-variable ;