diff --git a/physics-compiler.lisp b/physics-compiler.lisp index 0de5f60..3e019ec 100644 --- a/physics-compiler.lisp +++ b/physics-compiler.lisp @@ -38,12 +38,6 @@ ,(enmaxima-lagrangian lagrangian) ,(enmaxima-coords coords)))) -(defun momentum-symbol (q) - (intern (format nil "P_~a" (symbol-name q)))) - -(defun flatten (l) - (apply #'append l)) - (defun unmaxima-expression (expr) (defun unmaxima-symbol (sym) (let ((name (symbol-name sym))) @@ -56,17 +50,24 @@ ((listp expr) (mapcar #'unmaxima-expression expr)) (t expr))) +(defun momentum-symbol (q) + (intern (format nil "P_~a" (symbol-name q)))) + +(defun next-symbol (s) + (intern (format nil "NEXT-~a" (symbol-name s)))) + (defun update-logic (result coords) - (defun coord-updates (exprs q) - (let ((p (momentum-symbol q)) - (q-dot-expr (cadr exprs)) - (p-dot-expr (caddr exprs))) - `((incf ,p (* dt ,(unmaxima-expression p-dot-expr))) - (incf ,q (* dt ,(unmaxima-expression q-dot-expr)))))) - (flatten (loop for coord-expressions - in (cdr (maxima-interface::maxima-to-lisp result)) - for q in coords - collect (coord-updates coord-expressions q)))) + (defun coord-update (q exprs) + `(,(next-symbol q) + (+ ,q (* dt ,(unmaxima-expression (cadr exprs)))))) + (defun momentum-update (q exprs) + (let ((p (momentum-symbol q))) + `(,(next-symbol p) + (+ ,p (* dt ,(unmaxima-expression (caddr exprs))))))) + (loop for exprs in (cdr (maxima-interface::maxima-to-lisp result)) + for q in coords + collect (coord-update q exprs) + collect (momentum-update q exprs))) (defun keys (plist) (loop for key in plist by #'cddr collect key)) @@ -75,7 +76,7 @@ (let ((vars (append coords (mapcar #'momentum-symbol coords)))) `(let (,@(mapcar (lambda (s) `(,s (getf params ',s))) (keys params)) ,@(mapcar (lambda (s) `(,s (getf state ',s))) vars)) - ,@(update-logic result coords) - (list ,@(flatten - (mapcar (lambda (s) (list `',s s)) - vars)))))) + (let ,(update-logic result coords) + (list ,@(loop for s in vars + collect `',s + collect (next-symbol s)))))))