diff --git a/include/picrin.h b/include/picrin.h index f5b908d0..bbcf47d6 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -27,6 +27,7 @@ typedef struct { pic_callinfo *cibase, *ciend; pic_value sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE; + pic_value sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING; pic_value sCONS, sCAR, sCDR, sNILP; pic_value sADD, sSUB, sMUL, sDIV; diff --git a/src/gc.c b/src/gc.c index 4be5686c..53685773 100644 --- a/src/gc.c +++ b/src/gc.c @@ -214,6 +214,9 @@ gc_mark_phase(pic_state *pic) gc_mark(pic, pic->sIF); gc_mark(pic, pic->sBEGIN); gc_mark(pic, pic->sQUOTE); + gc_mark(pic, pic->sQUASIQUOTE); + gc_mark(pic, pic->sUNQUOTE); + gc_mark(pic, pic->sUNQUOTE_SPLICING); gc_mark(pic, pic->sCONS); gc_mark(pic, pic->sCAR); gc_mark(pic, pic->sCDR); diff --git a/src/pair.c b/src/pair.c index bba2a181..68ae7ac4 100644 --- a/src/pair.c +++ b/src/pair.c @@ -1,3 +1,5 @@ +#include + #include "picrin.h" #include "picrin/pair.h" @@ -48,6 +50,23 @@ pic_list_p(pic_state *pic, pic_value obj) return pic_nil_p(obj); } +pic_value +pic_list(pic_state *pic, size_t c, ...) +{ + va_list ap; + pic_value v; + + va_start(ap, c); + + v = pic_nil_value(); + while (c--) { + v = pic_cons(pic, va_arg(ap, pic_value), v); + } + + va_end(ap); + return pic_reverse(pic, v); +} + pic_value pic_reverse(pic_state *pic, pic_value list) { diff --git a/src/parse.y b/src/parse.y index c5363b3c..5b8fac5c 100644 --- a/src/parse.y +++ b/src/parse.y @@ -34,7 +34,7 @@ void yylex_destroy(); } %token tLPAREN tRPAREN tDOT -%token tQUOTE +%token tQUOTE tQUASIQUOTE tUNQUOTE tUNQUOTE_SPLICING %token tSYMBOL tNUMBER tBOOLEAN tSTRING %type datum simple_datum compound_datum abbrev @@ -43,11 +43,7 @@ void yylex_destroy(); %% program - : - { - p->value = pic_undef_value(); - } - | datum + : datum { p->value = $1; } @@ -100,24 +96,41 @@ list_data abbrev : tQUOTE datum { - $$ = pic_cons(p->pic, p->pic->sQUOTE, pic_cons(p->pic, $2, pic_nil_value())); + $$ = pic_list(p->pic, 2, p->pic->sQUOTE, $2); + } + | tQUASIQUOTE datum + { + $$ = pic_list(p->pic, 2, p->pic->sQUASIQUOTE, $2); + } + | tUNQUOTE datum + { + $$ = pic_list(p->pic, 2, p->pic->sUNQUOTE, $2); + } + | tUNQUOTE_SPLICING datum + { + $$ = pic_list(p->pic, 2, p->pic->sUNQUOTE_SPLICING, $2); } ; incomplete_datum - : tLPAREN incomplete_data - | tQUOTE - | tQUOTE incomplete_datum + : /* none */ + | tLPAREN incomplete_data + | incomplete_abbrev ; incomplete_data - : /* none */ - | datum tDOT - | datum incomplete_datum + : incomplete_datum | datum tDOT incomplete_datum | datum incomplete_data ; +incomplete_abbrev + : tQUOTE incomplete_datum + | tQUASIQUOTE incomplete_datum + | tUNQUOTE incomplete_datum + | tUNQUOTE_SPLICING incomplete_datum +; + %% void diff --git a/src/scan.l b/src/scan.l index ac494c2c..09b136e7 100644 --- a/src/scan.l +++ b/src/scan.l @@ -26,7 +26,7 @@ static pic_value new_escaped_string(pic_state *, const char *); boolean #t|#f|#true|#false /* symbol */ -identifier [a-z0-9A-Z+-/*!$%&:@^~?<=>_.]+ +identifier [a-z0-9A-Z+/*!$%&:@^~?<=>_.-]+ /* number */ digit [0-9] @@ -46,6 +46,9 @@ string_elem [^\"\\]|"\\\""|"\\\\" "(" return tLPAREN; ")" return tRPAREN; "'" return tQUOTE; +"`" return tQUASIQUOTE; +"," return tUNQUOTE; +",@" return tUNQUOTE_SPLICING; {boolean} { yylvalp->datum = pic_bool_value(strcmp(yytext, "#t") == 0 || strcmp(yytext, "#true") == 0); return tBOOLEAN; } {real} { yylvalp->datum = pic_float_value(atof(yytext)); return tNUMBER; } {identifier} { yylvalp->datum = pic_intern_cstr(p->pic, yytext); return tSYMBOL; } diff --git a/src/state.c b/src/state.c index f0f90a70..c39e2051 100644 --- a/src/state.c +++ b/src/state.c @@ -80,6 +80,9 @@ pic_open(int argc, char *argv[], char **envp) pic->sIF = pic_intern_cstr(pic, "if"); pic->sBEGIN = pic_intern_cstr(pic, "begin"); pic->sQUOTE = pic_intern_cstr(pic, "quote"); + pic->sQUASIQUOTE = pic_intern_cstr(pic, "quasiquote"); + pic->sUNQUOTE = pic_intern_cstr(pic, "unquote"); + pic->sUNQUOTE_SPLICING = pic_intern_cstr(pic, "unquote-splicing"); pic->sCONS = pic_intern_cstr(pic, "cons"); pic->sCAR = pic_intern_cstr(pic, "car"); pic->sCDR = pic_intern_cstr(pic, "cdr");