@@ -81,10 +81,41 @@ const char stringsizeof[] PROGMEM = "sizeof";
8181const 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
85115const 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