better error reporting in native factor

TODO.FACTOR.txt

@@ -1,10 +1,8 @@
 - plugin should not exit jEdit on fatal errors
 - auto insert USE:
 - add a socket timeout
-- read# and eof
 - don't allow multiple reads on the same port
 - multiple tasks should be able to write to the same port
-- prettyprinting an empty vector
 - jvm factor -- still supporting httpd?
 - make inferior.factor nicer to use
 
@@ -47,7 +45,6 @@
 - accept multi-line input in listener
 - gc call in the middle of some ops might affect callstack
 - better i/o scheduler
-- better error reporting
 
 + JVM compiler:
 

build.xml

@@ -48,6 +48,7 @@
 				<include name="factor/**/*.class"/>
 				<include name="factor/**/*.props"/>
 				<include name="factor/**/*.bsh"/>
+				<include name="factor/**/*.txt"/>
 				<include name="*.xml"/>
 				<include name="library/**/*.factor"/>
 				<include name="org/**/*.class"/>

factor/FactorLib.java

@@ -222,7 +222,7 @@ public class FactorLib
 		int read = 0;
 		while((read = in.read(bytes,offset,count - offset)) > 0)
 			offset += read;
-		return new String(bytes,"ASCII");
+		return new String(bytes,0,offset,"ASCII");
 	} //}}}
 
 	//{{{ readCount() method
@@ -234,6 +234,6 @@ public class FactorLib
 		int read = 0;
 		while((read = in.read(chars,offset,count - offset)) > 0)
 			offset += read;
-		return new String(chars);
+		return new String(chars,0,offset);
 	} //}}}
 }

library/platform/jvm/parser.factor

@@ -38,6 +38,9 @@ USE: strings
 : run-file ( path -- )
     parse-file call ;
 
+: <resource-stream> ( path -- stream )
+    <rreader> f <char-stream> ;
+
 : parse-resource* ( resource -- list )
     dup <rreader> swap "resource:" swap cat2 swap parse-stream ;
 

library/platform/native/boot-stage2.factor

@@ -71,6 +71,13 @@ USE: stdio
     "/library/platform/native/parser.factor"
     "/library/platform/native/parse-syntax.factor"
     "/library/platform/native/parse-stream.factor"
+    "/library/platform/native/unparser.factor"
+    "/library/format.factor"
+    "/library/styles.factor"
+    "/library/vocabulary-style.factor"
+    "/library/prettyprint.factor"
+    "/library/debugger.factor"
+    "/library/platform/native/debugger.factor"
     "/library/platform/native/init.factor"
 
     "/library/math/math.factor"

library/platform/native/debugger.factor

@@ -40,38 +40,65 @@ USE: strings
 USE: unparser
 USE: vectors
 
-: kernel-error? ( obj -- ? )
-    dup cons? [ car fixnum? ] [ drop f ] ifte ;
+: expired-port-error ( obj -- )
+    "Expired port: " write . ;
 
-: ?vector-nth ( n vec -- obj )
-    over [
-        dup >r vector-length min 0 max r> vector-nth
-    ] [
-        2drop f
-    ] ifte ;
+: undefined-word-error ( obj -- )
+    "Undefined word: " write . ;
 
