summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--com.c104
-rw-r--r--tests/letstar.out1
-rw-r--r--tests/vars6.bth11
-rw-r--r--tests/vars6.out8
-rw-r--r--tests/vars7.bth7
-rw-r--r--tests/vars7.out2
-rw-r--r--todo1
7 files changed, 87 insertions, 47 deletions
diff --git a/com.c b/com.c
index 2465777..23abeaa 100644
--- a/com.c
+++ b/com.c
@@ -115,9 +115,11 @@ static void compile_call_instr(Compiler *C, uint8_t len) {
}
static void compile_endscope_instr(Compiler *C, uint8_t nlocals) {
- compile_opcode(C, OP_ENDSCOPE);
- compile_byte(C, nlocals);
- C->stack_cur -= nlocals;
+ if (nlocals > 0) {
+ compile_opcode(C, OP_ENDSCOPE);
+ compile_byte(C, nlocals);
+ C->stack_cur -= nlocals;
+ }
}
static size_t placeholder(Compiler *C) {
@@ -133,46 +135,53 @@ static void patch(Compiler *C, size_t addr, uint16_t val) {
// ----
-static void compile_node(Compiler *C, AstNode a);
+static void compile_node(Compiler *C, AstNode a, bool toplevel);
+static void begin_scope(Compiler *C);
+static void end_scope(Compiler *C);
-typedef void (*form_compiler)(Compiler *C, AstVec l, Op op);
+typedef void (*form_compiler)(Compiler *C, AstVec l, Op op, bool toplevel);
+static void compile_body(Compiler *C, AstVec l, int startat) {
+ begin_scope(C);
+ for (int i = startat; i < l.len - 1; i++) {
+ compile_node(C, l.vals[i], true);
+ compile_opcode(C, OP_DROP);
+ }
+ compile_node(C, l.vals[l.len - 1], true);
+ end_scope(C);
+}
void single_form(Compiler *C, AstVec l, Op op) {
- compile_node(C, l.vals[1]);
+ compile_node(C, l.vals[1], false);
compile_opcode(C, op);
}
static Local *locate_local(Compiler *C, char *name);
-void set_form(Compiler *C, AstVec l, Op _) {
+void set_form(Compiler *C, AstVec l, Op _, bool __) {
AstNode ident = l.vals[1];
CHECK(ident.ty == AST_IDENT, "set's first argument must be identifier");
char *name = ident.as.str;
Local *loc = locate_local(C, name);
if (loc != NULL) {
- compile_node(C, l.vals[2]);
+ compile_node(C, l.vals[2], false);
compile_opcode(C, OP_SETLOCAL);
compile_byte(C, loc->slot);
} else {
// write global
ObjString *o = objstring_copy_cstr(C->S, name);
- compile_node(C, l.vals[2]);
+ compile_node(C, l.vals[2], false);
compile_opcode(C, OP_SETGLOBAL);
compile_byte(C, compile_constant(C, VAL_OBJ(o)));
}
}
-void do_form(Compiler *C, AstVec l, Op _) {
- for (int i = 1; i < l.len - 1; i++) {
- compile_node(C, l.vals[i]);
- compile_opcode(C, OP_DROP);
- }
- compile_node(C, l.vals[l.len - 1]);
+void do_form(Compiler *C, AstVec l, Op _, bool __) {
+ compile_body(C, l, 1);
}
-void if_form(Compiler *C, AstVec l, Op _) {
+void if_form(Compiler *C, AstVec l, Op _, bool __) {
// (if cond if-true if-false)
// cond
// 0branch ->A
@@ -183,10 +192,10 @@ void if_form(Compiler *C, AstVec l, Op _) {
int orig_stack_cur = C->stack_cur;
- compile_node(C, l.vals[1]);
+ compile_node(C, l.vals[1], false);
compile_opcode(C, OP_0BRANCH);
size_t ph_a = placeholder(C);
- compile_node(C, l.vals[2]);
+ compile_node(C, l.vals[2], false);
compile_opcode(C, OP_SKIP);
size_t ph_b = placeholder(C);
@@ -194,7 +203,7 @@ void if_form(Compiler *C, AstVec l, Op _) {
int stack_cur_a = C->stack_cur;
C->stack_cur = orig_stack_cur;
- compile_node(C, l.vals[3]);
+ compile_node(C, l.vals[3], false);
size_t dest_b = BYTECODE(C).len;
int stack_cur_b = C->stack_cur;
@@ -206,7 +215,7 @@ void if_form(Compiler *C, AstVec l, Op _) {
CHECK(stack_cur_a == orig_stack_cur + 1, "this should never happen");
}
-void while_form(Compiler *C, AstVec l, Op _) {
+void while_form(Compiler *C, AstVec l, Op _, bool __) {
// (while cond body ...)
// A:
// cond
@@ -216,13 +225,11 @@ void while_form(Compiler *C, AstVec l, Op _) {
// B:
// nil (while loop always returns nil)
size_t dest_a = BYTECODE(C).len;
- compile_node(C, l.vals[1]);
+ compile_node(C, l.vals[1], false);
compile_opcode(C, OP_0BRANCH);
size_t ph_b = placeholder(C);
- for (int i = 2; i < l.len; i++) {
- compile_node(C, l.vals[i]);
- compile_opcode(C, OP_DROP);
- }
+ compile_body(C, l, 2);
+ compile_opcode(C, OP_DROP);
compile_opcode(C, OP_REDO);
size_t ph_a = placeholder(C);
size_t dest_b = BYTECODE(C).len;
@@ -232,9 +239,9 @@ void while_form(Compiler *C, AstVec l, Op _) {
patch(C, ph_b, dest_b - ph_b - 2);
}
-void arith_form(Compiler *C, AstVec l, Op op) {
- compile_node(C, l.vals[1]);
- compile_node(C, l.vals[2]);
+void arith_form(Compiler *C, AstVec l, Op op, bool __) {
+ compile_node(C, l.vals[1], false);
+ compile_node(C, l.vals[2], false);
compile_opcode(C, op);
}
@@ -281,30 +288,38 @@ static Local *locate_local(Compiler *C, char *name) {
return NULL;
}
-void let_form(Compiler *C, AstVec l, Op _) {
+void let_form(Compiler *C, AstVec l, Op _, bool __) {
CHECK(l.vals[1].ty == AST_LIST, "let's first argument must be list");
AstVec bindlist = l.vals[1].as.list;
CHECK(bindlist.len % 2 == 0, "unmatched binding in let");
int nbinds = bindlist.len / 2;
begin_scope(C);
+
for (int i = 0; i < nbinds; i++) {
int ix = i * 2;
AstNode name = bindlist.vals[ix];
AstNode expr = bindlist.vals[ix+1];
CHECK(name.ty == AST_IDENT, "binding name must be identifier");
- compile_node(C, expr);
+ compile_node(C, expr, false);
declare_local(C, name.as.str);
}
- for (int i = 2; i < l.len - 1; i++) {
- compile_node(C, l.vals[i]);
- compile_opcode(C, OP_DROP);
- }
- compile_node(C, l.vals[l.len-1]);
+
+ compile_body(C, l, 2);
+
end_scope(C);
}
-void fn_form(Compiler *C, AstVec l, Op _) {
+void def_form(Compiler *C, AstVec l, Op _, bool toplevel) {
+ CHECK(l.vals[1].ty == AST_IDENT, "def's first argument must be ident");
+ CHECK(toplevel, "def only allowed at top level");
+ compile_node(C, l.vals[2], false);
+ declare_local(C, l.vals[1].as.str);
+ // whatever is calling us will compile an OP_DROP next
+ compile_opcode(C, OP_NIL);
+}
+
+void fn_form(Compiler *C, AstVec l, Op _, bool __) {
// (fn (arg arg arg) body ...)
CHECK(l.vals[1].ty == AST_LIST, "fn's first argument must be list");
AstVec arglist = l.vals[1].as.list;
@@ -327,11 +342,7 @@ void fn_form(Compiler *C, AstVec l, Op _) {
declare_local(SC, argname.as.str);
}
- for (int i = 2; i < l.len - 1; i++) {
- compile_node(SC, l.vals[i]);
- compile_opcode(SC, OP_DROP);
- }
- compile_node(&subcompiler, l.vals[l.len-1]);
+ compile_body(SC, l, 2);
end_scope(SC);
compile_opcode(SC, OP_RET);
@@ -355,6 +366,7 @@ static BuiltinForm builtin_forms[] = {
{ "while", 2, true, while_form, 0 },
{ "fn", 2, true, fn_form, 0 },
{ "let", 2, true, let_form, 0 },
+ { "def", 2, false, def_form, 0 },
#define ARITH_OP(str, op) \
{ str, 2, false, arith_form, op },
ARITH_OP("+", OP_ADD)
@@ -381,7 +393,7 @@ static BuiltinIdent builtin_idents[] = {
-static void compile_node(Compiler *C, AstNode a) {
+static void compile_node(Compiler *C, AstNode a, bool toplevel) {
switch (a.ty) {
case AST_IDENT:;
char *ident = a.as.str;
@@ -420,7 +432,7 @@ static void compile_node(Compiler *C, AstNode a) {
compile_opcode(C, OP_ARRNEW);
AstVec v = a.as.list;
for (int i = 0; i < v.len; i++) {
- compile_node(C, v.vals[i]);
+ compile_node(C, v.vals[i], false);
compile_opcode(C, OP_ARRAPPEND);
}
break;
@@ -452,7 +464,7 @@ static void compile_node(Compiler *C, AstNode a) {
CHECK(nparams == form->min_params, "%s requires exactly %d parameters",
form->name, form->min_params);
- form->action(C, l, form->op);
+ form->action(C, l, form->op, toplevel);
} else {
// function call
// (f a b c )
@@ -461,7 +473,7 @@ static void compile_node(Compiler *C, AstNode a) {
exit(1);
}
for (int i = 0; i < l.len; i++) {
- compile_node(C, l.vals[i]);
+ compile_node(C, l.vals[i], false);
}
compile_call_instr(C, l.len);
}
@@ -526,7 +538,7 @@ int main(int argc, char **argv) {
do {
astnode_free(&an);
rv = pcc_parse(parser, &an);
- compile_node(&com, an);
+ compile_node(&com, an, false);
} while (rv != 0);
pcc_destroy(parser);
}
diff --git a/tests/letstar.out b/tests/letstar.out
new file mode 100644
index 0000000..3d4c7bf
--- /dev/null
+++ b/tests/letstar.out
@@ -0,0 +1 @@
+220
diff --git a/tests/vars6.bth b/tests/vars6.bth
new file mode 100644
index 0000000..30d3851
--- /dev/null
+++ b/tests/vars6.bth
@@ -0,0 +1,11 @@
+(do
+ (let (a 100 b 200 c 300) (say b))
+ (do
+ (let (a 100 b 200 c 300) (say b))
+ (def x 99)
+ (say "hii")
+ (say x)
+ (let (a 100 b 200 c 300) (say b))
+ (let (x 77) (say x))
+ (say x))
+ (let (a 100 b 200 c 300) (say b)))
diff --git a/tests/vars6.out b/tests/vars6.out
new file mode 100644
index 0000000..5d1335a
--- /dev/null
+++ b/tests/vars6.out
@@ -0,0 +1,8 @@
+200
+200
+hii
+99
+200
+77
+99
+200
diff --git a/tests/vars7.bth b/tests/vars7.bth
new file mode 100644
index 0000000..6bcbace
--- /dev/null
+++ b/tests/vars7.bth
@@ -0,0 +1,7 @@
+(do
+ (say (if (< 3 2)
+ "hii"
+ (do
+ (def x 100)
+ x)))
+ (let (a 100 b 200 c 300) (say b)))
diff --git a/tests/vars7.out b/tests/vars7.out
new file mode 100644
index 0000000..15c2ac3
--- /dev/null
+++ b/tests/vars7.out
@@ -0,0 +1,2 @@
+100
+200
diff --git a/todo b/todo
index 3ffe892..744be41 100644
--- a/todo
+++ b/todo
@@ -23,7 +23,6 @@ good loops
array for each
functional variants of the above
variants of the above that record an array of all their results
-declarations inline
pattern matching
probably doesn't need to be too complex
garbage collector