Merge branch 'trie-reader'
This commit is contained in:
Yuichi Nishiwaki
commit
79417040e6
|
|
@ -75,15 +75,15 @@ typedef struct {
|
|||
|
||||
pic_sym sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE, sSETBANG;
|
||||
pic_sym sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING;
|
||||
pic_sym sDEFINE_SYNTAX;
|
||||
pic_sym sDEFINE_LIBRARY, sIMPORT, sEXPORT;
|
||||
pic_sym sDEFINE_SYNTAX, sIMPORT, sEXPORT;
|
||||
pic_sym sDEFINE_LIBRARY, sIN_LIBRARY;
|
||||
pic_sym sCONS, sCAR, sCDR, sNILP;
|
||||
pic_sym sADD, sSUB, sMUL, sDIV, sMINUS;
|
||||
pic_sym sEQ, sLT, sLE, sGT, sGE, sNOT;
|
||||
|
||||
pic_sym rDEFINE, rLAMBDA, rIF, rBEGIN, rQUOTE, rSETBANG;
|
||||
pic_sym rDEFINE_SYNTAX;
|
||||
pic_sym rDEFINE_LIBRARY, rIMPORT, rEXPORT;
|
||||
pic_sym rDEFINE_SYNTAX, rIMPORT, rEXPORT;
|
||||
pic_sym rDEFINE_LIBRARY, rIN_LIBRARY;
|
||||
|
||||
xhash syms; /* name to symbol */
|
||||
xhash sym_names; /* symbol to name */
|
||||
|
|
@ -94,8 +94,7 @@ typedef struct {
|
|||
xhash macros;
|
||||
pic_value libs;
|
||||
|
||||
bool rfcase;
|
||||
xhash rlabels;
|
||||
struct pic_reader *reader;
|
||||
|
||||
jmp_buf *jmp;
|
||||
struct pic_error *err;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,39 @@
|
|||
/**
|
||||
* See Copyright Notice in picrin.h
|
||||
*/
|
||||
|
||||
#ifndef PICRIN_READ_H__
|
||||
#define PICRIN_READ_H__
|
||||
|
||||
#if defined(__cplusplus)
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
enum pic_typecase {
|
||||
PIC_CASE_DEFAULT,
|
||||
PIC_CASE_FOLD,
|
||||
};
|
||||
|
||||
struct pic_trie {
|
||||
struct pic_trie *table[256];
|
||||
struct pic_proc *proc;
|
||||
};
|
||||
|
||||
struct pic_reader {
|
||||
short typecase;
|
||||
xhash labels;
|
||||
struct pic_trie *trie;
|
||||
};
|
||||
|
||||
void pic_init_reader(pic_state *);
|
||||
|
||||
void pic_define_reader(pic_state *, const char *, pic_func_t);
|
||||
|
||||
struct pic_trie *pic_trie_new(pic_state *);
|
||||
void pic_trie_delete(pic_state *, struct pic_trie *);
|
||||
|
||||
#if defined(__cplusplus)
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif
|
||||
19
src/gc.c
19
src/gc.c
|
|
@ -21,6 +21,7 @@
|
|||
#include "picrin/data.h"
|
||||
#include "picrin/dict.h"
|
||||
#include "picrin/record.h"
|
||||
#include "picrin/read.h"
|
||||
|
||||
#if GC_DEBUG
|
||||
# include <string.h>
|
||||
|
|
@ -550,6 +551,21 @@ gc_mark(pic_state *pic, pic_value v)
|
|||
gc_mark_object(pic, obj);
|
||||
}
|
||||
|
||||
static void
|
||||
gc_mark_trie(pic_state *pic, struct pic_trie *trie)
|
||||
{
|
||||
size_t i;
|
||||
|
||||
for (i = 0; i < sizeof trie->table / sizeof(struct pic_trie *); ++i) {
|
||||
if (trie->table[i] != NULL) {
|
||||
gc_mark_trie(pic, trie->table[i]);
|
||||
}
|
||||
}
|
||||
if (trie->proc != NULL) {
|
||||
gc_mark_object(pic, (struct pic_object *)trie->proc);
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
gc_mark_phase(pic_state *pic)
|
||||
{
|
||||
|
|
@ -604,6 +620,9 @@ gc_mark_phase(pic_state *pic)
|
|||
}
|
||||
}
|
||||
|
||||
/* readers */
|
||||
gc_mark_trie(pic, pic->reader->trie);
|
||||
|
||||
/* library table */
|
||||
gc_mark(pic, pic->libs);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -6,6 +6,7 @@
|
|||
|
||||
#include "picrin.h"
|
||||
#include "picrin/pair.h"
|
||||
#include "picrin/read.h"
|
||||
#include "picrin/lib.h"
|
||||
#include "picrin/macro.h"
|
||||
#include "picrin/error.h"
|
||||
|
|
@ -73,6 +74,8 @@ pic_init_core(pic_state *pic)
|
|||
{
|
||||
size_t ai = pic_gc_arena_preserve(pic);
|
||||
|
||||
pic_init_reader(pic);
|
||||
|
||||
pic_deflibrary (pic, "(picrin base core)") {
|
||||
pic_define_syntactic_keyword(pic, pic->lib->env, pic->sDEFINE, pic->rDEFINE);
|
||||
pic_define_syntactic_keyword(pic, pic->lib->env, pic->sSETBANG, pic->rSETBANG);
|
||||
|
|
|
|||
13
src/lib.c
13
src/lib.c
|
|
@ -249,6 +249,18 @@ pic_lib_define_library(pic_state *pic)
|
|||
return pic_none_value();
|
||||
}
|
||||
|
||||
static pic_value
|
||||
pic_lib_in_library(pic_state *pic)
|
||||
{
|
||||
pic_value spec;
|
||||
|
||||
pic_get_args(pic, "o", &spec);
|
||||
|
||||
pic_in_library(pic, spec);
|
||||
|
||||
return pic_none_value();
|
||||
}
|
||||
|
||||
void
|
||||
pic_init_lib(pic_state *pic)
|
||||
{
|
||||
|
|
@ -257,4 +269,5 @@ pic_init_lib(pic_state *pic)
|
|||
pic_defmacro(pic, pic->sIMPORT, pic->rIMPORT, pic_lib_import);
|
||||
pic_defmacro(pic, pic->sEXPORT, pic->rEXPORT, pic_lib_export);
|
||||
pic_defmacro(pic, pic->sDEFINE_LIBRARY, pic->rDEFINE_LIBRARY, pic_lib_define_library);
|
||||
pic_defmacro(pic, pic->sIN_LIBRARY, pic->rIN_LIBRARY, pic_lib_in_library);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -364,6 +364,7 @@ pic_null_syntactic_environment(pic_state *pic)
|
|||
pic_define_syntactic_keyword(pic, senv, pic->sDEFINE_LIBRARY, pic->rDEFINE_LIBRARY);
|
||||
pic_define_syntactic_keyword(pic, senv, pic->sIMPORT, pic->rIMPORT);
|
||||
pic_define_syntactic_keyword(pic, senv, pic->sEXPORT, pic->rEXPORT);
|
||||
pic_define_syntactic_keyword(pic, senv, pic->sIN_LIBRARY, pic->rIN_LIBRARY);
|
||||
|
||||
return senv;
|
||||
}
|
||||
|
|
|
|||
404
src/read.c
404
src/read.c
|
|
@ -6,14 +6,14 @@
|
|||
#include <math.h>
|
||||
#include <stdlib.h>
|
||||
#include "picrin.h"
|
||||
#include "picrin/read.h"
|
||||
#include "picrin/error.h"
|
||||
#include "picrin/pair.h"
|
||||
#include "picrin/string.h"
|
||||
#include "picrin/vector.h"
|
||||
#include "picrin/blob.h"
|
||||
#include "picrin/port.h"
|
||||
|
||||
typedef pic_value (*read_func_t)(pic_state *, struct pic_port *, int);
|
||||
#include "picrin/proc.h"
|
||||
|
||||
static pic_value read(pic_state *pic, struct pic_port *port, int c);
|
||||
static pic_value read_nullable(pic_state *pic, struct pic_port *port, int c);
|
||||
|
|
@ -82,9 +82,12 @@ strcaseeq(const char *s1, const char *s2)
|
|||
}
|
||||
|
||||
static pic_value
|
||||
read_comment(pic_state *pic, struct pic_port *port, int c)
|
||||
read_comment(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
int c;
|
||||
|
||||
UNUSED(pic);
|
||||
UNUSED(str);
|
||||
|
||||
do {
|
||||
c = next(port);
|
||||
|
|
@ -94,13 +97,13 @@ read_comment(pic_state *pic, struct pic_port *port, int c)
|
|||
}
|
||||
|
||||
static pic_value
|
||||
read_block_comment(pic_state *pic, struct pic_port *port, int c)
|
||||
read_block_comment(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
int x, y;
|
||||
int i = 1;
|
||||
|
||||
UNUSED(pic);
|
||||
UNUSED(c);
|
||||
UNUSED(str);
|
||||
|
||||
y = next(port);
|
||||
|
||||
|
|
@ -119,9 +122,9 @@ read_block_comment(pic_state *pic, struct pic_port *port, int c)
|
|||
}
|
||||
|
||||
static pic_value
|
||||
read_datum_comment(pic_state *pic, struct pic_port *port, int c)
|
||||
read_datum_comment(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
UNUSED(c);
|
||||
UNUSED(str);
|
||||
|
||||
read(pic, port, next(port));
|
||||
|
||||
|
|
@ -129,32 +132,32 @@ read_datum_comment(pic_state *pic, struct pic_port *port, int c)
|
|||
}
|
||||
|
||||
static pic_value
|
||||
read_directive(pic_state *pic, struct pic_port *port, int c)
|
||||
read_directive(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
switch (peek(port)) {
|
||||
case 'n':
|
||||
if (expect(port, "no-fold-case")) {
|
||||
pic->rfcase = false;
|
||||
pic->reader->typecase = PIC_CASE_DEFAULT;
|
||||
return pic_undef_value();
|
||||
}
|
||||
break;
|
||||
case 'f':
|
||||
if (expect(port, "fold-case")) {
|
||||
pic->rfcase = true;
|
||||
pic->reader->typecase = PIC_CASE_FOLD;
|
||||
return pic_undef_value();
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
return read_comment(pic, port, c);
|
||||
return read_comment(pic, port, str);
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_eval(pic_state *pic, struct pic_port *port, int c)
|
||||
read_eval(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
pic_value form;
|
||||
|
||||
UNUSED(c);
|
||||
UNUSED(str);
|
||||
|
||||
form = read(pic, port, next(port));
|
||||
|
||||
|
|
@ -162,54 +165,65 @@ read_eval(pic_state *pic, struct pic_port *port, int c)
|
|||
}
|
||||
|
||||
static pic_value
|
||||
read_quote(pic_state *pic, struct pic_port *port, int c)
|
||||
read_quote(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
UNUSED(c);
|
||||
UNUSED(str);
|
||||
|
||||
return pic_list2(pic, pic_sym_value(pic->sQUOTE), read(pic, port, next(port)));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_quasiquote(pic_state *pic, struct pic_port *port, int c)
|
||||
read_quasiquote(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
UNUSED(c);
|
||||
UNUSED(str);
|
||||
|
||||
return pic_list2(pic, pic_sym_value(pic->sQUASIQUOTE), read(pic, port, next(port)));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_comma(pic_state *pic, struct pic_port *port, int c)
|
||||
read_unquote(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
c = next(port);
|
||||
UNUSED(str);
|
||||
|
||||
if (c == '@') {
|
||||
return pic_list2(pic, pic_sym_value(pic->sUNQUOTE_SPLICING), read(pic, port, next(port)));
|
||||
} else {
|
||||
return pic_list2(pic, pic_sym_value(pic->sUNQUOTE), read(pic, port, c));
|
||||
}
|
||||
return pic_list2(pic, pic_sym_value(pic->sUNQUOTE), read(pic, port, next(port)));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_symbol(pic_state *pic, struct pic_port *port, int c)
|
||||
read_unquote_splicing(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
size_t len;
|
||||
UNUSED(str);
|
||||
|
||||
return pic_list2(pic, pic_sym_value(pic->sUNQUOTE_SPLICING), read(pic, port, next(port)));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_symbol(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
size_t len, i;
|
||||
char *buf;
|
||||
pic_sym sym;
|
||||
int c;
|
||||
|
||||
len = 0;
|
||||
buf = NULL;
|
||||
len = strlen(str);
|
||||
buf = pic_calloc(pic, 1, len + 1);
|
||||
|
||||
do {
|
||||
if (len != 0) {
|
||||
c = next(port);
|
||||
for (i = 0; i < len; ++i) {
|
||||
if (pic->reader->typecase == PIC_CASE_FOLD) {
|
||||
buf[i] = tolower(str[i]);
|
||||
} else {
|
||||
buf[i] = str[i];
|
||||
}
|
||||
if (pic->rfcase) {
|
||||
}
|
||||
|
||||
while (! isdelim(peek(port))) {
|
||||
c = next(port);
|
||||
if (pic->reader->typecase == PIC_CASE_FOLD) {
|
||||
c = tolower(c);
|
||||
}
|
||||
len += 1;
|
||||
buf = pic_realloc(pic, buf, len + 1);
|
||||
buf[len - 1] = c;
|
||||
} while (! isdelim(peek(port)));
|
||||
}
|
||||
|
||||
sym = pic_intern(pic, buf, len);
|
||||
pic_free(pic, buf);
|
||||
|
|
@ -240,7 +254,7 @@ static size_t
|
|||
read_suffix(pic_state *pic, struct pic_port *port, char buf[])
|
||||
{
|
||||
size_t i = 0;
|
||||
char c;
|
||||
int c;
|
||||
|
||||
c = peek(port);
|
||||
|
||||
|
|
@ -261,7 +275,7 @@ read_suffix(pic_state *pic, struct pic_port *port, char buf[])
|
|||
}
|
||||
|
||||
static pic_value
|
||||
read_number(pic_state *pic, struct pic_port *port, int c)
|
||||
read_unsigned(pic_state *pic, struct pic_port *port, int c)
|
||||
{
|
||||
char buf[256];
|
||||
size_t i;
|
||||
|
|
@ -281,6 +295,12 @@ read_number(pic_state *pic, struct pic_port *port, int c)
|
|||
}
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_number(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
return read_unsigned(pic, port, str[0]);
|
||||
}
|
||||
|
||||
static pic_value
|
||||
negate(pic_value n)
|
||||
{
|
||||
|
|
@ -292,15 +312,15 @@ negate(pic_value n)
|
|||
}
|
||||
|
||||
static pic_value
|
||||
read_minus(pic_state *pic, struct pic_port *port, int c)
|
||||
read_minus(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
pic_value sym;
|
||||
|
||||
if (isdigit(peek(port))) {
|
||||
return negate(read_number(pic, port, next(port)));
|
||||
return negate(read_unsigned(pic, port, next(port)));
|
||||
}
|
||||
else {
|
||||
sym = read_symbol(pic, port, c);
|
||||
sym = read_symbol(pic, port, str);
|
||||
if (strcaseeq(pic_symbol_name(pic, pic_sym(sym)), "-inf.0")) {
|
||||
return pic_float_value(-INFINITY);
|
||||
}
|
||||
|
|
@ -312,56 +332,52 @@ read_minus(pic_state *pic, struct pic_port *port, int c)
|
|||
}
|
||||
|
||||
static pic_value
|
||||
read_plus(pic_state *pic, struct pic_port *port, int c)
|
||||
read_plus(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
pic_value sym;
|
||||
|
||||
if (isdigit(peek(port))) {
|
||||
return read_number(pic, port, next(port));
|
||||
return read_unsigned(pic, port, next(port));
|
||||
}
|
||||
else {
|
||||
sym = read_symbol(pic, port, c);
|
||||
sym = read_symbol(pic, port, str);
|
||||
if (strcaseeq(pic_symbol_name(pic, pic_sym(sym)), "+inf.0")) {
|
||||
return pic_float_value(INFINITY);
|
||||
}
|
||||
if (strcaseeq(pic_symbol_name(pic, pic_sym(sym)), "+nan.0")) {
|
||||
return pic_float_value(NAN);
|
||||
}
|
||||
return read_symbol(pic, port, c);
|
||||
return sym;
|
||||
}
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_boolean(pic_state *pic, struct pic_port *port, int c)
|
||||
read_true(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
UNUSED(pic);
|
||||
UNUSED(port);
|
||||
UNUSED(str);
|
||||
|
||||
if (! isdelim(peek(port))) {
|
||||
if (c == 't') {
|
||||
if (! expect(port, "rue")) {
|
||||
goto fail;
|
||||
}
|
||||
} else {
|
||||
if (! expect(port, "alse")) {
|
||||
goto fail;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (c == 't') {
|
||||
return pic_true_value();
|
||||
} else {
|
||||
return pic_false_value();
|
||||
}
|
||||
|
||||
fail:
|
||||
read_error(pic, "illegal character during reading boolean literal");
|
||||
return pic_true_value();
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_char(pic_state *pic, struct pic_port *port, int c)
|
||||
read_false(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
UNUSED(pic);
|
||||
UNUSED(port);
|
||||
UNUSED(str);
|
||||
|
||||
return pic_false_value();
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_char(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
int c;
|
||||
|
||||
UNUSED(str);
|
||||
|
||||
c = next(port);
|
||||
|
||||
if (! isdelim(peek(port))) {
|
||||
|
|
@ -395,12 +411,15 @@ read_char(pic_state *pic, struct pic_port *port, int c)
|
|||
}
|
||||
|
||||
static pic_value
|
||||
read_string(pic_state *pic, struct pic_port *port, int c)
|
||||
read_string(pic_state *pic, struct pic_port *port, const char *name)
|
||||
{
|
||||
int c;
|
||||
char *buf;
|
||||
size_t size, cnt;
|
||||
pic_str *str;
|
||||
|
||||
UNUSED(name);
|
||||
|
||||
size = 256;
|
||||
buf = pic_alloc(pic, size);
|
||||
cnt = 0;
|
||||
|
|
@ -430,7 +449,7 @@ read_string(pic_state *pic, struct pic_port *port, int c)
|
|||
}
|
||||
|
||||
static pic_value
|
||||
read_pipe(pic_state *pic, struct pic_port *port, char c)
|
||||
read_pipe(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
char *buf;
|
||||
size_t size, cnt;
|
||||
|
|
@ -438,6 +457,9 @@ read_pipe(pic_state *pic, struct pic_port *port, char c)
|
|||
/* Currently supports only ascii chars */
|
||||
char HEX_BUF[3];
|
||||
size_t i = 0;
|
||||
int c;
|
||||
|
||||
UNUSED(str);
|
||||
|
||||
size = 256;
|
||||
buf = pic_alloc(pic, size);
|
||||
|
|
@ -474,13 +496,15 @@ read_pipe(pic_state *pic, struct pic_port *port, char c)
|
|||
}
|
||||
|
||||
static pic_value
|
||||
read_unsigned_blob(pic_state *pic, struct pic_port *port, int c)
|
||||
read_blob(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
int nbits, n;
|
||||
int nbits, n, c;
|
||||
size_t len, i;
|
||||
char *dat, buf[256];
|
||||
pic_blob *blob;
|
||||
|
||||
UNUSED(str);
|
||||
|
||||
nbits = 0;
|
||||
|
||||
while (isdigit(c = next(port))) {
|
||||
|
|
@ -520,10 +544,11 @@ read_unsigned_blob(pic_state *pic, struct pic_port *port, int c)
|
|||
}
|
||||
|
||||
static pic_value
|
||||
read_pair(pic_state *pic, struct pic_port *port, int c)
|
||||
read_pair(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
char tOPEN = c, tCLOSE = (tOPEN == '(') ? ')' : ']';
|
||||
const int tCLOSE = (str[0] == '(') ? ')' : ']';
|
||||
pic_value car, cdr;
|
||||
int c;
|
||||
|
||||
retry:
|
||||
|
||||
|
|
@ -551,17 +576,17 @@ read_pair(pic_state *pic, struct pic_port *port, int c)
|
|||
goto retry;
|
||||
}
|
||||
|
||||
cdr = read_pair(pic, port, tOPEN); /* FIXME: don't use recursion */
|
||||
cdr = read_pair(pic, port, str);
|
||||
return pic_cons(pic, car, cdr);
|
||||
}
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_vector(pic_state *pic, struct pic_port *port, int c)
|
||||
read_vector(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
pic_value list;
|
||||
|
||||
list = read(pic, port, c);
|
||||
list = read(pic, port, str[1]);
|
||||
|
||||
return pic_obj_value(pic_vec_new_from_list(pic, list));
|
||||
}
|
||||
|
|
@ -579,7 +604,7 @@ read_label_set(pic_state *pic, struct pic_port *port, int i)
|
|||
|
||||
val = pic_cons(pic, pic_none_value(), pic_none_value());
|
||||
|
||||
xh_put_int(&pic->rlabels, i, &val);
|
||||
xh_put_int(&pic->reader->labels, i, &val);
|
||||
|
||||
tmp = read(pic, port, c);
|
||||
pic_pair_ptr(val)->car = pic_car(pic, tmp);
|
||||
|
|
@ -602,7 +627,7 @@ read_label_set(pic_state *pic, struct pic_port *port, int i)
|
|||
|
||||
val = pic_obj_value(pic_vec_new(pic, 0));
|
||||
|
||||
xh_put_int(&pic->rlabels, i, &val);
|
||||
xh_put_int(&pic->reader->labels, i, &val);
|
||||
|
||||
tmp = pic_vec_ptr(read(pic, port, c));
|
||||
SWAP(pic_value *, tmp->data, pic_vec_ptr(val)->data);
|
||||
|
|
@ -617,7 +642,7 @@ read_label_set(pic_state *pic, struct pic_port *port, int i)
|
|||
{
|
||||
val = read(pic, port, c);
|
||||
|
||||
xh_put_int(&pic->rlabels, i, &val);
|
||||
xh_put_int(&pic->reader->labels, i, &val);
|
||||
|
||||
return val;
|
||||
}
|
||||
|
|
@ -631,7 +656,7 @@ read_label_ref(pic_state *pic, struct pic_port *port, int i)
|
|||
|
||||
UNUSED(port);
|
||||
|
||||
e = xh_get_int(&pic->rlabels, i);
|
||||
e = xh_get_int(&pic->reader->labels, i);
|
||||
if (! e) {
|
||||
read_error(pic, "label of given index not defined");
|
||||
}
|
||||
|
|
@ -639,11 +664,12 @@ read_label_ref(pic_state *pic, struct pic_port *port, int i)
|
|||
}
|
||||
|
||||
static pic_value
|
||||
read_label(pic_state *pic, struct pic_port *port, int c)
|
||||
read_label(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
int i;
|
||||
int i, c;
|
||||
|
||||
i = 0;
|
||||
c = str[1]; /* initial index letter */
|
||||
do {
|
||||
i = i * 10 + c;
|
||||
} while (isdigit(c = next(port)));
|
||||
|
|
@ -658,73 +684,54 @@ read_label(pic_state *pic, struct pic_port *port, int c)
|
|||
}
|
||||
|
||||
static pic_value
|
||||
read_dispatch(pic_state *pic, struct pic_port *port, int c)
|
||||
read_unmatch(pic_state *pic, struct pic_port *port, const char *str)
|
||||
{
|
||||
c = next(port);
|
||||
UNUSED(port);
|
||||
UNUSED(str);
|
||||
|
||||
switch (c) {
|
||||
case '!':
|
||||
return read_directive(pic, port, c);
|
||||
case '|':
|
||||
return read_block_comment(pic, port, c);
|
||||
case ';':
|
||||
return read_datum_comment(pic, port, c);
|
||||
case 't': case 'f':
|
||||
return read_boolean(pic, port, c);
|
||||
case '\\':
|
||||
return read_char(pic, port, c);
|
||||
case '(':
|
||||
return read_vector(pic, port, c);
|
||||
case '0': case '1': case '2': case '3': case '4':
|
||||
case '5': case '6': case '7': case '8': case '9':
|
||||
return read_label(pic, port, c);
|
||||
case 'u':
|
||||
return read_unsigned_blob(pic, port, c);
|
||||
case '.':
|
||||
return read_eval(pic, port, c);
|
||||
default:
|
||||
read_error(pic, "unexpected dispatch character");
|
||||
}
|
||||
read_error(pic, "unmatched parenthesis");
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_nullable(pic_state *pic, struct pic_port *port, int c)
|
||||
{
|
||||
struct pic_trie *trie = pic->reader->trie;
|
||||
char buf[128];
|
||||
size_t i = 0;
|
||||
pic_str *str;
|
||||
|
||||
c = skip(port, c);
|
||||
|
||||
if (c == EOF) {
|
||||
read_error(pic, "unexpected EOF");
|
||||
}
|
||||
|
||||
switch (c) {
|
||||
case ')':
|
||||
read_error(pic, "unmatched parenthesis");
|
||||
case ';':
|
||||
return read_comment(pic, port, c);
|
||||
case '#':
|
||||
return read_dispatch(pic, port, c);
|
||||
case '\'':
|
||||
return read_quote(pic, port, c);
|
||||
case '`':
|
||||
return read_quasiquote(pic, port, c);
|
||||
case ',':
|
||||
return read_comma(pic, port, c);
|
||||
case '"':
|
||||
return read_string(pic, port, c);
|
||||
case '|':
|
||||
return read_pipe(pic, port, c);
|
||||
case '0': case '1': case '2': case '3': case '4':
|
||||
case '5': case '6': case '7': case '8': case '9':
|
||||
return read_number(pic, port, c);
|
||||
case '+':
|
||||
return read_plus(pic, port, c);
|
||||
case '-':
|
||||
return read_minus(pic, port, c);
|
||||
case '(': case '[':
|
||||
return read_pair(pic, port, c);
|
||||
default:
|
||||
return read_symbol(pic, port, c);
|
||||
if (trie->table[c] == NULL) {
|
||||
read_error(pic, "invalid character at the seeker head");
|
||||
}
|
||||
|
||||
buf[i++] = c;
|
||||
|
||||
while (i < sizeof buf) {
|
||||
trie = trie->table[c];
|
||||
|
||||
if ((c = peek(port)) == EOF) {
|
||||
break;
|
||||
}
|
||||
if (trie->table[c] == NULL) {
|
||||
break;
|
||||
}
|
||||
buf[i++] = next(port);
|
||||
}
|
||||
if (i == sizeof buf) {
|
||||
read_error(pic, "too long dispatch string");
|
||||
}
|
||||
|
||||
if (trie->proc == NULL) {
|
||||
read_error(pic, "no reader registered for current string");
|
||||
}
|
||||
str = pic_str_new(pic, buf, i);
|
||||
return pic_apply2(pic, trie->proc, pic_obj_value(port), pic_obj_value(str));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
|
@ -743,6 +750,139 @@ read(pic_state *pic, struct pic_port *port, int c)
|
|||
return val;
|
||||
}
|
||||
|
||||
struct pic_trie *
|
||||
pic_trie_new(pic_state *pic)
|
||||
{
|
||||
struct pic_trie *trie;
|
||||
|
||||
trie = pic_alloc(pic, sizeof(struct pic_trie));
|
||||
trie->proc = NULL;
|
||||
memset(trie->table, 0, sizeof trie->table);
|
||||
|
||||
return trie;
|
||||
}
|
||||
|
||||
void
|
||||
pic_trie_delete(pic_state *pic, struct pic_trie *trie)
|
||||
{
|
||||
size_t i;
|
||||
|
||||
for (i = 0; i < sizeof trie->table / sizeof(struct pic_trie *); ++i) {
|
||||
if (trie->table[i] != NULL) {
|
||||
pic_trie_delete(pic, trie->table[i]);
|
||||
}
|
||||
}
|
||||
|
||||
pic_free(pic, trie);
|
||||
}
|
||||
|
||||
void
|
||||
pic_define_reader(pic_state *pic, const char *str, pic_func_t reader)
|
||||
{
|
||||
struct pic_trie *trie = pic->reader->trie;
|
||||
int c;
|
||||
|
||||
while ((c = *str++)) {
|
||||
if (trie->table[c] == NULL) {
|
||||
trie->table[c] = pic_trie_new(pic);
|
||||
}
|
||||
trie = trie->table[c];
|
||||
}
|
||||
trie->proc = pic_proc_new(pic, reader, "reader");
|
||||
}
|
||||
|
||||
#define DEFINE_READER(name) \
|
||||
static pic_value \
|
||||
pic_##name(pic_state *pic) \
|
||||
{ \
|
||||
struct pic_port *port; \
|
||||
const char *str; \
|
||||
\
|
||||
pic_get_args(pic, "pz", &port, &str); \
|
||||
\
|
||||
return name(pic, port, str); \
|
||||
}
|
||||
|
||||
DEFINE_READER(read_unmatch)
|
||||
DEFINE_READER(read_comment)
|
||||
DEFINE_READER(read_quote)
|
||||
DEFINE_READER(read_quasiquote)
|
||||
DEFINE_READER(read_unquote)
|
||||
DEFINE_READER(read_unquote_splicing)
|
||||
DEFINE_READER(read_string)
|
||||
DEFINE_READER(read_pipe)
|
||||
DEFINE_READER(read_plus)
|
||||
DEFINE_READER(read_minus)
|
||||
DEFINE_READER(read_pair)
|
||||
DEFINE_READER(read_directive)
|
||||
DEFINE_READER(read_block_comment)
|
||||
DEFINE_READER(read_datum_comment)
|
||||
DEFINE_READER(read_true)
|
||||
DEFINE_READER(read_false)
|
||||
DEFINE_READER(read_char)
|
||||
DEFINE_READER(read_vector)
|
||||
DEFINE_READER(read_blob)
|
||||
DEFINE_READER(read_eval)
|
||||
DEFINE_READER(read_symbol)
|
||||
DEFINE_READER(read_number)
|
||||
DEFINE_READER(read_label)
|
||||
|
||||
void
|
||||
pic_init_reader(pic_state *pic)
|
||||
{
|
||||
static const char INIT[] = "!$%&*./:<=>?@^_~";
|
||||
char buf[3] = { 0 };
|
||||
size_t i;
|
||||
|
||||
pic_define_reader(pic, ")", pic_read_unmatch);
|
||||
pic_define_reader(pic, ";", pic_read_comment);
|
||||
pic_define_reader(pic, "'", pic_read_quote);
|
||||
pic_define_reader(pic, "`", pic_read_quasiquote);
|
||||
pic_define_reader(pic, ",", pic_read_unquote);
|
||||
pic_define_reader(pic, ",@", pic_read_unquote_splicing);
|
||||
pic_define_reader(pic, "\"", pic_read_string);
|
||||
pic_define_reader(pic, "|", pic_read_pipe);
|
||||
pic_define_reader(pic, "+", pic_read_plus);
|
||||
pic_define_reader(pic, "-", pic_read_minus);
|
||||
pic_define_reader(pic, "(", pic_read_pair);
|
||||
pic_define_reader(pic, "[", pic_read_pair);
|
||||
|
||||
pic_define_reader(pic, "#!", pic_read_directive);
|
||||
pic_define_reader(pic, "#|", pic_read_block_comment);
|
||||
pic_define_reader(pic, "#;", pic_read_datum_comment);
|
||||
pic_define_reader(pic, "#t", pic_read_true);
|
||||
pic_define_reader(pic, "#true", pic_read_true);
|
||||
pic_define_reader(pic, "#f", pic_read_false);
|
||||
pic_define_reader(pic, "#false", pic_read_false);
|
||||
pic_define_reader(pic, "#\\", pic_read_char);
|
||||
pic_define_reader(pic, "#(", pic_read_vector);
|
||||
pic_define_reader(pic, "#u", pic_read_blob);
|
||||
pic_define_reader(pic, "#.", pic_read_eval);
|
||||
|
||||
/* read number */
|
||||
for (buf[0] = '0'; buf[0] <= '9'; ++buf[0]) {
|
||||
pic_define_reader(pic, buf, pic_read_number);
|
||||
}
|
||||
|
||||
/* read symbol */
|
||||
for (buf[0] = 'a'; buf[0] <= 'z'; ++buf[0]) {
|
||||
pic_define_reader(pic, buf, pic_read_symbol);
|
||||
}
|
||||
for (buf[0] = 'A'; buf[0] <= 'Z'; ++buf[0]) {
|
||||
pic_define_reader(pic, buf, pic_read_symbol);
|
||||
}
|
||||
for (i = 0; i < sizeof INIT; ++i) {
|
||||
buf[0] = INIT[i];
|
||||
pic_define_reader(pic, buf, pic_read_symbol);
|
||||
}
|
||||
|
||||
/* read label */
|
||||
buf[0] = '#';
|
||||
for (buf[1] = '0'; buf[1] <= '9'; ++buf[1]) {
|
||||
pic_define_reader(pic, buf, pic_read_label);
|
||||
}
|
||||
}
|
||||
|
||||
pic_value
|
||||
pic_read(pic_state *pic, struct pic_port *port)
|
||||
{
|
||||
|
|
|
|||
27
src/state.c
27
src/state.c
|
|
@ -6,6 +6,7 @@
|
|||
|
||||
#include "picrin.h"
|
||||
#include "picrin/gc.h"
|
||||
#include "picrin/read.h"
|
||||
#include "picrin/proc.h"
|
||||
#include "picrin/macro.h"
|
||||
#include "picrin/cont.h"
|
||||
|
|
@ -21,7 +22,7 @@ pic_open(int argc, char *argv[], char **envp)
|
|||
pic_state *pic;
|
||||
size_t ai;
|
||||
|
||||
pic = (pic_state *)malloc(sizeof(pic_state));
|
||||
pic = malloc(sizeof(pic_state));
|
||||
|
||||
/* root block */
|
||||
pic->blk = NULL;
|
||||
|
|
@ -32,11 +33,11 @@ pic_open(int argc, char *argv[], char **envp)
|
|||
pic->envp = envp;
|
||||
|
||||
/* prepare VM stack */
|
||||
pic->stbase = pic->sp = (pic_value *)calloc(PIC_STACK_SIZE, sizeof(pic_value));
|
||||
pic->stbase = pic->sp = calloc(PIC_STACK_SIZE, sizeof(pic_value));
|
||||
pic->stend = pic->stbase + PIC_STACK_SIZE;
|
||||
|
||||
/* callinfo */
|
||||
pic->cibase = pic->ci = (pic_callinfo *)calloc(PIC_STACK_SIZE, sizeof(pic_callinfo));
|
||||
pic->cibase = pic->ci = calloc(PIC_STACK_SIZE, sizeof(pic_callinfo));
|
||||
pic->ciend = pic->cibase + PIC_STACK_SIZE;
|
||||
|
||||
/* memory heap */
|
||||
|
|
@ -59,8 +60,10 @@ pic_open(int argc, char *argv[], char **envp)
|
|||
pic->lib = NULL;
|
||||
|
||||
/* reader */
|
||||
pic->rfcase = false;
|
||||
xh_init_int(&pic->rlabels, sizeof(pic_value));
|
||||
pic->reader = malloc(sizeof(struct pic_reader));
|
||||
pic->reader->typecase = PIC_CASE_DEFAULT;
|
||||
pic->reader->trie = pic_trie_new(pic);
|
||||
xh_init_int(&pic->reader->labels, sizeof(pic_value));
|
||||
|
||||
/* error handling */
|
||||
pic->jmp = NULL;
|
||||
|
|
@ -70,7 +73,7 @@ pic_open(int argc, char *argv[], char **envp)
|
|||
pic->try_jmp_size = PIC_RESCUE_SIZE;
|
||||
|
||||
/* GC arena */
|
||||
pic->arena = (struct pic_object **)calloc(PIC_ARENA_SIZE, sizeof(struct pic_object **));
|
||||
pic->arena = calloc(PIC_ARENA_SIZE, sizeof(struct pic_object **));
|
||||
pic->arena_size = PIC_ARENA_SIZE;
|
||||
pic->arena_idx = 0;
|
||||
|
||||
|
|
@ -92,9 +95,10 @@ pic_open(int argc, char *argv[], char **envp)
|
|||
register_core_symbol(pic, sUNQUOTE, "unquote");
|
||||
register_core_symbol(pic, sUNQUOTE_SPLICING, "unquote-splicing");
|
||||
register_core_symbol(pic, sDEFINE_SYNTAX, "define-syntax");
|
||||
register_core_symbol(pic, sDEFINE_LIBRARY, "define-library");
|
||||
register_core_symbol(pic, sIMPORT, "import");
|
||||
register_core_symbol(pic, sEXPORT, "export");
|
||||
register_core_symbol(pic, sDEFINE_LIBRARY, "define-library");
|
||||
register_core_symbol(pic, sIN_LIBRARY, "in-library");
|
||||
register_core_symbol(pic, sCONS, "cons");
|
||||
register_core_symbol(pic, sCAR, "car");
|
||||
register_core_symbol(pic, sCDR, "cdr");
|
||||
|
|
@ -124,9 +128,10 @@ pic_open(int argc, char *argv[], char **envp)
|
|||
register_renamed_symbol(pic, rSETBANG, "set!");
|
||||
register_renamed_symbol(pic, rQUOTE, "quote");
|
||||
register_renamed_symbol(pic, rDEFINE_SYNTAX, "define-syntax");
|
||||
register_renamed_symbol(pic, rDEFINE_LIBRARY, "define-library");
|
||||
register_renamed_symbol(pic, rIMPORT, "import");
|
||||
register_renamed_symbol(pic, rEXPORT, "export");
|
||||
register_renamed_symbol(pic, rDEFINE_LIBRARY, "define-library");
|
||||
register_renamed_symbol(pic, rIN_LIBRARY, "in-library");
|
||||
pic_gc_arena_restore(pic, ai);
|
||||
|
||||
/* root block */
|
||||
|
|
@ -175,12 +180,16 @@ pic_close(pic_state *pic)
|
|||
free(pic->stbase);
|
||||
free(pic->cibase);
|
||||
|
||||
/* free reader struct */
|
||||
xh_destroy(&pic->reader->labels);
|
||||
pic_trie_delete(pic, pic->reader->trie);
|
||||
free(pic->reader);
|
||||
|
||||
/* free global stacks */
|
||||
free(pic->try_jmps);
|
||||
xh_destroy(&pic->syms);
|
||||
xh_destroy(&pic->globals);
|
||||
xh_destroy(&pic->macros);
|
||||
xh_destroy(&pic->rlabels);
|
||||
|
||||
/* free GC arena */
|
||||
free(pic->arena);
|
||||
|
|
|
|||
Loading…
Reference in New Issue