diff --git a/include/picrin/pair.h b/include/picrin/pair.h index c44aef8e..a298e257 100644 --- a/include/picrin/pair.h +++ b/include/picrin/pair.h @@ -8,6 +8,7 @@ pic_value pic_cdr(pic_state *, pic_value); bool pic_list_p(pic_state *, pic_value); pic_value pic_list(pic_state *, size_t, ...); +int pic_length(pic_state *, pic_value); pic_value pic_reverse(pic_state *, pic_value); pic_value pic_assq(pic_state *, pic_value key, pic_value assoc); diff --git a/include/picrin/value.h b/include/picrin/value.h index 456f2284..903367a5 100644 --- a/include/picrin/value.h +++ b/include/picrin/value.h @@ -85,5 +85,6 @@ pic_value pic_float_value(double); #define pic_undef_p(v) ((v).type == PIC_VTYPE_UNDEF) #define pic_float_p(v) ((v).type == PIC_VTYPE_FLOAT) #define pic_pair_p(v) (pic_type(v) == PIC_TT_PAIR) +#define pic_symbol_p(v) (pic_type(v) == PIC_TT_SYMBOL) #endif diff --git a/src/codegen.c b/src/codegen.c index b27df0ee..bb411cdf 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -192,16 +192,27 @@ codegen(codegen_state *state, pic_value obj) case PIC_TT_PAIR: { pic_value proc; + if (! pic_list_p(pic, obj)) { + pic_error(pic, "invalid expression given"); + } + proc = pic_car(pic, obj); if (pic_eq_p(pic, proc, pic->sDEFINE)) { int idx; - const char *name; + pic_value var; - name = pic_symbol_ptr(pic_car(pic, pic_cdr(pic, obj)))->name; - idx = scope_global_define(pic, name); + if (pic_length(pic, obj) != 3) { + pic_error(pic, "syntax error"); + } + + var = pic_car(pic, pic_cdr(pic, obj)); + if (! pic_symbol_p(var)) { + pic_error(pic, "syntax error"); + } + + idx = scope_global_define(pic, pic_symbol_ptr(var)->name); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); - irep->code[irep->clen].insn = OP_GSET; irep->code[irep->clen].u.i = idx; irep->clen++; @@ -221,6 +232,10 @@ codegen(codegen_state *state, pic_value obj) else if (pic_eq_p(pic, proc, pic->sIF)) { int s,t; + if (pic_length(pic, obj) != 4) { + pic_error(pic, "syntax error"); + } + codegen(state, pic_car(pic, pic_cdr(pic, obj))); irep->code[irep->clen].insn = OP_JMPIF; @@ -252,11 +267,19 @@ codegen(codegen_state *state, pic_value obj) } else if (pic_eq_p(pic, proc, pic->sSETBANG)) { codegen_scope *s; + pic_value var; int depth, idx; - const char *name; - name = pic_symbol_ptr(pic_car(pic, pic_cdr(pic, obj)))->name; - s = scope_lookup(state, name, &depth, &idx); + if (pic_length(pic, obj) != 3) { + pic_error(pic, "syntax error"); + } + + var = pic_car(pic, pic_cdr(pic, obj)); + if (! pic_symbol_p(var)) { + pic_error(pic, "syntax error"); + } + + s = scope_lookup(state, pic_symbol_ptr(var)->name, &depth, &idx); if (! s) { pic_error(pic, "unbound variable"); } @@ -288,6 +311,11 @@ codegen(codegen_state *state, pic_value obj) } else if (pic_eq_p(pic, proc, pic->sQUOTE)) { int pidx; + + if (pic_length(pic, obj) != 2) { + pic_error(pic, "syntax error"); + } + pidx = pic->plen++; pic->pool[pidx] = pic_car(pic, pic_cdr(pic, obj)); irep->code[irep->clen].insn = OP_PUSHCONST; @@ -295,7 +323,15 @@ codegen(codegen_state *state, pic_value obj) irep->clen++; break; } + +#define ARGC_ASSERT(n) do { \ + if (pic_length(pic, obj) != (n) + 1) { \ + pic_error(pic, "wrong number of arguments"); \ + } \ + } while (0) + else if (pic_eq_p(pic, proc, pic->sCONS)) { + ARGC_ASSERT(2); codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); irep->code[irep->clen].insn = OP_CONS; @@ -303,24 +339,28 @@ codegen(codegen_state *state, pic_value obj) break; } else if (pic_eq_p(pic, proc, pic->sCAR)) { + ARGC_ASSERT(1); codegen(state, pic_car(pic, pic_cdr(pic, obj))); irep->code[irep->clen].insn = OP_CAR; irep->clen++; break; } else if (pic_eq_p(pic, proc, pic->sCDR)) { + ARGC_ASSERT(1); codegen(state, pic_car(pic, pic_cdr(pic, obj))); irep->code[irep->clen].insn = OP_CDR; irep->clen++; break; } else if (pic_eq_p(pic, proc, pic->sNILP)) { + ARGC_ASSERT(1); codegen(state, pic_car(pic, pic_cdr(pic, obj))); irep->code[irep->clen].insn = OP_NILP; irep->clen++; break; } else if (pic_eq_p(pic, proc, pic->sADD)) { + ARGC_ASSERT(2); codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); irep->code[irep->clen].insn = OP_ADD; @@ -328,6 +368,7 @@ codegen(codegen_state *state, pic_value obj) break; } else if (pic_eq_p(pic, proc, pic->sSUB)) { + ARGC_ASSERT(2); codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); irep->code[irep->clen].insn = OP_SUB; @@ -335,6 +376,7 @@ codegen(codegen_state *state, pic_value obj) break; } else if (pic_eq_p(pic, proc, pic->sMUL)) { + ARGC_ASSERT(2); codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); irep->code[irep->clen].insn = OP_MUL; @@ -342,6 +384,7 @@ codegen(codegen_state *state, pic_value obj) break; } else if (pic_eq_p(pic, proc, pic->sDIV)) { + ARGC_ASSERT(2); codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); irep->code[irep->clen].insn = OP_DIV; @@ -349,6 +392,7 @@ codegen(codegen_state *state, pic_value obj) break; } else if (pic_eq_p(pic, proc, pic->sEQ)) { + ARGC_ASSERT(2); codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); irep->code[irep->clen].insn = OP_EQ; @@ -356,6 +400,7 @@ codegen(codegen_state *state, pic_value obj) break; } else if (pic_eq_p(pic, proc, pic->sLT)) { + ARGC_ASSERT(2); codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); irep->code[irep->clen].insn = OP_LT; @@ -363,6 +408,7 @@ codegen(codegen_state *state, pic_value obj) break; } else if (pic_eq_p(pic, proc, pic->sLE)) { + ARGC_ASSERT(2); codegen(state, pic_car(pic, pic_cdr(pic, obj))); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); irep->code[irep->clen].insn = OP_LE; @@ -370,6 +416,7 @@ codegen(codegen_state *state, pic_value obj) break; } else if (pic_eq_p(pic, proc, pic->sGT)) { + ARGC_ASSERT(2); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); codegen(state, pic_car(pic, pic_cdr(pic, obj))); irep->code[irep->clen].insn = OP_LT; @@ -377,6 +424,7 @@ codegen(codegen_state *state, pic_value obj) break; } else if (pic_eq_p(pic, proc, pic->sGE)) { + ARGC_ASSERT(2); codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj)))); codegen(state, pic_car(pic, pic_cdr(pic, obj))); irep->code[irep->clen].insn = OP_LE; @@ -448,20 +496,52 @@ codegen_call(codegen_state *state, pic_value obj) irep->clen++; } +static bool +valid_formal(pic_state *pic, pic_value formal) +{ + if (pic_symbol_p(formal)) + return true; + + while (! pic_pair_p(formal)) { + if (! pic_symbol_p(pic_car(pic, formal))) { + return false; + } + formal = pic_cdr(pic, formal); + } + if (pic_nil_p(formal)) + return true; + if (pic_symbol_p(formal)) + return true; + + return false; +} + static struct pic_irep * codegen_lambda(codegen_state *state, pic_value obj) { pic_state *pic = state->pic; codegen_scope *prev_scope; struct pic_irep *prev_irep, *irep; - pic_value body, v; + pic_value args, body, v; int i; + if (pic_length(pic, obj) < 2) { + pic_error(pic, "syntax error"); + } + + args = pic_car(pic, pic_cdr(pic, obj)); + if (! valid_formal(pic, args)) { + pic_error(pic, "syntax error"); + } + if (! pic_list_p(pic, args)) { + pic_error(pic, "variable-length argument not supported (for now)"); + } + /* inner environment */ prev_irep = state->irep; prev_scope = state->scope; - state->scope = new_local_scope(pic, pic_car(pic, pic_cdr(pic, obj)), state->scope); + state->scope = new_local_scope(pic, args, state->scope); state->irep = irep = new_irep(pic); irep->argc = state->scope->argc; { diff --git a/src/pair.c b/src/pair.c index 68ae7ac4..072cb97e 100644 --- a/src/pair.c +++ b/src/pair.c @@ -67,6 +67,19 @@ pic_list(pic_state *pic, size_t c, ...) return pic_reverse(pic, v); } +int +pic_length(pic_state *pic, pic_value obj) +{ + int c = 0; + + while (! pic_nil_p(obj)) { + obj = pic_cdr(pic, obj); + ++c; + } + + return c; +} + pic_value pic_reverse(pic_state *pic, pic_value list) {