# HG changeset patch # User Steve Losh # Date 1462048941 0 # Node ID 7e02590046c6080a62251a88408ce33a3f12e138 # Parent e6ce856a5a4ade5137d62df2c85272b9b369a470 Rewrite vec to use structs for speed diff -r e6ce856a5a4a -r 7e02590046c6 Makefile --- a/Makefile Sat Apr 30 20:20:04 2016 +0000 +++ b/Makefile Sat Apr 30 20:42:21 2016 +0000 @@ -1,4 +1,4 @@ .PHONY: quickutils.lisp: make-quickutils.lisp - sbcl --noinform --load make-quickutils.lisp --eval '(quit)' + sbcl-rlwrap --noinform --load make-quickutils.lisp --eval '(quit)' diff -r e6ce856a5a4a -r 7e02590046c6 make-quickutils.lisp --- a/make-quickutils.lisp Sat Apr 30 20:20:04 2016 +0000 +++ b/make-quickutils.lisp Sat Apr 30 20:42:21 2016 +0000 @@ -7,5 +7,6 @@ :while :ensure-boolean :with-gensyms + :once-only ) :package "CODING-MATH.QUICKUTILS") diff -r e6ce856a5a4a -r 7e02590046c6 package.lisp --- a/package.lisp Sat Apr 30 20:20:04 2016 +0000 +++ b/package.lisp Sat Apr 30 20:42:21 2016 +0000 @@ -67,7 +67,8 @@ #:vec-sub! #:vec-mul! #:vec-div! - #:vec-to-string)) + #:vec-to-string + #:with-vec)) (defpackage #:coding-math.particles (:use diff -r e6ce856a5a4a -r 7e02590046c6 quickutils.lisp --- a/quickutils.lisp Sat Apr 30 20:20:04 2016 +0000 +++ b/quickutils.lisp Sat Apr 30 20:42:21 2016 +0000 @@ -2,7 +2,7 @@ ;;;; See http://quickutil.org for details. ;;;; To regenerate: -;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:DEFINE-CONSTANT :SWITCH :WHILE :ENSURE-BOOLEAN :WITH-GENSYMS) :ensure-package T :package "CODING-MATH.QUICKUTILS") +;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:DEFINE-CONSTANT :SWITCH :WHILE :ENSURE-BOOLEAN :WITH-GENSYMS :ONCE-ONLY) :ensure-package T :package "CODING-MATH.QUICKUTILS") (eval-when (:compile-toplevel :load-toplevel :execute) (unless (find-package "CODING-MATH.QUICKUTILS") @@ -15,7 +15,8 @@ (when (boundp '*utilities*) (setf *utilities* (union *utilities* '(:DEFINE-CONSTANT :STRING-DESIGNATOR :WITH-GENSYMS :EXTRACT-FUNCTION-NAME - :SWITCH :UNTIL :WHILE :ENSURE-BOOLEAN)))) + :SWITCH :UNTIL :WHILE :ENSURE-BOOLEAN + :MAKE-GENSYM-LIST :ONCE-ONLY)))) (defun %reevaluate-constant (name value test) (if (not (boundp name)) @@ -166,7 +167,54 @@ (and x t)) (eval-when (:compile-toplevel :load-toplevel :execute) + (defun make-gensym-list (length &optional (x "G")) + "Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`, +using the second (optional, defaulting to `\"G\"`) argument." + (let ((g (if (typep x '(integer 0)) x (string x)))) + (loop repeat length + collect (gensym g)))) + ) ; eval-when + + (defmacro once-only (specs &body forms) + "Evaluates `forms` with symbols specified in `specs` rebound to temporary +variables, ensuring that each initform is evaluated only once. + +Each of `specs` must either be a symbol naming the variable to be rebound, or of +the form: + + (symbol initform) + +Bare symbols in `specs` are equivalent to + + (symbol symbol) + +Example: + + (defmacro cons1 (x) (once-only (x) `(cons ,x ,x))) + (let ((y 0)) (cons1 (incf y))) => (1 . 1)" + (let ((gensyms (make-gensym-list (length specs) "ONCE-ONLY")) + (names-and-forms (mapcar (lambda (spec) + (etypecase spec + (list + (destructuring-bind (name form) spec + (cons name form))) + (symbol + (cons spec spec)))) + specs))) + ;; bind in user-macro + `(let ,(mapcar (lambda (g n) (list g `(gensym ,(string (car n))))) + gensyms names-and-forms) + ;; bind in final expansion + `(let (,,@(mapcar (lambda (g n) + ``(,,g ,,(cdr n))) + gensyms names-and-forms)) + ;; bind in user-macro + ,(let ,(mapcar (lambda (n g) (list (car n) g)) + names-and-forms gensyms) + ,@forms))))) + +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(define-constant switch eswitch cswitch while ensure-boolean - with-gensyms with-unique-names))) + with-gensyms with-unique-names once-only))) ;;;; END OF quickutils.lisp ;;;; diff -r e6ce856a5a4a -r 7e02590046c6 src/main.lisp --- a/src/main.lisp Sat Apr 30 20:20:04 2016 +0000 +++ b/src/main.lisp Sat Apr 30 20:42:21 2016 +0000 @@ -1,8 +1,8 @@ (in-package #:coding-math) -(declaim (optimize (speed 1) +(declaim (optimize (speed 3) (safety 1) - (debug 1))) + (debug 0))) ;;;; Config (defparameter *width* 600) diff -r e6ce856a5a4a -r 7e02590046c6 src/vectors.lisp --- a/src/vectors.lisp Sat Apr 30 20:20:04 2016 +0000 +++ b/src/vectors.lisp Sat Apr 30 20:42:21 2016 +0000 @@ -1,12 +1,15 @@ (in-package #:coding-math.vectors) -(defclass vec () - ((x :type 'real :initarg :x :accessor vec-x) - (y :type 'real :initarg :y :accessor vec-y))) + +(declaim (inline vec-x vec-y)) +(defstruct (vec + (:constructor make-vec + (&optional (x 0) (y 0))) + (:type vector)) + (x 0 :type real) + (y 0 :type real)) -(defun make-vec (&optional (x 0) (y 0)) - (make-instance 'vec :x x :y y)) (defun make-vec-md (magnitude angle) (let ((v (make-vec 0 0))) @@ -18,13 +21,20 @@ (make-vec-md magnitude angle)) +(defmacro with-vec (bindings vec &body body) + (once-only (vec) + `(let ((,(first bindings) (vec-x ,vec)) + (,(second bindings) (vec-y ,vec))) + ,@body))) + + (defun vec-magnitude (vec) - (with-slots (x y) vec + (with-vec (x y) vec (sqrt (+ (* x x) (* y y))))) (defun vec-angle (vec) - (with-slots (x y) vec + (with-vec (x y) vec (atan y x))) (defun vec-direction (vec) @@ -33,9 +43,8 @@ (defun (setf vec-angle) (angle vec) (let ((magnitude (vec-magnitude vec))) - (with-slots (x y) vec - (setf x (* magnitude (cos angle))) - (setf y (* magnitude (sin angle))))) + (setf (vec-x vec) (* magnitude (cos angle))) + (setf (vec-y vec) (* magnitude (sin angle)))) angle) (defun (setf vec-direction) (angle vec) @@ -43,9 +52,8 @@ (defun (setf vec-magnitude) (magnitude vec) (let ((angle (vec-angle vec))) - (with-slots (x y) vec - (setf x (* magnitude (cos angle))) - (setf y (* magnitude (sin angle))))) + (setf (vec-x vec) (* magnitude (cos angle))) + (setf (vec-y vec) (* magnitude (sin angle)))) magnitude)