conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'read'. close #21

This commit is contained in:
Yuichi Nishiwaki 2014-03-01 20:29:48 +09:00
parent 22dd97fd44 c215a8059c
commit ac09af95ce
15 changed files with 422 additions and 614 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -1,5 +1,6 @@
bin/*
src/lex.yy.c
src/lex.yy.h
src/y.tab.c
src/y.tab.h
lib/*

3
Makefile
View File

@ -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

3
README.md
View File

@ -154,8 +154,7 @@ https://github.com/wasabiz/picrin
picrin scheme depends on some external libraries to build the binary:
- bison
- yacc
- lex (preferably, flex)
- make
- gcc
- readline

17
include/picrin.h
View File

@ -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);
@ -160,6 +154,7 @@ void pic_defvar(pic_state *, const char *, pic_value);
bool pic_equal_p(pic_state *, pic_value, pic_value);
pic_sym pic_intern(pic_state *, const char *, size_t);
pic_sym pic_intern_cstr(pic_state *, const char *);
const char *pic_symbol_name(pic_state *, pic_sym);
pic_sym pic_gensym(pic_state *, pic_sym);
@ -168,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 *);
@ -186,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)

35
include/picrin/parse.h
View File

@ -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)

2
src/codegen.c
View File

@ -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");

65
src/init.c
View File

@ -79,40 +79,41 @@ pic_init_core(pic_state *pic)
{
int ai = pic_gc_arena_preserve(pic);
pic_make_library(pic, pic_parse(pic, "(scheme base)"));
pic_in_library(pic, pic_parse(pic, "(scheme base)"));
pic_deflibrary ("(scheme base)") {
/* load core syntaces */
pic->lib->senv = pic_core_syntactic_env(pic);
pic_export(pic, pic_intern_cstr(pic, "define"));
pic_export(pic, pic_intern_cstr(pic, "set!"));
pic_export(pic, pic_intern_cstr(pic, "quote"));
pic_export(pic, pic_intern_cstr(pic, "lambda"));
pic_export(pic, pic_intern_cstr(pic, "if"));
pic_export(pic, pic_intern_cstr(pic, "begin"));
pic_export(pic, pic_intern_cstr(pic, "define-syntax"));
/* load core syntaces */
pic->lib->senv = pic_core_syntactic_env(pic);
pic_export(pic, pic_intern_cstr(pic, "define"));
pic_export(pic, pic_intern_cstr(pic, "set!"));
pic_export(pic, pic_intern_cstr(pic, "quote"));
pic_export(pic, pic_intern_cstr(pic, "lambda"));
pic_export(pic, pic_intern_cstr(pic, "if"));
pic_export(pic, pic_intern_cstr(pic, "begin"));
pic_export(pic, pic_intern_cstr(pic, "define-syntax"));
pic_init_bool(pic); DONE;
pic_init_pair(pic); DONE;
pic_init_port(pic); DONE;
pic_init_number(pic); DONE;
pic_init_time(pic); DONE;
pic_init_system(pic); DONE;
pic_init_file(pic); DONE;
pic_init_proc(pic); DONE;
pic_init_symbol(pic); DONE;
pic_init_vector(pic); DONE;
pic_init_blob(pic); DONE;
pic_init_cont(pic); DONE;
pic_init_char(pic); DONE;
pic_init_error(pic); DONE;
pic_init_str(pic); DONE;
pic_init_macro(pic); DONE;
pic_init_var(pic); DONE;
pic_init_load(pic); DONE;
pic_init_write(pic); DONE;
pic_init_bool(pic); DONE;
pic_init_pair(pic); DONE;
pic_init_port(pic); DONE;
pic_init_number(pic); DONE;
pic_init_time(pic); DONE;
pic_init_system(pic); DONE;
pic_init_file(pic); DONE;
pic_init_proc(pic); DONE;
pic_init_symbol(pic); DONE;
pic_init_vector(pic); DONE;
pic_init_blob(pic); DONE;
pic_init_cont(pic); DONE;
pic_init_char(pic); DONE;
pic_init_error(pic); DONE;
pic_init_str(pic); DONE;
pic_init_macro(pic); DONE;
pic_init_var(pic); DONE;
pic_init_load(pic); DONE;
pic_init_write(pic); DONE;
pic_load_stdlib(pic); DONE;
pic_load_stdlib(pic); DONE;
pic_defun(pic, "features", pic_features);
pic_defun(pic, "features", pic_features);
}
}

20
src/load.c
View File

@ -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");
}
ai = pic_gc_arena_preserve(pic);
for (i = 0; i < n; ++i, vs = pic_cdr(pic, vs)) {
v = pic_car(pic, vs);
pic_for_each (v, exprs) {
ai = pic_gc_arena_preserve(pic);
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);
}

