Quality of life improvements:

- Add standard library
- Update display

LispLibrary.h

@@ -0,0 +1,176 @@
+// Library of additional Lisp functions with integral documentation
+// LispLibrary.h - Version 2 - 5th November 2023
+
+const char LispLibrary[] PROGMEM = R"lisplibrary(
+
+(defun every (tst lst)
+  "(every tst lst)
+Returns t if tst is true for every item in lst, or nil on the first false item."
+  (if (null lst) t
+    (and (funcall tst (car lst)) (every tst (cdr lst)))))
+
+(defun load (filename)
+ "(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)))))
+
+(defun rgb (r g b)
+  "(rgb r g b)
+Define a colour from its RGB components."
+  (logior (ash (logand r #xf8) 8) (ash (logand g #xfc) 3) (ash b -3)))
+
+(defun hsv (h s v)
+  "(hsv h s v)
+Specify colours in the alternative HSV colour system."
+  (let* ((chroma (* v s))
+         (x (* chroma (- 1 (abs (- (mod (/ h 60) 2) 1)))))
+         (m (- v chroma))
+         (i (truncate h 60))
+         (params (list chroma x 0 0 x chroma))
+         (r (+ m (nth i params)))
+         (g (+ m (nth (mod (+ i 4) 6) params)))
+         (b (+ m (nth (mod (+ i 2) 6) params))))
+    (rgb (round (* r 255)) (round (* g 255)) (round (* b 255)))))
+
+(defun col (n)
+  "(col n)
+Defines a different colour for each value of n from 0 to 7."
+  (rgb (* (logand n 1) 160) (* (logand n 2) 80) (* (logand n 4) 40)))
+
+(defun butlast (lst)
+  "(butlast lst)
+Returns all but the last item in lst."
+  (unless (null lst) (subseq lst 0 (1- (length lst)))))
+
+(defun count (x lst)
+  "(count x lst)
+Counts the number of items eq to x in lst."
+  (if (null lst) 0
+    (+ (if (eq x (car lst)) 1 0) (count x (cdr lst)))))
+
+(defun count-if (tst lst)
+  "(count-if tst lst)
+Counts the number of items in lst for which tst is true."
+  (if (null lst) 0
+    (+ (if (funcall tst (car lst)) 1 0) (count-if tst (cdr lst)))))
+
+(defun count-if-not (tst lst)
+  "(count-if-not tst lst)
+Counts the number of items in lst for which tst is false."
+  (if (null lst) 0
+    (+ (if (funcall tst (car lst)) 0 1) (count-if-not tst (cdr lst)))))
+
+(defun find (x lst)
+  "(find x lst)
+Returns x if x is in lst, or nil otherwise."
+  (car (member x lst)))
+
+(defun find-if (tst lst)
+  "(find-if tst lst)
+Returns the first item in lst for which tst is true, or nil otherwise."
+  (cond
+   ((null lst) nil)
+   ((funcall tst (car lst)) (car lst))
+   (t (find-if tst (cdr lst)))))
+
+(defun find-if-not (tst lst)
+  "(find-if-not tst lst)
+Returns the first item in lst for which tst is false, or nil otherwise."
+  (cond
+   ((null lst) nil)
+   ((not (funcall tst (car lst))) (car lst))
+   (t (find-if-not tst (cdr lst)))))
+
+(defun identity (x)
+  "(identity x)
+Returns its argument."
+  x)
+
+(defun last (lst)
+  "(last lst)
+Returns the last cdr of lst."
+  (unless (null lst) (subseq lst (1- (length lst)))))
+
+(defun mapl (fn lst)
+  "(mapl fn lst)
+Applies fn to successive cdrs of lst, and returns lst."
+  (mapl2 fn lst)
+  lst)
+
+(defun mapl2 (fn lst)
+  (cond
+   ((null lst) nil)
+   (t (funcall fn lst)
+      (mapl2 fn (cdr lst)))))
+
+(defun maplist (fn lst)
+  "(maplist fn lst)
+Applies fn to successive cdrs of lst, and returns a list of the results."
+  (if (null lst) nil
+   (cons (funcall fn lst) (maplist fn (cdr lst)))))
+
+(defun nconc (&rest lst)
+  "(nconc lst*)
+Destructively appends its arguments together, which must be lists."
+  (mapcan #'(lambda (x) x) lst))
+
+(defun nthcdr (n lst)
+  "(nthcdr n lst)
+Returns the nth cdr of lst."
+  (if (zerop n) lst
+    (nthcdr (1- n) (cdr lst))))
+
+(defun position (x lst &optional (n 0))
+  "(position x lst)
+Returns the position of the first x in lst, or nil if it's not found."
+  (cond
+   ((null lst) nil)
+   ((eq x (car lst)) n)
+   (t (position x (cdr lst) (1+ n)))))
+
+(defun position-if (tst lst &optional (n 0))
+  "(position-if tst lst)
+Returns the position of the first item in lst for which tst is true,
+or nil if none is found."
+  (cond
+   ((null lst) nil)
+   ((funcall tst (car lst)) n)
+   (t (position-if tst (cdr lst) (1+ n)))))
+
+(defun position-if-not (tst lst &optional (n 0))
+  "(position-if-not tst lst)
+Returns the position of the first item in lst for which tst is false,
+or nil if none is found."
+  (cond
+   ((null lst) nil)
+   ((not (funcall tst (car lst))) n)
+   (t (position-if-not tst (cdr lst) (1+ n)))))
+
+(defun reduce (fn lst)
+  "(reduce fn lst)
+Returns the result of applying fn to successive pairs of items from lst."
+     (if (null (cdr lst)) (car lst)
+      (funcall fn (car lst) (reduce fn (cdr lst)))))
+
+(defun remove (x lst)
+  "(remove x lst)
+Returns a list with all occurrences of x removed from lst."
+  (mapcan #'(lambda (y) (unless (eq x y) (list y))) lst))
+
+(defun remove-if (tst lst)
+  "(remove-if tst lst)
+Returns a list with all items for which tst is true removed from lst."
+  (mapcan #'(lambda (x) (unless (funcall tst x) (list x))) lst))
+
+(defun remove-if-not (tst lst)
+  "(remove-if-not tst 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))
+
+)lisplibrary";
+

PICOCALC.md

@@ -13,3 +13,6 @@ Future work:
 - Clean up code and error messages.
 - Lots of formatting fixes.
 - Support an RTC.
+- Improve error handling - instead of hanging, print error message
+  and return to top-level.
+    - Note: appears to return control to serial, not kbd/display.

ulisp-extensions.ino

@@ -3,7 +3,9 @@
 */
 
 // Definitions
-object *fn_now (object *args, object *env) {
+object *
+fn_now(object *args, object *env)
+{
 	(void) env;
 	static unsigned long Offset;
 	unsigned long now = millis()/1000;
@@ -11,15 +13,19 @@ object *fn_now (object *args, object *env) {
 
 	// Set time
 	if (nargs == 3) {
-    Offset = (unsigned long)((checkinteger(first(args))*60 + checkinteger(second(args)))*60
+		Offset = (unsigned long)((checkinteger(first(args))*60		\
+					+ checkinteger(second(args)))*60	\
 				+ checkinteger(third(args)) - now);
-  } else if (nargs > 0) error2(PSTR("wrong number of arguments"));
+	} else if (nargs > 0) {
+		error2(PSTR("wrong number of arguments"));
+	}
 
 	// Return time
 	unsigned long secs = Offset + now;
 	object *seconds = number(secs%60);
 	object *minutes = number((secs/60)%60);
 	object *hours = number((secs/3600)%24);
+
 	return cons(hours, cons(minutes, cons(seconds, NULL)));
 }
 
@@ -41,10 +47,14 @@ const tbl_entry_t lookup_table2[] PROGMEM = {
 tbl_entry_t *tables[] = {lookup_table, lookup_table2};
 const unsigned int tablesizes[] = { arraysize(lookup_table), arraysize(lookup_table2) };
 
-const tbl_entry_t *table (int n) {
+const tbl_entry_t *
+table(int n)
+{
 	return tables[n];
 }
 
-unsigned int tablesize (int n) {
+unsigned int
+tablesize(int n)
+{
 	return tablesizes[n];
 }