From e8c0f8e58b0039d8d3ed886654a5452168168436 Mon Sep 17 00:00:00 2001
From: Colin Okay <cbeok@protonmail.com>
Date: Thu, 13 Aug 2020 10:38:30 -0500
Subject: removed replaced $and $or with macros; added reader macro for $$

---
 examples.lisp     | 15 +++++++--------
 lambda-tools.lisp | 39 ++-------------------------------------
 macros.lisp       | 38 ++++++++++++++++++++++++++++++++------
 package.lisp      |  6 +++---
 4 files changed, 44 insertions(+), 54 deletions(-)

diff --git a/examples.lisp b/examples.lisp
index 7bd44e2..973ebee 100644
--- a/examples.lisp
+++ b/examples.lisp
@@ -1,15 +1,14 @@
 
 (defpackage #:lt-examples
-  (:use #:cl #:lambda-toosl))
+  (:use #:cl #:lambda-tools))
 
 
 ;; http://rosettacode.org/wiki/Luhn_test_of_credit_card_numbers 
 (defun luhn (n)
   (flet ((sum-dig (x) (if (> x 9) (- x 9) x)))
-    (>> n
-        #'reverse
-        ($$ (map 'list #'digit-char-p $char))
-        ($$ (mapcar #'*
-                    (loop :for i :upto (length $digits) :collect (1+ (mod i 2)))
-                    $digits))
-        ($$ (zerop (mod (apply #'+ (mapcar #'sum-dig $digits)) 10))))))
+    (>> n #'reverse
+        #$(map 'list #'digit-char-p $char)
+        #$(mapcar #'*
+                (loop :for i :upto (length $digits) :collect (1+ (mod i 2)))
+                $digits)
+        #$(zerop (mod (apply #'+ (mapcar #'sum-dig $digits)) 10)))))
diff --git a/lambda-tools.lisp b/lambda-tools.lisp
index 24e3cb2..63f5c4d 100644
--- a/lambda-tools.lisp
+++ b/lambda-tools.lisp
@@ -2,43 +2,6 @@
 
 (in-package #:lambda-tools)
 
-(defun $or (&rest predicates)
-  "Each argument in PREDICATES is a predicate function of one
-argument. Returns a new predicate, call it P, that is the
-disjunction of each of the PREDICATES.
-
-The value of (P X) is the value of the first predicate Q in PREDICATES
-such that (Q X) is non-NIL, or is NIL if none of the PREDICATES return
-non-NIL.
-
-That is, the disjuction of PREDICATES is short-circuiting. If any
-PREDICATES have side effects, they will be executed only if each of
-the preceding predicates in the list returned NIL."
-  (labels ((disj (x preds)
-             (if (null preds) nil
-                 (or (funcall (car preds) x)
-                     (disj x (cdr preds))))))
-    (lambda (x) (disj x predicates))))
-
-(defun $and (&rest predicates)
-  "Each argument in PREDICATES is a predicate function of one
-argument. Returns a new predicate of one argument, call it P, that is
-the conjunction of each of the PREDICATES.
-
-The value of (P X) is NIL if any of the PREDICATES applied to X are
-NIL. Otherwise it is the value of the last member in PREDICATES
-applied to X.
-
-That is, the conjunction of PREDICATES is short-circuiting.  If any
-PREDICATES have side effects, they will be executed only if each of
-the preceding predicates in the list returned non-NIL."
-  (labels ((conj (x preds)
-             (cond ((null preds) t)
-                   ((null (cdr preds)) (funcall (car preds) x))
-                   ((funcall (car preds) x)
-                    (conj x (cdr preds))))))
-    (lambda (x) (conj x predicates))))
-
 (defun >> (arg &rest fns)
   (dolist (fn fns)
     (setf arg (funcall fn arg)))
@@ -49,3 +12,5 @@ the preceding predicates in the list returned non-NIL."
   (lambda (arg)
     (apply #'>> arg fns)))
 
+
+
diff --git a/macros.lisp b/macros.lisp
index bbc7f4a..37d111e 100644
--- a/macros.lisp
+++ b/macros.lisp
@@ -21,12 +21,7 @@
   (defun numerically-before-p (a b)
     (apply #'<
            (mapcar (lambda (x) (parse-integer (symbol-name x) :start 1 :junk-allowed t))
-                   (list a b))))
-  )
-
-
-
-
+                   (list a b)))))
 
 (defmacro $$ (expr)
   "Quickly create functions from an expression EXPR with 'blanks' in
@@ -99,3 +94,34 @@ those numbers.
 
 
 
+(defmacro and> (&rest preds)
+  (let ((block-label (gensym)))
+    `(let ((preds (list ,@preds)))
+       (lambda (arg)
+         (block ,block-label
+           (unless preds (return-from ,block-label t))
+           (let (acc)
+             (dolist (p preds)
+               (setf acc (funcall p arg))
+               (unless acc (return-from ,block-label nil)))
+             acc))))))
+
+(defmacro or> (&rest preds)
+  (let ((block-label (gensym)))
+    `(let ((preds (list ,@preds)))
+       (lambda (arg)
+         (block ,block-label
+           (unless preds (return-from ,block-label nil))
+           (let (acc)
+             (dolist (p preds)
+               (setf acc (funcall p arg))
+               (when acc (return-from ,block-label acc)))
+             acc))))))
+
+
+(set-dispatch-macro-character
+ #\# #\$
+ (lambda (stream subchar arg)
+   (declare (ignore arg subchar))
+   (let ((form (read stream)))
+     (list '$$ form))))
diff --git a/package.lisp b/package.lisp
index 35c5f5f..3763ee0 100644
--- a/package.lisp
+++ b/package.lisp
@@ -3,7 +3,7 @@
 (defpackage #:lambda-tools
   (:use #:cl)
   (:export #:$$
-           #:$and
-           #:$or
            #:>>
-           #:<>))
+           #:<>
+           #:and>
+           #:or>))
-- 
cgit v1.2.3