native factor can now parse most source files that comprise it

TODO.FACTOR.txt

@@ -1,3 +1,7 @@
++ native:
+
+- parsing: -1, HEX:, #\, |
+- minimal use/in for parse-stream
 - prettyprint-1
 - {...} vectors
 - better .s
@@ -10,9 +14,6 @@
 - contains ==> contains?
 - telnetd: send errors on socket
 - native 'see'
-
-+ native:
-
 - partition, sort
 - inspector: sort
 

library/combinators.factor

@@ -54,9 +54,6 @@ USE: stack
     #! If the quotation compiles, this combinator compiles.
     -rot >r >r call r> r> ; inline interpret-only
 
-: 3dip ( a b c quot -- )
-    swap >r swap >r swap >r call r> r> r> ;
-
 : forever ( code -- )
     #! The code is evaluated in an infinite loop. Typically, a
     #! continuation is used to escape the infinite loop.

library/debugger.factor

@@ -30,6 +30,7 @@ USE: combinators
 USE: continuations
 USE: kernel
 USE: inspector
+USE: logic
 USE: namespaces
 USE: stack
 USE: stdio
@@ -41,8 +42,8 @@ USE: unparser
 
 : parse-dump ( error -- )
     <%
-    "parse-name" get % ":" %
+    "parse-name" get [ "<interactive>" ] unless* % ":" %
-    "line-number" get fixnum>str % ": " %
+    "line-number" get [ 1 ] unless* fixnum>str % ": " %
     error>str %
     %> print
     
@@ -50,10 +51,12 @@ USE: unparser
     
     <% "pos" get " " fill % "^" % %> print ;
 
+: in-parser? ( -- ? )
+    "line" get "pos" get and ;
+
 : default-error-handler ( error -- )
     #! Print the error and return to the top level.
-    "parse-name" get [ parse-dump ] [ standard-dump ] ifte
+    in-parser? [ parse-dump ] [ standard-dump ] ifte terpri
-    terpri
 
     "Stacks have been reset." print
     ":s :r :n :c show stacks at time of error." print

library/platform/native/kernel.factor

@@ -91,6 +91,10 @@ USE: words
 : java? f ;
 : native? t ;
 
+! No compiler...
+: inline ;
+: interpret-only ;
+
 !!! HACK
 
 IN: strings

library/platform/native/parse-stream.factor

@@ -31,6 +31,7 @@ USE: combinators
 USE: errors
 USE: lists
 USE: namespaces
+USE: stack
 USE: stdio
 USE: streams
 
@@ -39,22 +40,24 @@ USE: streams
     "line-number" succ@ ;
 
 : (parse-stream) ( -- )
-    next-line [ print (parse-stream) ] when* ;
+    next-line [ (parse) (parse-stream) ] when* ;
+
+: <parse-stream ( name stream -- )
+    "parse-stream" set
+    "parse-name" set
+    0 "line-number" set ;
 
 : parse-stream ( name stream -- )
     <namespace> [
         [
-            "parse-stream" set
+            <parse-stream f (parse-stream) nreverse
-            "parse-name" set
-            0 "line-number" set
-            f (parse-stream) nreverse
         ] [
             "parse-stream" get fclose rethrow
         ] catch
     ] bind ;
 
 : parse-file ( file -- code )
-    "r" <file-stream> parse-stream ;
+    dup "r" <file-stream> parse-stream ;
 
 : run-file ( file -- )
     parse-file call ;

library/platform/native/parser.factor

@@ -37,6 +37,7 @@ USE: stack
 USE: strings
 USE: words
 USE: vocabularies
+USE: unparser
 
 ! Number parsing
 
@@ -83,7 +84,7 @@ USE: vocabularies
     #! "hello world"
     #!
     #! Will call the parsing word ".
-    ch "\"" str-contains? ;
+    ch "\"!" str-contains? ;
 
 : (scan) ( -- start end )
     skip-blank "pos" get
@@ -130,6 +131,9 @@ USE: vocabularies
 : until-eol ( ch -- str )
     "line" get str-length (until) ;
 
+: next-ch ( -- ch )
+    end? [ "Unexpected EOF" throw ] [ ch advance ] ifte ;
+
 !!! Parsing words. 'builtins' is a stupid vocabulary name now
 !!! that it does not contain Java words anymore!
 
@@ -143,13 +147,6 @@ IN: builtins
 : [ f ; parsing
 : ] nreverse swons ; parsing
     
-! Comments
-: ( ")" until drop ; parsing
-: ! until-eol drop ; parsing
-
-! String literal
-: " "\"" until swons ; parsing
-    
 ! Colon defs
 : :
     #! Begin a word definition. Word name follows.
@@ -160,5 +157,42 @@ IN: builtins
     nreverse define ; parsing
 
 ! Vocabularies
+: DEFER: scan "in" get create drop ; parsing
 : USE: scan "use" cons@ ; parsing
 : IN: scan dup "use" cons@ "in" set ; parsing
+
+! \x
+: escape ( ch -- esc )
+    [
+        [ #\e | #\\e ]
+        [ #\n | #\\n ]
+        [ #\r | #\\r ]
+        [ #\t | #\\t ]
+        [ #\s | #\\s ]
+        [ #\\s | #\\s ]
+        [ #\0 | #\\0 ]
+        [ #\\\ | #\\\ ]
+        [ #\\" | #\\" ]
+    ] assoc ;
+
+! String literal
+
+: scan-escape ( -- )
+    next-ch escape dup [ % ] [ drop "Bad escape" throw ] ifte ;
+
+: scan-string ( -- )
+    next-ch dup #\" = [
+        drop
+    ] [
+        dup #\\\ = [ drop scan-escape ] [ % ] ifte scan-string
+    ] ifte ;
+
+: "
+    #! Note the ugly hack to carry the new value of 'pos' from
+    #! the <% %> scope up to the original scope.
+    <% scan-string "pos" get %> swap "pos" set swons ; parsing
+
+! Comments
+: ( ")" until drop ; parsing
+: ! until-eol drop ; parsing
+: #! until-eol drop ; parsing

native/io.c

@@ -13,10 +13,7 @@ void primitive_open_file(void)
 {
 	char* mode = to_c_string(untag_string(env.dt));
 	char* path = to_c_string(untag_string(dpop()));
-	printf("fopen %s %s\n",path,mode);
 	FILE* file = fopen(path,mode);
-	if(file == 0)
-		printf("error %d\n",errno);
 	env.dt = handle(file);
 }
 
@@ -72,4 +69,5 @@ void primitive_close(void)
 {
 	HANDLE* h = untag_handle(env.dt);
 	fclose((FILE*)h->object);
+	env.dt = dpop();
 }