Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Chris Müller
cherry
Commits
fe5c60db
Commit
fe5c60db
authored
Jul 23, 2013
by
Chris Müller
Browse files
Add symbollist based on binary trees
parent
53ae27be
Changes
2
Hide whitespace changes
Inline
Side-by-side
source/bootstrap.c
View file @
fe5c60db
...
...
@@ -24,6 +24,8 @@
// ----------------------------------------------------------------------------
// Default symbols
// ----------------------------------------------------------------------------
static
struct
value
*
global_symbollist
=
NULL
;
struct
value
*
True
=
NULL
;
struct
value
*
False
=
NULL
;
struct
value
*
Emptylist
=
NULL
;
...
...
@@ -54,19 +56,61 @@ alloc_value(void)
struct
value
*
value
=
GC_MALLOC
(
sizeof
(
struct
value
));
if
(
value
==
NULL
)
{
failure
(
"Boehm GC:
out of memory in value allocation
"
);
failure
(
"Boehm GC:
can not allocate a value (out of memory)
"
);
}
return
value
;
}
struct
value
*
alloc_symbol
(
const
byte_t
*
symbol_value
)
{
size_t
size
=
strlen
(
symbol_value
)
+
1
;
byte_t
*
symbol_string
=
GC_MALLOC
(
sizeof
(
byte_t
)
*
size
);
if
(
symbol_string
==
NULL
)
failure
(
"Boehm GC: can not allocate a symbol (out of memory)"
);
else
memcpy
(
symbol_string
,
symbol_value
,
size
);
struct
value
*
value
=
alloc_value
();
value
->
tag
=
SYMBOL
;
value
->
symbol_value
=
symbol_string
;
return
value
;
}
struct
value
*
symbol
(
const
byte_t
*
symbol_value
)
{
struct
value
*
v
=
alloc_value
();
v
->
tag
=
SYMBOL
;
v
->
symbol_value
=
symbol_value
;
return
v
;
struct
value
*
node
=
global_symbollist
;
if
(
IS_NULL
(
node
))
{
global_symbollist
=
SYMBOL_ENTRY
(
alloc_symbol
(
symbol_value
),
Emptylist
,
Emptylist
);
return
HEAD
(
global_symbollist
);
}
while
(
TRUE
)
{
const
byte_t
*
current
=
HEAD
(
node
)
->
symbol_value
;
if
(
strcmp
(
current
,
symbol_value
)
>
0
)
{
if
(
IS_NULL
(
SYMBOL_LEFT
(
node
)))
{
SYMBOL_LEFT
(
node
)
=
SYMBOL_ENTRY
(
alloc_symbol
(
symbol_value
),
Emptylist
,
Emptylist
);
return
HEAD
(
SYMBOL_LEFT
(
node
));
}
else
node
=
SYMBOL_LEFT
(
node
);
}
else
if
(
strcmp
(
current
,
symbol_value
)
<
0
)
{
if
(
IS_NULL
(
SYMBOL_RIGHT
(
node
)))
{
SYMBOL_RIGHT
(
node
)
=
SYMBOL_ENTRY
(
alloc_symbol
(
symbol_value
),
Emptylist
,
Emptylist
);
return
HEAD
(
SYMBOL_RIGHT
(
node
));
}
else
node
=
SYMBOL_RIGHT
(
node
);
}
else
{
return
HEAD
(
node
);
}
}
return
Emptylist
;
}
struct
value
*
...
...
@@ -135,7 +179,7 @@ tuple(size_t size, ...)
v
->
tuple
.
data
=
GC_MALLOC
(
sizeof
(
struct
value
*
)
*
size
);
if
(
v
->
tuple
.
data
==
NULL
)
failure
(
"Boehm GC:
Out of memory in tuple allocation
"
);
failure
(
"Boehm GC:
can not allocate tuple (out of memory)
"
);
va_list
args
;
va_start
(
args
,
size
);
...
...
@@ -193,6 +237,8 @@ initialize(void)
Emptylist
=
alloc_value
();
Emptylist
->
tag
=
EMPTYLIST
;
global_symbollist
=
Emptylist
;
Quote
=
symbol
(
"quote"
);
Define
=
symbol
(
"define"
);
Let
=
symbol
(
"let"
);
...
...
@@ -391,7 +437,7 @@ lex_char(byte_t** begin, byte_t* buffer, size_t buffer_size)
buffer
++
;
p
++
;
}
else
failure
(
"Bufferoverflow in
raw string
literal"
);
failure
(
"Bufferoverflow in
character
literal"
);
}
*
buffer
=
'\0'
;
...
...
@@ -524,7 +570,7 @@ NO_BUFFER_APPEND:
buffer
++
;
p
++
;
}
else
failure
(
"Bufferoverflow in s
ymbol
scanning"
);
failure
(
"Bufferoverflow in s
tring
scanning"
);
}
RETURN_TOKEN:
...
...
@@ -735,6 +781,13 @@ cherry_read(byte_t** src, byte_t* buffer, size_t buffer_size)
return
val
;
}
// ----------------------------------------------------------------------------
// runtime utils
// ----------------------------------------------------------------------------
// ----------------------------------------------------------------------------
// compile
// ----------------------------------------------------------------------------
...
...
@@ -743,6 +796,7 @@ cherry_read(byte_t** src, byte_t* buffer, size_t buffer_size)
struct
closure
*
cherry_compile
(
struct
value
*
ast
,
struct
value
*
env
)
{
return
NULL
;
}
...
...
source/bootstrap.h
View file @
fe5c60db
...
...
@@ -121,17 +121,25 @@ struct value* cons(struct value* head, struct value* tail);
#define list3(A, B, C) cons(A, cons(B, cons(C, emptylist)))
#define list4(A, B, C, D) cons(A, cons(B, cons(C, cons(D, emptylist))))
#define SYMBOL_ENTRY(sym, left, right) \
cons(sym, cons(left, right))
#define SYMBOL_LEFT(node) HEAD(TAIL(node))
#define SYMBOL_RIGHT(node) TAIL(TAIL(node))
struct
closure
{
struct
value
*
(
*
execute
)(
struct
closure
*
self
);
struct
value
*
env
;
struct
value
*
args
;
};
#define IS_CONTINUATION(closure) (((struct closure*) closure)->execute != NULL)
#define EXECUTE(obj) (((struct closure*) obj)->execute((struct closure*)obj))
void
cherry_initialize
(
void
);
struct
value
*
cherry_read
(
byte_t
**
begin
,
byte_t
*
buffer
,
size_t
buffer_size
);
struct
closure
*
cherry_compile
(
struct
value
*
ast
,
struct
value
*
env
);
struct
value
*
cherry_eval
(
struct
closure
*
code
);
void
cherry_write
(
FILE
*
out
,
struct
value
*
v
);
void
cherry_initialize
(
void
);
struct
value
*
cherry_read
(
byte_t
**
begin
,
byte_t
*
buffer
,
size_t
buffer_size
);
struct
closure
*
cherry_compile
(
struct
value
*
ast
,
struct
value
*
env
);
struct
value
*
cherry_eval
(
struct
closure
*
code
);
void
cherry_write
(
FILE
*
out
,
struct
value
*
v
);
Write
Preview
Markdown
is supported
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