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
e77c61ab
Commit
e77c61ab
authored
Jul 25, 2013
by
Chris Müller
Browse files
Add ports to the runtime representation
parent
b9b7b612
Changes
3
Hide whitespace changes
Inline
Side-by-side
bootstrap/bootstrap.h
View file @
e77c61ab
...
...
@@ -46,7 +46,8 @@ typedef struct value* (*primitive_t)(struct environment* env, struct value* args
enum
value_type
{
EMPTYLIST
,
BOOLEAN
,
DOT
,
FIXNUM
,
FLOAT
,
STRING
,
CHAR
,
PAIR
,
TUPLE
,
SYMBOL
,
PRIMITIVE
,
PROCEDURE
TUPLE
,
SYMBOL
,
PRIMITIVE
,
PROCEDURE
,
PORT
};
...
...
@@ -62,6 +63,7 @@ struct value {
primitive_t
fun_value
;
const
byte_t
*
string_value
;
const
byte_t
*
symbol_value
;
FILE
*
port_value
;
// lists
struct
{
...
...
@@ -94,9 +96,11 @@ struct value {
#define IS_SYMBOL(value) (value->tag == SYMBOL)
#define IS_FLOAT(value) (value->tag == FLOAT)
#define IS_CHAR(value) (value->tag == CHAR)
#define IS_TUPLE(value) (value->tag == TUPLE)
#define IS_PAIR(value) (value->tag == PAIR)
#define IS_PRIMITIVE(value) (value->tag == PRIMITIVE)
#define IS_PROCEDURE(value) (value->tag == PROCEDURE)
#define IS_PORT(value) (value->tag == PORT)
#define TUPLE_DATA(obj) (obj->tuple.data)
#define TUPLE_SIZE(obj) (obj->tuple.size)
...
...
@@ -119,6 +123,7 @@ struct value* floatpoint(float_t float_value);
struct
value
*
string
(
const
byte_t
*
string_value
);
struct
value
*
character
(
unicode_t
char_value
);
struct
value
*
primitive
(
primitive_t
fun_value
);
struct
value
*
port
(
FILE
*
stream
);
struct
value
*
value_dup
(
struct
value
*
value
);
...
...
@@ -180,7 +185,7 @@ extern struct value* symbol_begin;
#define IS_TRUE(obj) (!IS_FALSE(obj))
#define IS_SELF_EVALUATING(value) \
(IS_BOOLEAN(value) || IS_FIXNUM(value) || IS_CHAR(value) || IS_STRING(value) || IS_FLOAT(value) || IS_PROCEDURE(value))
(IS_BOOLEAN(value) || IS_FIXNUM(value) || IS_CHAR(value) || IS_STRING(value) || IS_FLOAT(value) || IS_PROCEDURE(value)
|| IS_PORT(value)
)
#define IS_LIST(obj) (IS_PAIR(obj) || IS_NULL(obj))
...
...
bootstrap/runtime.c
View file @
e77c61ab
...
...
@@ -38,6 +38,10 @@ struct value* symbol_quote;
struct
value
*
symbol_loop
;
struct
value
*
symbol_begin
;
struct
value
*
STDIN
;
struct
value
*
STDOUT
;
struct
value
*
STDERR
;
void
initialize
(
struct
value
*
arguments
)
...
...
@@ -68,6 +72,10 @@ initialize(struct value* arguments)
symbol_if
=
symbol
(
"if"
);
symbol_loop
=
symbol
(
"loop"
);
symbol_begin
=
symbol
(
"begin"
);
STDIN
=
port
(
stdin
);
STDOUT
=
port
(
stdout
);
STDERR
=
port
(
stderr
);
}
...
...
@@ -139,6 +147,19 @@ core_list(struct environment* env, struct value* args)
}
struct
value
*
core_is_list
(
struct
environment
*
env
,
struct
value
*
args
)
{
if
(
IS_NULL
(
args
))
core_raise
(
env
,
string
(
"cherry.core/list?: expects one value"
));
return
(
IS_NULL
(
HEAD
(
args
))
||
IS_PAIR
(
HEAD
(
args
)))
&&
(
IS_NULL
(
TAIL
(
HEAD
(
args
)))
||
IS_PAIR
(
TAIL
(
HEAD
(
args
))))
?
True
:
False
;
}
struct
value
*
core_is_null
(
struct
environment
*
env
,
struct
value
*
args
)
{
...
...
@@ -346,6 +367,15 @@ core_list_to_tuple(struct environment* env, struct value* args)
}
struct
value
*
core_is_tuple
(
struct
environment
*
env
,
struct
value
*
args
)
{
if
(
IS_NULL
(
args
))
return
False
;
return
IS_TUPLE
(
HEAD
(
args
))
?
True
:
False
;
}
struct
value
*
core_tuple
(
struct
environment
*
env
,
struct
value
*
args
)
...
...
@@ -958,6 +988,78 @@ core_equal(struct environment* env, struct value* args)
}
struct
value
*
core_is_number
(
struct
environment
*
env
,
struct
value
*
args
)
{
if
(
IS_NULL
(
args
))
return
False
;
return
IS_FIXNUM
(
HEAD
(
args
))
?
True
:
False
;
}
struct
value
*
core_number_to_string
(
struct
environment
*
env
,
struct
value
*
args
)
{
if
(
IS_NULL
(
args
)
||
!
IS_FIXNUM
(
HEAD
(
args
)))
core_raise
(
env
,
string
(
"cherry.core/number->string: expects a number"
));
char
buffer
[
64
];
snprintf
(
buffer
,
64
,
"%ld"
,
HEAD
(
args
)
->
fixnum_value
);
return
string
(
string_dup
(
buffer
));
}
struct
value
*
core_number_to_float
(
struct
environment
*
env
,
struct
value
*
args
)
{
if
(
IS_NULL
(
args
)
||
!
IS_FIXNUM
(
HEAD
(
args
)))
core_raise
(
env
,
string
(
"cherry.core/number->float: expects a number"
));
return
floatpoint
((
float_t
)
HEAD
(
args
)
->
fixnum_value
);
}
struct
value
*
core_number_to_char
(
struct
environment
*
env
,
struct
value
*
args
)
{
if
(
IS_NULL
(
args
)
||
!
IS_FIXNUM
(
HEAD
(
args
)))
core_raise
(
env
,
string
(
"cherry.core/number->char: expects a number"
));
return
character
(
HEAD
(
args
)
->
fixnum_value
);
}
struct
value
*
core_is_float
(
struct
environment
*
env
,
struct
value
*
args
)
{
if
(
IS_NULL
(
args
))
return
False
;
return
IS_FLOAT
(
HEAD
(
args
))
?
True
:
False
;
}
struct
value
*
core_float_to_string
(
struct
environment
*
env
,
struct
value
*
args
)
{
if
(
IS_NULL
(
args
)
||
!
IS_FLOAT
(
HEAD
(
args
)))
core_raise
(
env
,
string
(
"cherry.core/float->string: expects a float"
));
char
buffer
[
64
];
snprintf
(
buffer
,
64
,
"%lf"
,
HEAD
(
args
)
->
float_value
);
return
string
(
string_dup
(
buffer
));
}
struct
value
*
core_float_to_number
(
struct
environment
*
env
,
struct
value
*
args
)
{
if
(
IS_NULL
(
args
)
||
!
IS_FLOAT
(
HEAD
(
args
)))
core_raise
(
env
,
string
(
"cherry.core/float->number: expects a number"
));
return
fixnum
((
fixnum_t
)
HEAD
(
args
)
->
float_value
);
}
struct
value
*
...
...
@@ -1020,6 +1122,10 @@ environment(void)
#define proc_to_env(ENV, STR, FUN) \
env_add(ENV, symbol(STR), primitive(FUN))
env_add
(
env
,
symbol
(
"*out*"
),
STDOUT
);
env_add
(
env
,
symbol
(
"*in*"
),
STDIN
);
env_add
(
env
,
symbol
(
"*err*"
),
STDERR
);
proc_to_env
(
env
,
"println"
,
core_println
);
proc_to_env
(
env
,
"type"
,
core_type
);
proc_to_env
(
env
,
"+"
,
core_add
);
...
...
@@ -1040,10 +1146,12 @@ environment(void)
proc_to_env
(
env
,
"head"
,
core_head
);
proc_to_env
(
env
,
"tail"
,
core_tail
);
proc_to_env
(
env
,
"null?"
,
core_is_null
);
proc_to_env
(
env
,
"
map
"
,
core_
map
);
proc_to_env
(
env
,
"
list?
"
,
core_
is_list
);
proc_to_env
(
env
,
"list->string"
,
core_list_to_string
);
proc_to_env
(
env
,
"list->tuple"
,
core_list_to_tuple
);
proc_to_env
(
env
,
"map"
,
core_map
);
proc_to_env
(
env
,
"tuple?"
,
core_is_tuple
);
proc_to_env
(
env
,
"tuple"
,
core_tuple
);
proc_to_env
(
env
,
"length"
,
core_length
);
proc_to_env
(
env
,
"nth"
,
core_nth
);
...
...
@@ -1051,6 +1159,15 @@ environment(void)
proc_to_env
(
env
,
"make-list"
,
core_make_list
);
proc_to_env
(
env
,
"make-tuple"
,
core_make_tuple
);
proc_to_env
(
env
,
"number?"
,
core_is_number
);
proc_to_env
(
env
,
"number->string"
,
core_number_to_string
);
proc_to_env
(
env
,
"number->float"
,
core_number_to_float
);
proc_to_env
(
env
,
"number->char"
,
core_number_to_char
);
proc_to_env
(
env
,
"float?"
,
core_is_float
);
proc_to_env
(
env
,
"float->string"
,
core_float_to_string
);
proc_to_env
(
env
,
"float->number"
,
core_float_to_number
);
proc_to_env
(
env
,
"string?"
,
core_is_string
);
proc_to_env
(
env
,
"string->list"
,
core_string_to_list
);
proc_to_env
(
env
,
"string->tuple"
,
core_string_to_tuple
);
...
...
bootstrap/value.c
View file @
e77c61ab
...
...
@@ -169,6 +169,16 @@ floatpoint(float_t value)
}
struct
value
*
port
(
FILE
*
stream
)
{
struct
value
*
v
=
value_alloc
();
v
->
tag
=
PORT
;
v
->
port_value
=
stream
;
return
v
;
}
struct
value
*
string
(
const
byte_t
*
value
)
{
...
...
@@ -414,6 +424,9 @@ cherry_print(FILE* out, struct value* value)
break
;
case
PROCEDURE
:
fprintf
(
out
,
"#lambda-procedure"
);
break
;
case
PORT
:
fprintf
(
out
,
"#port"
);
break
;
case
PAIR
:
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