From 25ae52259d68ca4d58c6d33229752be69c6dd458 Mon Sep 17 00:00:00 2001 From: Kyle Isom Date: Fri, 4 Apr 2025 10:01:17 -0700 Subject: [PATCH 1/8] working on pform --- ulisp-arm.ino | 1 + ulisp-extensions.ino | 89 +++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 89 insertions(+), 1 deletion(-) 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 -- 2.40.1 From 101f0b998fd5355e2ee3148d6c229d53d18ceb6d Mon Sep 17 00:00:00 2001 From: Kyle Isom Date: Fri, 4 Apr 2025 16:04:45 -0700 Subject: [PATCH 2/8] starting bcd conversion --- LispLibrary.h | 6 ++++-- ulisp-extensions.ino | 20 ++++++++++++++++++++ 2 files changed, 24 insertions(+), 2 deletions(-) diff --git a/LispLibrary.h b/LispLibrary.h index b23d6f7..bff5e2a 100644 --- a/LispLibrary.h +++ b/LispLibrary.h @@ -172,19 +172,21 @@ Returns a list with all items for which tst is true removed from lst." Returns a list with all items for which tst is false removed from lst." (mapcan #'(lambda (x) (when (funcall tst x) (list x))) lst)) +(defvar *rtc-port* 1) + (defun rtc-set (hr min) "(rtc-set hr min) Set the time on a DS3231 RTC. Times are in BCD, so use the appropriate reader macro, e.g. (rtc-set #x12 #x34) for 12:34. Assumes seconds are zero." - (with-i2c (str #x68) + (with-i2c (str *rtc-port* #x68) (write-byte 0 str) (write-byte 0 str) (write-byte min str) (write-byte hr str))) (defun rtc-get () - (with-i2c (str #x68) + (with-i2c (str *rtc-port* #x68) (write-byte 0 str) (restart-i2c str 3) (reverse diff --git a/ulisp-extensions.ino b/ulisp-extensions.ino index 4645e38..c3734b9 100644 --- a/ulisp-extensions.ino +++ b/ulisp-extensions.ino @@ -2,6 +2,26 @@ User Extensions */ +// Utility functions +uint8_t +dec_to_bcd(uint8_t n) +{ + uint8_t bcd = 0; + uint8_t tens = n / 10; + + bcd = tens << 4; + tens *= 10; + bcd += (n - tens) & 0x0f; + return bcd; +} + + +uint8_t +bcd_to_dec(uint8_t n) +{ + return ((n>>4) * 10) + (n&0x0f); +} + // Definitions object * fn_now(object *args, object *env) -- 2.40.1 From 3d3b27baad211e98af50be9f56359edd0fa52454 Mon Sep 17 00:00:00 2001 From: Kyle Isom Date: Fri, 4 Apr 2025 16:08:17 -0700 Subject: [PATCH 3/8] adding more lisp tools --- lisp/rtc.lsp | 43 +++++++++++++++++++++++++++++++++++++++++++ lisp/sync.sh | 5 +++++ lisp/tools.lsp | 30 ++++++++++++++++++++++++++++++ 3 files changed, 78 insertions(+) create mode 100644 lisp/rtc.lsp create mode 100755 lisp/sync.sh create mode 100644 lisp/tools.lsp diff --git a/lisp/rtc.lsp b/lisp/rtc.lsp new file mode 100644 index 0000000..e0932bb --- /dev/null +++ b/lisp/rtc.lsp @@ -0,0 +1,43 @@ +(defvar *rtc-port* 0) + +(defun rtc-set (hr min) + "(rtc-set hr min) +Set the time on a DS3231 RTC. Times are in BCD, so use +the appropriate reader macro, e.g. (rtc-set #x12 #x34) +for 12:34. Assumes seconds are zero." + (with-i2c (str *rtc-port* #x68) + (write-byte 0 str) + (write-byte 0 str) + (write-byte min str) + (write-byte hr str))) + +(defun bcd-to-dec (x) + "(bcd-to-dec x) +Convert the BCD-encoded number x to a decimal value." + (+ + (* 10 (ash x -4)) + (logand x #xf))) + +(defun dec-to-bcd (x) + "(dec-to-bcd x) +Converts the decimal value to a BCD-encoded number. +Number must be in the range 0 to 99.") + +(defun rtc-get () + (with-i2c (str *rtc-port* #x68) + (write-byte 0 str) + (restart-i2c str 3) + (mapcar bcd-to-dec + (reverse + (list + (read-byte str) + (read-byte str) + (read-byte str)))))) + +(defun rtc-now () + "(rtc-now) +Set the time using the RTC." + (apply now (rtc-get))) + +(defun now-rtc () + diff --git a/lisp/sync.sh b/lisp/sync.sh new file mode 100755 index 0000000..7f91c14 --- /dev/null +++ b/lisp/sync.sh @@ -0,0 +1,5 @@ +#!/bin/sh + +MEDIA="$1" +cp *.lsp "$MEDIA" +umount "$MEDIA" diff --git a/lisp/tools.lsp b/lisp/tools.lsp new file mode 100644 index 0000000..c5132f6 --- /dev/null +++ b/lisp/tools.lsp @@ -0,0 +1,30 @@ +(defun pprintf (sym str) + "(pprintf sym str) +Pretty-print the function pointed to by sym to +the stream, which follows the 'format directives." + (let ((form (eval sym))) + (format str "(defun ~a ~a~%~{ ~a~^~%~})" + (string sym) + (cadr form) + (cddr form)))) + +(defun copy-file (source dest) + (with-sd-card (writer dest 2) + (with-sd-card (reader source) + (loop + (let ((data (read-byte reader))) + (when (null data) + (return)) + (write-byte data writer)))))) + +(defun i2c-scan (port) + (dotimes (addr 127) + (with-i2c (str port addr) + (when str (print addr))))) + +(defun i2c-scan2 (port) + (dotimes (addr 127) + (with-i2c (str port addr) + (format t "~2,0'x: " addr) + (if str (print t) + (print nil))))) -- 2.40.1 From bf7af0e7610b93ce7b68a22b0bfe9cdc9972fa4a Mon Sep 17 00:00:00 2001 From: Kyle Isom Date: Fri, 4 Apr 2025 16:24:36 -0700 Subject: [PATCH 4/8] update RTC code --- lisp/rtc.lsp | 33 +++++++++++++++++++++------------ 1 file changed, 21 insertions(+), 12 deletions(-) diff --git a/lisp/rtc.lsp b/lisp/rtc.lsp index e0932bb..953fd59 100644 --- a/lisp/rtc.lsp +++ b/lisp/rtc.lsp @@ -1,16 +1,5 @@ (defvar *rtc-port* 0) -(defun rtc-set (hr min) - "(rtc-set hr min) -Set the time on a DS3231 RTC. Times are in BCD, so use -the appropriate reader macro, e.g. (rtc-set #x12 #x34) -for 12:34. Assumes seconds are zero." - (with-i2c (str *rtc-port* #x68) - (write-byte 0 str) - (write-byte 0 str) - (write-byte min str) - (write-byte hr str))) - (defun bcd-to-dec (x) "(bcd-to-dec x) Convert the BCD-encoded number x to a decimal value." @@ -21,7 +10,24 @@ Convert the BCD-encoded number x to a decimal value." (defun dec-to-bcd (x) "(dec-to-bcd x) Converts the decimal value to a BCD-encoded number. -Number must be in the range 0 to 99.") +Number must be in the range 0 to 99." + (+ + (ash (floor x 10) 4) + (logand (rem x 10) #xf))) + +(defun rtc-set (h m s) + "(rtc-set hr min sec) +Set the time on a DS3231 RTC. Times are in BCD, so use +the appropriate reader macro, e.g. (rtc-set #x12 #x34 #x00) +for 12:34:00." + (let ((h (dec-to-bcd h)) + (m (dec-to-bcd m)) + (s (dec-to-bcd s))) + (with-i2c (str *rtc-port* #x68) + (write-byte 0 str) + (write-byte s str) + (write-byte m str) + (write-byte h str))) (defun rtc-get () (with-i2c (str *rtc-port* #x68) @@ -40,4 +46,7 @@ Set the time using the RTC." (apply now (rtc-get))) (defun now-rtc () + "(now-rtc) +Sets the RTC time using the now function." + (apply rtc-set (now))) -- 2.40.1 From cb504011c89ab8e46954f5bfb8ea1a5f37faf544 Mon Sep 17 00:00:00 2001 From: Kyle Isom Date: Fri, 4 Apr 2025 16:48:43 -0700 Subject: [PATCH 5/8] updating rtc code --- lisp/rtc.lsp | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/lisp/rtc.lsp b/lisp/rtc.lsp index 953fd59..3f4d7a5 100644 --- a/lisp/rtc.lsp +++ b/lisp/rtc.lsp @@ -15,6 +15,12 @@ Number must be in the range 0 to 99." (ash (floor x 10) 4) (logand (rem x 10) #xf))) +(defun rtc-p () + "(rtc-p) +Returns t if the RTC is connected." + (with-i2c (str *rtc-port* #x68) + (streamp str))) + (defun rtc-set (h m s) "(rtc-set hr min sec) Set the time on a DS3231 RTC. Times are in BCD, so use @@ -27,7 +33,7 @@ for 12:34:00." (write-byte 0 str) (write-byte s str) (write-byte m str) - (write-byte h str))) + (write-byte h str)))) (defun rtc-get () (with-i2c (str *rtc-port* #x68) @@ -49,4 +55,3 @@ Set the time using the RTC." "(now-rtc) Sets the RTC time using the now function." (apply rtc-set (now))) - -- 2.40.1 From a0734f0a4091c6a536fded7e42f812cc79db4afa Mon Sep 17 00:00:00 2001 From: Kyle Isom Date: Fri, 4 Apr 2025 16:50:38 -0700 Subject: [PATCH 6/8] ignore that pesky patch file --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 0b1d7f1..fedd24f 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ build *.uf2 +*.patch -- 2.40.1 From 2070545df7b1994e40dad27e2208a7320fb96738 Mon Sep 17 00:00:00 2001 From: Kyle Isom Date: Mon, 7 Apr 2025 13:24:05 -0700 Subject: [PATCH 7/8] add more lisp --- lisp/bels.lsp | 38 ++++++++++++++++++++++++++++++++++++++ lisp/sync.sh | 19 ++++++++++++++++++- 2 files changed, 56 insertions(+), 1 deletion(-) create mode 100644 lisp/bels.lsp diff --git a/lisp/bels.lsp b/lisp/bels.lsp new file mode 100644 index 0000000..b5f7e60 --- /dev/null +++ b/lisp/bels.lsp @@ -0,0 +1,38 @@ +; +; Ringing the changes +; see http://www.ulisp.com/show?1G42 +; + +(defvar *bell-pin* 3) + +(defun fnd (x lst) + (cond + ((null lst) nil) + ((< x (car lst)) (car lst)) + (t (fnd x (cdr lst))))) + +(defun sub (new old lst) + (cond + ((null lst) nil) + ((eq old (car lst)) (cons new (cdr lst))) + (t (cons (car lst) (sub new old (cdr lst)))))) + +(defun nxt (lst) + (cond + ((not (apply > (cdr lst))) (cons (car lst) (nxt (cdr lst)))) + ((> (car lst) (cadr lst)) nil) + (t (let* ((rest (reverse (cdr lst))) + (old (fnd (car lst) rest))) + (cons old (sub (car lst) old rest)))))) + +(defun all (fun lst) + (when lst + (funcall fun lst) + (all fun (nxt lst)))) + +(defun bel (lis) + (mapc + (lambda (x) (note *bell-pin* x 4) (delay 500) (note) (delay 125)) + lis) + (delay 500)) + diff --git a/lisp/sync.sh b/lisp/sync.sh index 7f91c14..dee2379 100755 --- a/lisp/sync.sh +++ b/lisp/sync.sh @@ -1,5 +1,22 @@ #!/bin/sh -MEDIA="$1" +if [ "$(uname -s)" = "Linux" ] +then + DEFAULT_MOUNT="/media/kyle/ULISP" +else + DEFAULT_MOUNT="/Volumes/ULISP" +fi + +MEDIA="${1:-${DEFAULT_MOUNT}}" + +if [ ! -d "${MEDIA}" ] +then + echo "[!] ${MEDIA} isn't mounted!" + exit 1 +fi + +echo "[+] transferring lisp files to ${MEDIA}..." cp *.lsp "$MEDIA" +echo "[+] unmounting ${MEDIA}" umount "$MEDIA" +echo "[+] transfer complete" -- 2.40.1 From 3198c2ff6f13f14f378a83b00d86b1ed86b35bef Mon Sep 17 00:00:00 2001 From: Kyle Isom Date: Mon, 7 Apr 2025 14:40:01 -0700 Subject: [PATCH 8/8] add symboldef and clean up lib --- LispLibrary.h | 95 ++++++++++++++++++--------- ulisp-extensions.ino | 151 ++++++++++++++++++++++++++----------------- 2 files changed, 155 insertions(+), 91 deletions(-) diff --git a/LispLibrary.h b/LispLibrary.h index bff5e2a..1e0aa33 100644 --- a/LispLibrary.h +++ b/LispLibrary.h @@ -13,11 +13,13 @@ Returns t if tst is true for every item in lst, or nil on the first false item." "(load filename) Open the Lisp file on the SD card and load the contents into the workspace." (with-sd-card (str filename) - (loop - (let ((form (read str))) - (unless form (return)) - (print (second form)) - (eval form))))) + (let ((lst nil)) + (loop + (let ((form (read str))) + (unless form (return)) + (setf lst (cons (quote (second form)) lst)) + (eval form))) + (reverse lst)))) (defun rgb (r g b) "(rgb r g b) @@ -172,33 +174,66 @@ Returns a list with all items for which tst is true removed from lst." Returns a list with all items for which tst is false removed from lst." (mapcan #'(lambda (x) (when (funcall tst x) (list x))) lst)) -(defvar *rtc-port* 1) -(defun rtc-set (hr min) - "(rtc-set hr min) -Set the time on a DS3231 RTC. Times are in BCD, so use -the appropriate reader macro, e.g. (rtc-set #x12 #x34) -for 12:34. Assumes seconds are zero." - (with-i2c (str *rtc-port* #x68) - (write-byte 0 str) - (write-byte 0 str) - (write-byte min str) - (write-byte hr str))) +(defvar *packages* nil) -(defun rtc-get () - (with-i2c (str *rtc-port* #x68) - (write-byte 0 str) - (restart-i2c str 3) - (reverse - (list - (read-byte str) - (read-byte str) - (read-byte str))))) +(defun load-package (filename ) + (let* ((filename (concatenate 'string filename ".pkg")) + (forms (load filename))) + (setf *packages* -(defun rtc-now () - "(rtc-now) -Set the time using the RTC." - (now (rtc-get))) +(defun save-package (filename lst) + (with-sd-card (str filename 2) + (dolist (f lst) + (symbol-def f str)))) + +(defun add-to-package (filename list) + (with-sd-card (str filename 1) + (dolist (f lst) + (symbol-def f str)))) + +(defun %edit (fun) + (cond + ((null *cmds*) fun) + ((eq (car *cmds*) #\b) (pop *cmds*) fun) + ((eq (car *cmds*) #\e) (pop *cmds*) (%edit (list fun))) + ((eq (car *cmds*) #\h) (pop *cmds*) (%edit (cons 'highlight (list fun)))) + ((consp (car *cmds*)) + (let ((val (cdar *cmds*))) + (case (caar *cmds*) + (#\r (pop *cmds*) (%edit val)) + ((#\c #\i) (pop *cmds*) (%edit (cons val fun))) + (#\f (cond + ((null fun) nil) + ((equal val fun) (pop *cmds*) (%edit fun)) + ((atom fun) fun) + (t (cons (%edit (car fun)) (%edit (cdr fun))))))))) + ((atom fun) (pop *cmds*) (%edit fun)) + ((eq (car *cmds*) #\d) (pop *cmds*) (%edit (cons (car fun) (%edit (cdr fun))))) + ((eq (car *cmds*) #\a) (pop *cmds*) (%edit (cons (%edit (car fun)) (cdr fun)))) + ((eq (car *cmds*) #\x) (pop *cmds*) (%edit (cdr fun))) + (t fun))) + +(defun edit (name) + (let ((fun (eval name)) + cc) + (setq *cmds* nil) + (loop + (write-byte 12) + (setq cc (append cc (list #\h))) + (setq *cmds* cc) + (pprint (%edit fun)) + (setq cc (butlast cc)) + (let ((c (get-key))) + (case c + (#\q (set name fun) (return name)) + (#\s (setq *cmds* cc) (set name (%edit fun)) (return name)) + (#\z (when cc (setq cc (butlast cc)))) + ((#\r #\c #\i #\f #\e) + (write-byte 11) (princ c) (princ #\:) + (setq cc (append cc (list (cons c (read)))))) + ((#\d #\a #\x #\b) + (setq cc (append cc (list c)))) + (t (write-byte 7))))))) )lisplibrary"; - diff --git a/ulisp-extensions.ino b/ulisp-extensions.ino index c3734b9..ee14925 100644 --- a/ulisp-extensions.ino +++ b/ulisp-extensions.ino @@ -49,6 +49,87 @@ fn_now(object *args, object *env) return cons(hours, cons(minutes, cons(seconds, NULL))); } + +void +hyperprint(object *form, int lm, pfun_t pfun) +{ + if (atom(form)) { + if (isbuiltin(form, NOTHING)) { + printsymbol(form, pfun); + } else { + printobject(form, pfun); + } + } else if (quoted(form)) { + pfun('\''); + hyperprint(car(cdr(form)), lm + 1, pfun); + } else { + lm = lm + PPINDENT; + bool fits = (subwidth(form, PPWIDTH - lm - PPINDENT) >= 0); + int special = 0, extra = 0; bool separate = true; + object *arg = car(form); + + if (symbolp(arg) && builtinp(arg->name)) { + uint8_t minmax = getminmax(builtin(arg->name)); + if (minmax == 0327 || minmax == 0313) { + special = 2; // defun, setq, setf, defvar + } else if (minmax == 0317 || minmax == 0017 || + minmax == 0117 || minmax == 0123) { + special = 1; + } + } + + while (form != NULL) { + if (atom(form)) { + pfstring(PSTR(" . "), pfun); + printobject(form, pfun); + pfun(')'); + return; + } else if (separate) { + pfun('('); + separate = false; + } else if (special) { + pfun(' '); + special--; + } else if (fits) { + pfun(' '); + } else { + pln(pfun); + indent(lm, ' ', pfun); + } + + hyperprint(car(form), lm+extra, pfun); + form = cdr(form); + } + pfun(')'); + } +} + +object * +fn_sym_def(object *args, object *env) +{ + (void) env; + + object *obj = first(args); + pfun_t pfun = pstreamfun(cdr(args)); +#if defined(gfxsupport) + if (pfun == gfxwrite) ppwidth = GFXPPWIDTH; +#endif + object *pair = findvalue(obj, env); + object *var = car(pair); + object *val = cdr(pair); + pln(pfun); + + if (consp(val) && symbolp(car(val)) && builtin(car(val)->name) == LAMBDA) { + hyperprint(cons(bsymbol(DEFUN), cons(var, cdr(val))), 0, pfun); + } else { + hyperprint(cons(bsymbol(DEFVAR), cons(var, cons(quote(val), NULL))), 0, pfun); + } + + pln(pfun); + ppwidth = PPWIDTH; + return bsymbol(NOTHING); +} + object * fn_lambdap(object *arg, object *env) { @@ -65,70 +146,11 @@ fn_lambdap(object *arg, object *env) 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 stringlambdap[] PROGMEM = "lambdap"; const char stringnow[] PROGMEM = "now"; -const char stringpform[] PROGMEM = "pform"; +const char string_sym_def[] PROGMEM = "symbol-def"; // Documentation strings @@ -142,11 +164,18 @@ const char docnow[] PROGMEM = "(now [hh mm ss])\n" const char docpform[] PROGMEM = "(pform form str)\n" "Print a form to a stream in a manner suitable for writing to storage."; +const char doc_sym_def[] PROGMEM = "(symbol-def symbol [str])\n" +"Prints the definition of a symbol (variable or function) defined in\n" +"ulisp using the pretty printer." +"If str is specified it prints to the specified stream.\n" +"It returns no value."; + + // 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 }, + { string_sym_def, fn_sym_def, 0212, doc_sym_def }, }; // Table cross-reference functions -- 2.40.1