From da82614663432d96e6e47b167de452bb7d7bb803 Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Fri, 28 Oct 2022 10:34:30 -0500
Subject: Add: hofs and closure

---
 hofs.lisp    | 23 +++++++++++++++++++++++
 macros.lisp  | 13 ++++++++-----
 package.lisp |  5 ++++-
 3 files changed, 35 insertions(+), 6 deletions(-)
 create mode 100644 hofs.lisp

diff --git a/hofs.lisp b/hofs.lisp
new file mode 100644
index 0000000..7eb1d51
--- /dev/null
+++ b/hofs.lisp
@@ -0,0 +1,23 @@
+;;; hofs.lisp -- higher-order functions
+
+(in-package :lambda-riffs)
+
+(defun labmda-if (pred then &optional (else (constantly nil)))
+  "Returns a function that applies PRED and conditionally executes
+THEN when PRED returned non-nil or otherwise executes ELSE.  Each of
+PRED, THEN, and ELSE are  assumed to accept the same arguments."
+  (lambda (&rest args)
+    (if (apply pred args)
+        (apply then args)
+        (apply else args))))
+
+(defun lambda-cond (&rest pairs)
+  "PAIRS is a list: PRED1 F1 PRED2 F2 ...
+   Returns a function that applies FN to the argumetns for the first N
+   such that PREDN returns non-nil.  Each of the PREDN and FN are
+   assumed to accept the same arguments."
+  (lambda (&rest args)
+    (loop for (pred fn . more) on pairs by #'cddr
+          when (apply pred args)
+            return (apply fn args))))
+
diff --git a/macros.lisp b/macros.lisp
index fa93bc5..8cf528f 100644
--- a/macros.lisp
+++ b/macros.lisp
@@ -23,8 +23,7 @@
      (declare (ignore subchar infix))
      (let ((form1 (read stream)))
        (if (symbolp form1)
-           (list '$ (list (concatenate 'string "$"
-                                       (symbol-name form1)))
+           (list '$ (list (concatenate 'string "$" (symbol-name form1)))
                  (read stream))
            (list '$ () form1))))))
 
@@ -110,7 +109,11 @@ surrounding form.
     `(lambda ,new-params ,expr)))
 
 
-
-
-
+(defmacro closure (&body body)
+  "Creates a lambda that accepts any number of arguments, all of which
+   are ignored."
+  (let ((args (gensym)))
+    `(lambda (&rest ,args)
+       (declare (ignorable ,args))
+       ,@body)))
 
diff --git a/package.lisp b/package.lisp
index dcadede..2db36f3 100644
--- a/package.lisp
+++ b/package.lisp
@@ -1,4 +1,7 @@
 ;;;; package.lisp
 
 (defpackage #:lambda-riffs
-  (:use #:cl))
+  (:use #:cl)
+  (:export #:closure
+           #:lambda-if
+           #:lambda-cond))
-- 
cgit v1.2.3