Skip to content

Commit 5f3a1b9

Browse files
1 parent 1e3aad3 commit 5f3a1b9

File tree

1 file changed

+31
-0
lines changed

1 file changed

+31
-0
lines changed

extensions.hpp

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -81,10 +81,41 @@ const char stringsizeof[] PROGMEM = "sizeof";
8181
const char docsizeof[] PROGMEM = "(sizeof obj)\n"
8282
"Returns the number of Lisp cells the object occupies in memory.";
8383

84+
void destructure (object* structure, object* data, object** env) {
85+
if (structure == nil) return;
86+
if (symbolp(structure)) push(cons(structure, data), *env);
87+
else if (consp(structure)) {
88+
if (!consp(data)) error(canttakecar, data);
89+
destructure(car(structure), car(data), env);
90+
destructure(cdr(structure), cdr(data), env);
91+
}
92+
else error(invalidarg, structure);
93+
}
94+
95+
object* sp_destructuring_bind (object* args, object* env) {
96+
object* structure = first(args);
97+
object* data_expr = second(args);
98+
protect(data_expr);
99+
object* data = eval(data_expr, env);
100+
unprotect();
101+
object* body = cddr(args);
102+
destructure(structure, data, &env);
103+
protect(body);
104+
object* result = eval(tf_progn(body, env), env);
105+
unprotect();
106+
return result;
107+
}
108+
109+
const char stringdestructuringbind[] PROGMEM = "destructuring-bind";
110+
const char docdestructuringbind[] PROGMEM = "(destructuring-bind structure data [forms*])\n\n"
111+
"Recursively assigns the datums of `data` to the symbols named in `structure`,\n"
112+
"and then evaluates forms in that new environment.";
113+
84114
// Symbol lookup table
85115
const tbl_entry_t ExtensionsTable[] PROGMEM = {
86116
{ stringnow, fn_now, MINMAX(FUNCTIONS, 0, 3), docnow },
87117
{ stringgensym, fn_gensym, MINMAX(FUNCTIONS, 0, 1), docgensym },
88118
{ stringintern, fn_intern, MINMAX(FUNCTIONS, 1, 1), docintern },
89119
{ stringsizeof, fn_sizeof, MINMAX(FUNCTIONS, 1, 1), docsizeof },
120+
{ stringdestructuringbind, sp_destructuring_bind, MINMAX(SPECIAL_FORMS, 2, UNLIMITED), docdestructuringbind },
90121
};

0 commit comments

Comments
 (0)