94d32b1b2f8f

Factor out my utility library
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sat, 13 Aug 2016 15:58:08 +0000
parents 8a0c2154cda5
children ce08d6455b84
branches/tags (none)
files coding-math.asd package.lisp src/utils.lisp

Changes

--- 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)
 
--- 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
--- 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)