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

remove pre-interned symbols

This commit is contained in:
Yuichi Nishiwaki 2016-02-21 04:34:26 +09:00
parent 864a17d0be
commit f89a55c082
10 changed files with 95 additions and 153 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

104
extlib/benz/eval.c
View File

@ -8,6 +8,9 @@
#include "picrin/private/opcode.h"
#include "picrin/private/state.h"
#define EQ(sym, lit) (strcmp(pic_str(pic, pic_sym_name(pic, sym)), lit) == 0)
#define S(lit) (pic_intern_lit(pic, lit))
static pic_value
optimize_beta(pic_state *pic, pic_value expr)
{
@ -23,10 +26,10 @@ optimize_beta(pic_state *pic, pic_value expr)
if (pic_sym_p(pic, pic_list_ref(pic, expr, 0))) {
pic_value sym = pic_list_ref(pic, expr, 0);
if (pic_eq_p(pic, sym, pic->sQUOTE)) {
if (EQ(sym, "quote")) {
return expr;
} else if (pic_eq_p(pic, sym, pic->sLAMBDA)) {
return pic_list(pic, 3, pic->sLAMBDA, pic_list_ref(pic, expr, 1), optimize_beta(pic, pic_list_ref(pic, expr, 2)));
} else if (EQ(sym, "lambda")) {
return pic_list(pic, 3, S("lambda"), pic_list_ref(pic, expr, 1), optimize_beta(pic, pic_list_ref(pic, expr, 2)));
}
}
@ -40,7 +43,7 @@ optimize_beta(pic_state *pic, pic_value expr)
pic_protect(pic, expr);
functor = pic_list_ref(pic, expr, 0);
if (pic_pair_p(pic, functor) && pic_eq_p(pic, pic_car(pic, functor), pic->sLAMBDA)) {
if (pic_pair_p(pic, functor) && EQ(pic_car(pic, functor), "lambda")) {
formals = pic_list_ref(pic, functor, 1);
if (! pic_list_p(pic, formals))
goto exit; /* TODO: support ((lambda args x) 1 2) */
@ -49,12 +52,12 @@ optimize_beta(pic_state *pic, pic_value expr)
goto exit;
defs = pic_nil_value(pic);
pic_for_each (val, args, it) {
pic_push(pic, pic_list(pic, 3, pic->sDEFINE, pic_car(pic, formals), val), defs);
pic_push(pic, pic_list(pic, 3, S("define"), pic_car(pic, formals), val), defs);
formals = pic_cdr(pic, formals);
}
expr = pic_list_ref(pic, functor, 2);
pic_for_each (val, defs, it) {
expr = pic_list(pic, 3, pic->sBEGIN, val, expr);
expr = pic_list(pic, 3, S("begin"), val, expr);
}
}
exit:
@ -159,11 +162,6 @@ define_var(pic_state *pic, analyze_scope *scope, pic_value sym)
static pic_value analyze(pic_state *, analyze_scope *, pic_value);
static pic_value analyze_lambda(pic_state *, analyze_scope *, pic_value);
#define GREF pic_intern_lit(pic, "gref")
#define LREF pic_intern_lit(pic, "lref")
#define CREF pic_intern_lit(pic, "cref")
#define CALL pic_intern_lit(pic, "call")
static pic_value
analyze_var(pic_state *pic, analyze_scope *scope, pic_value sym)
{
@ -172,11 +170,11 @@ analyze_var(pic_state *pic, analyze_scope *scope, pic_value sym)
depth = find_var(pic, scope, sym);
if (depth == scope->depth) {
return pic_list(pic, 2, GREF, sym);
return pic_list(pic, 2, S("gref"), sym);
} else if (depth == 0) {
return pic_list(pic, 2, LREF, sym);
return pic_list(pic, 2, S("lref"), sym);
} else {
return pic_list(pic, 3, CREF, pic_int_value(pic, depth), sym);
return pic_list(pic, 3, S("cref"), pic_int_value(pic, depth), sym);
}
}
@ -255,7 +253,7 @@ analyze_lambda(pic_state *pic, analyze_scope *up, pic_value form)
analyzer_scope_destroy(pic, scope);
return pic_list(pic, 6, pic->sLAMBDA, rest, args, locals, captures, body);
return pic_list(pic, 6, S("lambda"), rest, args, locals, captures, body);
}
static pic_value
@ -281,7 +279,7 @@ analyze_define(pic_state *pic, analyze_scope *scope, pic_value obj)
static pic_value
analyze_call(pic_state *pic, analyze_scope *scope, pic_value obj)
{
return pic_cons(pic, CALL, analyze_list(pic, scope, obj));
return pic_cons(pic, S("call"), analyze_list(pic, scope, obj));
}
static pic_value
@ -302,16 +300,16 @@ analyze_node(pic_state *pic, analyze_scope *scope, pic_value obj)
if (pic_sym_p(pic, proc)) {
pic_value sym = proc;
if (pic_eq_p(pic, sym, pic->sDEFINE)) {
if (EQ(sym, "define")) {
return analyze_define(pic, scope, obj);
}
else if (pic_eq_p(pic, sym, pic->sLAMBDA)) {
else if (EQ(sym, "lambda")) {
return analyze_defer(pic, scope, obj);
}
else if (pic_eq_p(pic, sym, pic->sQUOTE)) {
else if (EQ(sym, "quote")) {
return obj;
}
else if (pic_eq_p(pic, sym, pic->sBEGIN) || pic_eq_p(pic, sym, pic->sSETBANG) || pic_eq_p(pic, sym, pic->sIF)) {
else if (EQ(sym, "begin") || EQ(sym, "set!") || EQ(sym, "if")) {
return pic_cons(pic, pic_car(pic, obj), analyze_list(pic, scope, pic_cdr(pic, obj)));
}
}
@ -319,7 +317,7 @@ analyze_node(pic_state *pic, analyze_scope *scope, pic_value obj)
return analyze_call(pic, scope, obj);
}
default:
return pic_list(pic, 2, pic->sQUOTE, obj);
return pic_list(pic, 2, S("quote"), obj);
}
}
@ -547,14 +545,14 @@ codegen_ref(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
pic_value sym;
sym = pic_car(pic, obj);
if (pic_eq_p(pic, sym, GREF)) {
if (EQ(sym, "gref")) {
pic_value name;
name = pic_list_ref(pic, obj, 1);
emit_i(pic, cxt, OP_GREF, index_global(pic, cxt, name));
emit_ret(pic, cxt, tailpos);
}
else if (pic_eq_p(pic, sym, CREF)) {
else if (EQ(sym, "cref")) {
pic_value name;
int depth;
@ -563,7 +561,7 @@ codegen_ref(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
emit_r(pic, cxt, OP_CREF, depth, index_capture(pic, cxt, name, depth));
emit_ret(pic, cxt, tailpos);
}
else if (pic_eq_p(pic, sym, LREF)) {
else if (EQ(sym, "lref")) {
pic_value name;
int i;
@ -589,14 +587,14 @@ codegen_set(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
var = pic_list_ref(pic, obj, 1);
type = pic_list_ref(pic, var, 0);
if (pic_eq_p(pic, type, GREF)) {
if (EQ(type, "gref")) {
pic_value name;
name = pic_list_ref(pic, var, 1);
emit_i(pic, cxt, OP_GSET, index_global(pic, cxt, name));
emit_ret(pic, cxt, tailpos);
}
else if (pic_eq_p(pic, type, CREF)) {
else if (EQ(type, "cref")) {
pic_value name;
int depth;
@ -605,7 +603,7 @@ codegen_set(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
emit_r(pic, cxt, OP_CSET, depth, index_capture(pic, cxt, name, depth));
emit_ret(pic, cxt, tailpos);
}
else if (pic_eq_p(pic, type, LREF)) {
else if (EQ(type, "lref")) {
pic_value name;
int i;
@ -730,8 +728,8 @@ codegen_quote(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
emit_ret(pic, cxt, tailpos);
}
#define VM(uid, op) \
if (pic_eq_p(pic, sym, uid)) { \
#define VM(name, op) \
if (EQ(sym, name)) { \
emit_i(pic, cxt, op, len - 1); \
emit_ret(pic, cxt, tailpos); \
return; \
@ -748,27 +746,27 @@ codegen_call(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
}
functor = pic_list_ref(pic, obj, 1);
if (pic_eq_p(pic, pic_list_ref(pic, functor, 0), GREF)) {
if (EQ(pic_list_ref(pic, functor, 0), "gref")) {
pic_value sym;
sym = pic_list_ref(pic, functor, 1);
VM(pic->sCONS, OP_CONS)
VM(pic->sCAR, OP_CAR)
VM(pic->sCDR, OP_CDR)
VM(pic->sNILP, OP_NILP)
VM(pic->sSYMBOLP, OP_SYMBOLP)
VM(pic->sPAIRP, OP_PAIRP)
VM(pic->sNOT, OP_NOT)
VM(pic->sEQ, OP_EQ)
VM(pic->sLT, OP_LT)
VM(pic->sLE, OP_LE)
VM(pic->sGT, OP_GT)
VM(pic->sGE, OP_GE)
VM(pic->sADD, OP_ADD)
VM(pic->sSUB, OP_SUB)
VM(pic->sMUL, OP_MUL)
VM(pic->sDIV, OP_DIV)
VM("cons", OP_CONS)
VM("car", OP_CAR)
VM("cdr", OP_CDR)
VM("null?", OP_NILP)
VM("symbol?", OP_SYMBOLP)
VM("pair?", OP_PAIRP)
VM("not", OP_NOT)
VM("=", OP_EQ)
VM("<", OP_LT)
VM("<=", OP_LE)
VM(">", OP_GT)
VM(">=", OP_GE)
VM("+", OP_ADD)
VM("-", OP_SUB)
VM("*", OP_MUL)
VM("/", OP_DIV)
}
emit_i(pic, cxt, (tailpos ? OP_TAILCALL : OP_CALL), len - 1);
@ -780,25 +778,25 @@ codegen(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
pic_value sym;
sym = pic_car(pic, obj);
if (pic_eq_p(pic, sym, GREF) || pic_eq_p(pic, sym, CREF) || pic_eq_p(pic, sym, LREF)) {
if (EQ(sym, "gref") || EQ(sym, "cref") || EQ(sym, "lref")) {
codegen_ref(pic, cxt, obj, tailpos);
}
else if (pic_eq_p(pic, sym, pic->sSETBANG) || pic_eq_p(pic, sym, pic->sDEFINE)) {
else if (EQ(sym, "set!") || EQ(sym, "define")) {
codegen_set(pic, cxt, obj, tailpos);
}
else if (pic_eq_p(pic, sym, pic->sLAMBDA)) {
else if (EQ(sym, "lambda")) {
codegen_lambda(pic, cxt, obj, tailpos);
}
else if (pic_eq_p(pic, sym, pic->sIF)) {
else if (EQ(sym, "if")) {
codegen_if(pic, cxt, obj, tailpos);
}
else if (pic_eq_p(pic, sym, pic->sBEGIN)) {
else if (EQ(sym, "begin")) {
codegen_begin(pic, cxt, obj, tailpos);
}
else if (pic_eq_p(pic, sym, pic->sQUOTE)) {
else if (EQ(sym, "quote")) {
codegen_quote(pic, cxt, obj, tailpos);
}
else if (pic_eq_p(pic, sym, CALL)) {
else if (EQ(sym, "call")) {
codegen_call(pic, cxt, obj, tailpos);
}
else {

13
extlib/benz/gc.c
View File

@ -416,8 +416,6 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
}
}
#define M(x) gc_mark(pic, pic->x)
static void
gc_mark_phase(pic_state *pic)
{
@ -465,15 +463,6 @@ gc_mark_phase(pic_state *pic)
}
}
/* mark reserved symbols */
M(sDEFINE); M(sDEFINE_MACRO); M(sLAMBDA); M(sIF); M(sBEGIN); M(sSETBANG);
M(sQUOTE); M(sQUASIQUOTE); M(sUNQUOTE); M(sUNQUOTE_SPLICING);
M(sSYNTAX_QUOTE); M(sSYNTAX_QUASIQUOTE); M(sSYNTAX_UNQUOTE); M(sSYNTAX_UNQUOTE_SPLICING);
M(sDEFINE_LIBRARY); M(sIMPORT); M(sEXPORT); M(sCOND_EXPAND);
M(sCONS); M(sCAR); M(sCDR); M(sNILP); M(sSYMBOLP); M(sPAIRP);
M(sADD); M(sSUB); M(sMUL); M(sDIV); M(sEQ); M(sLT); M(sLE); M(sGT); M(sGE); M(sNOT);
/* global variables */
gc_mark(pic, pic->globals);
@ -670,7 +659,7 @@ gc_sweep_phase(pic_state *pic)
if (! kh_exist(s, it))
continue;
sym = kh_val(s, it);
if (sym->gc_mark == WHITE) {
if (sym && sym->gc_mark == WHITE) {
kh_del(oblist, s, it);
}
}

2
extlib/benz/include/picrin/private/gc.h
View File

@ -9,8 +9,6 @@
extern "C" {
#endif
struct pic_heap;
struct pic_heap *pic_heap_open(pic_state *);
void pic_heap_close(pic_state *, struct pic_heap *);

8
extlib/benz/include/picrin/private/state.h
View File

@ -59,14 +59,6 @@ struct pic_state {
struct pic_lib *lib;
pic_value sDEFINE, sDEFINE_MACRO, sLAMBDA, sIF, sBEGIN, sSETBANG;
pic_value sQUOTE, sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING;
pic_value sSYNTAX_QUOTE, sSYNTAX_QUASIQUOTE;
pic_value sSYNTAX_UNQUOTE, sSYNTAX_UNQUOTE_SPLICING;
pic_value sDEFINE_LIBRARY, sIMPORT, sEXPORT, sCOND_EXPAND;
pic_value sCONS, sCAR, sCDR, sNILP, sSYMBOLP, sPAIRP;
pic_value sADD, sSUB, sMUL, sDIV, sEQ, sLT, sLE, sGT, sGE, sNOT;
pic_value features;
khash_t(oblist) oblist; /* string to symbol */

10
extlib/benz/lib.c
View File

@ -46,11 +46,13 @@ make_library_env(pic_state *pic, pic_value name)
e = pic_obj_value(env);
#define REGISTER(name) pic_put_identifier(pic, pic_intern_lit(pic, name), pic_intern_lit(pic, name), e)
/* set up default environment */
pic_put_identifier(pic, pic->sDEFINE_LIBRARY, pic->sDEFINE_LIBRARY, e);
pic_put_identifier(pic, pic->sIMPORT, pic->sIMPORT, e);
pic_put_identifier(pic, pic->sEXPORT, pic->sEXPORT, e);
pic_put_identifier(pic, pic->sCOND_EXPAND, pic->sCOND_EXPAND, e);
REGISTER("define-library");
REGISTER("import");
REGISTER("export");
REGISTER("cond-expand");
return e;
}

17
extlib/benz/macro.c
View File

@ -139,6 +139,9 @@ shadow_macro(pic_state *pic, pic_value uid)
static pic_value expand(pic_state *, pic_value expr, pic_value env, pic_value deferred);
static pic_value expand_lambda(pic_state *, pic_value expr, pic_value env);
#define EQ(sym, lit) (strcmp(pic_str(pic, pic_sym_name(pic, sym)), lit) == 0)
#define S(lit) (pic_intern_lit(pic, lit))
static pic_value
expand_var(pic_state *pic, pic_value id, pic_value env, pic_value deferred)
{
@ -155,7 +158,7 @@ expand_var(pic_state *pic, pic_value id, pic_value env, pic_value deferred)
static pic_value
expand_quote(pic_state *pic, pic_value expr)
{
return pic_cons(pic, pic->sQUOTE, pic_cdr(pic, expr));
return pic_cons(pic, S("quote"), pic_cdr(pic, expr));
}
static pic_value
@ -229,7 +232,7 @@ expand_lambda(pic_state *pic, pic_value expr, pic_value env)
expand_deferred(pic, deferred, in);
return pic_list(pic, 3, pic->sLAMBDA, formal, body);
return pic_list(pic, 3, S("lambda"), formal, body);
}
static pic_value
@ -245,7 +248,7 @@ expand_define(pic_state *pic, pic_value expr, pic_value env, pic_value deferred)
}
val = expand(pic, pic_list_ref(pic, expr, 2), env, deferred);
return pic_list(pic, 3, pic->sDEFINE, uid, val);
return pic_list(pic, 3, S("define"), uid, val);
}
static pic_value
@ -289,16 +292,16 @@ expand_node(pic_state *pic, pic_value expr, pic_value env, pic_value deferred)
functor = pic_find_identifier(pic, pic_car(pic, expr), env);
if (pic_eq_p(pic, functor, pic->sDEFINE_MACRO)) {
if (EQ(functor, "define-macro")) {
return expand_defmacro(pic, expr, env);
}
else if (pic_eq_p(pic, functor, pic->sLAMBDA)) {
else if (EQ(functor, "lambda")) {
return expand_defer(pic, expr, deferred);
}
else if (pic_eq_p(pic, functor, pic->sDEFINE)) {
else if (EQ(functor, "define")) {
return expand_define(pic, expr, env, deferred);
}
else if (pic_eq_p(pic, functor, pic->sQUOTE)) {
else if (EQ(functor, "quote")) {
return expand_quote(pic, expr);
}

20
extlib/benz/read.c
View File

@ -151,23 +151,25 @@ read_directive(pic_state *pic, xFILE *file, int c)
static pic_value
read_quote(pic_state *pic, xFILE *file, int PIC_UNUSED(c))
{
return pic_list(pic, 2, pic->sQUOTE, read(pic, file, next(pic, file)));
return pic_list(pic, 2, pic_intern_lit(pic, "quote"), read(pic, file, next(pic, file)));
}
static pic_value
read_quasiquote(pic_state *pic, xFILE *file, int PIC_UNUSED(c))
{
return pic_list(pic, 2, pic->sQUASIQUOTE, read(pic, file, next(pic, file)));
return pic_list(pic, 2, pic_intern_lit(pic, "quasiquote"), read(pic, file, next(pic, file)));
}
static pic_value
read_unquote(pic_state *pic, xFILE *file, int PIC_UNUSED(c))
{
pic_value tag = pic->sUNQUOTE;
pic_value tag;
if (peek(pic, file) == '@') {
tag = pic->sUNQUOTE_SPLICING;
tag = pic_intern_lit(pic, "unquote-splicing");
next(pic, file);
} else {
tag = pic_intern_lit(pic, "unquote");
}
return pic_list(pic, 2, tag, read(pic, file, next(pic, file)));
}
@ -175,23 +177,25 @@ read_unquote(pic_state *pic, xFILE *file, int PIC_UNUSED(c))
static pic_value
read_syntax_quote(pic_state *pic, xFILE *file, int PIC_UNUSED(c))
{
return pic_list(pic, 2, pic->sSYNTAX_QUOTE, read(pic, file, next(pic, file)));
return pic_list(pic, 2, pic_intern_lit(pic, "syntax-quote"), read(pic, file, next(pic, file)));
}
static pic_value
read_syntax_quasiquote(pic_state *pic, xFILE *file, int PIC_UNUSED(c))
{
return pic_list(pic, 2, pic->sSYNTAX_QUASIQUOTE, read(pic, file, next(pic, file)));
return pic_list(pic, 2, pic_intern_lit(pic, "syntax-quasiquote"), read(pic, file, next(pic, file)));
}
static pic_value
read_syntax_unquote(pic_state *pic, xFILE *file, int PIC_UNUSED(c))
{
pic_value tag = pic->sSYNTAX_UNQUOTE;
pic_value tag;
if (peek(pic, file) == '@') {
tag = pic->sSYNTAX_UNQUOTE_SPLICING;
tag = pic_intern_lit(pic, "syntax-unquote-splicing");
next(pic, file);
} else {
tag = pic_intern_lit(pic, "syntax-unquote");
}
return pic_list(pic, 2, tag, read(pic, file, next(pic, file)));
}

53
extlib/benz/state.c
View File

@ -193,7 +193,6 @@ pic_open(pic_allocf allocf, void *userdata)
char t;
pic_state *pic;
size_t ai;
pic = allocf(userdata, NULL, sizeof(pic_state));
@ -260,10 +259,10 @@ pic_open(pic_allocf allocf, void *userdata)
pic->ucnt = 0;
/* global variables */
pic->globals = pic_make_weak(pic);
pic->globals = pic_invalid_value(pic);
/* macros */
pic->macros = pic_make_weak(pic);
pic->macros = pic_invalid_value(pic);
/* features */
pic->features = pic_nil_value(pic);
@ -299,48 +298,6 @@ pic_open(pic_allocf allocf, void *userdata)
/* native stack marker */
pic->native_stack_start = &t;
ai = pic_enter(pic);
#define S(slot,name) pic->slot = pic_intern_lit(pic, name)
S(sDEFINE, "define");
S(sDEFINE_MACRO, "define-macro");
S(sLAMBDA, "lambda");
S(sIF, "if");
S(sBEGIN, "begin");
S(sSETBANG, "set!");
S(sQUOTE, "quote");
S(sQUASIQUOTE, "quasiquote");
S(sUNQUOTE, "unquote");
S(sUNQUOTE_SPLICING, "unquote-splicing");
S(sSYNTAX_QUOTE, "syntax-quote");
S(sSYNTAX_QUASIQUOTE, "syntax-quasiquote");
S(sSYNTAX_UNQUOTE, "syntax-unquote");
S(sSYNTAX_UNQUOTE_SPLICING, "syntax-unquote-splicing");
S(sIMPORT, "import");
S(sEXPORT, "export");
S(sDEFINE_LIBRARY, "define-library");
S(sCOND_EXPAND, "cond-expand");
S(sCONS, "cons");
S(sCAR, "car");
S(sCDR, "cdr");
S(sNILP, "null?");
S(sSYMBOLP, "symbol?");
S(sPAIRP, "pair?");
S(sADD, "+");
S(sSUB, "-");
S(sMUL, "*");
S(sDIV, "/");
S(sEQ, "=");
S(sLT, "<");
S(sLE, "<=");
S(sGT, ">");
S(sGE, ">=");
S(sNOT, "not");
pic_leave(pic, ai);
/* root tables */
pic->globals = pic_make_weak(pic);
pic->macros = pic_make_weak(pic);
@ -355,20 +312,18 @@ pic_open(pic_allocf allocf, void *userdata)
pic_reader_init(pic);
/* parameter table */
pic->ptable = pic_cons(pic, pic_make_weak(pic), pic->ptable);
pic->ptable = pic_cons(pic, pic_make_weak(pic), pic_nil_value(pic));
/* standard libraries */
pic_make_library(pic, "picrin.user");
pic_in_library(pic, "picrin.user");
pic_leave(pic, ai);
/* turn on GC */
pic->gc_enable = true;
pic_init_core(pic);
pic_leave(pic, ai);
pic_leave(pic, 0); /* empty arena */
return pic;

2
extlib/benz/symbol.c
View File

@ -27,7 +27,7 @@ pic_intern(pic_state *pic, pic_value str)
return pic_obj_value(sym);
}
kh_val(h, it) = pic_sym_ptr(pic, pic->sQUOTE); /* dummy */
kh_val(h, it) = NULL; /* dummy */
sym = (pic_sym *)pic_obj_alloc(pic, offsetof(pic_sym, env), PIC_TYPE_SYMBOL);
sym->u.str = pic_str_ptr(pic, str);

19
extlib/benz/write.c
View File

@ -5,7 +5,6 @@
#include "picrin.h"
#include "picrin/extra.h"
#include "picrin/private/object.h"
#include "picrin/private/state.h"
KHASH_DECLARE(l, void *, int)
KHASH_DECLARE(v, void *, int)
@ -170,6 +169,8 @@ write_pair_help(struct writer_control *p, pic_value pair)
}
}
#define EQ(sym, lit) (strcmp(pic_str(pic, pic_sym_name(pic, sym)), lit) == 0)
static void
write_pair(struct writer_control *p, pic_value pair)
{
@ -179,42 +180,42 @@ write_pair(struct writer_control *p, pic_value pair)
if (pic_pair_p(pic, pic_cdr(pic, pair)) && pic_nil_p(pic, pic_cddr(pic, pair)) && pic_sym_p(pic, pic_car(pic, pair))) {
tag = pic_car(pic, pair);
if (pic_eq_p(pic, tag, pic->sQUOTE)) {
if (EQ(tag, "quote")) {
xfprintf(pic, file, "'");
write_core(p, pic_cadr(pic, pair));
return;
}
else if (pic_eq_p(pic, tag, pic->sUNQUOTE)) {
else if (EQ(tag, "unquote")) {
xfprintf(pic, file, ",");
write_core(p, pic_cadr(pic, pair));
return;
}
else if (pic_eq_p(pic, tag, pic->sUNQUOTE_SPLICING)) {
else if (EQ(tag, "unquote-splicing")) {
xfprintf(pic, file, ",@");
write_core(p, pic_cadr(pic, pair));
return;
}
else if (pic_eq_p(pic, tag, pic->sQUASIQUOTE)) {
else if (EQ(tag, "quasiquote")) {
xfprintf(pic, file, "`");
write_core(p, pic_cadr(pic, pair));
return;
}
else if (pic_eq_p(pic, tag, pic->sSYNTAX_QUOTE)) {
else if (EQ(tag, "syntax-quote")) {
xfprintf(pic, file, "#'");
write_core(p, pic_cadr(pic, pair));
return;
}
else if (pic_eq_p(pic, tag, pic->sSYNTAX_UNQUOTE)) {
else if (EQ(tag, "syntax-unquote")) {
xfprintf(pic, file, "#,");
write_core(p, pic_cadr(pic, pair));
return;
}
else if (pic_eq_p(pic, tag, pic->sSYNTAX_UNQUOTE_SPLICING)) {
else if (EQ(tag, "syntax-unquote-splicing")) {
xfprintf(pic, file, "#,@");
write_core(p, pic_cadr(pic, pair));
return;
}
else if (pic_eq_p(pic, tag, pic->sSYNTAX_QUASIQUOTE)) {
else if (EQ(tag, "syntax-quasiquote")) {
xfprintf(pic, file, "#`");
write_core(p, pic_cadr(pic, pair));
return;