From d25e5a1cdd2e934c8c21851aac93d9a30b8bb0cf Mon Sep 17 00:00:00 2001
From: Colin Okay <okay@toyful.space>
Date: Sun, 13 Dec 2020 07:27:53 -0600
Subject: renaming

---
 functions.lisp   | 28 ++++++++++++++++++++
 lambda-riffs.asd | 11 ++++++++
 macros.lisp      | 79 ++++++++++++++++++++++++++++++++------------------------
 package.lisp     | 12 ++++-----
 4 files changed, 90 insertions(+), 40 deletions(-)
 create mode 100644 functions.lisp
 create mode 100644 lambda-riffs.asd

diff --git a/functions.lisp b/functions.lisp
new file mode 100644
index 0000000..3c06f79
--- /dev/null
+++ b/functions.lisp
@@ -0,0 +1,28 @@
+;;;; lambda-tools.lisp
+
+(in-package #:lambda-riffs)
+
+(defun -> (arg &rest fns)
+  (dolist (fn fns arg)
+    (setf arg (funcall fn arg))))
+
+(defun all> (arg &rest preds)
+  "Predicate Filter. Returns ARG if (PRED ARG) is non-NIL for each
+PRED in PREDS"
+  (dolist (pred preds arg)
+    (unless (funcall pred arg)
+      (return-from all> nil))))
+
+
+(defun some> (arg &rest preds)
+  (dolist (pred preds nil)
+    (when (funcall pred arg)
+      (return-from some> arg))))
+
+
+(defun <> (&rest fns)
+  (lambda (arg)
+    (apply #'>> arg fns)))
+
+
+
diff --git a/lambda-riffs.asd b/lambda-riffs.asd
new file mode 100644
index 0000000..03187f9
--- /dev/null
+++ b/lambda-riffs.asd
@@ -0,0 +1,11 @@
+;;;; lambda-tools.asd
+
+(asdf:defsystem #:lambda-riffs
+  :description "Macros and utilities for higher-order riffing"
+  :author "Colin Okay <okay@toyful.space>"
+  :license  "GPLv3"
+  :version "0.0.1"
+  :serial t
+  :components ((:file "package")
+               (:file "macros")
+               (:file "functions")))
diff --git a/macros.lisp b/macros.lisp
index eb742e6..6381101 100644
--- a/macros.lisp
+++ b/macros.lisp
@@ -1,4 +1,4 @@
-(in-package :lambda-tools)
+(in-package :lambda-riffs)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   ;;; some fucntions for workign with substitution variables
@@ -14,7 +14,46 @@
   (defun numeric-var-p (symbol prefix)
     (and (substitute-var-p symbol prefix)
          (digit-char-p
-          (elt (symbol-name symbol) (length prefix))))))
+          (elt (symbol-name symbol) (length prefix)))))
+
+
+  (set-dispatch-macro-character
+   #\# #\$
+   (lambda (stream subchar infix)
+     (declare (ignore subchar infix))
+     (let ((form1 (read stream)))
+       (if (symbolp form1)
+           (list '$ (list (concatenate 'string "$"
+                                       (symbol-name form1)))
+                 (read stream))
+           (list '$ () form1)))))
+  
+  
+  (set-dispatch-macro-character
+   #\# #\~
+   (lambda (stream subchar arg)
+     (declare (ignore arg subchar))
+     (list 'make-lazy (read stream))))
+  
+  (set-dispatch-macro-character
+   #\# #\!
+   (lambda (stream subchar arg)
+     (declare (ignore arg subchar))
+     (list 'funcall (read stream)))))
+
+;; Note, presently references to upper level variables in nested
+;; partials requires tha tthose upper level variables acttually appear
+;; in the upper level partials.
+
+;; e.g. 
+;; 
+;; #$(mapcar #$$(cons $$x (length $xs)) $xs)
+;;
+;;  is OK but 
+;;
+;; #$(mapcar #$$(cons $$x (length $passed-in-list)) '(1 2 3 4))
+;;
+;; is not ok. 
 
 (defmacro $ ((&optional (prefix "$")) expr)
   (let ((new-params (list))
@@ -46,7 +85,6 @@
     `(lambda ,new-params ,expr)))
 
 
-
 (defmacro conj (&rest preds)
   (let ((block-label (gensym)))
     `(let ((preds (list ,@preds)))
@@ -54,10 +92,9 @@
          (block ,block-label
            (unless preds (return-from ,block-label t))
            (let (acc)
-             (dolist (p preds)
+             (dolist (p preds acc)
                (setf acc (funcall p arg))
-               (unless acc (return-from ,block-label nil)))
-             acc))))))
+               (unless acc (return-from ,block-label nil)))))))))
 
 (defmacro disj (&rest preds)
   (let ((block-label (gensym)))
@@ -66,10 +103,9 @@
          (block ,block-label
            (unless preds (return-from ,block-label nil))
            (let (acc)
-             (dolist (p preds)
+             (dolist (p preds acc)
                (setf acc (funcall p arg))
-               (when acc (return-from ,block-label acc)))
-             acc))))))
+               (when acc (return-from ,block-label acc)))))))))
 
 (defmacro make-lazy (form)
   (let ((run-p (gensym))
@@ -83,29 +119,4 @@
          ,val))))
 
 
-(defun enable-partial-eval-reader-macro ()
-  (set-dispatch-macro-character
-   #\# #\$
-   (lambda (stream subchar infix)
-     (declare (ignore subchar infix))
-     (let ((form1 (read stream)))
-       (if (symbolp form1)
-           (list '$ (list (concatenate 'string "$"
-                                       (symbol-name form1)))
-                 (read stream))
-           (list '$ () form1))))))
-
-
-(defun enable-lazy-eval-reader-macros ()
 
-  (set-dispatch-macro-character
-   #\# #\~
-   (lambda (stream subchar arg)
-     (declare (ignore arg subchar))
-     (list 'make-lazy (read stream))))
-
-  (set-dispatch-macro-character
-   #\# #\!
-   (lambda (stream subchar arg)
-     (declare (ignore arg subchar))
-     (list 'funcall (read stream)))))
diff --git a/package.lisp b/package.lisp
index e50fe78..4028f77 100644
--- a/package.lisp
+++ b/package.lisp
@@ -1,11 +1,11 @@
 ;;;; package.lisp
 
-(defpackage #:lambda-tools
+(defpackage #:lambda-riffs
   (:use #:cl)
   (:export #:$
-           #:>>
-           #:<>
+           #:->
+           #:all>
+           #:some>
+           #:make-lazy
            #:conj
-           #:disj
-           #:enable-partial-eval-reader-macro
-           #:enable-lazy-eval-reader-macros))
+           #:disj))
-- 
cgit v1.2.3