Refactor listener so that it infers

diff --git a/basis/listener/listener-docs.factor b/basis/listener/listener-docs.factor
index 014e096b1db41107fb68258536bb127521b6ecc1..0f13b6dd8624064c264d500e0f8b2edd4df0e00d 100644 (file)
--- a/basis/listener/listener-docs.factor
+++ b/basis/listener/listener-docs.factor
@@ -1,4 +1,4 @@
-USING: help.markup help.syntax kernel io system prettyprint ;
+USING: help.markup help.syntax kernel io system prettyprint continuations ;
 IN: listener
 
 ARTICLE: "listener-watch" "Watching variables in the listener"
@@ -41,32 +41,18 @@ $nl
 { $example "{ 1 2 3 } [\n    .\n] each" "1\n2\n3" }
 "The listener knows when to expect more input by looking at the height of the stack. Parsing words such as " { $link POSTPONE: { } " leave elements on the parser stack, and corresponding words such as " { $link POSTPONE: } } " pop them."
 { $subsection "listener-watch" }
-"You can start a nested listener or exit a listener using the following words:"
+"To start a nested listener:"
 { $subsection listener }
-{ $subsection bye }
-"Finally, the multi-line expression reading word can be used independently of the rest of the listener:"
+"To exit the listener, invoke the " { $link return } " word."
+$nl
+"Multi-line quotations can be read independently of the rest of the listener:"
 { $subsection read-quot } ;
 
 ABOUT: "listener"
 
-<PRIVATE
-
-HELP: quit-flag
-{ $var-description "Variable set to true by " { $link bye } " word; it forces the next iteration of the " { $link listener } " loop to end." } ;
-
-PRIVATE>
-
 HELP: read-quot
 { $values { "quot/f" "a parsed quotation, or " { $link f } " indicating end of file" } }
 { $description "Reads a Factor expression which possibly spans more than one line from " { $link input-stream } ". Additional lines of input are read while the parser stack height is greater than one. Since structural parsing words push partial quotations on the stack, this will keep on reading input until all delimited parsing words are terminated." } ;
 
-HELP: listen
-{ $description "Prompts for an expression on " { $link input-stream } " and evaluates it. On end of file, " { $link quit-flag } " is set to terminate the listener loop." }
-{ $errors "If the expression input by the user throws an error, the error is printed to " { $link output-stream } " and the word returns normally." } ;
-
 HELP: listener
 { $description "Prompts for expressions on " { $link input-stream } " and evaluates them until end of file is reached." } ;
-
-HELP: bye
-{ $description "Exits the current listener." }
-{ $notes "This word is for interactive use only. To exit the Factor runtime, use " { $link exit } "." } ;

diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor
index 1f01388c14ba8e166fa2b098dfe0a6e70e4d72de..122921aaa367f9f7b102278d1d8da611d41598ed 100644 (file)
--- a/basis/listener/listener.factor
+++ b/basis/listener/listener.factor
@@ -4,7 +4,7 @@ USING: arrays hashtables io kernel math math.parser memory
 namespaces parser lexer sequences strings io.styles
 vectors words generic system combinators continuations debugger
 definitions compiler.units accessors colors prettyprint fry
-sets vocabs.parser source-files.errors ;
+sets vocabs.parser source-files.errors locals ;
 IN: listener
 
 GENERIC: stream-read-quot ( stream -- quot/f )
@@ -32,14 +32,6 @@ M: object stream-read-quot
 
 : read-quot ( -- quot/f ) input-stream get stream-read-quot ;
 
-<PRIVATE
-
-SYMBOL: quit-flag
-
-PRIVATE>
-
-: bye ( -- ) quit-flag on ;
-
 SYMBOL: visible-vars
 
 : show-var ( var -- ) visible-vars  [ swap suffix ] change ;
@@ -98,28 +90,43 @@ SYMBOL: error-summary-hook
         ] dip
     ] when stack. ;
 
-: stacks. ( -- )
+: datastack. ( datastack -- )
     display-stacks? get [
-        datastack [ nl "--- Data stack:" title. trimmed-stack. ] unless-empty
-    ] when ;
+        [ nl "--- Data stack:" title. trimmed-stack. ] unless-empty
+    ] [ drop ] if ;
 
 : prompt. ( -- )
-    "( " in get auto-use? get [ " - auto" append ] when " )" 3append
+    in get auto-use? get [ " - auto" append ] when "( " " )" surround
     H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl flush ;
 
 [ error-summary ] error-summary-hook set-global
 
-: listen ( -- )
-    error-summary-hook get call( -- ) visible-vars. stacks. prompt.
-    [ read-quot [ [ call-error-hook ] recover ] [ bye ] if* ]
-    [ dup lexer-error? [ call-error-hook ] [ rethrow ] if ] recover ;
-
-: until-quit ( -- )
-    quit-flag get [ quit-flag off ] [ listen until-quit ] if ;
+: call-error-summary-hook ( -- )
+    error-summary-hook get call( -- ) ;
+
+:: (listener) ( datastack -- )
+    call-error-summary-hook
+    visible-vars.
+    datastack datastack.
+    prompt.
+
+    [
+        read-quot [
+            '[ datastack _ with-datastack ]
+            [ call-error-hook datastack ]
+            recover
+            (listener)
+        ] when*
+    ] [
+        dup lexer-error?
+        [ call-error-hook datastack (listener) ]
+        [ rethrow ]
+        if
+    ] recover ;
 
 PRIVATE>
 
 : listener ( -- )
-    [ until-quit ] with-interactive-vocabs ;
+    [ [ { } (listener) ] with-interactive-vocabs ] with-return ;
 
 MAIN: listener