-
Notifications
You must be signed in to change notification settings - Fork 5
/
executor.lisp
113 lines (90 loc) · 3.02 KB
/
executor.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
(in-package :cl-symbolic-math)
;;;; Execute symbolic math trees. Or even better, compile them to closures.
;;; keep track of special symbols/operators
(defparameter *constants* nil)
(defparameter *variate-operators* nil)
(def! symbolic-compile nil
(constantly nil))
;;; constants
(defmacro define-symbolic-constant (symbolic-constant value)
`(progn
(push ',symbolic-constant *constants*)
(def symbolic-compile ,symbolic-constant
(constantly ,value))))
(define-symbolic-constant pi pi)
(define-symbolic-constant e (exp 1))
;;; terminals
(def symbolic-compile _x
(where (symbolp _x))
(lambda (b)
(if-let (bg (assoc _x b))
(cdr bg)
(error "Binding ~a not found." _x))))
(def symbolic-compile _n
(where (numberp _n))
(constantly _n))
;;; basic arithmetic
(defmacro define-unary-operator (symbolic-op real-op)
"Define mapping from symbolic-op unary operator to real-op unary operator."
(with-unique-names (b a)
`(def symbolic-compile (,symbolic-op _a)
(let ((,a (symbolic-compile _a)))
(lambda (,b)
(,real-op (funcall ,a ,b)))))))
(defmacro define-binary-operator (symbolic-op real-op)
"Define mapping from symbolic-op binary operator to real-op binary operator."
(with-unique-names (b l r)
`(def symbolic-compile (,symbolic-op _a _b)
(let ((,l (symbolic-compile _a))
(,r (symbolic-compile _b)))
(lambda (,b)
(,real-op (funcall ,l ,b)
(funcall ,r ,b)))))))
(defmacro define-variate-operator (symbolic-op real-op)
"Define expander for multivariate operator to nested binary operators"
(with-unique-names (b l r)
`(progn
(push ',symbolic-op *variate-operators*)
(def symbolic-compile (,symbolic-op _a . _rest)
(where (> (length _rest) 1))
(let ((,l (symbolic-compile _a))
(,r (symbolic-compile (cons ',symbolic-op _rest))))
(lambda (,b)
(,real-op (funcall ,l ,b)
(funcall ,r ,b))))))))
(define-unary-operator - -)
(define-binary-operator + +)
(define-binary-operator - -)
(define-binary-operator * *)
(define-binary-operator / /)
(define-variate-operator + +)
(define-variate-operator - -)
(define-variate-operator * *)
(define-variate-operator / /)
;;; some basic functions
(defmacro define-unary-function (symbolic-op unary-function)
"Map symbolic-op to arbitrary unary function"
(with-unique-names (b a f)
`(def symbolic-compile (,symbolic-op _a)
(let ((,a (symbolic-compile _a))
(,f ,unary-function))
(lambda (,b)
(funcall ,f
(funcall ,a ,b)))))))
(define-unary-operator sin sin)
(define-unary-operator cos cos)
(define-unary-operator tan tan)
(define-unary-function ctg (lambda (x)
(/ 1 (tan x))))
(define-unary-operator asin asin)
(define-unary-operator acos acos)
(define-unary-operator atan atan)
(define-unary-function actg (lambda (x)
(atan (/ 1 x))))
(define-binary-operator ^ expt)
(define-unary-operator exp exp)
(define-unary-operator sqrt sqrt)
(define-unary-operator log log)
;;; failure
(def symbolic-compile _x
(error "Unknown symbolic math operation ~a" _x))