CL-style (but more limited) restarts, better undefined word handling in the parser

TODO.FACTOR.txt

@@ -57,7 +57,6 @@
 - focus is not top-level window aware
 - display lists
 - saving the image should save window configuration
-- fix up the min thumb size hack
 - variable width word wrap
 - new gesture style
 

library/bootstrap/boot-stage1.factor

@@ -11,9 +11,8 @@ vectors words ;
 
 : parse-resource* ( path -- )
     [ parse-resource ] catch [
-        dup error.
+        { { "Parse file again" t } } condition drop
-        "Try again? [yn]" print flush readln "yY" subseq?
+        parse-resource*
-        [ drop parse-resource* ] [ rethrow ] if
     ] when* ;
 
 : if-arch ( arch seq -- )
@@ -80,7 +79,7 @@ vectors words ;
         "/library/io/files.factor"
         "/library/io/binary.factor"
 
-        "/library/syntax/parser.factor"
+        "/library/syntax/early-parser.factor"
 
         "/library/generic/generic.factor"
         "/library/generic/standard-combination.factor"
@@ -92,6 +91,7 @@ vectors words ;
         
         "/library/syntax/prettyprint.factor"
         "/library/syntax/see.factor"
+        "/library/syntax/parser.factor"
 
         "/library/tools/interpreter.factor"
         
@@ -104,9 +104,9 @@ vectors words ;
         
         "/library/tools/describe.factor"
         "/library/tools/debugger.factor"
-
-        "/library/syntax/parse-stream.factor"
         
+        "/library/syntax/parse-stream.factor"
+
         "/library/tools/memory.factor"
         "/library/tools/listener.factor"
         "/library/tools/walker.factor"
@@ -260,6 +260,7 @@ vectors words ;
         "/library/math/ratio.facts"
         "/library/math/trig-hyp.facts"
         "/library/math/vectors.facts"
+        "/library/syntax/early-parser.facts"
         "/library/syntax/parse-stream.facts"
         "/library/syntax/parser.facts"
         "/library/syntax/parse-syntax.facts"

library/errors.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: kernel-internals
-USING: sequences ;
+USING: generic sequences ;
 
 : >c ( continuation -- ) catchstack* push ;
 : c> ( -- continuation ) catchstack* pop ;
@@ -24,4 +24,25 @@ USING: kernel ;
     [ >c drop call c> drop ]
     [ drop (continue-with) rot drop swap call ] ifcc ; inline
 
+TUPLE: condition restarts cc ;
+
+C: condition ( error restarts cc -- condition )
+    [ set-condition-cc ] keep
+    [ set-condition-restarts ] keep
+    [ set-delegate ] keep ;
+
+: condition ( error restarts -- value )
+    [ <condition> throw ] callcc1 2nip ;
+
+GENERIC: compute-restarts
+
+M: object compute-restarts drop { } ;
+
+M: tuple compute-restarts delegate compute-restarts ;
+
+M: condition compute-restarts
+    [ delegate compute-restarts ] keep
+    [ condition-cc ] keep
+    condition-restarts [ swap add ] map-with append ;
+
 GENERIC: error. ( error -- )

library/math/parse-numbers.factor

@@ -1,34 +1,34 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
+! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: math
 USING: errors generic kernel math-internals namespaces sequences
 strings ;
 
-: not-a-number "Not a number" throw ;
-
 DEFER: base>
 
 : string>ratio ( "a/b" radix -- a/b )
-    >r "/" split1 r> tuck base> >r base> r> / ;
+    >r "/" split1 r> tuck base> >r base> r>
+    2dup and [ / ] [ 2drop f ] if ;
 
 GENERIC: digit> ( ch -- n )
 M: digit  digit> CHAR: 0 - ;
 M: letter digit> CHAR: a - 10 + ;
 M: LETTER digit> CHAR: A - 10 + ;
-M: object digit> not-a-number ;
+M: object digit> drop f ;
 
 : digit+ ( num digit base -- num )
-    2dup < [ rot * + ] [ not-a-number ] if ;
+    pick pick and
+    [ 2dup < [ rot * + ] [ 3drop f ] if ] [ 3drop f ] if ;
 
