@@ -81,10 +81,41 @@ const char stringsizeof[] PROGMEM = "sizeof";
81
81
const char docsizeof[] PROGMEM = " (sizeof obj)\n "
82
82
" Returns the number of Lisp cells the object occupies in memory." ;
83
83
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
+
84
114
// Symbol lookup table
85
115
const tbl_entry_t ExtensionsTable[] PROGMEM = {
86
116
{ stringnow, fn_now, MINMAX (FUNCTIONS, 0 , 3 ), docnow },
87
117
{ stringgensym, fn_gensym, MINMAX (FUNCTIONS, 0 , 1 ), docgensym },
88
118
{ stringintern, fn_intern, MINMAX (FUNCTIONS, 1 , 1 ), docintern },
89
119
{ stringsizeof, fn_sizeof, MINMAX (FUNCTIONS, 1 , 1 ), docsizeof },
120
+ { stringdestructuringbind, sp_destructuring_bind, MINMAX (SPECIAL_FORMS, 2 , UNLIMITED), docdestructuringbind },
90
121
};
0 commit comments