provide tensor function, just creating arrays

This commit is contained in:
Helmut Merz 2025-05-22 11:49:24 +02:00
parent 580d9f34df
commit 049c352ea8
2 changed files with 30 additions and 2 deletions

View file

@ -3,9 +3,9 @@
(defpackage :decons (defpackage :decons
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:util :scopes/util)) (:local-nicknames (:util :scopes/util))
(:export #:*pi* (:export #:*pi* #:area #:circle
#:area #:circle
#:absv #:double #:remainder #:absv #:double #:remainder
#:scalar-p #:tensor #:at
#:line #:line
)) ))
@ -34,6 +34,22 @@
v v
(remainder (- v d) d))) (remainder (- v d) d)))
;;;; library 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))
;;;; parameterized functions ;;;; parameterized functions
(defun line (x) (defun line (x)

View file

@ -11,6 +11,7 @@
(defun run () (defun run ()
(let ((t:*test-suite* (t:test-suite "decons"))) (let ((t:*test-suite* (t:test-suite "decons")))
(test-basic) (test-basic)
(test-lib)
(test-line) (test-line)
(t:show-result))) (t:show-result)))
@ -24,6 +25,17 @@
(== (decons:remainder 7 4) 3) (== (decons:remainder 7 4) 3)
) )
(deftest test-lib ()
(== (decons:scalar-p 7) t)
(== (decons:scalar-p '(a b)) nil)
(let ((t1 (decons:tensor '(4) '(0 1 2 3))))
(== (decons:at t1 0) 0)
(setf (decons:at t1 0) 5)
(== (decons:at t1 0) 5)
(== (decons:scalar-p t1) nil)
)
)
(deftest test-line () (deftest test-line ()
(let ((p1 (decons:line 0.0)) (let ((p1 (decons:line 0.0))
(p2 (decons:line 1.0)) (p2 (decons:line 1.0))