5
src/macro.c
View File

@ -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);

450
src/parse.y
View File

@ -1,450 +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_cstr(struct parser_control *p, const char *cstr)
{
struct pic_string *str;
str = (struct pic_string *)yy_obj_alloc(p, sizeof(struct pic_string), PIC_TT_STRING);
str->rope = xr_new_volatile(cstr, strlen(cstr));
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;
char *cstr;
char c;
struct {
char *dat;
int 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 <cstr> 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_cstr(p->pic, $1));
free($1);
}
| tSTRING
{
$$ = yy_str_new_cstr(p, $1);
free($1);
}
| 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);
}

253
src/read.c Normal file
View File

@ -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;
}

112
src/scan.l
View File

@ -3,14 +3,10 @@
*/
%{
#include <stdlib.h>
#include <string.h>
#include "picrin.h"
#include "picrin/parse.h"
#include "y.tab.h"
#define YY_DECL int yylex_(YYSTYPE *yylvalp, yyscan_t yyscanner)
#define yylval (yyextra->yylval)
/* NOTE:
* An internal function `yy_fatal_error` takes yyscanner for its second
@ -23,11 +19,17 @@
#define YY_EXIT_FAILURE ( (void)yyscanner, 2 )
%}
%option noyyalloc noyyrealloc noyyfree
%option reentrant
%option noyyalloc
%option noyyrealloc
%option noyyfree
%option noinput
%option nounput
%option noyywrap
%option extra-type="struct parser_control *"
%option header-file="lex.yy.h"
%option never-interactive
/* comment */
@ -67,16 +69,16 @@ infnan "+inf.0"|"-inf.0"|"+nan.0"|"-nan.0"
"#|" {
BEGIN(BLOCK_COMMENT);
yylvalp->i = 0;
yylval.i = 0;
}
<BLOCK_COMMENT>"#|" {
yylvalp->i++;
yylval.i++;
}
<BLOCK_COMMENT>"|#" {
if (yylvalp->i == 0)
if (yylval.i == 0)
BEGIN(INITIAL);
else
yylvalp->i--;
yylval.i--;
}
<BLOCK_COMMENT>.|\n {
/* skip block comment */
@ -95,65 +97,72 @@ infnan "+inf.0"|"-inf.0"|"+nan.0"|"-nan.0"
",@" return tUNQUOTE_SPLICING;
{boolean} {
yylvalp->i = (yytext[1] == 't');
yylval.i = (yytext[1] == 't');
return tBOOLEAN;
}
{integer} {
yylvalp->i = atoi(yytext);
yylval.i = atoi(yytext);
return tINT;
}
{real} {
yylvalp->f = atof(yytext);
yylval.f = atof(yytext);
return tFLOAT;
}
{identifier} {
yylvalp->cstr = pic_strdup(yyextra->pic, yytext);
yylval.str.buf = yytext;
yylval.str.len = yyleng;
return tSYMBOL;
}
"\"" BEGIN(STRING);
<STRING>{
[^\\"]* yymore();
"\"" {
yytext[yyleng-1] = '\0';
yylvalp->cstr = pic_strdup(yyextra->pic, yytext);
BEGIN(INITIAL);
return tSTRING;
}
"\"" {
BEGIN(STRING);
}
<STRING>[^\\"]* {
yymore();
}
<STRING>"\"" {
yylval.str.buf = yytext;
yylval.str.len = yyleng - 1;
BEGIN(INITIAL);
return tSTRING;
}
#\\ {
BEGIN(CHAR);
}
<CHAR>alarm { yylvalp->c = '\a'; BEGIN(INITIAL); return tCHAR; }
<CHAR>backspace { yylvalp->c = '\b'; BEGIN(INITIAL); return tCHAR; }
<CHAR>delete { yylvalp->c = 0x7f; BEGIN(INITIAL); return tCHAR; }
<CHAR>escape { yylvalp->c = 0x1b; BEGIN(INITIAL); return tCHAR; }
<CHAR>newline { yylvalp->c = '\n'; BEGIN(INITIAL); return tCHAR; }
<CHAR>null { yylvalp->c = '\0'; BEGIN(INITIAL); return tCHAR; }
<CHAR>return { yylvalp->c = '\r'; BEGIN(INITIAL); return tCHAR; }
<CHAR>space { yylvalp->c = ' '; BEGIN(INITIAL); return tCHAR; }
<CHAR>tab { yylvalp->c = '\t'; BEGIN(INITIAL); return tCHAR; }
<CHAR>. { yylvalp->c = yytext[0]; BEGIN(INITIAL); return tCHAR; }
<CHAR>alarm { yylval.c = '\a'; BEGIN(INITIAL); return tCHAR; }
<CHAR>backspace { yylval.c = '\b'; BEGIN(INITIAL); return tCHAR; }
<CHAR>delete { yylval.c = 0x7f; BEGIN(INITIAL); return tCHAR; }
<CHAR>escape { yylval.c = 0x1b; BEGIN(INITIAL); return tCHAR; }
<CHAR>newline { yylval.c = '\n'; BEGIN(INITIAL); return tCHAR; }
<CHAR>null { yylval.c = '\0'; BEGIN(INITIAL); return tCHAR; }
<CHAR>return { yylval.c = '\r'; BEGIN(INITIAL); return tCHAR; }
<CHAR>space { yylval.c = ' '; BEGIN(INITIAL); return tCHAR; }
<CHAR>tab { yylval.c = '\t'; BEGIN(INITIAL); return tCHAR; }
<CHAR>. { yylval.c = yytext[0]; BEGIN(INITIAL); return tCHAR; }
"#u8(" {
BEGIN(BYTEVECTOR);
yylvalp->blob.len = 0;
yylvalp->blob.capa = 10;
yylvalp->blob.dat = calloc(10, 1);
yylval.blob.len = 0;
yylval.blob.capa = 10;
yylval.blob.dat = yyalloc(10, yyscanner);
}
<BYTEVECTOR>[ \r\n\t] {
/* skip whitespace */
}
<BYTEVECTOR>[ \r\n\t]
<BYTEVECTOR>{uinteger} {
int i = atoi(yytext);
if (0 > i || i > 255)
if (0 > i || i > 255) {
yyfree(yylval.blob.dat, yyscanner);
REJECT;
yylvalp->blob.dat[yylvalp->blob.len++] = (char)i;
if (yylvalp->blob.len > yylvalp->blob.capa) {
yylvalp->blob.capa *= 2;
yylvalp->blob.dat = realloc(yylvalp->blob.dat, yylvalp->blob.capa);
}
yylval.blob.dat[yylval.blob.len++] = (char)i;
if (yylval.blob.len > yylval.blob.capa) {
yylval.blob.capa *= 2;
yylval.blob.dat = yyrealloc(yylval.blob.dat, yylval.blob.capa, yyscanner);
}
}
<BYTEVECTOR>")" {
@ -163,33 +172,20 @@ infnan "+inf.0"|"-inf.0"|"+nan.0"|"-nan.0"
%%
#undef yyextra
#define yyextra ((struct yyguts_t *)yyscanner)->yyextra_r
void *
yyalloc(size_t bytes, yyscan_t yyscanner)
{
return pic_alloc(yyextra->pic, bytes);
return pic_alloc(yyget_extra(yyscanner)->pic, bytes);
}
void *
yyrealloc(void *ptr, size_t bytes, yyscan_t yyscanner)
{
return pic_realloc(yyextra->pic, ptr, bytes);
return pic_realloc(yyget_extra(yyscanner)->pic, ptr, bytes);
}
void
yyfree(void * ptr, yyscan_t yyscanner)
{
return pic_free(yyextra->pic, ptr);
}
#define UNUSED(v) ((void)(v))
int
yywrap(yyscan_t yyscanner)
{
UNUSED(yyscanner);
return 1;
return pic_free(yyget_extra(yyscanner)->pic, ptr);
}

4
src/state.c
View File

@ -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, "user"));
pic_in_library(pic, pic_parse(pic, "user"));
pic_make_library(pic, pic_read(pic, "(picrin user)"));
pic_in_library(pic, pic_read(pic, "(picrin user)"));
return pic;
}

21
src/symbol.c
View File

@ -10,24 +10,33 @@
#include "picrin/string.h"
pic_sym
pic_intern_cstr(pic_state *pic, const char *str)
pic_intern(pic_state *pic, const char *str, size_t len)
{
char *cstr;
xh_entry *e;
pic_sym id;
e = xh_get(pic->syms, str);
cstr = (char *)pic_malloc(pic, len + 1);
cstr[len] = '\0';
memcpy(cstr, str, len);
e = xh_get(pic->syms, cstr);
if (e) {
return e->val;
}
str = pic_strdup(pic, str);
id = pic->sym_cnt++;
xh_put(pic->syms, str, id);
xh_put_int(pic->sym_names, id, (long)str);
xh_put(pic->syms, cstr, id);
xh_put_int(pic->sym_names, id, (long)cstr);
return id;
}
pic_sym
pic_intern_cstr(pic_state *pic, const char *str)
{
return pic_intern(pic, str, strlen(str));
}
pic_sym
pic_gensym(pic_state *pic, pic_sym base)
{

45
tools/main.c
View File

@ -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);
}