parse-stream and better catch

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 -- )

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"

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 ;

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 ;

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 ;

library/telnetd.factor

@@ -38,7 +38,7 @@ USE: stdio
 USE: streams
 
 : telnet-client ( socket -- )
-    [
+    dup [
         "client" set
         log-client
         interpreter-loop