Skip to content
GitLab
Menu
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Chris Müller
cherry
Commits
2fda67c6
Commit
2fda67c6
authored
Jul 24, 2013
by
Chris Müller
Browse files
Refactor error messages and several names
parent
d3e0542b
Changes
6
Hide whitespace changes
Inline
Side-by-side
bootstrap/bootstrap.c
View file @
2fda67c6
...
...
@@ -18,6 +18,7 @@
#include
"bootstrap.h"
#include
<stdarg.h>
#include
<getopt.h>
#include
<readline/readline.h>
#include
<gc.h>
...
...
@@ -59,10 +60,8 @@ process_file(const char* filename, const byte_t* method, struct value* arguments
struct
environment
*
env
=
environment
();
if
(
src
==
0
)
{
fprintf
(
stderr
,
"cherry: couldn't load %s
\n
"
,
filename
);
exit
(
EXIT_FAILURE
);
}
if
(
src
==
0
)
failure
(
0
,
"Could not load %s"
,
filename
);
struct
context
*
c
=
context
(
src
,
filename
,
SUPRESS_COMMENTS
);
...
...
@@ -75,7 +74,6 @@ process_file(const char* filename, const byte_t* method, struct value* arguments
if
(
method
)
{
struct
value
*
main
=
cons
(
symbol
(
method
),
arguments
);
cherry_eval
(
env
,
main
);
}
...
...
bootstrap/bootstrap.h
View file @
2fda67c6
...
...
@@ -160,8 +160,8 @@ struct environment* environment(void);
extern
struct
symbollist
*
global_symbollist
;
extern
struct
value
*
emptylist
;
extern
struct
value
*
t
rue
;
extern
struct
value
*
f
alse
;
extern
struct
value
*
T
rue
;
extern
struct
value
*
F
alse
;
extern
struct
value
*
dot
;
extern
struct
value
*
symbol_quote
;
extern
struct
value
*
symbol_define
;
...
...
@@ -221,6 +221,8 @@ struct value* cherry_eval(struct environment* env, struct value* exp);
void
cherry_print
(
FILE
*
out
,
struct
value
*
value
);
struct
value
*
cherry_read
(
struct
context
*
context
);
void
failure
(
struct
context
*
context
,
const
char
*
format
,
...);
void
initialize
(
struct
value
*
arguments
);
struct
array
;
...
...
@@ -242,7 +244,6 @@ struct context* context(const byte_t* source, const char* filename, flags_t fl
struct
context
*
context_repl
(
const
byte_t
*
source
);
void
context_repl_set_source
(
struct
context
*
c
,
const
byte_t
*
source
);
void
error
(
struct
context
*
context
,
const
char
*
format
,
...);
enum
tok
{
TOK_EOF
,
...
...
bootstrap/eval.c
View file @
2fda67c6
...
...
@@ -25,9 +25,9 @@ eval_let(struct environment* env, struct value* exp)
struct
value
*
value
=
HEAD
(
TAIL
(
exp
));
if
(
env_add
(
env
,
symbol
,
cherry_eval
(
env
,
value
)))
return
t
rue
;
return
T
rue
;
else
return
f
alse
;
return
F
alse
;
}
...
...
bootstrap/read.c
View file @
2fda67c6
...
...
@@ -53,7 +53,7 @@ context_repl_set_source(struct context* c, const byte_t* source)
void
error
(
struct
context
*
context
,
const
char
*
format
,
...)
failure
(
struct
context
*
context
,
const
char
*
format
,
...)
{
va_list
args
;
va_start
(
args
,
format
);
...
...
@@ -68,8 +68,9 @@ error(struct context* context, const char* format, ...)
fprintf
(
stderr
,
" --- "
);
vfprintf
(
stderr
,
format
,
args
);
fprintf
(
stderr
,
"
\n
"
);
va_end
(
args
);
exit
(
EXIT_FAILURE
);
}
...
...
@@ -154,7 +155,7 @@ lex_float(struct context* context)
if
(
ch
==
'+'
||
ch
==
'-'
)
state
=
FP_MINUSPLUS
;
else
if
(
'0'
>
ch
||
ch
>
'9'
)
{
error
(
context
,
"Unexpected character found in float literal after +/-"
);
failure
(
context
,
"Unexpected character found in float literal after +/-"
);
array_append
(
buffer
,
"0"
,
1
);
goto
RETURN_TOKEN
;
}
else
...
...
@@ -164,7 +165,7 @@ lex_float(struct context* context)
case
FP_DOT
:
state
=
FP_DECIMAL
;
if
(
'0'
>
ch
||
ch
>
'9'
)
{
error
(
context
,
"Unexpected character found in float literal after dot"
);
failure
(
context
,
"Unexpected character found in float literal after dot"
);
array_append
(
buffer
,
"0"
,
1
);
goto
RETURN_TOKEN
;
}
...
...
@@ -180,7 +181,7 @@ lex_float(struct context* context)
case
FP_MINUSPLUS
:
state
=
FP_FINAL
;
if
(
'0'
>
ch
||
ch
>
'9'
)
{
error
(
context
,
"Unexpected character found in float literal"
);
failure
(
context
,
"Unexpected character found in float literal"
);
array_append
(
buffer
,
"0"
,
1
);
goto
RETURN_TOKEN
;
}
...
...
@@ -260,7 +261,7 @@ lex_number(struct context* context)
case
INT_HEX_WAIT
:
if
((
'0'
>
ch
||
ch
>
'9'
)
&&
(
'A'
>
ch
||
ch
>
'F'
))
{
error
(
context
,
"Unexpected character found in hex literal"
);
failure
(
context
,
"Unexpected character found in hex literal"
);
array_append
(
buffer
,
"0"
,
1
);
token
=
TOK_HEX
;
goto
RETURN_TOKEN
;
...
...
@@ -270,7 +271,7 @@ lex_number(struct context* context)
case
INT_BIN_WAIT
:
if
(
ch
!=
'0'
&&
ch
!=
'1'
)
{
error
(
context
,
"Unexpected character found in binary literal"
);
failure
(
context
,
"Unexpected character found in binary literal"
);
array_append
(
buffer
,
"0"
,
1
);
token
=
TOK_BIN
;
goto
RETURN_TOKEN
;
...
...
@@ -350,7 +351,7 @@ lex_character(struct context* context)
}
if
(
array_size
(
buffer
)
==
1
)
{
error
(
context
,
"No character symbol is given in character literal"
);
failure
(
context
,
"No character symbol is given in character literal"
);
array_append
(
buffer
,
"0"
,
1
);
}
...
...
@@ -377,7 +378,7 @@ lex_raw_string(struct context* context)
p
++
;
goto
RETURN_TOKEN
;
}
else
if
(
ch
==
'\r'
||
ch
==
'\n'
)
{
error
(
context
,
"Unexpected newline/carriage return found in raw string literal"
);
failure
(
context
,
"Unexpected newline/carriage return found in raw string literal"
);
goto
RETURN_TOKEN
;
}
...
...
@@ -424,7 +425,7 @@ lex_string(struct context* context)
state
=
STR_FINAL
;
goto
NO_BUFFER_APPEND
;
}
else
if
(
ch
==
'\r'
||
ch
==
'\n'
)
{
error
(
context
,
"Unexpected newline/carriage return found in string literal"
);
failure
(
context
,
"Unexpected newline/carriage return found in string literal"
);
state
=
STR_FINAL
;
goto
RETURN_TOKEN
;
}
...
...
@@ -446,7 +447,7 @@ lex_string(struct context* context)
state
=
STR_UNICODE
;
break
;
default:
error
(
context
,
"Unknown escape sequence found in this string literal"
);
failure
(
context
,
"Unknown escape sequence found in this string literal"
);
state
=
STR_EAT
;
array_append
(
buffer
,
"t"
,
1
);
goto
NO_BUFFER_APPEND
;
...
...
@@ -459,7 +460,7 @@ lex_string(struct context* context)
state
=
STR_EAT
;
if
((
'0'
>
ch
||
ch
>
'9'
)
&&
(
'A'
>
ch
||
ch
>
'F'
))
{
error
(
context
,
"Unexpected hex number in unicode escape sequence found"
);
failure
(
context
,
"Unexpected hex number in unicode escape sequence found"
);
array_append
(
buffer
,
"0"
,
1
);
goto
NO_BUFFER_APPEND
;
}
...
...
@@ -478,7 +479,7 @@ NO_BUFFER_APPEND:
RETURN_TOKEN:
if
(
state
!=
STR_FINAL
)
{
error
(
context
,
"Unexpected end of file found in unclosed string"
);
failure
(
context
,
"Unexpected end of file found in unclosed string"
);
while
(
unicount
--
>
0
)
array_append
(
buffer
,
"0"
,
1
);
...
...
@@ -546,9 +547,9 @@ lex_symbol(struct context* context)
byte_t
*
sym
=
array_get
(
buffer
,
0
);
if
(
strcmp
(
sym
,
"
t
rue"
)
==
0
)
if
(
strcmp
(
sym
,
"
T
rue"
)
==
0
)
return
TOK_TRUE
;
else
if
(
strcmp
(
sym
,
"
f
alse"
)
==
0
)
else
if
(
strcmp
(
sym
,
"
F
alse"
)
==
0
)
return
TOK_FALSE
;
else
return
TOK_SYMBOL
;
...
...
@@ -628,7 +629,7 @@ lex(struct context* context)
if
(
unicode_isalpha
(
ch
))
return
lex_symbol
(
context
);
else
{
error
(
context
,
"Unknown character found in input scanning"
);
failure
(
context
,
"Unknown character found in input scanning"
);
p
=
utf8_next
(
p
);
}
}
...
...
@@ -709,9 +710,9 @@ transform_define(struct value* value)
static
struct
value
*
transform_if
(
struct
value
*
value
)
{
struct
value
*
pred
=
f
alse
;
struct
value
*
tru
=
f
alse
;
struct
value
*
fal
=
f
alse
;
struct
value
*
pred
=
F
alse
;
struct
value
*
tru
=
F
alse
;
struct
value
*
fal
=
F
alse
;
// check predicate
if
(
IS_NULL
(
TAIL
(
value
)))
...
...
@@ -719,13 +720,13 @@ transform_if(struct value* value)
else
pred
=
TAIL
(
value
);
// check
t
rue case
// check
T
rue case
if
(
IS_NULL
(
TAIL
(
pred
)))
tru
=
TAIL
(
pred
)
=
cons
(
tru
,
emptylist
);
else
tru
=
TAIL
(
pred
);
// check
f
alse case
// check
F
alse case
if
(
IS_NULL
(
TAIL
(
tru
)))
fal
=
TAIL
(
tru
)
=
cons
(
fal
,
emptylist
);
else
...
...
@@ -781,7 +782,7 @@ cherry_read(struct context* context)
{
assert
(
context
!=
0
);
struct
value
*
value
=
f
alse
;
struct
value
*
value
=
F
alse
;
enum
tok
tok
=
lex
(
context
);
...
...
@@ -790,10 +791,10 @@ cherry_read(struct context* context)
switch
(
tok
)
{
case
TOK_FALSE
:
return
f
alse
;
return
F
alse
;
case
TOK_TRUE
:
return
t
rue
;
return
T
rue
;
case
TOK_DOT
:
return
dot
;
...
...
@@ -829,7 +830,7 @@ cherry_read(struct context* context)
return
cons
(
symbol_quote
,
cons
(
cherry_read
(
context
),
emptylist
));
default:
error
(
context
,
"bad input with token %s"
,
tok_to_string
(
tok
));
failure
(
context
,
"bad input with token %s"
,
tok_to_string
(
tok
));
}
}
...
...
bootstrap/runtime.c
View file @
2fda67c6
...
...
@@ -26,8 +26,8 @@
struct
symbollist
*
global_symbollist
;
struct
value
*
emptylist
;
struct
value
*
t
rue
;
struct
value
*
f
alse
;
struct
value
*
T
rue
;
struct
value
*
F
alse
;
struct
value
*
dot
;
struct
value
*
symbol_define
;
...
...
@@ -45,13 +45,13 @@ initialize(struct value* arguments)
GC_INIT
();
global_symbollist
=
symbollist
();
t
rue
=
value_alloc
();
t
rue
->
tag
=
BOOLEAN
;
t
rue
->
boolean_value
=
1
;
T
rue
=
value_alloc
();
T
rue
->
tag
=
BOOLEAN
;
T
rue
->
boolean_value
=
1
;
f
alse
=
value_alloc
();
f
alse
->
tag
=
BOOLEAN
;
f
alse
->
boolean_value
=
0
;
F
alse
=
value_alloc
();
F
alse
->
tag
=
BOOLEAN
;
F
alse
->
boolean_value
=
0
;
dot
=
value_alloc
();
dot
->
tag
=
DOT
;
...
...
@@ -114,7 +114,7 @@ core_type(struct environment* env, struct value* args)
return
symbol
(
"#tuple"
);
}
return
f
alse
;
return
F
alse
;
}
...
...
@@ -145,7 +145,7 @@ core_is_null(struct environment* env, struct value* args)
if
(
IS_NULL
(
args
))
core_raise
(
env
,
string
(
"null? expects an operand"
));
return
IS_NULL
(
HEAD
(
args
))
?
t
rue
:
f
alse
;
return
IS_NULL
(
HEAD
(
args
))
?
T
rue
:
F
alse
;
}
...
...
@@ -259,7 +259,7 @@ core_nth(struct environment* env, struct value* args)
core_raise
(
env
,
string
(
"Out of Bounds Error"
));
return
f
alse
;
return
F
alse
;
}
...
...
@@ -456,8 +456,8 @@ core_string_equal(struct environment* env, struct value* args)
struct
value
*
b
=
HEAD
(
TAIL
(
args
));
return
(
utf8_compare
(
a
->
string_value
,
b
->
string_value
)
==
0
)
?
t
rue
:
f
alse
;
?
T
rue
:
F
alse
;
}
...
...
@@ -629,17 +629,17 @@ core_not(struct environment* env, struct value* args)
if
(
IS_NULL
(
args
)
||
!
IS_BOOLEAN
(
HEAD
(
args
)))
core_raise
(
env
,
string
(
"not operator expects one boolean operand"
));
return
IS_TRUE
(
HEAD
(
args
))
?
f
alse
:
t
rue
;
return
IS_TRUE
(
HEAD
(
args
))
?
F
alse
:
T
rue
;
}
struct
value
*
core_and
(
struct
environment
*
env
,
struct
value
*
args
)
{
struct
value
*
result
=
t
rue
;
struct
value
*
result
=
T
rue
;
while
(
!
IS_NULL
(
args
))
{
if
(
IS_FALSE
(
HEAD
(
args
)))
return
f
alse
;
return
F
alse
;
args
=
TAIL
(
args
);
}
...
...
@@ -649,11 +649,11 @@ core_and(struct environment* env, struct value* args)
struct
value
*
core_or
(
struct
environment
*
env
,
struct
value
*
args
)
{
struct
value
*
result
=
f
alse
;
struct
value
*
result
=
F
alse
;
while
(
!
IS_NULL
(
args
))
{
if
(
IS_TRUE
(
HEAD
(
args
)))
return
t
rue
;
return
T
rue
;
args
=
TAIL
(
args
);
}
...
...
@@ -664,7 +664,7 @@ struct value*
core_greater
(
struct
environment
*
env
,
struct
value
*
args
)
{
if
(
IS_NULL
(
args
))
return
t
rue
;
return
T
rue
;
struct
value
*
val
=
HEAD
(
args
);
args
=
TAIL
(
args
);
...
...
@@ -675,11 +675,11 @@ core_greater(struct environment* env, struct value* args)
switch
(
next
->
tag
)
{
case
FIXNUM
:
if
(
next
->
fixnum_value
>=
val
->
fixnum_value
)
return
f
alse
;
return
F
alse
;
break
;
case
FLOAT
:
if
(
next
->
float_value
>=
(
val
->
fixnum_value
))
return
f
alse
;
return
F
alse
;
break
;
default:
...
...
@@ -693,11 +693,11 @@ core_greater(struct environment* env, struct value* args)
switch
(
next
->
tag
)
{
case
FIXNUM
:
if
(
next
->
fixnum_value
>=
val
->
float_value
)
return
f
alse
;
return
F
alse
;
break
;
case
FLOAT
:
if
(
next
->
float_value
>=
val
->
float_value
)
return
f
alse
;
return
F
alse
;
break
;
default:
...
...
@@ -708,14 +708,14 @@ core_greater(struct environment* env, struct value* args)
}
else
core_raise
(
env
,
string
(
"> operator expects a number"
));
return
t
rue
;
return
T
rue
;
}
struct
value
*
core_less
(
struct
environment
*
env
,
struct
value
*
args
)
{
if
(
IS_NULL
(
args
))
return
t
rue
;
return
T
rue
;
struct
value
*
val
=
HEAD
(
args
);
args
=
TAIL
(
args
);
...
...
@@ -726,11 +726,11 @@ core_less(struct environment* env, struct value* args)
switch
(
next
->
tag
)
{
case
FIXNUM
:
if
(
next
->
fixnum_value
<=
val
->
fixnum_value
)
return
f
alse
;
return
F
alse
;
break
;
case
FLOAT
:
if
(
next
->
float_value
<=
(
val
->
fixnum_value
))
return
f
alse
;
return
F
alse
;
break
;
default:
...
...
@@ -744,11 +744,11 @@ core_less(struct environment* env, struct value* args)
switch
(
next
->
tag
)
{
case
FIXNUM
:
if
(
next
->
fixnum_value
<=
val
->
float_value
)
return
f
alse
;
return
F
alse
;
break
;
case
FLOAT
:
if
(
next
->
float_value
<=
val
->
float_value
)
return
f
alse
;
return
F
alse
;
break
;
default:
...
...
@@ -759,7 +759,7 @@ core_less(struct environment* env, struct value* args)
}
else
core_raise
(
env
,
string
(
"> operator expects a number"
));
return
t
rue
;
return
T
rue
;
}
...
...
@@ -767,7 +767,7 @@ struct value*
core_greater_equal
(
struct
environment
*
env
,
struct
value
*
args
)
{
if
(
IS_NULL
(
args
))
return
t
rue
;
return
T
rue
;
struct
value
*
val
=
HEAD
(
args
);
args
=
TAIL
(
args
);
...
...
@@ -778,11 +778,11 @@ core_greater_equal(struct environment* env, struct value* args)
switch
(
next
->
tag
)
{
case
FIXNUM
:
if
(
next
->
fixnum_value
>
val
->
fixnum_value
)
return
f
alse
;
return
F
alse
;
break
;
case
FLOAT
:
if
(
next
->
float_value
>
(
val
->
fixnum_value
))
return
f
alse
;
return
F
alse
;
break
;
default:
...
...
@@ -796,11 +796,11 @@ core_greater_equal(struct environment* env, struct value* args)
switch
(
next
->
tag
)
{
case
FIXNUM
:
if
(
next
->
fixnum_value
>
val
->
float_value
)
return
f
alse
;
return
F
alse
;
break
;
case
FLOAT
:
if
(
next
->
float_value
>
val
->
float_value
)
return
f
alse
;
return
F
alse
;
break
;
default:
...
...
@@ -811,7 +811,7 @@ core_greater_equal(struct environment* env, struct value* args)
}
else
core_raise
(
env
,
string
(
"> operator expects a number"
));
return
t
rue
;
return
T
rue
;
}
...
...
@@ -820,7 +820,7 @@ core_less_equal(struct environment* env, struct value* args)
{
if
(
IS_NULL
(
args
))
return
t
rue
;
return
T
rue
;
struct
value
*
val
=
HEAD
(
args
);
args
=
TAIL
(
args
);
...
...
@@ -831,11 +831,11 @@ core_less_equal(struct environment* env, struct value* args)
switch
(
next
->
tag
)
{
case
FIXNUM
:
if
(
next
->
fixnum_value
<
val
->
fixnum_value
)
return
f
alse
;
return
F
alse
;
break
;
case
FLOAT
:
if
(
next
->
float_value
<
(
val
->
fixnum_value
))
return
f
alse
;
return
F
alse
;
break
;
default:
...
...
@@ -849,11 +849,11 @@ core_less_equal(struct environment* env, struct value* args)
switch
(
next
->
tag
)
{
case
FIXNUM
:
if
(
next
->
fixnum_value
<
val
->
float_value
)
return
f
alse
;
return
F
alse
;
break
;
case
FLOAT
:
if
(
next
->
float_value
<
val
->
float_value
)
return
f
alse
;
return
F
alse
;
break
;
default:
...
...
@@ -864,14 +864,14 @@ core_less_equal(struct environment* env, struct value* args)
}
else
core_raise
(
env
,
string
(
"> operator expects a number"
));
return
t
rue
;
return
T
rue
;
}
struct
value
*
core_equal
(
struct
environment
*
env
,
struct
value
*
args
)
{
if
(
IS_NULL
(
args
))
return
t
rue
;
return
T
rue
;
struct
value
*
val
=
HEAD
(
args
);
args
=
TAIL
(
args
);
...
...
@@ -882,11 +882,11 @@ core_equal(struct environment* env, struct value* args)
switch
(
next
->
tag
)
{
case
FIXNUM
:
if
(
next
->
fixnum_value
!=
val
->
fixnum_value
)
return
f
alse
;
return
F
alse
;
break
;
case
FLOAT
:
if
(
next
->
float_value
!=
((
float_t
)
val
->
fixnum_value
))
return
f
alse
;
return
F
alse
;
break
;
default:
...
...
@@ -900,11 +900,11 @@ core_equal(struct environment* env, struct value* args)
switch
(
next
->
tag
)
{
case
FIXNUM
:
if
(
next
->
fixnum_value
!=
((
float_t
)
val
->
float_value
))
return
f
alse
;
return
F
alse
;
break
;
case
FLOAT
:
if
(
next
->
float_value
!=
val
->
float_value
)
return
f
alse
;
return
F
alse
;
break
;
default:
...
...
@@ -915,7 +915,7 @@ core_equal(struct environment* env, struct value* args)
}
else
core_raise
(
env
,
string
(
"> operator expects a number"
));
return
t
rue
;
return
T
rue
;
}
...
...
@@ -929,9 +929,9 @@ core_println(struct environment* env, struct value* args)
switch
(
v
->
tag
)
{
case
BOOLEAN
:
if
(
IS_TRUE
(
v
))
printf
(
"
t
rue"
);
printf
(
"
T
rue"
);
else
printf
(
"
f
alse"
);
printf
(
"
F
alse"
);
break
;
case
STRING
:
printf
(
"%s"
,
v
->
string_value
);
...
...
@@ -954,7 +954,7 @@ core_println(struct environment* env, struct value* args)
}
printf
(
"
\n
"
);
return
t
rue
;
return
T
rue
;
}
...
...
@@ -968,7 +968,7 @@ core_exit(struct environment* env, struct value* args)
else
core_raise
(
env
,
string
(
"Exit is expecting a fixnum for the first argument"
));
return
f
alse
;
return
F
alse
;
}
...
...
bootstrap/value.c
View file @
2fda67c6
...
...
@@ -142,10 +142,8 @@ value_alloc(void)
{
struct
value
*
value
=
GC_MALLOC
(
sizeof
(
struct
value
));
if
(
value
==
0
)
{
fprintf
(
stderr
,
"GC: out of memory"
);
exit
(
1
);
}
if
(
value
==
0
)
failure
(
0
,
"can not allocate a value (out of memory)"
);
return
value
;
}
...
...
@@ -323,7 +321,7 @@ cherry_print(FILE* out, struct value* value)
fprintf
(
out
,
"()"
);
break
;
case
BOOLEAN
:
fprintf
(
out
,
(
value
->
boolean_value
)
?
"
t
rue"
:
"
f
alse"
);
fprintf
(
out
,
(
value
->
boolean_value
)
?
"
T
rue"
:
"
F
alse"
);
break
;
case
DOT
:
fprintf
(
out
,
" . "
);
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment