From 8b8eec936cbf866ec42b74bf6d806c57aa8c2e36 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 18 Jul 2004 23:52:01 +0000
Subject: [PATCH] parse-stream and better catch

---
 library/errors.factor                       |  2 +-
 library/platform/native/boot.factor         |  1 +
 library/platform/native/parse-stream.factor | 54 +++++++++++++++++++++
 library/platform/native/parser.factor       | 10 ++--
 library/stdio.factor                        | 11 ++---
 library/telnetd.factor                      |  2 +-
 6 files changed, 66 insertions(+), 14 deletions(-)
 create mode 100644 library/platform/native/parse-stream.factor

diff --git a/library/errors.factor b/library/errors.factor
index dbf0e84b13..3743ab2220 100644
--- a/library/errors.factor
+++ b/library/errors.factor
@@ -61,7 +61,7 @@ USE: vectors
     #! Call the try quotation, restore the datastack to its
     #! state before the try quotation, push the error (or f if
     #! no error occurred) and call the catch quotation.
-    [ >c drop call f c> call ] callcc1 ( c> drop )
+    [ >c >r call c> drop f r> f ] callcc1
     ( try catch error ) rot drop swap ( error catch ) call ;
 
 : rethrow ( error -- )
diff --git a/library/platform/native/boot.factor b/library/platform/native/boot.factor
index 038c9b3881..47f86d4c54 100644
--- a/library/platform/native/boot.factor
+++ b/library/platform/native/boot.factor
@@ -80,6 +80,7 @@ primitives,
     "/library/platform/native/kernel.factor"
     "/library/platform/native/namespaces.factor"
     "/library/platform/native/parser.factor"
+    "/library/platform/native/parse-stream.factor"
     "/library/platform/native/prettyprint.factor"
     "/library/platform/native/stack.factor"
     "/library/platform/native/words.factor"
diff --git a/library/platform/native/parse-stream.factor b/library/platform/native/parse-stream.factor
new file mode 100644
index 0000000000..4b0bc128b7
--- /dev/null
+++ b/library/platform/native/parse-stream.factor
@@ -0,0 +1,54 @@
+!:folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+IN: parser
+USE: arithmetic
+USE: combinators
+USE: errors
+USE: lists
+USE: namespaces
+USE: stdio
+USE: streams
+
+: next-line ( -- str )
+    "parse-stream" get freadln
+    "line-number" succ@ ;
+
+: (parse-stream) ( -- )
+    next-line [ (parse) (parse-stream) ] when* ;
+
+: parse-stream ( name stream -- )
+    <namespace> [
+        [
+            "parse-stream" set
+            "parse-name" set
+            0 "line-number" set
+            f (parse-stream) nreverse
+        ] [
+            "parse-stream" get fclose rethrow
+        ] catch
+    ] bind ;
diff --git a/library/platform/native/parser.factor b/library/platform/native/parser.factor
index 7a3c38d7e7..f7e474c960 100644
--- a/library/platform/native/parser.factor
+++ b/library/platform/native/parser.factor
@@ -64,8 +64,8 @@ USE: vocabularies
 : parsing? ( word -- ? ) "parsing" swap word-property ;
 : parsing ( -- ) t "parsing" word set-word-property ;
 
-: (parsing "line" set 0 "pos" set f ;
-: parsing) f "line" set f "pos" set nreverse ;
+: <parsing "line" set 0 "pos" set ;
+: parsing> f "line" set f "pos" set ;
 : end? ( -- ? ) "pos" get "line" get str-length >= ;
 : ch ( -- ch ) "pos" get "line" get str-nth ;
 : advance ( -- ) "pos" succ@ ;
@@ -108,9 +108,11 @@ USE: vocabularies
         ] ifte
     ] when* ;
 
-: parse ( str -- list )
+: (parse) <parsing [ end? not ] [ scan word, ] while parsing> ;
+
+: parse ( str -- code )
     #! Parse the string into a parse tree that can be executed.
-    (parsing [ end? not ] [ scan word, ] while parsing) ;
+    f swap (parse) nreverse ;
 
 : eval ( "X" -- X )
     parse call ;
diff --git a/library/stdio.factor b/library/stdio.factor
index 00f8a88604..2c489c822b 100644
--- a/library/stdio.factor
+++ b/library/stdio.factor
@@ -57,12 +57,7 @@ USE: streams
     #! Print a newline to standard output.
     "\n" write ;
 
-: (with-stream) ( stream quot -- )
-    <namespace> [ swap "stdio" set call ] bind ;
-
 : with-stream ( stream quot -- )
-    [
-        (with-stream)
-    ] [
-        >r drop fclose r> rethrow
-    ] catch ;
+    <namespace> [
+        swap "stdio" set [ "stdio" get fclose rethrow ] catch
+    ] bind ;
diff --git a/library/telnetd.factor b/library/telnetd.factor
index d5cd4daeef..13c8f8b0c5 100644
--- a/library/telnetd.factor
+++ b/library/telnetd.factor
@@ -38,7 +38,7 @@ USE: stdio
 USE: streams
 
 : telnet-client ( socket -- )
-    [
+    dup [
         "client" set
         log-client
         interpreter-loop