Skip to content
Newer
Older
100644 62 lines (52 sloc) 1.28 KB
27257ab monad-parse update
Vincent Toups authored
1 (require 'utils)
2 (require 'recur)
3
4 (defstruct unit-atom name type abbreviation conversions)
5 (defstruct unit-comp num den)
6
7 (defalias 'unit-atom? #'unit-atom-p)
8 (defalias 'unit-comp? #'unit-comp-p)
9
10 (defun u*2 (u1 u2)
11 (make-unit-comp
12 :num
13 (cond
14 ((and (unit-atom? u1)
15 (unit-atom? u2))
16 (list u1 u2))
17 ((and (unit-atom? u1)
18 (unit-comp? u2))
19 (cons u1 (unit-comp-num u2)))
20 ((and (unit-comp? u1)
21 (unit-atom? u2))
22 (suffix (unit-comp-num u1) u2))
23 ((and (unit-comp? u1)
24 (unit-comp? u2))
25 (append (unit-comp-num u1)
26 (unit-comp-num u2))))
27 :den
28 (cond
29 ((and (unit-atom? u1)
30 (unit-atom? u2))
31 (list u1 u2))
32 ((and (unit-atom? u1)
33 (unit-comp? u2))
34 (cons u1 (unit-comp-den u2)))
35 ((and (unit-comp? u1)
36 (unit-atom? u2))
37 (suffix (unit-comp-den u1) u2))
38 ((and (unit-comp? u1)
39 (unit-comp? u2))
40 (append (unit-comp-den u1)
41 (unit-comp-den u2))))))
42
43
44 (defun u* (&rest us)
45 (reduce #'u*2 us))
46
47 (defun u-invert (u)
48 (if (unit-atom? u)
49 (make-unit-comp
50 :num '()
51 :den (list u))
52 (make-unit-comp
53 :num (unit-comp-den u)
54 :den (unit-comp-num u))))
55
56 (defun u/ (u1 &rest us)
57 (apply #'u* u1 (mapcar #'u-invert us)))
58
59 (u* (make-unit-atom :name 'grams :type 'mass :conversions '())
60 (make-unit-atom :name 'seconds :type 'time :conversions '()))
61
Something went wrong with that request. Please try again.