diff options
| -rw-r--r-- | examples.lisp | 15 | ||||
| -rw-r--r-- | lambda-tools.lisp | 39 | ||||
| -rw-r--r-- | macros.lisp | 38 | ||||
| -rw-r--r-- | 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>)) |