ae02fff6fa65

Add in-place vector mutators
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Thu, 18 Aug 2016 22:15:06 +0000
parents 8119f8eccbed
children a5b56cd9bbcf
branches/tags (none)
files package.lisp src/vectors.lisp

Changes

--- a/package.lisp	Tue Aug 16 18:25:48 2016 +0000
+++ b/package.lisp	Thu Aug 18 22:15:06 2016 +0000
@@ -82,58 +82,84 @@
 (defpackage #:coding-math.vectors
   (:use #:cl)
   (:export
-    vec2
-    vec2f
-    vec2d
-    vec2i
-    vec2-add
-    vec2f-add
-    vec2d-add
-    vec2i-add
-    vec2-sub
-    vec2f-sub
-    vec2d-sub
-    vec2i-sub
-    vec2-mul
-    vec2f-mul
-    vec2d-mul
-    vec2i-mul
-    vec2-div
-    vec2f-div
-    vec2d-div
-    vec2i-div
-    vec2-magdir
-    vec2f-magdir
-    vec2d-magdir
-    vec2i-magdir
-    vec2-eql
-    vec2f-eql
-    vec2d-eql
-    vec2i-eql
-    vec2-magnitude
-    vec2f-magnitude
-    vec2d-magnitude
-    vec2i-magnitude
-    vec2-length
-    vec2f-length
-    vec2d-length
-    vec2i-length
-    vec2-angle
-    vec2f-angle
-    vec2d-angle
-    vec2i-angle
-    vec2-direction
-    vec2f-direction
-    vec2d-direction
-    vec2i-direction
-    vec2-x
-    vec2f-x
-    vec2d-x
-    vec2i-x
-    vec2-y
-    vec2f-y
-    vec2d-y
-    vec2i-y
+    #:vec2
+    #:vec2f
+    #:vec2d
+    #:vec2i
+
+    #:vec2-add
+    #:vec2f-add
+    #:vec2d-add
+    #:vec2i-add
+    #:vec2-sub
+    #:vec2f-sub
+    #:vec2d-sub
+    #:vec2i-sub
+    #:vec2-mul
+    #:vec2f-mul
+    #:vec2d-mul
+    #:vec2i-mul
+    #:vec2-div
+    #:vec2f-div
+    #:vec2d-div
+    #:vec2i-div
+
+    #:vec2-add!
+    #:vec2f-add!
+    #:vec2d-add!
+    #:vec2i-add!
+    #:vec2-sub!
+    #:vec2f-sub!
+    #:vec2d-sub!
+    #:vec2i-sub!
+    #:vec2-mul!
+    #:vec2f-mul!
+    #:vec2d-mul!
+    #:vec2i-mul!
+    #:vec2-div!
+    #:vec2f-div!
+    #:vec2d-div!
+    #:vec2i-div!
+
+    #:vec2-magdir
+    #:vec2f-magdir
+    #:vec2d-magdir
+    #:vec2i-magdir
+
+    #:vec2-eql
+    #:vec2f-eql
+    #:vec2d-eql
+    #:vec2i-eql
+
+    #:vec2-magnitude
+    #:vec2f-magnitude
+    #:vec2d-magnitude
+    #:vec2i-magnitude
+
+    #:vec2-length
+    #:vec2f-length
+    #:vec2d-length
+    #:vec2i-length
+
+    #:vec2-angle
+    #:vec2f-angle
+    #:vec2d-angle
+    #:vec2i-angle
+
+    #:vec2-direction
+    #:vec2f-direction
+    #:vec2d-direction
+    #:vec2i-direction
+
+    #:vec2-x
+    #:vec2f-x
+    #:vec2d-x
+    #:vec2i-x
+
+    #:vec2-y
+    #:vec2f-y
+    #:vec2d-y
+    #:vec2i-y
     )
   )
 
--- a/src/vectors.lisp	Tue Aug 16 18:25:48 2016 +0000
+++ b/src/vectors.lisp	Thu Aug 18 22:15:06 2016 +0000
@@ -20,8 +20,11 @@
 
 ;;;; Structs
 (defmacro defvec (name slots arglist type default)
-  `(defstruct (,name (:constructor ,name ,arglist))
-     ,@(loop :for slot :in slots :collect `(,slot ,default :type ,type))))
+  `(progn
+    (declaim (inline ,name))
+    (defstruct (,name (:constructor ,name ,arglist))
+      ,@(loop :for slot :in slots :collect `(,slot ,default :type ,type)))
+    (declaim (notinline ,name))))
 
 (defmacro defvec2 (name type default)
   `(defvec ,name (x y) (&optional (x ,default) (y x)) ,type ,default))
@@ -51,25 +54,32 @@
 
 ;;;; Operations
 (defmacro with-fns (vec-type element-type &body body)
-  `(macrolet
-    ((vec (&rest args) `(,',vec-type ,@args))
-     (vec-x (v) `(,(symbolize ',vec-type '-x) ,v))
-     (vec-y (v) `(,(symbolize ',vec-type '-y) ,v))
-     (vec-z (v) `(,(symbolize ',vec-type '-z) ,v))
-     (vec-w (v) `(,(symbolize ',vec-type '-w) ,v))
-     ,(if (eq element-type 'fixnum)
-        `(wrap (x) `(logand most-positive-fixnum ,x))
-        `(wrap (x) x))
-     ,(if (eq element-type 'fixnum)
-       `(// (x y) `(floor ,x ,y))
-       `(// (x y) `(/ ,x ,y))))
-    ,@body))
+  `(progn
+    (declaim (inline ,vec-type))
+    (macrolet
+        ((vec (&rest args) `(,',vec-type ,@args))
+         (vec-x (v) `(,(symbolize ',vec-type '-x) ,v))
+         (vec-y (v) `(,(symbolize ',vec-type '-y) ,v))
+         (vec-z (v) `(,(symbolize ',vec-type '-z) ,v))
+         (vec-w (v) `(,(symbolize ',vec-type '-w) ,v))
+         ,(if (eq element-type 'fixnum)
+            `(wrap (x) `(logand most-positive-fixnum ,x))
+            `(wrap (x) x))
+         ,(if (eq element-type 'fixnum)
+            `(// (x y) `(floor ,x ,y))
+            `(// (x y) `(/ ,x ,y))))
+      ,@body)
+    (declaim (notinline ,vec-type))))
 
 (defmacro defvec2ops (vec-type element-type)
   (let ((add (symbolize vec-type '-add))
+        (add! (symbolize vec-type '-add!))
         (sub (symbolize vec-type '-sub))
+        (sub! (symbolize vec-type '-sub!))
         (mul (symbolize vec-type '-mul))
+        (mul! (symbolize vec-type '-mul!))
         (div (symbolize vec-type '-div))
+        (div! (symbolize vec-type '-div!))
         (eql (symbolize vec-type '-eql))
         (magdir (symbolize vec-type '-magdir))
         (magnitude (symbolize vec-type '-magnitude))
@@ -77,27 +87,28 @@
         (angle (symbolize vec-type '-angle))
         (direction (symbolize vec-type '-direction)))
     `(progn
-      (declaim (ftype (function (,element-type ,element-type)
-                                (values ,vec-type &optional))
-                      ,magdir))
+      (declaim
+        (ftype (function (,element-type ,element-type)
+                         (values ,vec-type &optional))
+               ,magdir)
 
-      (declaim (ftype (function (,vec-type ,vec-type)
-                                (values boolean &optional))
-                      ,eql))
+        (ftype (function (,vec-type ,vec-type &optional (or null ,element-type))
+                         (values boolean &optional))
+               ,eql)
 
-      (declaim (ftype (function (,vec-type ,vec-type)
-                                (values ,vec-type &optional))
-                      ,add ,sub))
+        (ftype (function (,vec-type ,vec-type)
+                         (values ,vec-type &optional))
+               ,add ,sub ,add! ,sub!)
 
-      (declaim (ftype (function (,vec-type ,element-type)
-                                (values ,vec-type &optional))
-                      ,mul ,div))
+        (ftype (function (,vec-type ,element-type)
+                         (values ,vec-type &optional))
+               ,mul ,div ,mul! ,div!)
 
-      (declaim (ftype (function (,vec-type)
-                                ,(if (eq 'fixnum element-type)
-                                   `(values real &optional)
-                                   `(values ,element-type &optional)))
-                      ,magnitude ,length ,angle ,direction))
+        (ftype (function (,vec-type)
+                         ,(if (eq 'fixnum element-type)
+                            `(values real &optional)
+                            `(values ,element-type &optional)))
+               ,magnitude ,length ,angle ,direction))
 
       (with-fns
         ,vec-type ,element-type
@@ -108,30 +119,53 @@
             (* magnitude (cos direction))
             (* magnitude (sin direction))))
 
-        (defun ,eql (v1 v2)
-          (and (= (vec-x v1) (vec-x v2))
-               (= (vec-y v1) (vec-y v2))))
+        (defun ,eql (v1 v2 &optional epsilon)
+          (if epsilon
+            (and (<= (abs (- (vec-x v1) (vec-x v2))) epsilon)
+                 (<= (abs (- (vec-y v1) (vec-y v2))) epsilon))
+            (and (= (vec-x v1) (vec-x v2))
+                 (= (vec-y v1) (vec-y v2)))))
 
         (defun ,add (v1 v2)
           (vec
             (wrap (+ (vec-x v1) (vec-x v2)))
             (wrap (+ (vec-y v1) (vec-y v2)))))
 
+        (defun ,add! (v1 v2)
+          (setf (vec-x v1) (wrap (+ (vec-x v1) (vec-x v2)))
+                (vec-y v1) (wrap (+ (vec-y v1) (vec-y v2))))
+          v1)
+
         (defun ,sub (v1 v2)
           (vec
             (wrap (- (vec-x v1) (vec-x v2)))
             (wrap (- (vec-y v1) (vec-y v2)))))
 
+        (defun ,sub! (v1 v2)
+          (setf (vec-x v1) (wrap (- (vec-x v1) (vec-x v2)))
+                (vec-y v1) (wrap (- (vec-y v1) (vec-y v2))))
+          v1)
+
         (defun ,mul (v scalar)
           (vec
             (wrap (* (vec-x v) scalar))
             (wrap (* (vec-y v) scalar))))
 
+        (defun ,mul! (v scalar)
+          (setf (vec-x v) (wrap (* (vec-x v) scalar))
+                (vec-y v) (wrap (* (vec-y v) scalar)))
+          v)
+
         (defun ,div (v scalar)
           (vec
             (wrap (// (vec-x v) scalar))
             (wrap (// (vec-y v) scalar))))
 
+        (defun ,div! (v scalar)
+          (setf (vec-x v) (wrap (// (vec-x v) scalar))
+                (vec-y v) (wrap (// (vec-y v) scalar)))
+          v)
+
         (defuns (,magnitude ,length) (v)
           (sqrt (+ (square (vec-x v))
                    (square (vec-y v)))))
@@ -145,5 +179,13 @@
 (defvec2ops vec2d double-float)
 (defvec2ops vec2i fixnum)
 
-(declaim (optimize (speed 3)))
-; vec2i-add
+; (declaim (optimize (speed 3) (safety 1) (debug 0)))
+; vec2i-eql
+; vec2f-add
+; vec2f-add!
+; vec2f-sub!
+; vec2f-mul!
+; vec2f-div
+; vec2f-mul
+; vec2f
+; vec2f-div!