aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorColin Okay <okay@toyful.space>2020-12-13 07:27:53 -0600
committerColin Okay <okay@toyful.space>2020-12-13 07:27:53 -0600
commitd25e5a1cdd2e934c8c21851aac93d9a30b8bb0cf (patch)
treeffc7130db2c7fe75cb765da5f47fb1c83924dfb8
parent2e2263a011846cb04dce9538079d2d5e9b7724d0 (diff)
renaming
-rw-r--r--functions.lisp28
-rw-r--r--lambda-riffs.asd11
-rw-r--r--macros.lisp79
-rw-r--r--package.lisp12
4 files changed, 90 insertions, 40 deletions
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))