59 lines
1.2 KiB
Common Lisp
59 lines
1.2 KiB
Common Lisp
;;;; 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)))
|