Merge branch 'read'. close #21

.gitignore

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

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
 

README.md

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

include/picrin.h

@@ -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 *);
+pic_value pic_read(pic_state *, const char *);
-int pic_parse_cstr(pic_state *, const char *, pic_value *);
+pic_value pic_read_file(pic_state *, FILE *); /* returns a list of read data. When input string is incomplete, returns undef. */
-pic_value pic_parse(pic_state *, const char *);
+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)),          \
+         *tmp2 = (pic_make_library(pic, pic_read(pic, spec)),           \
-                  pic_in_library(pic, pic_parse(pic, spec)),            \
+                  pic_in_library(pic, pic_read(pic, spec)),             \
                   NULL);                                                \
        tmp3 < 1;                                                        \
        (pic->lib = tmp1), ((void)tmp2), ++tmp3)

include/picrin/parse.h

@@ -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;
+  YYSTYPE yylval;
-  pic_value value;
+  jmp_buf jmp;
-  bool incomp;
+  const char *msg;
-  int yynerrs;
-  struct pic_vector *yy_arena;
-  size_t yy_arena_idx;
 };
 
 #if defined(__cplusplus)

src/codegen.c

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

src/init.c

@@ -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_deflibrary ("(scheme base)") {
-  pic_in_library(pic, pic_parse(pic, "(scheme base)"));
 
-  /* load core syntaces */
+    /* load core syntaces */
-  pic->lib->senv = pic_core_syntactic_env(pic);
+    pic->lib->senv = pic_core_syntactic_env(pic);
-  pic_export(pic, pic_intern_cstr(pic, "define"));
+    pic_export(pic, pic_intern_cstr(pic, "define"));
-  pic_export(pic, pic_intern_cstr(pic, "set!"));
+    pic_export(pic, pic_intern_cstr(pic, "set!"));
-  pic_export(pic, pic_intern_cstr(pic, "quote"));
+    pic_export(pic, pic_intern_cstr(pic, "quote"));
-  pic_export(pic, pic_intern_cstr(pic, "lambda"));
+    pic_export(pic, pic_intern_cstr(pic, "lambda"));
-  pic_export(pic, pic_intern_cstr(pic, "if"));
+    pic_export(pic, pic_intern_cstr(pic, "if"));
-  pic_export(pic, pic_intern_cstr(pic, "begin"));
+    pic_export(pic, pic_intern_cstr(pic, "begin"));
-  pic_export(pic, pic_intern_cstr(pic, "define-syntax"));
+    pic_export(pic, pic_intern_cstr(pic, "define-syntax"));
 
-  pic_init_bool(pic); DONE;
+    pic_init_bool(pic); DONE;
-  pic_init_pair(pic); DONE;
+    pic_init_pair(pic); DONE;
-  pic_init_port(pic); DONE;
+    pic_init_port(pic); DONE;
-  pic_init_number(pic); DONE;
+    pic_init_number(pic); DONE;
-  pic_init_time(pic); DONE;
+    pic_init_time(pic); DONE;
-  pic_init_system(pic); DONE;
+    pic_init_system(pic); DONE;
-  pic_init_file(pic); DONE;
+    pic_init_file(pic); DONE;
-  pic_init_proc(pic); DONE;
+    pic_init_proc(pic); DONE;
-  pic_init_symbol(pic); DONE;
+    pic_init_symbol(pic); DONE;
-  pic_init_vector(pic); DONE;
+    pic_init_vector(pic); DONE;
-  pic_init_blob(pic); DONE;
+    pic_init_blob(pic); DONE;
-  pic_init_cont(pic); DONE;
+    pic_init_cont(pic); DONE;
-  pic_init_char(pic); DONE;
+    pic_init_char(pic); DONE;
-  pic_init_error(pic); DONE;
+    pic_init_error(pic); DONE;
-  pic_init_str(pic); DONE;
+    pic_init_str(pic); DONE;
-  pic_init_macro(pic); DONE;
+    pic_init_macro(pic); DONE;
-  pic_init_var(pic); DONE;
+    pic_init_var(pic); DONE;
-  pic_init_load(pic); DONE;
+    pic_init_load(pic); DONE;
-  pic_init_write(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);
+
+  }
 }

src/load.c