-: error# ( n -- str )
+: type-check-error ( list -- )
+    "Type check error" print
+    uncons car dup "Object: " write .
+    "Object type: " write type-of type-name print
+    "Expected type: " write type-name print ;
+
+: array-range-error ( list -- )
+    "Array range check error" print
+    unswons "Object: " write .
+    uncons car "Maximum index: " write .
+    "Requested index: " write . ;
+
+: io-error ( list -- )
+    "I/O error in kernel function " write
+    unswons write ": " write car print ;
+
+: numerical-comparison-error ( list -- )
+    "Cannot compare " write unswons unparse write
+    " with " write unparse print ;
+
+: float-format-error ( list -- )
+    "Invalid floating point literal format: " write car . ;
+
+: signal-error ( obj -- )
+    "Operating system signal " write . ;
+
+: io-task-twice-error ( obj -- )
+    "Attempting to perform two simulatenous I/O operations on "
+    write . ;
+
+: no-io-tasks-error ( obj -- )
+    "No I/O tasks" print ;
+
+: kernel-error. ( obj n -- str )
     {
-        "Expired port: "
-        "Undefined word: "
-        "Type check: "
-        "Array range check: "
-        "Underflow"
-        "I/O error: "
-        "Overflow"
-        "Incomparable types: "
-        "Float format: "
-        "Signal "
-        "Adding I/O task twice on port: "
-        "No I/O tasks"
-    } ?vector-nth ;
+        expired-port-error
+        undefined-word-error
+        type-check-error
+        array-range-error
+        io-error
+        numerical-comparison-error
+        float-format-error
+        signal-error
+        io-task-twice-error
+        no-io-tasks-error
+    } vector-nth execute ;
 
-: ?kernel-error ( cons -- error# param )
-    dup cons? [ uncons dup cons? [ car ] when ] [ f ] ifte ;
-
-: kernel-error. ( error -- )
-    ?kernel-error swap error# dup "" ? write
-    dup [ . ] [ drop terpri ] ifte ;
+: kernel-error? ( obj -- ? )
+    dup cons? [ uncons cons? swap fixnum? and ] [ drop f ] ifte ;
 
 : error. ( error -- str )
-    dup kernel-error? [ kernel-error. ] [ . ] ifte ;
+    dup kernel-error? [
+        uncons car swap kernel-error.
+    ] [
+        dup string? [ print ] [ . ] ifte
+    ] ifte ;

library/platform/native/kernel.factor

@@ -82,23 +82,26 @@ USE: vectors
         [ drop t ] [ ( return the object ) ]
     ] cond ;
 
-: class-of ( obj -- name )
+: type-name ( n -- str )
     [
-        [ fixnum?  ] [ drop "fixnum" ]
-        [ bignum?  ] [ drop "bignum" ]
-        [ ratio?   ] [ drop "ratio" ]
-        [ float?   ] [ drop "float" ]
-        [ complex? ] [ drop "complex" ]
-        [ cons?    ] [ drop "cons" ]
-        [ word?    ] [ drop "word" ]
-        [ f =      ] [ drop "f" ]
-        [ t =      ] [ drop "t" ]
-        [ vector?  ] [ drop "vector" ]
-        [ string?  ] [ drop "string" ]
-        [ sbuf?    ] [ drop "sbuf" ]
-        [ port?    ] [ drop "port" ]
-        [ drop t   ] [ drop "unknown" ]
-    ] cond ;
+        [ 0 | "fixnum" ]
+        [ 1 | "word" ]
+        [ 2 | "cons" ]
+        [ 4 | "ratio" ]
+        [ 5 | "complex" ]
+        [ 6 | "f" ]
+        [ 7 | "t" ]
+        [ 9 | "vector" ]
+        [ 10 | "string" ]
+        [ 11 | "sbuf" ]
+        [ 12 | "port" ]
+        [ 13 | "bignum" ]
+        [ 14 | "float" ]
+        [ 100 | "fixnum/bignum" ]
+        [ 101 | "fixnum/bignum/ratio" ]
+        [ 102 | "fixnum/bignum/ratio/float" ]
+        [ 103 | "fixnum/bignum/ratio/float/complex" ]
+    ] assoc ;
 
 : toplevel ( -- )
     init-namespaces

library/platform/native/unparser.factor

@@ -122,5 +122,5 @@ USE: words
         [ float?   ] [ unparse-float fix-float ]
         [ complex? ] [ unparse-complex ]
         [ string?  ] [ unparse-str ]
-        [ drop t   ] [ <% "#<" % class-of % ">" % %> ]
+        [ drop t   ] [ <% "#<" % type-of type-name % ">" % %> ]
     ] cond ;

library/prettyprint.factor

