# HG changeset patch # User Steve Losh # Date 1471103888 0 # Node ID 94d32b1b2f8f3ea417b5015bfbccb6d3fec24b2f # Parent 8a0c2154cda574eae4eee08038ce10c5c1e079ea Factor out my utility library diff -r 8a0c2154cda5 -r 94d32b1b2f8f coding-math.asd --- a/coding-math.asd Wed Aug 03 13:53:19 2016 +0000 +++ b/coding-math.asd Sat Aug 13 15:58:08 2016 +0000 @@ -14,6 +14,7 @@ #:sb-cga #:trivial-types #:cl-arrows + #:losh #:fare-quasiquote-optima #:fare-quasiquote-readtable) diff -r 8a0c2154cda5 -r 94d32b1b2f8f package.lisp --- a/package.lisp Wed Aug 03 13:53:19 2016 +0000 +++ b/package.lisp Sat Aug 13 15:58:08 2016 +0000 @@ -2,6 +2,7 @@ (defpackage #:coding-math.utils (:use #:cl + #:losh #:sketch #:iterate #:coding-math.quickutils) @@ -11,21 +12,18 @@ #:in-context #:scancode-case #:with-vals - #:zap% - #:% - #:pairs-of-list #:setf-slots #:symbolicate #:ensure-car #:ensure-cadr #:with-place #:draw-axes - #:juxt #:graph-function)) (defpackage #:coding-math.math (:use #:cl + #:losh #:coding-math.quickutils #:coding-math.utils) (:export @@ -55,6 +53,7 @@ (defpackage #:coding-math.fps (:use #:cl + #:losh #:sketch #:coding-math.quickutils #:coding-math.math @@ -66,6 +65,7 @@ (defpackage #:coding-math.tween (:use #:cl + #:losh #:coding-math.quickutils #:coding-math.math #:coding-math.utils) @@ -147,6 +147,7 @@ (defpackage #:coding-math.2d.vectors (:use #:cl + #:losh #:coding-math.math #:coding-math.quickutils #:coding-math.utils) @@ -184,6 +185,7 @@ (defpackage #:coding-math.2d.hitboxes (:use #:cl + #:losh #:sketch #:coding-math.2d.vectors #:coding-math.math @@ -205,6 +207,7 @@ (defpackage #:coding-math.2d.particles (:use #:cl + #:losh #:coding-math.math #:coding-math.2d.vectors #:coding-math.2d.hitboxes @@ -239,6 +242,7 @@ (defpackage #:coding-math.2d.points (:use #:cl + #:losh #:sketch #:coding-math.math #:coding-math.2d.vectors @@ -256,6 +260,7 @@ (defpackage #:coding-math.2d.lines (:use #:cl + #:losh #:sketch #:coding-math.math #:coding-math.2d.vectors @@ -278,6 +283,7 @@ (defpackage #:coding-math.2d.demo (:use #:cl + #:losh #:sketch #:iterate #:coding-math.quickutils @@ -297,6 +303,7 @@ (defpackage #:coding-math.2d.ballistics (:use #:cl + #:losh #:sketch #:coding-math.quickutils #:coding-math.tween @@ -311,6 +318,7 @@ (defpackage #:coding-math.3d.vectors (:use #:cl + #:losh #:sb-cga #:coding-math.math #:coding-math.utils @@ -327,6 +335,7 @@ (defpackage #:coding-math.3d.coordinates (:use #:cl + #:losh #:sb-cga #:coding-math.math #:coding-math.3d.vectors @@ -341,6 +350,7 @@ (defpackage #:coding-math.3d.demo (:use #:cl + #:losh #:iterate #:sketch #:coding-math.quickutils diff -r 8a0c2154cda5 -r 94d32b1b2f8f src/utils.lisp --- a/src/utils.lisp Wed Aug 03 13:53:19 2016 +0000 +++ b/src/utils.lisp Sat Aug 13 15:58:08 2016 +0000 @@ -1,32 +1,6 @@ (in-package #:coding-math.utils) -(defmacro zap% (place function &rest arguments &environment env) - "Update `place` by applying `function` to its current value and `arguments`. - - `arguments` should contain the symbol `%`, which is treated as a placeholder - where the current value of the place will be substituted into the function - call. - - For example: - - (zap% foo #'- % 10) => (setf foo (- foo 10) - (zap% foo #'- 10 %) => (setf foo (- 10 foo) - - " - ;; original idea/name from http://malisper.me/2015/09/29/zap/ - (assert (find '% arguments) - () - "Placeholder % not included in zap macro form.") - (multiple-value-bind (temps exprs stores store-expr access-expr) - (get-setf-expansion place env) - `(let* (,@(mapcar #'list temps exprs) - (,(car stores) - (funcall ,function - ,@(substitute access-expr '% arguments)))) - ,store-expr))) - - (defmacro in-context (&body body) `(prog1 (push-matrix) @@ -62,11 +36,6 @@ :append (list slot val))))) -(defun juxt (&rest fns) - (lambda (&rest args) - (mapcar (rcurry #'apply args) fns))) - - ;;;; Handy drawing functions (defparameter axis-pen (make-pen :stroke (gray 0.7) :weight 2)) @@ -104,30 +73,6 @@ :step (/ (- fn-end fn-start) steps))))))) -;;;; Iterate -(defmacro-driver (FOR var PAIRS-OF-LIST list) - (let ((kwd (if generate 'generate 'for))) - (with-gensyms (current l) - `(progn - (with ,l = ,list) - (with ,current = ,l) - (,kwd ,var next - (cond - ((null ,current) - (terminate)) - - ((null (cdr ,current)) - (prog1 - (cons (first ,current) (car ,l)) - (setf ,current nil))) - - (t - (prog1 - (cons (first ,current) (second ,current)) - (setf ,current (cdr ,current)))))))))) - - - ;; snagged from squirl (eval-when (:compile-toplevel :load-toplevel :execute) (defun symbolicate (&rest things)