@@ -184,7 +184,7 @@ typedef int (*gfun_t)();
184
184
typedef void (*pfun_t )(char );
185
185
186
186
enum builtins: builtin_t { NIL, TEE, NOTHING, OPTIONAL, INITIALELEMENT, ELEMENTTYPE, BIT, AMPREST, LAMBDA, MACRO, LET, LETSTAR,
187
- CLOSURE, PSTAR, QUOTE, BACKQUOTE, UNQUOTE, UNQUOTE_SPLICING, CONS, APPEND, DEFUN, DEFVAR, DEFMACRO, CAR, FIRST, CDR, REST, NTH, AREF, STRINGFN, PINMODE, DIGITALWRITE,
187
+ CLOSURE, PSTAR, QUOTE, BACKQUOTE, UNQUOTE, UNQUOTE_SPLICING, CONS, APPEND, DEFUN, SETF, DEFVAR, DEFMACRO, CAR, FIRST, CDR, REST, NTH, AREF, STRINGFN, PINMODE, DIGITALWRITE,
188
188
ANALOGREAD, REGISTER, FORMAT,
189
189
};
190
190
@@ -2162,16 +2162,31 @@ object* sp_or (object* args, object* env) {
2162
2162
return nil;
2163
2163
}
2164
2164
2165
+ // Need to do manual search because findvalue() uses eq() but we need equal() for this.
2166
+ object* find_setf_func (object* whatenv, object* funcname) {
2167
+ object* what = cons (bsymbol (SETF), cons (funcname, nil));
2168
+ for (object* z = whatenv; z != nil; z = cdr (z)) {
2169
+ object* pair = car (z);
2170
+ if (equal (what, car (pair))) return pair;
2171
+ }
2172
+ return nil;
2173
+ }
2174
+
2165
2175
/*
2166
2176
(defun name (parameters) form*)
2167
2177
Defines a function.
2168
2178
*/
2169
2179
object* sp_defun (object* args, object* env) {
2170
2180
(void ) env;
2171
2181
object* var = first (args);
2172
- if (!symbolp (var)) error (notasymbol, var);
2182
+ if (!symbolp (var)) {
2183
+ // Check for (setf foo) forms
2184
+ if (consp (var) && listlength (var) == 2 && eq (first (var), bsymbol (SETF))) /* do nothing */ ;
2185
+ else error (notasymbol, var);
2186
+ }
2173
2187
object* val = cons (bsymbol (LAMBDA), cdr (args));
2174
2188
object* pair = value (var->name , GlobalEnv);
2189
+ if (consp (var) && !pair) pair = find_setf_func (GlobalEnv, second (var));
2175
2190
if (pair != NULL ) cdr (pair) = val;
2176
2191
else push (cons (var, val), GlobalEnv);
2177
2192
return var;
@@ -2384,12 +2399,27 @@ object* sp_decf (object* args, object* env) {
2384
2399
object* sp_setf (object* args, object* env) {
2385
2400
int bit;
2386
2401
object* arg = nil;
2402
+ object* placeform = nil;
2403
+ object** loc;
2387
2404
while (args != NULL ) {
2388
2405
if (cdr (args) == NULL ) error2 (oddargs);
2389
- object** loc = place (first (args), env, &bit);
2406
+ placeform = first (args);
2407
+ // Check for special defsetf forms first before calling place()
2408
+ if (consp (placeform)) {
2409
+ object* funcname = first (placeform);
2410
+ object* userdef = find_setf_func (env, funcname);
2411
+ if (!userdef) userdef = find_setf_func (GlobalEnv, funcname);
2412
+ if (userdef) {
2413
+ // usercode should be a lambda
2414
+ arg = eval (cons (cdr (userdef), cons (second (args), rest (placeform))), env);
2415
+ goto next;
2416
+ }
2417
+ }
2390
2418
arg = eval (second (args), env);
2419
+ loc = place (placeform, env, &bit);
2391
2420
if (bit == -1 ) *loc = arg;
2392
2421
else *loc = number ((checkinteger (*loc) & ~(1 <<bit)) | checkbitvalue (arg)<<bit);
2422
+ next:
2393
2423
args = cddr (args);
2394
2424
}
2395
2425
return arg;
@@ -6451,6 +6481,7 @@ const tbl_entry_t BuiltinTable[] PROGMEM = {
6451
6481
{ string57, fn_cons, MINMAX (FUNCTIONS, 2 , 2 ), doc57 },
6452
6482
{ string92, fn_append, MINMAX (FUNCTIONS, 0 , UNLIMITED), doc92 },
6453
6483
{ string14, sp_defun, MINMAX (SPECIAL_FORMS, 2 , UNLIMITED), doc14 },
6484
+ { string36, sp_setf, MINMAX (SPECIAL_FORMS, 2 , UNLIMITED), doc36 },
6454
6485
{ string15, sp_defvar, MINMAX (SPECIAL_FORMS, 1 , 3 ), doc15 },
6455
6486
{ stringdefmacro, sp_defmacro, MINMAX (SPECIAL_FORMS, 2 , UNLIMITED), docdefmacro },
6456
6487
{ string16, fn_car, MINMAX (FUNCTIONS, 1 , 1 ), doc16 },
@@ -6473,7 +6504,6 @@ const tbl_entry_t BuiltinTable[] PROGMEM = {
6473
6504
{ string33, sp_pop, MINMAX (SPECIAL_FORMS, 1 , 1 ), doc33 },
6474
6505
{ string34, sp_incf, MINMAX (SPECIAL_FORMS, 1 , 2 ), doc34 },
6475
6506
{ string35, sp_decf, MINMAX (SPECIAL_FORMS, 1 , 2 ), doc35 },
6476
- { string36, sp_setf, MINMAX (SPECIAL_FORMS, 2 , UNLIMITED), doc36 },
6477
6507
{ string37, sp_dolist, MINMAX (SPECIAL_FORMS, 1 , UNLIMITED), doc37 },
6478
6508
{ string38, sp_dotimes, MINMAX (SPECIAL_FORMS, 1 , UNLIMITED), doc38 },
6479
6509
{ string39, sp_trace, MINMAX (SPECIAL_FORMS, 0 , 1 ), doc39 },
0 commit comments