@@ -130,8 +130,12 @@ DEFER: prettyprint*
     #! Pretty-print a vector, without { and }.
     [ [ prettyprint-element ] vector-each ] check-recursion ;
 
-: prettyprint-{} ( indent list -- indent )
-    swap prettyprint-{ swap prettyprint-vector prettyprint-} ;
+: prettyprint-{} ( indent vector -- indent )
+    dup vector-length 0 = [
+        drop "{ }" write
+    ] [
+        swap prettyprint-{ swap prettyprint-vector prettyprint-}
+    ] ifte ;
 
 : trim-newline ( str -- str )
     dup ends-with-newline? dup [ nip ] [ drop ] ifte ;

library/test/io/io.factor

@@ -23,3 +23,9 @@ USE: test
 ] [
     "/library/test/io/mac-os-eol.txt" <resource-stream> lines-test
 ] unit-test
+
+[
+    "This is a line.\rThis is another line.\r"
+] [
+    500 "/library/test/io/mac-os-eol.txt" <resource-stream> fread#
+] unit-test

library/test/threads.factor

@@ -1,11 +1,16 @@
 IN: scratchpad
 
 USE: namespaces
+USE: stdio
 USE: test
 USE: threads
 
 ! This only tests co-operative threads in CFactor.
+! It won't give intended results in Java (or in CFactor if
+! we ever get preemptive threads).
 
 3 "x" set
 [ yield 2 "x" set ] in-thread
 [ 2 ] [ yield "x" get ] unit-test
+
+[ flush ] in-thread flush

native/complex.c

@@ -162,26 +162,29 @@ CELL divfloat_complex(CELL x, CELL y)
 	return possibly_complex(divfloat(r,mag),divfloat(i,mag));
 }
 
+#define INCOMPARABLE(x,y) general_error(ERROR_INCOMPARABLE, \
+	tag_cons(cons(tag_complex(x),tag_complex(y))));
+
 CELL less_complex(CELL x, CELL y)
 {
-	general_error(ERROR_INCOMPARABLE,tag_cons(cons(x,y)));
+	INCOMPARABLE(x,y);
 	return F;
 }
 
 CELL lesseq_complex(CELL x, CELL y)
 {
-	general_error(ERROR_INCOMPARABLE,tag_cons(cons(x,y)));
+	INCOMPARABLE(x,y);
 	return F;
 }
 
 CELL greater_complex(CELL x, CELL y)
 {
-	general_error(ERROR_INCOMPARABLE,tag_cons(cons(x,y)));
+	INCOMPARABLE(x,y);
 	return F;
 }
 
 CELL greatereq_complex(CELL x, CELL y)
 {
-	general_error(ERROR_INCOMPARABLE,tag_cons(cons(x,y)));
+	INCOMPARABLE(x,y);
 	return F;
 }

native/error.h

@@ -2,14 +2,12 @@
 #define ERROR_UNDEFINED_WORD (1<<3)
 #define ERROR_TYPE (2<<3)
 #define ERROR_RANGE (3<<3)
-#define ERROR_UNDERFLOW (4<<3)
-#define ERROR_IO (5<<3)
-#define ERROR_OVERFLOW (6<<3)
-#define ERROR_INCOMPARABLE (7<<3)
-#define ERROR_FLOAT_FORMAT (8<<3)
-#define ERROR_SIGNAL (9<<3)
-#define ERROR_IO_TASK_TWICE (10<<3)
-#define ERROR_IO_TASK_NONE (11<<3)
+#define ERROR_IO (4<<3)
+#define ERROR_INCOMPARABLE (5<<3)
+#define ERROR_FLOAT_FORMAT (6<<3)
+#define ERROR_SIGNAL (7<<3)
+#define ERROR_IO_TASK_TWICE (8<<3)
+#define ERROR_IO_TASK_NONE (9<<3)
 
 void fatal_error(char* msg, CELL tagged);
 void critical_error(char* msg, CELL tagged);