diff --git a/ulisp-arm.ino b/ulisp-arm.ino index 4b4b4e2..a30d512 100644 --- a/ulisp-arm.ino +++ b/ulisp-arm.ino @@ -10493,6 +10493,7 @@ void setup () { initkybd(); #endif pfstring(PSTR("uLisp 4.7b "), pserial); pln(pserial); + loadimage(NULL); } // Read/Evaluate/Print loop diff --git a/ulisp-extensions.ino b/ulisp-extensions.ino index 2da59f3..4645e38 100644 --- a/ulisp-extensions.ino +++ b/ulisp-extensions.ino @@ -29,17 +29,104 @@ fn_now(object *args, object *env) return cons(hours, cons(minutes, cons(seconds, NULL))); } +object * +fn_lambdap(object *arg, object *env) +{ + (void) env; + + if (consp(arg)) { + arg = car(arg); + } + + if (builtin(arg->name) == LAMBDA) { + return tee; + } + + return nil; +} + +object * +sp_pform(object *args, object *env) +{ + pfun_t pfun = pserial; + object *sym = car(args); + object *str = car(cdr(args)); + object *obj; + + if (!boundp(sym, env)) { + error2(PSTR("symbol isn't bound")); + } + + if (str == nil) { + obj = startstring(); + pfun = pstr; + } else if (!eq(str, tee)) { + pfun = pstreamfun(args); + } + +#if defined(gfxsupport) + if (pfun == gfxwrite) ppwidth = GFXPPWIDTH; +#endif + + pln(pfun); + + object *pair = eval(sym, env); + object *var = car(pair); + object *val = cdr(pair); + + if (consp(val)) { + pfstring(PSTR("consp val"), pfun); pln(pfun); + } + + if (var->name == LAMBDA) { + pfstring(PSTR("var->name == LAMBDA"), pfun); pln(pfun); + } + + if (builtin(val->name) == LAMBDA) { + pfstring(PSTR("builtin -> LAMBDA"), pfun); pln(pfun); + } + + // if (consp(val) && symbolp(car(val)) && builtin(car(val)->name) == LAMBDA) { + // superprint(cons(bsymbol(DEFUN), cons(var, cdr(val))), 0, pfun); + // } else if (consp(val) && car(val)->type == CODE) { + // superprint(cons(bsymbol(DEFCODE), cons(var, cdr(val))), 0, pfun); + // } else if (consp(val) && var->name == LAMBDA) { + // superprint(cons(bsymbol(DEFUN), cons(sym, val)), 0, pfun); + // } else { + // superprint(cons(bsymbol(DEFVAR), cons(var, cons(quote(val), NULL))), 0, pfun); + // } + + pln(pfun); + ppwidth = PPWIDTH; + + if (str == nil) { + return obj; + } + return nil; +} + // Symbol names -const char stringnow[] PROGMEM = "now"; +const char stringlambdap[] PROGMEM = "lambdap"; +const char stringnow[] PROGMEM = "now"; +const char stringpform[] PROGMEM = "pform"; // Documentation strings + +const char doclambdap[] PROGMEM = "(lambdap x)" +"Returns t if the form passed in is a lambda."; + const char docnow[] PROGMEM = "(now [hh mm ss])\n" "Sets the current time, or with no arguments returns the current time\n" "as a list of three integers (hh mm ss)."; +const char docpform[] PROGMEM = "(pform form str)\n" +"Print a form to a stream in a manner suitable for writing to storage."; + // Symbol lookup table const tbl_entry_t lookup_table2[] PROGMEM = { + { stringlambdap, fn_lambdap, 0211, doclambdap }, { stringnow, fn_now, 0203, docnow }, + { stringpform, sp_pform, 0322, docpform }, }; // Table cross-reference functions