;;;; decons/xplore - explorations (defpackage :decons/xplore (:use :common-lisp) (:local-nicknames (:util :scopes/util)) (:export #:+pi+ #:area #:circle #:absv #:double #:remainder #:scalar-p #:tensor #:at )) (in-package :decons/xplore) ;;;; basic explorations (defconstant +pi+ 3.14159) (defclass circle () ;;; ! implement as closure ((radius :accessor radius :initarg :radius :initform 1))) (defgeneric area (c) (:method ((c circle)) (* +pi+ (radius c) (radius c)))) (defun double (f) #'(lambda (v) (* 2 (funcall f v)))) (defun absv (v) (if (< v 0) (- v) v)) (defun remainder (v d) (if (< v d) v (remainder (- v d) d))) ;;;; tensor stuff (defgeneric scalar-p (x) (:method (x) t) (:method ((x list)) nil) (:method ((x array)) nil)) (defun tensor (s v) (make-array s :initial-contents v)) (defun at (a &rest subs) (apply #'aref a subs)) (defun (setf at) (v a &rest subs) (setf (apply #'aref a subs) v)) (defun traverse (op &rest args) (if (null (cdr args)) (car args) (apply #'traverse op (trav2 op (car args) (cadr args)) (cddr args)))) (defgeneric trav2 (op a b) (:method (op (a number) (b number)) (funcall op a b)))