@@ -9,8 +9,8 @@ pic_value
 pic_load(pic_state *pic, const char *fn)
 {
   FILE *file;
-  int n, i, ai;
+  int ai;
-  pic_value v, vs;
+  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);
+  exprs = pic_read_file(pic, file);
-  if (n < 0) {
+  if (pic_undef_p(exprs)) {
-    pic_error(pic, "load: parse failure");
+    pic_error(pic, "load: unexpected EOF");
   }
 
-  ai = pic_gc_arena_preserve(pic);
+  pic_for_each (v, exprs) {
-  for (i = 0; i < n; ++i, vs = pic_cdr(pic, vs)) {
+    ai = pic_gc_arena_preserve(pic);
-    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());
+    pic_apply(pic, proc, pic_nil_value());
-    if (pic_undef_p(v)) {
-      pic_error(pic, "load: evaluation failure");
-    }
 
     pic_gc_arena_restore(pic, ai);
   }

src/macro.c

@@ -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);
+    exprs = pic_read_file(pic, file);
-    if (res < 0) {
+    if (pic_undef_p(exprs)) {
       pic_error(pic, "parse error");
     }
     body = pic_append(pic, body, exprs);

src/parse.y

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

src/read.c

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

src/scan.l

@@ -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>{
+  BEGIN(STRING);
-	[^\\"]*		yymore();
+}
-	"\""		{
+<STRING>[^\\"]*	{
-			  yytext[yyleng-1] = '\0';
+  yymore();
-			  yylvalp->cstr = pic_strdup(yyextra->pic, yytext);
+}
-			  BEGIN(INITIAL);
+<STRING>"\""	{
-			  return tSTRING;
+  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>alarm	{ yylval.c = '\a'; BEGIN(INITIAL); return tCHAR; }
-<CHAR>backspace	{ yylvalp->c = '\b'; BEGIN(INITIAL); return tCHAR; }
+<CHAR>backspace	{ yylval.c = '\b'; BEGIN(INITIAL); return tCHAR; }
-<CHAR>delete	{ yylvalp->c = 0x7f; BEGIN(INITIAL); return tCHAR; }
+<CHAR>delete	{ yylval.c = 0x7f; BEGIN(INITIAL); return tCHAR; }
-<CHAR>escape	{ yylvalp->c = 0x1b; BEGIN(INITIAL); return tCHAR; }
+<CHAR>escape	{ yylval.c = 0x1b; BEGIN(INITIAL); return tCHAR; }
-<CHAR>newline	{ yylvalp->c = '\n'; BEGIN(INITIAL); return tCHAR; }
+<CHAR>newline	{ yylval.c = '\n'; BEGIN(INITIAL); return tCHAR; }
-<CHAR>null	{ yylvalp->c = '\0'; BEGIN(INITIAL); return tCHAR; }
+<CHAR>null	{ yylval.c = '\0'; BEGIN(INITIAL); return tCHAR; }
-<CHAR>return	{ yylvalp->c = '\r'; BEGIN(INITIAL); return tCHAR; }
+<CHAR>return	{ yylval.c = '\r'; BEGIN(INITIAL); return tCHAR; }
-<CHAR>space	{ yylvalp->c = ' '; BEGIN(INITIAL); return tCHAR; }
+<CHAR>space	{ yylval.c = ' ';  BEGIN(INITIAL); return tCHAR; }
-<CHAR>tab	{ yylvalp->c = '\t'; BEGIN(INITIAL); return tCHAR; }
+<CHAR>tab	{ yylval.c = '\t'; BEGIN(INITIAL); return tCHAR; }
-<CHAR>.		{ yylvalp->c = yytext[0]; BEGIN(INITIAL); return tCHAR; }
+<CHAR>.		{ yylval.c = yytext[0]; BEGIN(INITIAL); return tCHAR; }
 
 "#u8("		{
   BEGIN(BYTEVECTOR);
-  yylvalp->blob.len = 0;
+  yylval.blob.len = 0;
-  yylvalp->blob.capa = 10;
+  yylval.blob.capa = 10;
-  yylvalp->blob.dat = calloc(10, 1);
+  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) {
+  yylval.blob.dat[yylval.blob.len++] = (char)i;
-    yylvalp->blob.capa *= 2;
+  if (yylval.blob.len > yylval.blob.capa) {
-    yylvalp->blob.dat = realloc(yylvalp->blob.dat, yylvalp->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);
+  return pic_free(yyget_extra(yyscanner)->pic, ptr);
-}
-
-#define UNUSED(v) ((void)(v))
-
-int
-yywrap(yyscan_t yyscanner)
-{
-  UNUSED(yyscanner);
-
-  return 1;
 }

src/state.c

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

src/symbol.c

@@ -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(pic->syms, cstr, id);
-  xh_put_int(pic->sym_names, id, (long)str);
+  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)
 {

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);
+    exprs = pic_read_cstr(pic, code);
-    if (n == PIC_PARSER_INCOMPLETE) {		/* wait for more input */
+    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) {
+    pic_for_each (v, exprs) {
-      v = pic_car(pic, vs);
 
 #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 v, exprs;
-  pic_value vs;
   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);
+  exprs = pic_read_file(pic, file);
-  if (n <= 0) {
+  if (pic_undef_p(exprs)) {
     fprintf(stderr, "fatal error: %s broken\n", fname);
     goto abort;
   }
 
-  for (i = 0; i < n; ++i) {
+  pic_for_each (v, exprs) {
-    pic_value v;
-
-    v = pic_car(pic, vs);
 
     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 v, exprs;
-  pic_value vs, v;
   struct pic_proc *proc;
-  int ai = pic_gc_arena_preserve(pic);
+  int ai;
 
-  n = pic_parse_cstr(pic, str, &vs);
+  exprs = pic_read_cstr(pic, str);
-  if (n < 0) {
+  if (pic_undef_p(exprs)) {
     goto abort;
   }
 
-  for (i = 0; i < n; ++i) {
+  ai = pic_gc_arena_preserve(pic);
-    v = pic_car(pic, vs);
+  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);
   }