forked from jingtaozf/burgled-batteries
-
Notifications
You must be signed in to change notification settings - Fork 10
/
module.lisp
89 lines (76 loc) · 2.82 KB
/
module.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
(in-package :burgled-batteries3)
(defstruct python-module
name python-name methods documentation)
(defvar *python-modules* (make-hash-table :test #'equalp))
(defvar *python-module* nil)
(defun replace-all (string part replacement &key (test #'char=))
"Returns a new string in which all the occurences of the part
is replaced with replacement."
(with-output-to-string (out)
(loop with part-length = (length part)
for old-pos = 0 then (+ pos part-length)
for pos = (search part string
:start2 old-pos
:test test)
do (write-string string out
:start old-pos
:end (or pos (length string)))
when pos do (write-string replacement out)
while pos)))
(defmethod python-string ((string symbol))
(python-string (string-downcase (string string))))
(defmethod python-string ((string string))
(replace-all string "-" "_"))
(defun get-pymodule (name &key (error-p t))
(or
(gethash name *python-modules*)
(and error-p
(error "Python module not defined: ~A" name))))
(defmacro defpymodule (name &key python-name documentation)
`(%defpymodule ',name
:python-name ,python-name
:documentation ,documentation))
(defun %defpymodule (name &key python-name documentation)
(let ((python-module (make-python-module :name name
:python-name (or python-name
(python-string name))
:documentation documentation)))
(setf (gethash name *python-modules*)
python-module)
(setf *python-module* python-module)))
(defmacro in-pymodule (name)
`(%in-pymodule ',name))
(defun %in-pymodule (name)
(setf *python-module* (get-pymodule name)))
(defmacro defpycallback (name-and-options (&rest args) &body body)
(multiple-value-bind (lisp-name python-name return-type python-module)
(if (listp name-and-options)
(let ((options (cdr name-and-options)))
(values (first name-and-options)
(or (getf options :python-name)
(python-string (first name-and-options)))
(or (getf options :return-type)
:pointer)
(let ((python-module (getf options :module)))
(or (and python-module `(get-pymodule ',python-module))
'*python-module*))))
(values name-and-options
(python-string name-and-options)
:pointer
'*python-module*))
`(progn
(python3.cffi::defpycallback ,lisp-name ,return-type ,args ,@body)
(when ,python-module
(pushnew
(cons ,python-name
',lisp-name)
(python-module-methods ,python-module)
:test #'equalp)))))
(defun initialize-module (module)
(python3.cffi::build-module
(python-module-python-name module)
(python-module-methods module)))
(defun initialize-modules ()
(loop
:for module :being :the :hash-values :of *python-modules*
:do (initialize-module module)))