steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

slava 2006-05-24 08:29:25 +00:00
parent 3856c26f69
commit c90c1d66da
15 changed files with 265 additions and 207 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
TODO.FACTOR.txt
View File

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

13
library/bootstrap/boot-stage1.factor
View File

@ -11,9 +11,8 @@ vectors words ;
: parse-resource* ( path -- )
[ parse-resource ] catch [
dup error.
"Try again? [yn]" print flush readln "yY" subseq?
[ drop parse-resource* ] [ rethrow ] if
{ { "Parse file again" t } } condition drop
parse-resource*
] 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"

23
library/errors.factor
View File

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

20
library/math/parse-numbers.factor
View File

@ -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 )
swap "-" ?head >r (string>integer) r> [ neg ] when ;
: string>integer ( string radix -- n )
swap "-" ?head >r (string>integer) dup r> and [ neg ] when ;
: base> ( string radix -- n )
{

48
library/syntax/early-parser.factor Normal file
View File

@ -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 ;

75
library/syntax/early-parser.facts Normal file
View File

@ -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." } ;

3
library/syntax/parse-stream.factor
View File

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

72
library/syntax/parser.factor
View File

@ -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
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 ;
USING: arrays errors generic hashtables kernel math namespaces
prettyprint sequences strings vectors words ;
: 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"
"queues" "sequences" "shells" "strings" "styles" "test"
"memory" "namespaces" "parser" "prettyprint"
"sequences" "shells" "strings" "styles" "test"
"threads" "vectors" "walker" "words"
} set-use
"scratchpad" set-in

74
library/syntax/parser.facts
View File

@ -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." }

60
library/test/parse-number.factor
View File

@ -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
[ "fdsf" bin> ] unit-test-fails
[ f ] [ "12" bin> ] unit-test
[ f ] [ "fdsf" bin> ] unit-test
[ 3 ] [ "11" bin> ] unit-test
[ t ] [

24
library/tools/debugger.factor
View File

@ -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 ;

6
library/tools/listener.factor
View File

@ -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
[

6
native/error.c
View File

@ -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(thrown,keep_stacks);
throw_error(make_array_4(userenv[ERROR_ENV],
tag_fixnum(error),arg1,arg2),keep_stacks);
}
/* It is not safe to access 'ds' from a signal handler, so we just not

42
native/error.h
View File

@ -1,22 +1,24 @@
#define ERROR_EXPIRED (0<<3)
#define ERROR_IO (1<<3)
#define ERROR_UNDEFINED_WORD (2<<3)
#define ERROR_TYPE (3<<3)
#define ERROR_FLOAT_FORMAT (4<<3)
#define ERROR_SIGNAL (5<<3)
#define ERROR_NEGATIVE_ARRAY_SIZE (6<<3)
#define ERROR_C_STRING (7<<3)
#define ERROR_FFI (8<<3)
#define ERROR_HEAP_SCAN (9<<3)
#define ERROR_UNDEFINED_SYMBOL (10<<3)
#define ERROR_USER_INTERRUPT (11<<3)
#define ERROR_DS_UNDERFLOW (12<<3)
#define ERROR_DS_OVERFLOW (13<<3)
#define ERROR_RS_UNDERFLOW (14<<3)
#define ERROR_RS_OVERFLOW (15<<3)
#define ERROR_CS_UNDERFLOW (16<<3)
#define ERROR_CS_OVERFLOW (17<<3)
#define ERROR_OBJECTIVE_C (18<<3)
typedef enum
{
ERROR_EXPIRED
ERROR_IO
ERROR_UNDEFINED_WORD
ERROR_TYPE
ERROR_SIGNAL
ERROR_NEGATIVE_ARRAY_SIZE
ERROR_C_STRING
ERROR_FFI
ERROR_HEAP_SCAN
ERROR_UNDEFINED_SYMBOL
ERROR_USER_INTERRUPT
ERROR_DS_UNDERFLOW
ERROR_DS_OVERFLOW
ERROR_RS_UNDERFLOW
ERROR_RS_OVERFLOW
ERROR_CS_UNDERFLOW
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);

5
native/float.c
View File

@ -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(tag_float(f));
drepl(F);
else
drepl(tag_float(f));
}
void primitive_float_to_str(void)