aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--examples.lisp15
-rw-r--r--lambda-tools.lisp39
-rw-r--r--macros.lisp38
-rw-r--r--package.lisp6
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>))