-: (string>integer) ( base str -- num )
+: (string>integer) ( radix str -- num )
     dup empty? [
-        not-a-number
+        2drop f
     ] [
         0 [ digit> pick digit+ ] reduce nip
     ] if ;
 
-: string>integer ( string -- n )
+: string>integer ( string radix -- n )
-    swap "-" ?head >r (string>integer) r> [ neg ] when ;
+    swap "-" ?head >r (string>integer) dup r> and [ neg ] when ;
 
 : base> ( string radix -- n )
     {

library/syntax/early-parser.factor

@@ -0,0 +1,48 @@
+! Copyright (C) 2005, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: parser
+USING: arrays errors generic hashtables kernel math namespaces
+sequences strings vectors words ;
+
+SYMBOL: use
+SYMBOL: in
+
+SYMBOL: file
+SYMBOL: line-number
+
+SYMBOL: line-text
+SYMBOL: column
+
+: check-vocab ( name -- vocab )
+    dup vocab
+    [ ] [ " is not a vocabulary name" append throw ] ?if ;
+
+: use+ ( string -- ) check-vocab use get push ;
+
+: add-use ( seq -- ) [ use+ ] each ;
+
+: set-use ( seq -- ) [ check-vocab ] map >vector use set ;
+
+: set-in ( name -- ) dup ensure-vocab dup in set use+ ;
+
+: parsing? ( word -- ? )
+    dup word? [ "parsing" word-prop ] [ drop f ] if ;
+
+: save-location ( word -- )
+    dup set-word
+    dup line-number get "line" set-word-prop
+    file get "file" set-word-prop ;
+
+: create-in in get create dup save-location ;
+
+: create-constructor ( class -- word )
+    word-name in get constructor-word dup save-location ;
+
+TUPLE: parse-error file line col text ;
+
+C: parse-error ( error -- error )
+    file get over set-parse-error-file
+    line-number get over set-parse-error-line
+    column get over set-parse-error-col
+    line-text get over set-parse-error-text
+    [ set-delegate ] keep ;

library/syntax/early-parser.facts

@@ -0,0 +1,75 @@
+USING: help kernel parser sequences ;
+
+IN: help : $parsing-note
+    drop "This word should only be called from parsing words." $notes ;
+
+HELP: use f
+{ $description "A variable holding the current vocabulary search path as a sequence of hashtables." }
+{ $see-also in use+ set-use POSTPONE: USING: POSTPONE: USE: } ;
+
+HELP: in f
+{ $description "A variable holding the current vocabulary for new definitions." }
+{ $see-also use set-in POSTPONE: IN: } ;
+
+HELP: check-vocab "( name -- vocab )"
+{ $values { "name" "a string" } { "vocab" "a hashtable" } }
+{ $description "Outputs a named vocabulary." }
+{ $errors "Throws an error if the vocabulary does not exist." } ;
+
+HELP: use+ "( vocab -- )"
+{ $values { "vocab" "a string" } }
+{ $description "Adds a new vocabulary at the front of the search path. Subsequent word lookups by the parser will search this vocabulary first." }
+$parsing-note
+{ $errors "Throws an error if the vocabulary does not exist." }
+{ $see-also in use add-use set-use POSTPONE: USE: } ;
+
+HELP: set-use "( seq -- )"
+{ $values { "seq" "a sequence of strings" } }
+{ $description "Sets the vocabulary search path. Later vocabularies take precedence." }
+{ $errors "Throws an error if one of the vocabularies does not exist." }
+$parsing-note
+{ $see-also in use use+ add-use file-vocabs } ;
+
+HELP: add-use "( seq -- )"
+{ $values { "seq" "a sequence of strings" } }
+{ $description "Adds multiple vocabularies to the search path, with later vocabularies taking precedence." }
+{ $errors "Throws an error if one of the vocabularies does not exist." }
+$parsing-note
+{ $see-also in use use+ set-use POSTPONE: USING: } ;
+
+HELP: set-in "( name -- )"
+{ $values { "name" "a string" } }
+{ $description "Sets the current vocabulary where new words will be defined, creating the vocabulary first if it does not exist." }
+$parsing-note
+{ $see-also in use POSTPONE: IN: } ;
+
+HELP: parsing? "( obj -- ? )"
+{ $values { "obj" "an object" } { "?" "a boolean" } }
+{ $description "Tests if an object is a parsing word." }
+{ $notes "Outputs " { $link f } " if the object is not a word." } ;
+
+HELP: file f
+{ $description "Variable stores the file name being parsed. This is the input parameter to " { $link parse-stream } "." } ;
+
+HELP: line-number f
+{ $description "Variable holds the line number being parsed." } ;
+
+HELP: line-text f
+{ $description "Variable holds the text of the line being parsed." } ;
+
+HELP: column f
+{ $description "Variable holds the column number being parsed." } ;
+
+HELP: save-location "( word -- )"
+{ $values { "word" "a word" } }
+{ $description "Sets the " { $snippet "\"file\"" } " and " {  $snippet "\"line\"" } " word properties to the current parser location." }
+$parsing-note ;
+
+HELP: create-in "( string -- word )"
+{ $values { "string" "a word name" } { "word" "a new word" } }
+{ $description "Creates a word in the current vocabulary. Until re-defined, the word throws an error when invoked." }
+$parsing-note ;
+
+HELP: create-constructor "( word -- constructor )"
+{ $values { "class" "a word" } { "constructor" "a new word" } }
+{ $description "Creates a new word in the current vocabulary, named by surrounding " { $snippet "word" } " with angle brackets." } ;

library/syntax/parse-stream.factor

@@ -7,7 +7,8 @@ words ;
 : file-vocabs ( -- )
     "scratchpad" set-in { "syntax" "scratchpad" } set-use ;
 
-: with-parser ( quot -- ) [ <parse-error> rethrow ] recover ;
+: with-parser ( quot -- )
+    [ [ <parse-error> rethrow ] recover ] with-scope ;
 
 : parse-lines ( lines -- quot )
     [

library/syntax/parser.factor

@@ -1,41 +1,8 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! See http://factorcode.org/license.txt for BSD license.
 IN: parser
-USING: errors generic hashtables kernel math namespaces
+USING: arrays errors generic hashtables kernel math namespaces
-sequences strings vectors words ;
+prettyprint sequences strings vectors words ;
-
-SYMBOL: use
-SYMBOL: in
-
-: check-vocab ( name -- vocab )
-    dup vocab
-    [ ] [ " is not a vocabulary name" append throw ] ?if ;
-
-: use+ ( string -- ) check-vocab use get push ;
-
-: add-use ( seq -- ) [ use+ ] each ;
-
-: set-use ( seq -- ) [ check-vocab ] map >vector use set ;
-
-: set-in ( name -- ) dup ensure-vocab dup in set use+ ;
-
-: parsing? ( word -- ? )
-    dup word? [ "parsing" word-prop ] [ drop f ] if ;
-
-SYMBOL: file
-SYMBOL: line-number
-
-SYMBOL: line-text
-SYMBOL: column
-
-TUPLE: parse-error file line col text ;
-
-C: parse-error ( error -- error )
-    file get over set-parse-error-file
-    line-number get over set-parse-error-line
-    column get over set-parse-error-col
-    line-text get over set-parse-error-text
-    [ set-delegate ] keep ;
 
 : skip ( i seq quot -- n | quot: elt -- ? )
     over >r find* drop dup -1 =
@@ -55,24 +22,29 @@ C: parse-error ( error -- error )
     column [ line-text get (scan) dup ] change
     2dup = [ 2drop f ] [ line-text get subseq ] if ;
 
-: save-location ( word -- )
-    dup set-word
-    dup line-number get "line" set-word-prop
-    file get "file" set-word-prop ;
-
-: create-in in get create dup save-location ;
-
-: create-constructor ( class -- word )
-    word-name in get constructor-word dup save-location ;
-
 : CREATE ( -- word ) scan create-in ;
 
 SYMBOL: string-mode
 
+: do-what-i-mean ( string -- restarts )
+    all-words [ word-name = ] subset-with natural-sort [
+        [ "Use the word " swap synopsis append ] keep 2array
+    ] map ;
+
+: word-not-found ( str -- word )
+    "No word named "
+    over
+    " found in current vocabulary search path" append3
+    swap do-what-i-mean condition ;
+
 : scan-word ( -- obj )
     scan dup [
         dup ";" = not string-mode get and [
-            dup use get hash-stack [ ] [ string>number ] ?if
+            dup use get hash-stack [ ] [
+                dup string>number [ ] [
+                    word-not-found dup word-vocabulary use+
+                ] ?if
+            ] ?if
         ] unless
     ] when ;
 
@@ -118,11 +90,11 @@ SYMBOL: string-mode
 
 global [
     {
-        "scratchpad" "syntax" "alien" "arrays" "compiler"
+        "scratchpad" "syntax" "arrays" "compiler"
         "errors" "generic" "hashtables" "help" "inference"
         "inspector" "io" "jedit" "kernel" "listener" "math"
-        "memory" "namespaces" "optimizer" "parser" "prettyprint"
+        "memory" "namespaces" "parser" "prettyprint"
-        "queues" "sequences" "shells" "strings" "styles" "test"
+        "sequences" "shells" "strings" "styles" "test"
         "threads" "vectors" "walker" "words"
     } set-use
     "scratchpad" set-in

library/syntax/parser.facts

@@ -1,65 +1,5 @@
 USING: help kernel parser sequences ;
 
-IN: help : $parsing-note
-    drop "This word should only be called from parsing words." $notes ;
-
-HELP: use f
-{ $description "A variable holding the current vocabulary search path as a sequence of hashtables." }
-{ $see-also in use+ set-use POSTPONE: USING: POSTPONE: USE: } ;
-
-HELP: in f
-{ $description "A variable holding the current vocabulary for new definitions." }
-{ $see-also use set-in POSTPONE: IN: } ;
-
-HELP: check-vocab "( name -- vocab )"
-{ $values { "name" "a string" } { "vocab" "a hashtable" } }
-{ $description "Outputs a named vocabulary." }
-{ $errors "Throws an error if the vocabulary does not exist." } ;
-
-HELP: use+ "( vocab -- )"
-{ $values { "vocab" "a string" } }
-{ $description "Adds a new vocabulary at the front of the search path. Subsequent word lookups by the parser will search this vocabulary first." }
-$parsing-note
-{ $errors "Throws an error if the vocabulary does not exist." }
-{ $see-also in use add-use set-use POSTPONE: USE: } ;
-
-HELP: set-use "( seq -- )"
-{ $values { "seq" "a sequence of strings" } }
-{ $description "Sets the vocabulary search path. Later vocabularies take precedence." }
-{ $errors "Throws an error if one of the vocabularies does not exist." }
-$parsing-note
-{ $see-also in use use+ add-use file-vocabs } ;
-
-HELP: add-use "( seq -- )"
-{ $values { "seq" "a sequence of strings" } }
-{ $description "Adds multiple vocabularies to the search path, with later vocabularies taking precedence." }
-{ $errors "Throws an error if one of the vocabularies does not exist." }
-$parsing-note
-{ $see-also in use use+ set-use POSTPONE: USING: } ;
-
-HELP: set-in "( name -- )"
-{ $values { "name" "a string" } }
-{ $description "Sets the current vocabulary where new words will be defined, creating the vocabulary first if it does not exist." }
-$parsing-note
-{ $see-also in use POSTPONE: IN: } ;
-
-HELP: parsing? "( obj -- ? )"
-{ $values { "obj" "an object" } { "?" "a boolean" } }
-{ $description "Tests if an object is a parsing word." }
-{ $notes "Outputs " { $link f } " if the object is not a word." } ;
-
-HELP: file f
-{ $description "Variable stores the file name being parsed. This is the input parameter to " { $link parse-stream } "." } ;
-
-HELP: line-number f
-{ $description "Variable holds the line number being parsed." } ;
-
-HELP: line-text f
-{ $description "Variable holds the text of the line being parsed." } ;
-
-HELP: column f
-{ $description "Variable holds the column number being parsed." } ;
-
 HELP: skip "( i seq quot -- n )"
 { $values { "n" "a starting index" } { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } }
 { $description "Variant of " { $link find* } " that outputs the length of the sequence instead of -1 if no elements satisfy the predicate." } ;
@@ -82,20 +22,6 @@ HELP: scan "( -- token )"
 { $description "Reads the next token from the line currently being parsed. This is the key word that the Factor parser is built on." }
 $parsing-note ;
 
-HELP: save-location "( word -- )"
-{ $values { "word" "a word" } }
-{ $description "Sets the " { $snippet "\"file\"" } " and " {  $snippet "\"line\"" } " word properties to the current parser location." }
-$parsing-note ;
-
-HELP: create-in "( string -- word )"
-{ $values { "string" "a word name" } { "word" "a new word" } }
-{ $description "Creates a word in the current vocabulary. Until re-defined, the word throws an error when invoked." }
-$parsing-note ;
-
-HELP: create-constructor "( word -- constructor )"
-{ $values { "class" "a word" } { "constructor" "a new word" } }
-{ $description "Creates a new word in the current vocabulary, named by surrounding " { $snippet "word" } " with angle brackets." } ;
-
 HELP: CREATE "( -- word )"
 { $values { "word" "a word" } }
 { $description "Reads the next token from the line currently being parsed, and creates a word with that name in the current vocabulary." }

library/test/parse-number.factor

@@ -1,116 +1,112 @@
 IN: temporary
 USING: errors kernel math parser sequences test ;
 
-: parse-number ( str -- num )
-    #! Convert a string to a number; return f on error.
-    [ string>number ] catch [ drop f ] when ;
-
 [ f ]
-[ f parse-number ]
+[ f string>number ]
 unit-test
 
 [ f ]
-[ "12345abcdef" parse-number ]
+[ "12345abcdef" string>number ]
 unit-test
 
 [ t ]
-[ "-12" parse-number 0 < ]
+[ "-12" string>number 0 < ]
 unit-test
 
 [ f ]
-[ "--12" parse-number ]
+[ "--12" string>number ]
 unit-test
 
 [ f ]
-[ "-" parse-number ]
+[ "-" string>number ]
 unit-test
 
 [ f ]
-[ "e" parse-number ]
+[ "e" string>number ]
 unit-test
 
 [ "100.0" ]
-[ "1.0e2" parse-number number>string ]
+[ "1.0e2" string>number number>string ]
 unit-test
 
 [ "-100.0" ]
-[ "-1.0e2" parse-number number>string ]
+[ "-1.0e2" string>number number>string ]
 unit-test
 
 [ "0.01" ]
-[ "1.0e-2" parse-number number>string ]
+[ "1.0e-2" string>number number>string ]
 unit-test
 
 [ "-0.01" ]
-[ "-1.0e-2" parse-number number>string ]
+[ "-1.0e-2" string>number number>string ]
 unit-test
 
 [ f ]
-[ "-1e-2e4" parse-number ]
+[ "-1e-2e4" string>number ]
 unit-test
 
 [ "3.14" ]
-[ "3.14" parse-number number>string ]
+[ "3.14" string>number number>string ]
 unit-test
 
 [ f ]
-[ "." parse-number ]
+[ "." string>number ]
 unit-test
 
 [ f ]
-[ ".e" parse-number ]
+[ ".e" string>number ]
 unit-test
 
 [ "101.0" ]
-[ "1.01e2" parse-number number>string ]
+[ "1.01e2" string>number number>string ]
 unit-test
 
 [ "-101.0" ]
-[ "-1.01e2" parse-number number>string ]
+[ "-1.01e2" string>number number>string ]
 unit-test
 
 [ "1.01" ]
-[ "101.0e-2" parse-number number>string ]
+[ "101.0e-2" string>number number>string ]
 unit-test
 
 [ "-1.01" ]
-[ "-101.0e-2" parse-number number>string ]
+[ "-101.0e-2" string>number number>string ]
 unit-test
 
 [ 5 ]
-[ "10/2" parse-number ]
+[ "10/2" string>number ]
 unit-test
 
 [ -5 ]
-[ "-10/2" parse-number ]
+[ "-10/2" string>number ]
 unit-test
 
 [ -5 ]
-[ "10/-2" parse-number ]
+[ "10/-2" string>number ]
 unit-test
 
 [ 5 ]
-[ "-10/-2" parse-number ]
+[ "-10/-2" string>number ]
 unit-test
 
 [ 5.0 ]
-[ "10.0/2" parse-number ]
+[ "10.0/2" string>number ]
 unit-test
 
 [ f ]
-[ "1e1/2" parse-number ]
+[ "1e1/2" string>number ]
 unit-test
 
 [ f ]
-[ "e/2" parse-number ]
+[ "e/2" string>number ]
 unit-test
 
 [ "33/100" ]
-[ "66/200" parse-number number>string ]
+[ "66/200" string>number number>string ]
 unit-test
 
-[ "12" bin> ] unit-test-fails
+[ f ] [ "12" bin> ] unit-test
-[ "fdsf" bin> ] unit-test-fails
+[ f ] [ "fdsf" bin> ] unit-test
 [ 3 ] [ "11" bin> ] unit-test
 
 [ t ] [

library/tools/debugger.factor

@@ -7,6 +7,7 @@ sequences-internals strings vectors words ;
 
 SYMBOL: error
 SYMBOL: error-continuation
+SYMBOL: restarts
 
 : expired-error. ( obj -- )
     "Object did not survive image save/load: " write third . ;
@@ -23,9 +24,6 @@ SYMBOL: error-continuation
     "Object type: " write dup fourth class .
     "Expected type: " write third type>class . ;
 
-: float-format-error. ( list -- )
-    "Invalid floating point literal format: " write third . ;
-
 : signal-error. ( obj -- )
     "Operating system signal " write third . ;
 
@@ -67,7 +65,6 @@ M: kernel-error error. ( error -- )
         [ io-error. ]
         [ undefined-word-error. ]
         [ type-check-error. ]
-        [ float-format-error. ]
         [ signal-error. ]
         [ negative-array-size-error. ]
         [ c-string-error. ]
@@ -114,6 +111,8 @@ M: parse-error error. ( error -- )
 
 M: bounds-error summary drop "Sequence index out of bounds" ;
 
+M: condition error. delegate error. ;
+
 M: tuple error. ( error -- ) describe ;
 
 M: object error. ( error -- ) . ;
@@ -127,7 +126,20 @@ M: object error. ( error -- ) . ;
 : :get ( var -- value )
     error-continuation get continuation-name hash-stack ;
 
+: :res ( n -- ) restarts get nth first3 continue-with ;
+
+: restarts. ( -- )
+    restarts get dup empty? [
+        drop
+    ] [
+        "The following restarts are available:" print
+        dup length [
+            number>string write " :res  " write first print
+        ] 2each
+    ] if ;
+
 : debug-help ( -- )
+    restarts.
     ":s :r :c show stacks at time of error" print
     ":get ( var -- value ) accesses variables at time of error" print
     ":error starts the inspector with the error" print
@@ -144,7 +156,9 @@ M: object error. ( error -- ) . ;
 : try ( quot -- ) [ print-error terpri debug-help ] recover ;
 
 : save-error ( error continuation -- )
-    error-continuation set-global error set-global ;
+    error-continuation set-global
+    dup error set-global
+    compute-restarts restarts set-global ;
 
 : error-handler ( error -- )
     dup continuation save-error rethrow ;

library/tools/listener.factor

@@ -15,7 +15,7 @@ SYMBOL: error-hook
 [ drop terpri debug-help ] error-hook set-global
 
 : bye ( -- ) quit-flag on ;
-
+help
 : (read-multiline) ( quot depth -- quot ? )
     >r readln dup [
         (parse) depth r> dup >r <= [
@@ -28,7 +28,9 @@ SYMBOL: error-hook
     ] if ;
 
 : read-multiline ( -- quot ? )
-    [ f depth (read-multiline) >r >quotation r> ] with-parser ;
+    [
+        f depth (read-multiline) >r >quotation r> in get
+    ] with-parser in set ;
 
 : listen-try
     [

native/error.c

@@ -48,10 +48,10 @@ void primitive_die(void)
 	factorbug();
 }
 
-void general_error(CELL error, CELL arg1, CELL arg2, bool keep_stacks)
+void general_error(F_ERRORTYPE error, CELL arg1, CELL arg2, bool keep_stacks)
 {
-	CELL thrown = make_array_4(userenv[ERROR_ENV],error,arg1,arg2);
+	throw_error(make_array_4(userenv[ERROR_ENV],
-	throw_error(thrown,keep_stacks);
+		tag_fixnum(error),arg1,arg2),keep_stacks);
 }
 
 /* It is not safe to access 'ds' from a signal handler, so we just not

native/error.h

@@ -1,22 +1,24 @@
-#define ERROR_EXPIRED (0<<3)
+typedef enum
-#define ERROR_IO (1<<3)
+{
-#define ERROR_UNDEFINED_WORD (2<<3)
+	ERROR_EXPIRED
-#define ERROR_TYPE (3<<3)
+	ERROR_IO
-#define ERROR_FLOAT_FORMAT (4<<3)
+	ERROR_UNDEFINED_WORD
-#define ERROR_SIGNAL (5<<3)
+	ERROR_TYPE
-#define ERROR_NEGATIVE_ARRAY_SIZE (6<<3)
+	ERROR_SIGNAL
-#define ERROR_C_STRING (7<<3)
+	ERROR_NEGATIVE_ARRAY_SIZE
-#define ERROR_FFI (8<<3)
+	ERROR_C_STRING
-#define ERROR_HEAP_SCAN (9<<3)
+	ERROR_FFI
-#define ERROR_UNDEFINED_SYMBOL (10<<3)
+	ERROR_HEAP_SCAN
-#define ERROR_USER_INTERRUPT (11<<3)
+	ERROR_UNDEFINED_SYMBOL
-#define ERROR_DS_UNDERFLOW (12<<3)
+	ERROR_USER_INTERRUPT
-#define ERROR_DS_OVERFLOW (13<<3)
+	ERROR_DS_UNDERFLOW
-#define ERROR_RS_UNDERFLOW (14<<3)
+	ERROR_DS_OVERFLOW
-#define ERROR_RS_OVERFLOW (15<<3)
+	ERROR_RS_UNDERFLOW
-#define ERROR_CS_UNDERFLOW (16<<3)
+	ERROR_RS_OVERFLOW
-#define ERROR_CS_OVERFLOW (17<<3)
+	ERROR_CS_UNDERFLOW
-#define ERROR_OBJECTIVE_C (18<<3)
+	ERROR_CS_OVERFLOW
+	ERROR_OBJECTIVE_C
+} F_ERRORTYPE;
 
 /* Are we throwing an error? */
 bool throwing;
@@ -32,7 +34,7 @@ void fatal_error(char* msg, CELL tagged);
 void critical_error(char* msg, CELL tagged);
 void throw_error(CELL error, bool keep_stacks);
 void early_error(CELL error);
-void general_error(CELL error, CELL arg1, CELL arg2, bool keep_stacks);
+void general_error(F_ERRORTYPE error, CELL arg1, CELL arg2, bool keep_stacks);
 void signal_error(int signal);
 void type_error(CELL type, CELL tagged);
 void primitive_throw(void);

native/float.c

@@ -44,8 +44,9 @@ void primitive_str_to_float(void)
 	end = c_str;
 	f = strtod(c_str,&end);
 	if(end != c_str + string_capacity(str))
-		general_error(ERROR_FLOAT_FORMAT,tag_object(str),F,true);
+		drepl(F);
-	drepl(tag_float(f));
+	else
+		drepl(tag_float(f));
 }
 
 void primitive_float_to_str(void)