my own read impl.
This commit is contained in:
Yuichi Nishiwaki
parent
6cf6c72f84
commit
6e7567a598
3
Makefile
3
Makefile
|
|
@ -27,12 +27,11 @@ build-main:
|
|||
|
||||
build-lib:
|
||||
cd src; \
|
||||
yacc -d parse.y; \
|
||||
flex scan.l
|
||||
$(CC) $(CFLAGS) -shared -fPIC src/*.c -o lib/$(PICRIN_LIB) -I./include -I./extlib -L./lib -lm -lxfile
|
||||
|
||||
clean:
|
||||
rm -f src/y.tab.c src/y.tab.h src/lex.yy.c
|
||||
rm -f src/lex.yy.c src/lex.yy.h
|
||||
rm -f lib/$(PICRIN_LIB)
|
||||
rm -f bin/picrin
|
||||
|
||||
|
|
|
|||
|
|
@ -126,12 +126,6 @@ typedef struct {
|
|||
|
||||
typedef pic_value (*pic_func_t)(pic_state *);
|
||||
|
||||
enum pic_parser_res {
|
||||
PIC_PARSER_INCOMPLETE = -1,
|
||||
PIC_PARSER_ERROR = -2
|
||||
/* if parser is successfully done, return the number of exprs (>= 0) */
|
||||
};
|
||||
|
||||
void *pic_malloc(pic_state *, size_t);
|
||||
#define pic_alloc(pic,size) pic_malloc(pic,size) /* obsoleted */
|
||||
void *pic_realloc(pic_state *, void *, size_t);
|
||||
|
|
@ -169,9 +163,9 @@ bool pic_interned_p(pic_state *, pic_sym);
|
|||
char *pic_strdup(pic_state *, const char *);
|
||||
char *pic_strndup(pic_state *, const char *, size_t);
|
||||
|
||||
int pic_parse_file(pic_state *, FILE *, pic_value *);
|
||||
int pic_parse_cstr(pic_state *, const char *, pic_value *);
|
||||
pic_value pic_parse(pic_state *, const char *);
|
||||
pic_value pic_read(pic_state *, const char *);
|
||||
pic_value pic_read_file(pic_state *, FILE *); /* returns a list of read data. When input string is incomplete, returns undef. */
|
||||
pic_value pic_read_cstr(pic_state *, const char *);
|
||||
|
||||
pic_value pic_load(pic_state *, const char *);
|
||||
|
||||
|
|
@ -187,8 +181,8 @@ struct pic_lib *pic_find_library(pic_state *, pic_value);
|
|||
|
||||
#define PIC_DEFLIBRARY_HELPER2(tmp1, tmp2, tmp3, spec) \
|
||||
for (struct pic_lib *tmp1 = pic->lib, \
|
||||
*tmp2 = (pic_make_library(pic, pic_parse(pic, spec)), \
|
||||
pic_in_library(pic, pic_parse(pic, spec)), \
|
||||
*tmp2 = (pic_make_library(pic, pic_read(pic, spec)), \
|
||||
pic_in_library(pic, pic_read(pic, spec)), \
|
||||
NULL); \
|
||||
tmp3 < 1; \
|
||||
(pic->lib = tmp1), ((void)tmp2), ++tmp3)
|
||||
|
|
|
|||
|
|
@ -9,14 +9,37 @@
|
|||
extern "C" {
|
||||
#endif
|
||||
|
||||
enum {
|
||||
tEOF = 0,
|
||||
tDATUM_COMMENT,
|
||||
tLPAREN, tRPAREN, tLBRACKET, tRBRACKET, tDOT, tVPAREN,
|
||||
tQUOTE, tQUASIQUOTE, tUNQUOTE, tUNQUOTE_SPLICING,
|
||||
tINT, tBOOLEAN,
|
||||
tFLOAT,
|
||||
tSYMBOL, tSTRING,
|
||||
tCHAR,
|
||||
tBYTEVECTOR,
|
||||
};
|
||||
|
||||
typedef union YYSTYPE {
|
||||
int i;
|
||||
double f;
|
||||
struct {
|
||||
char *buf;
|
||||
size_t len;
|
||||
} str;
|
||||
char c;
|
||||
struct {
|
||||
char *dat;
|
||||
size_t len, capa;
|
||||
} blob;
|
||||
} YYSTYPE;
|
||||
|
||||
struct parser_control {
|
||||
pic_state *pic;
|
||||
void *yyscanner;
|
||||
pic_value value;
|
||||
bool incomp;
|
||||
int yynerrs;
|
||||
struct pic_vector *yy_arena;
|
||||
size_t yy_arena_idx;
|
||||
YYSTYPE yylval;
|
||||
jmp_buf jmp;
|
||||
const char *msg;
|
||||
};
|
||||
|
||||
#if defined(__cplusplus)
|
||||
|
|
|
|||
|
|
@ -119,7 +119,7 @@ new_analyze_state(pic_state *pic)
|
|||
state->pic = pic;
|
||||
state->scope = NULL;
|
||||
|
||||
stdlib = pic_find_library(pic, pic_parse(pic, "(scheme base)"));
|
||||
stdlib = pic_find_library(pic, pic_read(pic, "(scheme base)"));
|
||||
|
||||
/* native VM procedures */
|
||||
register_renamed_symbol(pic, state, rCONS, stdlib, "cons");
|
||||
|
|
|
|||
18
src/load.c
18
src/load.c
|
|
@ -9,8 +9,8 @@ pic_value
|
|||
pic_load(pic_state *pic, const char *fn)
|
||||
{
|
||||
FILE *file;
|
||||
int n, i, ai;
|
||||
pic_value v, vs;
|
||||
int ai;
|
||||
pic_value v, exprs;
|
||||
struct pic_proc *proc;
|
||||
|
||||
file = fopen(fn, "r");
|
||||
|
|
@ -18,24 +18,20 @@ pic_load(pic_state *pic, const char *fn)
|
|||
pic_error(pic, "load: could not read file");
|
||||
}
|
||||
|
||||
n = pic_parse_file(pic, file, &vs);
|
||||
if (n < 0) {
|
||||
pic_error(pic, "load: parse failure");
|
||||
exprs = pic_read_file(pic, file);
|
||||
if (pic_undef_p(exprs)) {
|
||||
pic_error(pic, "load: unexpected EOF");
|
||||
}
|
||||
|
||||
pic_for_each (v, exprs) {
|
||||
ai = pic_gc_arena_preserve(pic);
|
||||
for (i = 0; i < n; ++i, vs = pic_cdr(pic, vs)) {
|
||||
v = pic_car(pic, vs);
|
||||
|
||||
proc = pic_compile(pic, v);
|
||||
if (proc == NULL) {
|
||||
pic_error(pic, "load: compilation failure");
|
||||
}
|
||||
|
||||
v = pic_apply(pic, proc, pic_nil_value());
|
||||
if (pic_undef_p(v)) {
|
||||
pic_error(pic, "load: evaluation failure");
|
||||
}
|
||||
pic_apply(pic, proc, pic_nil_value());
|
||||
|
||||
pic_gc_arena_restore(pic, ai);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -611,7 +611,6 @@ pic_macro_include(pic_state *pic)
|
|||
size_t argc, i;
|
||||
pic_value *argv, exprs, body;
|
||||
FILE *file;
|
||||
int res;
|
||||
|
||||
pic_get_args(pic, "*", &argc, &argv);
|
||||
|
||||
|
|
@ -628,8 +627,8 @@ pic_macro_include(pic_state *pic)
|
|||
if (file == NULL) {
|
||||
pic_error(pic, "could not open file");
|
||||
}
|
||||
res = pic_parse_file(pic, file, &exprs);
|
||||
if (res < 0) {
|
||||
exprs = pic_read_file(pic, file);
|
||||
if (pic_undef_p(exprs)) {
|
||||
pic_error(pic, "parse error");
|
||||
}
|
||||
body = pic_append(pic, body, exprs);
|
||||
|
|
|
|||
451
src/parse.y
451
src/parse.y
|
|
@ -1,451 +0,0 @@
|
|||
/**
|
||||
* See Copyright Notice in picrin.h
|
||||
*/
|
||||
|
||||
%{
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#include "picrin.h"
|
||||
#include "picrin/pair.h"
|
||||
#include "picrin/string.h"
|
||||
#include "picrin/vector.h"
|
||||
#include "picrin/blob.h"
|
||||
#include "picrin/parse.h"
|
||||
|
||||
#define YYERROR_VERBOSE 1
|
||||
|
||||
/* just for supressing warnings. a little bit evil */
|
||||
int yylex();
|
||||
int yylex_();
|
||||
void yylex_init_extra();
|
||||
void yyset_in();
|
||||
void yy_scan_string();
|
||||
void yylex_destroy();
|
||||
|
||||
#define YY_ARENA_SIZE 50
|
||||
|
||||
struct parser_control *
|
||||
parser_control_new(pic_state *pic)
|
||||
{
|
||||
struct parser_control *p;
|
||||
|
||||
p = (struct parser_control *)pic_alloc(pic, sizeof(struct parser_control));
|
||||
p->pic = pic;
|
||||
p->incomp = false;
|
||||
p->yynerrs = 0;
|
||||
p->value = pic_undef_value();
|
||||
p->yy_arena = pic_vec_new(pic, YY_ARENA_SIZE);
|
||||
p->yy_arena_idx = 0;
|
||||
yylex_init_extra(p, &p->yyscanner);
|
||||
|
||||
return p;
|
||||
}
|
||||
|
||||
void
|
||||
parser_control_destroy(struct parser_control *p)
|
||||
{
|
||||
pic_state *pic = p->pic;
|
||||
|
||||
yylex_destroy(p->yyscanner);
|
||||
pic_free(pic, p);
|
||||
}
|
||||
|
||||
void
|
||||
yy_obj_protect(struct parser_control *p, struct pic_object *obj)
|
||||
{
|
||||
if (p->yy_arena_idx >= p->yy_arena->len) {
|
||||
pic_vec_extend_ip(p->pic, p->yy_arena, p->yy_arena->len * 2);
|
||||
}
|
||||
p->yy_arena->data[p->yy_arena_idx++] = pic_obj_value(obj);
|
||||
}
|
||||
|
||||
struct pic_object *
|
||||
yy_obj_alloc(struct parser_control *p, size_t size, enum pic_tt tt)
|
||||
{
|
||||
struct pic_object *obj;
|
||||
|
||||
obj = pic_obj_alloc_unsafe(p->pic, size, tt);
|
||||
yy_obj_protect(p, obj);
|
||||
return obj;
|
||||
}
|
||||
|
||||
pic_value
|
||||
yy_cons(struct parser_control *p, pic_value car, pic_value cdr)
|
||||
{
|
||||
struct pic_pair *pair;
|
||||
|
||||
pair = (struct pic_pair *)yy_obj_alloc(p, sizeof(struct pic_pair), PIC_TT_PAIR);
|
||||
pair->car = car;
|
||||
pair->cdr = cdr;
|
||||
|
||||
return pic_obj_value(pair);
|
||||
}
|
||||
|
||||
pic_value
|
||||
yy_abbrev(struct parser_control *p, pic_sym sym, pic_value datum)
|
||||
{
|
||||
return yy_cons(p, pic_symbol_value(sym), yy_cons(p, datum, pic_nil_value()));
|
||||
}
|
||||
|
||||
pic_value
|
||||
yy_str_new(struct parser_control *p, const char *buf, size_t len)
|
||||
{
|
||||
pic_str *str;
|
||||
|
||||
str = (struct pic_string *)yy_obj_alloc(p, sizeof(struct pic_string), PIC_TT_STRING);
|
||||
str->rope = xr_new_volatile(buf, len);
|
||||
|
||||
return pic_obj_value(str);
|
||||
}
|
||||
|
||||
pic_value
|
||||
yy_vec_new_from_list(struct parser_control *p, pic_value data)
|
||||
{
|
||||
struct pic_vector *vec;
|
||||
int i, len;
|
||||
|
||||
len = pic_length(p->pic, data);
|
||||
|
||||
vec = (struct pic_vector *)yy_obj_alloc(p, sizeof(struct pic_vector), PIC_TT_VECTOR);
|
||||
vec->len = len;
|
||||
vec->data = (pic_value *)pic_alloc(p->pic, sizeof(pic_value) * len);
|
||||
for (i = 0; i < len; ++i) {
|
||||
vec->data[i] = pic_car(p->pic, data);
|
||||
data = pic_cdr(p->pic, data);
|
||||
}
|
||||
return pic_obj_value(vec);
|
||||
}
|
||||
|
||||
pic_value
|
||||
yy_blob_new(struct parser_control *p, char *dat, int len)
|
||||
{
|
||||
struct pic_blob *bv;
|
||||
|
||||
bv = (struct pic_blob *)yy_obj_alloc(p, sizeof(struct pic_blob), PIC_TT_BLOB);
|
||||
bv->data = pic_strndup(p->pic, dat, len);
|
||||
bv->len = len;
|
||||
return pic_obj_value(bv);
|
||||
}
|
||||
|
||||
void yyerror(struct parser_control *, const char *);
|
||||
%}
|
||||
|
||||
%pure-parser
|
||||
%parse-param {struct parser_control *p}
|
||||
%lex-param {struct parser_control *p}
|
||||
|
||||
%union {
|
||||
int i;
|
||||
double f;
|
||||
struct {
|
||||
char *buf;
|
||||
size_t len;
|
||||
} str;
|
||||
char c;
|
||||
struct {
|
||||
char *dat;
|
||||
size_t len, capa;
|
||||
} blob;
|
||||
pic_value datum;
|
||||
}
|
||||
|
||||
%token tDATUM_COMMENT
|
||||
%token tLPAREN tRPAREN tLBRACKET tRBRACKET tDOT tVPAREN
|
||||
%token tQUOTE tQUASIQUOTE tUNQUOTE tUNQUOTE_SPLICING
|
||||
%token <i> tINT tBOOLEAN
|
||||
%token <f> tFLOAT
|
||||
%token <str> tSYMBOL tSTRING
|
||||
%token <c> tCHAR
|
||||
%token <blob> tBYTEVECTOR
|
||||
|
||||
%type <datum> program_data
|
||||
%type <datum> datum simple_datum compound_datum abbrev
|
||||
%type <datum> list list_data vector vector_data
|
||||
|
||||
%%
|
||||
|
||||
program
|
||||
: program_data
|
||||
{
|
||||
p->value = $1;
|
||||
}
|
||||
| incomplete_program_data
|
||||
{
|
||||
p->incomp = true;
|
||||
p->value = pic_undef_value();
|
||||
}
|
||||
| /* empty line */
|
||||
{
|
||||
p->value = pic_nil_value();
|
||||
}
|
||||
;
|
||||
|
||||
program_data
|
||||
: datum
|
||||
{
|
||||
$$ = yy_cons(p, $1, pic_nil_value());
|
||||
}
|
||||
| datum program_data
|
||||
{
|
||||
$$ = yy_cons(p, $1, $2);
|
||||
}
|
||||
| tDATUM_COMMENT datum
|
||||
{
|
||||
$$ = pic_nil_value();
|
||||
}
|
||||
;
|
||||
|
||||
incomplete_program_data
|
||||
: incomplete_datum
|
||||
| datum incomplete_program_data
|
||||
;
|
||||
|
||||
datum
|
||||
: simple_datum
|
||||
| compound_datum
|
||||
| tDATUM_COMMENT datum datum
|
||||
{
|
||||
$$ = $3;
|
||||
}
|
||||
;
|
||||
|
||||
simple_datum
|
||||
: tSYMBOL
|
||||
{
|
||||
$$ = pic_symbol_value(pic_intern(p->pic, $1.buf, $1.len));
|
||||
}
|
||||
| tSTRING
|
||||
{
|
||||
$$ = yy_str_new(p, $1.buf, $1.len);
|
||||
}
|
||||
| tINT
|
||||
{
|
||||
$$ = pic_int_value($1);
|
||||
}
|
||||
| tFLOAT
|
||||
{
|
||||
$$ = pic_float_value($1);
|
||||
}
|
||||
| tBOOLEAN
|
||||
{
|
||||
$$ = pic_bool_value($1);
|
||||
}
|
||||
| tCHAR
|
||||
{
|
||||
$$ = pic_char_value($1);
|
||||
}
|
||||
| tBYTEVECTOR
|
||||
{
|
||||
$$ = yy_blob_new(p, $1.dat, $1.len);
|
||||
free($1.dat);
|
||||
}
|
||||
;
|
||||
|
||||
compound_datum
|
||||
: list
|
||||
| vector
|
||||
| abbrev
|
||||
;
|
||||
|
||||
list
|
||||
: tLPAREN list_data tRPAREN
|
||||
{
|
||||
$$ = $2;
|
||||
}
|
||||
| tLBRACKET list_data tRBRACKET
|
||||
{
|
||||
$$ = $2;
|
||||
}
|
||||
;
|
||||
|
||||
list_data
|
||||
: /* none */
|
||||
{
|
||||
$$ = pic_nil_value();
|
||||
}
|
||||
| tDATUM_COMMENT datum
|
||||
{
|
||||
$$ = pic_nil_value();
|
||||
}
|
||||
| datum tDOT datum
|
||||
{
|
||||
$$ = yy_cons(p, $1, $3);
|
||||
}
|
||||
| datum list_data
|
||||
{
|
||||
$$ = yy_cons(p, $1, $2);
|
||||
}
|
||||
;
|
||||
|
||||
vector
|
||||
: tVPAREN vector_data tRPAREN
|
||||
{
|
||||
$$ = yy_vec_new_from_list(p, $2);
|
||||
}
|
||||
;
|
||||
|
||||
vector_data
|
||||
: /* none */
|
||||
{
|
||||
$$ = pic_nil_value();
|
||||
}
|
||||
| tDATUM_COMMENT datum
|
||||
{
|
||||
$$ = pic_nil_value();
|
||||
}
|
||||
| datum vector_data
|
||||
{
|
||||
$$ = yy_cons(p, $1, $2);
|
||||
}
|
||||
;
|
||||
|
||||
abbrev
|
||||
: tQUOTE datum
|
||||
{
|
||||
$$ = yy_abbrev(p, p->pic->sQUOTE, $2);
|
||||
}
|
||||
| tQUASIQUOTE datum
|
||||
{
|
||||
$$ = yy_abbrev(p, p->pic->sQUASIQUOTE, $2);
|
||||
}
|
||||
| tUNQUOTE datum
|
||||
{
|
||||
$$ = yy_abbrev(p, p->pic->sUNQUOTE, $2);
|
||||
}
|
||||
| tUNQUOTE_SPLICING datum
|
||||
{
|
||||
$$ = yy_abbrev(p, p->pic->sUNQUOTE_SPLICING, $2);
|
||||
}
|
||||
;
|
||||
|
||||
incomplete_datum
|
||||
: tLPAREN incomplete_data
|
||||
| tLBRACKET incomplete_data
|
||||
| tVPAREN incomplete_data
|
||||
| incomplete_abbrev
|
||||
| tDATUM_COMMENT
|
||||
;
|
||||
|
||||
incomplete_tail
|
||||
: /* none */
|
||||
| incomplete_datum
|
||||
;
|
||||
|
||||
incomplete_data
|
||||
: incomplete_tail
|
||||
| datum tDOT incomplete_tail
|
||||
| datum incomplete_data
|
||||
;
|
||||
|
||||
incomplete_abbrev
|
||||
: tQUOTE incomplete_tail
|
||||
| tQUASIQUOTE incomplete_tail
|
||||
| tUNQUOTE incomplete_tail
|
||||
| tUNQUOTE_SPLICING incomplete_tail
|
||||
;
|
||||
|
||||
%%
|
||||
|
||||
void
|
||||
yyerror(struct parser_control *p, const char *msg)
|
||||
{
|
||||
puts(msg);
|
||||
p->yynerrs++;
|
||||
}
|
||||
|
||||
int
|
||||
yylex(YYSTYPE *yylvalp, struct parser_control *p)
|
||||
{
|
||||
return yylex_(yylvalp, p->yyscanner);
|
||||
}
|
||||
|
||||
int
|
||||
pic_parse_file(pic_state *pic, FILE *file, pic_value *v)
|
||||
{
|
||||
struct parser_control *p;
|
||||
int r, ai = pic_gc_arena_preserve(pic);
|
||||
|
||||
p = parser_control_new(pic);
|
||||
|
||||
yyset_in(file, p->yyscanner);
|
||||
yyparse(p);
|
||||
|
||||
if (p->yynerrs > 0) {
|
||||
r = PIC_PARSER_ERROR;
|
||||
}
|
||||
else if (p->incomp) {
|
||||
r = PIC_PARSER_INCOMPLETE;
|
||||
}
|
||||
else {
|
||||
r = pic_length(pic, p->value);
|
||||
}
|
||||
|
||||
*v = p->value;
|
||||
|
||||
parser_control_destroy(p);
|
||||
|
||||
#if DEBUG
|
||||
if (pic_gc_arena_preserve(pic) != ai + 1) {
|
||||
puts("**logic flaw! yy obj protection failure!**");
|
||||
}
|
||||
#endif
|
||||
|
||||
pic_gc_arena_restore(pic, ai);
|
||||
|
||||
pic_gc_protect(pic, *v);
|
||||
|
||||
return r;
|
||||
}
|
||||
|
||||
enum pic_parser_res
|
||||
pic_parse_cstr(pic_state *pic, const char *str, pic_value *v)
|
||||
{
|
||||
struct parser_control *p;
|
||||
int r, ai = pic_gc_arena_preserve(pic);
|
||||
|
||||
p = parser_control_new(pic);
|
||||
|
||||
yy_scan_string(str, p->yyscanner);
|
||||
yyparse(p);
|
||||
|
||||
if (p->yynerrs > 0) {
|
||||
r = PIC_PARSER_ERROR;
|
||||
}
|
||||
else if (p->incomp) {
|
||||
r = PIC_PARSER_INCOMPLETE;
|
||||
}
|
||||
else {
|
||||
r = pic_length(pic, p->value);
|
||||
}
|
||||
|
||||
*v = p->value;
|
||||
|
||||
parser_control_destroy(p);
|
||||
|
||||
#if DEBUG
|
||||
if (pic_gc_arena_preserve(pic) != ai + 1) {
|
||||
puts("**logic flaw! yy obj protection failure!**");
|
||||
printf("%d\n", pic_gc_arena_preserve(pic));
|
||||
}
|
||||
#endif
|
||||
|
||||
pic_gc_arena_restore(pic, ai);
|
||||
|
||||
pic_gc_protect(pic, *v);
|
||||
|
||||
return r;
|
||||
}
|
||||
|
||||
pic_value
|
||||
pic_parse(pic_state *pic, const char *src)
|
||||
{
|
||||
pic_value vs;
|
||||
int r;
|
||||
|
||||
r = pic_parse_cstr(pic, src, &vs);
|
||||
if (r != 1) {
|
||||
return pic_undef_value();
|
||||
}
|
||||
return pic_car(pic, vs);
|
||||
}
|
||||
|
|
@ -0,0 +1,253 @@
|
|||
/**
|
||||
* See Copyright Notice in picrin.h
|
||||
*/
|
||||
|
||||
#include "picrin.h"
|
||||
#include "picrin/parse.h"
|
||||
#include "picrin/pair.h"
|
||||
#include "picrin/string.h"
|
||||
#include "picrin/vector.h"
|
||||
#include "picrin/blob.h"
|
||||
#include "picrin/port.h"
|
||||
|
||||
#define YY_NO_UNISTD_H
|
||||
#include "lex.yy.h"
|
||||
|
||||
static pic_value read(int tok, yyscan_t scanner);
|
||||
|
||||
#define pic (yyget_extra(scanner)->pic)
|
||||
#define yylval (yyget_extra(scanner)->yylval)
|
||||
#define yymsg (yyget_extra(scanner)->msg)
|
||||
#define yyjmp (yyget_extra(scanner)->jmp)
|
||||
|
||||
static void
|
||||
error(const char *msg, yyscan_t scanner)
|
||||
{
|
||||
yymsg = msg;
|
||||
longjmp(yyjmp, 1);
|
||||
}
|
||||
|
||||
static int
|
||||
gettok(yyscan_t scanner)
|
||||
{
|
||||
int tok;
|
||||
|
||||
while ((tok = yylex(scanner)) == tDATUM_COMMENT) {
|
||||
read(gettok(scanner), scanner); /* discard */
|
||||
}
|
||||
return tok;
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_pair(int tOPEN, yyscan_t scanner)
|
||||
{
|
||||
int tok, tCLOSE = (tOPEN == tLPAREN) ? tRPAREN : tRBRACKET;
|
||||
pic_value car, cdr;
|
||||
|
||||
tok = gettok(scanner);
|
||||
if (tok == tCLOSE) {
|
||||
return pic_nil_value();
|
||||
}
|
||||
if (tok == tDOT) {
|
||||
cdr = read(gettok(scanner), scanner);
|
||||
|
||||
if (gettok(scanner) != tCLOSE) {
|
||||
error("unmatched parenthesis", scanner);
|
||||
}
|
||||
return cdr;
|
||||
}
|
||||
else {
|
||||
car = read(tok, scanner);
|
||||
cdr = read_pair(tOPEN, scanner);
|
||||
return pic_cons(pic, car, cdr);
|
||||
}
|
||||
}
|
||||
|
||||
static pic_vec *
|
||||
read_vect(yyscan_t scanner)
|
||||
{
|
||||
int tok;
|
||||
pic_value val;
|
||||
|
||||
val = pic_nil_value();
|
||||
while ((tok = gettok(scanner)) != tRPAREN) {
|
||||
val = pic_cons(pic, read(tok, scanner), val);
|
||||
}
|
||||
return pic_vec_new_from_list(pic, pic_reverse(pic, val));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_abbrev(pic_sym sym, yyscan_t scanner)
|
||||
{
|
||||
return pic_cons(pic, pic_sym_value(sym), pic_cons(pic, read(gettok(scanner), scanner), pic_nil_value()));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read_datum(int tok, yyscan_t scanner)
|
||||
{
|
||||
pic_value val;
|
||||
|
||||
switch (tok) {
|
||||
case tSYMBOL:
|
||||
return pic_symbol_value(pic_intern(pic, yylval.str.buf, yylval.str.len));
|
||||
|
||||
case tSTRING:
|
||||
return pic_obj_value(pic_str_new(pic, yylval.str.buf, yylval.str.len));
|
||||
|
||||
case tINT:
|
||||
return pic_int_value(yylval.i);
|
||||
|
||||
case tFLOAT:
|
||||
return pic_float_value(yylval.f);
|
||||
|
||||
case tBOOLEAN:
|
||||
return pic_bool_value(yylval.i);
|
||||
|
||||
case tCHAR:
|
||||
return pic_char_value(yylval.c);
|
||||
|
||||
case tBYTEVECTOR:
|
||||
val = pic_obj_value(pic_blob_new(pic, yylval.blob.dat, yylval.blob.len));
|
||||
pic_free(pic, yylval.blob.dat);
|
||||
return val;
|
||||
|
||||
case tLPAREN:
|
||||
case tLBRACKET:
|
||||
return read_pair(tok, scanner);
|
||||
|
||||
case tVPAREN:
|
||||
return pic_obj_value(read_vect(scanner));
|
||||
|
||||
case tQUOTE:
|
||||
return read_abbrev(pic->sQUOTE, scanner);
|
||||
|
||||
case tQUASIQUOTE:
|
||||
return read_abbrev(pic->sQUASIQUOTE, scanner);
|
||||
|
||||
case tUNQUOTE:
|
||||
return read_abbrev(pic->sUNQUOTE, scanner);
|
||||
|
||||
case tUNQUOTE_SPLICING:
|
||||
return read_abbrev(pic->sUNQUOTE_SPLICING, scanner);
|
||||
|
||||
case tRPAREN:
|
||||
error("unexpected close parenthesis", scanner);
|
||||
|
||||
case tRBRACKET:
|
||||
error("unexpected close bracket", scanner);
|
||||
|
||||
case tDOT:
|
||||
error("unexpected '.'", scanner);
|
||||
|
||||
case tEOF:
|
||||
error(NULL, scanner);
|
||||
}
|
||||
|
||||
/* unreachable */
|
||||
return pic_undef_value();
|
||||
}
|
||||
|
||||
static pic_value
|
||||
read(int tok, yyscan_t scanner)
|
||||
{
|
||||
int ai = pic_gc_arena_preserve(pic);
|
||||
pic_value val;
|
||||
|
||||
val = read_datum(tok, scanner);
|
||||
|
||||
pic_gc_arena_restore(pic, ai);
|
||||
pic_gc_protect(pic, val);
|
||||
return val;
|
||||
}
|
||||
|
||||
|
||||
pic_value
|
||||
read_one(yyscan_t scanner)
|
||||
{
|
||||
int tok;
|
||||
|
||||
if (setjmp(yyjmp) != 0) {
|
||||
pic_errorf(pic, "read-error: %s", yymsg ? yymsg : "unexpected EOF");
|
||||
}
|
||||
|
||||
if ((tok = gettok(scanner)) == tEOF) {
|
||||
return pic_undef_value();
|
||||
}
|
||||
return read(tok, scanner);
|
||||
}
|
||||
|
||||
pic_value
|
||||
read_many(yyscan_t scanner)
|
||||
{
|
||||
int tok;
|
||||
pic_value val;
|
||||
|
||||
if (setjmp(yyjmp) != 0) {
|
||||
if (yymsg) {
|
||||
pic_errorf(pic, "read-error: %s", yymsg);
|
||||
}
|
||||
return pic_undef_value(); /* incomplete string */
|
||||
}
|
||||
|
||||
val = pic_nil_value();
|
||||
while ((tok = gettok(scanner)) != tEOF) {
|
||||
val = pic_cons(pic, read(tok, scanner), val);
|
||||
}
|
||||
return pic_reverse(pic, val);
|
||||
}
|
||||
|
||||
#undef pic
|
||||
|
||||
pic_value
|
||||
pic_read(pic_state *pic, const char *cstr)
|
||||
{
|
||||
yyscan_t scanner;
|
||||
struct parser_control ctrl;
|
||||
pic_value val;
|
||||
|
||||
ctrl.pic = pic;
|
||||
yylex_init_extra(&ctrl, &scanner);
|
||||
yy_scan_string(cstr, scanner);
|
||||
|
||||
val = read_one(scanner);
|
||||
|
||||
yylex_destroy(scanner);
|
||||
|
||||
return val;
|
||||
}
|
||||
|
||||
pic_value
|
||||
pic_read_file(pic_state *pic, FILE *file)
|
||||
{
|
||||
yyscan_t scanner;
|
||||
struct parser_control ctrl;
|
||||
pic_value val;
|
||||
|
||||
ctrl.pic = pic;
|
||||
yylex_init_extra(&ctrl, &scanner);
|
||||
yyset_in(file, scanner);
|
||||
|
||||
val = read_many(scanner);
|
||||
|
||||
yylex_destroy(scanner);
|
||||
|
||||
return val;
|
||||
}
|
||||
|
||||
pic_value
|
||||
pic_read_cstr(pic_state *pic, const char *cstr)
|
||||
{
|
||||
yyscan_t scanner;
|
||||
struct parser_control ctrl;
|
||||
pic_value val;
|
||||
|
||||
ctrl.pic = pic;
|
||||
yylex_init_extra(&ctrl, &scanner);
|
||||
yy_scan_string(cstr, scanner);
|
||||
|
||||
val = read_many(scanner);
|
||||
|
||||
yylex_destroy(scanner);
|
||||
|
||||
return val;
|
||||
}
|
||||
|
|
@ -5,11 +5,8 @@
|
|||
%{
|
||||
#include "picrin.h"
|
||||
#include "picrin/parse.h"
|
||||
#include "y.tab.h"
|
||||
|
||||
#define YY_DECL int yylex_(YYSTYPE *yylvalp, yyscan_t yyscanner)
|
||||
|
||||
#define yylval (*yylvalp)
|
||||
#define yylval (yyextra->yylval)
|
||||
|
||||
/* NOTE:
|
||||
* An internal function `yy_fatal_error` takes yyscanner for its second
|
||||
|
|
|
|||
|
|
@ -118,8 +118,8 @@ pic_open(int argc, char *argv[], char **envp)
|
|||
pic_init_core(pic);
|
||||
|
||||
/* set library */
|
||||
pic_make_library(pic, pic_parse(pic, "(picrin user)"));
|
||||
pic_in_library(pic, pic_parse(pic, "(picrin user)"));
|
||||
pic_make_library(pic, pic_read(pic, "(picrin user)"));
|
||||
pic_in_library(pic, pic_read(pic, "(picrin user)"));
|
||||
|
||||
return pic;
|
||||
}
|
||||
|
|
|
|||
45
tools/main.c
45
tools/main.c
|
|
@ -38,7 +38,7 @@ import_repllib(pic_state *pic)
|
|||
{
|
||||
int ai = pic_gc_arena_preserve(pic);
|
||||
|
||||
pic_import(pic, pic_parse(pic, "(scheme base)"));
|
||||
pic_import(pic, pic_read(pic, "(scheme base)"));
|
||||
|
||||
#if DEBUG
|
||||
puts("* imported repl libraries");
|
||||
|
|
@ -54,9 +54,9 @@ repl(pic_state *pic)
|
|||
{
|
||||
char code[CODE_MAX_LENGTH] = "", line[LINE_MAX_LENGTH];
|
||||
char *prompt;
|
||||
pic_value v, vs;
|
||||
struct pic_proc *proc;
|
||||
int ai, n, i;
|
||||
pic_value v, exprs;
|
||||
int ai;
|
||||
|
||||
#if PIC_ENABLE_READLINE
|
||||
char *read_line;
|
||||
|
|
@ -103,17 +103,13 @@ repl(pic_state *pic)
|
|||
strcat(code, line);
|
||||
|
||||
/* read */
|
||||
n = pic_parse_cstr(pic, code, &vs);
|
||||
if (n == PIC_PARSER_INCOMPLETE) { /* wait for more input */
|
||||
exprs = pic_read_cstr(pic, code);
|
||||
if (pic_undef_p(exprs)) { /* wait for more input */
|
||||
goto next;
|
||||
}
|
||||
code[0] = '\0';
|
||||
if (n == PIC_PARSER_ERROR) { /* parse error */
|
||||
goto next;
|
||||
}
|
||||
|
||||
for (i = 0; i < n; ++i) {
|
||||
v = pic_car(pic, vs);
|
||||
pic_for_each (v, exprs) {
|
||||
|
||||
#if DEBUG
|
||||
printf("[read: ");
|
||||
|
|
@ -140,7 +136,6 @@ repl(pic_state *pic)
|
|||
pic_debug(pic, v);
|
||||
printf("\n"); fflush(stdout);
|
||||
|
||||
vs = pic_cdr(pic, vs);
|
||||
}
|
||||
|
||||
next:
|
||||
|
|
@ -162,8 +157,7 @@ void
|
|||
exec_file(pic_state *pic, const char *fname)
|
||||
{
|
||||
FILE *file;
|
||||
int n, i;
|
||||
pic_value vs;
|
||||
pic_value v, exprs;
|
||||
struct pic_proc *proc;
|
||||
|
||||
file = fopen(fname, "r");
|
||||
|
|
@ -172,16 +166,13 @@ exec_file(pic_state *pic, const char *fname)
|
|||
goto abort;
|
||||
}
|
||||
|
||||
n = pic_parse_file(pic, file, &vs);
|
||||
if (n <= 0) {
|
||||
exprs = pic_read_file(pic, file);
|
||||
if (pic_undef_p(exprs)) {
|
||||
fprintf(stderr, "fatal error: %s broken\n", fname);
|
||||
goto abort;
|
||||
}
|
||||
|
||||
for (i = 0; i < n; ++i) {
|
||||
pic_value v;
|
||||
|
||||
v = pic_car(pic, vs);
|
||||
pic_for_each (v, exprs) {
|
||||
|
||||
proc = pic_compile(pic, v);
|
||||
if (proc == NULL) {
|
||||
|
|
@ -197,7 +188,6 @@ exec_file(pic_state *pic, const char *fname)
|
|||
goto abort;
|
||||
}
|
||||
|
||||
vs = pic_cdr(pic, vs);
|
||||
}
|
||||
|
||||
return;
|
||||
|
|
@ -210,18 +200,17 @@ exec_file(pic_state *pic, const char *fname)
|
|||
void
|
||||
exec_string(pic_state *pic, const char *str)
|
||||
{
|
||||
int n, i;
|
||||
pic_value vs, v;
|
||||
pic_value v, exprs;
|
||||
struct pic_proc *proc;
|
||||
int ai = pic_gc_arena_preserve(pic);
|
||||
int ai;
|
||||
|
||||
n = pic_parse_cstr(pic, str, &vs);
|
||||
if (n < 0) {
|
||||
exprs = pic_read_cstr(pic, str);
|
||||
if (pic_undef_p(exprs)) {
|
||||
goto abort;
|
||||
}
|
||||
|
||||
for (i = 0; i < n; ++i) {
|
||||
v = pic_car(pic, vs);
|
||||
ai = pic_gc_arena_preserve(pic);
|
||||
pic_for_each (v, exprs) {
|
||||
|
||||
proc = pic_compile(pic, v);
|
||||
if (proc == NULL) {
|
||||
|
|
@ -232,8 +221,6 @@ exec_string(pic_state *pic, const char *str)
|
|||
goto abort;
|
||||
}
|
||||
|
||||
vs = pic_cdr(pic, vs);
|
||||
|
||||
pic_gc_arena_restore(pic, ai);
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue