further improvements following python3 spec
[software/python-on-guile.git] / modules / language / python / module.scm
1 (define-module (language python module)
2 #:use-module (oop pf-objects)
3 #:use-module (oop goops)
4 #:use-module (ice-9 match)
5 #:use-module (system syntax)
6 #:use-module (language python exceptions)
7 #:use-module (language python yield)
8 #:use-module (language python try)
9 #:use-module (language python dir)
10 #:export (Module private public import))
11
12 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
13
14 (define-syntax-rule (in-scheme x)
15 (let ((lan (current-language)))
16 (dynamic-wind
17 (lambda () (current-language 'scheme))
18 (lambda () x)
19 (lambda () (current-language lan)))))
20
21 (define (private mod)
22 ((ref mod '__setprivate__) #t))
23 (define (public mod)
24 ((ref mod '__setprivate__) #f))
25
26 (define e (list 'e))
27
28 (define _k
29 (lambda (k)
30 (if (string? k)
31 (string->symbol k)
32 k)))
33
34 (define _m
35 (lambda (self)
36 (if (rawref self '_private)
37 (rawref self '_module)
38 (rawref self '_export))))
39
40 (define-python-class Module ()
41 (define _modules (make-hash-table))
42 (define __setprivate__
43 (lambda (self p)
44 (rawset self '_isprivate p)))
45
46 (define _cont
47 (lambda (self id pre l nm skip-error?)
48 (if id
49 (aif it (rawref self id)
50 ((ref it '__init__) pre l nm)
51 (begin
52 (rawset self id (Module pre l nm))
53 (_make self pre nm skip-error?)))
54 (_make self pre nm skip-error?))))
55
56 (define _contupdate
57 (lambda (self id pre l nm)
58 (if id
59 (aif it (rawref self id)
60 ((ref it '__update__) pre l nm)
61 (rawset self id (Module pre l nm)))
62 #f)))
63
64 (define __init__
65 (case-lambda
66 ((self pre l nm)
67 (match l
68 ((name)
69 (set self '_path (reverse (cons name pre)))
70 (_cont self #f (cons name pre) #f (cons name nm) #f))
71
72 ((name . (and l (name2 . _)))
73 (set self '_path (reverse (cons name pre)))
74 (_cont self name2 (cons name pre) l (cons name nm) #t))))
75
76
77 ((self l nm)
78 (_cont self #f l #f nm #f))
79
80 ((self l)
81 (if (pair? l)
82 (if (and (> (length l) 3)
83 (equal? (list (list-ref l 0)
84 (list-ref l 1)
85 (list-ref l 2))
86 '(language python module)))
87 (__init__ self (reverse '(language python module)) (cdddr l) '())
88 #f)
89 (__init__ self
90 (map string->symbol
91 (string-split l #\.)))))))
92 (define __update__
93 (case-lambda
94 ((self pre l nm)
95 (match l
96 ((name)
97 (_contupdate self #f (cons name pre) #f (cons name nm)))
98
99 ((name . (and l (name2 . _)))
100 (_contupdate self name2 (cons name pre) l (cons name nm)))))
101
102
103 ((self l nm)
104 (_contupdate self #f l #f nm))
105
106 ((self l)
107 (if (pair? l)
108 (if (and (> (length l) 3)
109 (equal? (list (list-ref l 0)
110 (list-ref l 1)
111 (list-ref l 2))
112 '(language python module)))
113 (__update__ self (reverse '(language python module))
114 (cdddr l) '()))
115 (__update__ self
116 (map string->symbol
117 (string-split l #\.)))))))
118
119 (define _make
120 (lambda (self l nm skip-error?)
121 (rawset self '_private #f)
122 (if (not (rawref self '_module))
123 (begin
124 (set self '__dict__ self)
125 (set self '__name__ (string-join
126 (map symbol->string (reverse nm)) "."))
127 (let* ((_module (in-scheme (resolve-module (reverse l))))
128 (public-i (and _module (module-public-interface _module))))
129 (if (and (not skip-error?) (not public-i))
130 (raise (ModuleNotFoundError
131 (format #f "No module named ~a"
132 (ref self '__name__)))))
133
134 (set self '_export (module-public-interface _module))
135 (set self '_module _module)
136 (hash-set! _modules l self))))))
137
138 (define __getattribute__
139 (lambda (self k)
140 (define (fail)
141 (raise (KeyError "getattr in Module")))
142 (aif it (rawref self k)
143 it
144 (if (rawref self '_module)
145 (let ((k (_k k))
146 (m (_m self)))
147 (let ((x (module-ref m k e)))
148 (if (eq? e x)
149 (fail)
150 x)))
151 (fail)))))
152
153 (define __setattr__
154 (lambda (self k v)
155 (let ((k (_k k))
156 (fail (lambda () (raise KeyError "getattr in Module" k))))
157 (if (rawref self k)
158 (fail)
159 (aif m (rawref self '_module)
160 (catch #t
161 (lambda ()
162 (if (module-defined? m k)
163 (module-set! m k v)
164 (module-define! m k v)))
165 (lambda x (fail)))
166 (fail))))))
167
168 (define __delattr__
169 (lambda (self k)
170 (define (fail) (raise KeyError "getattr in Module"))
171 (aif m (rawref self '_module)
172 (let ((k (_k k)))
173 (if (module-defined? m k)
174 (module-remove! m k)
175 (raise KeyError "delattr of missing key in Module")))
176 (fail))))
177
178 (define __repr__
179 (lambda (self) (format #f "Module(~a)" (ref self '__name__))))
180
181 (define __getitem__
182 (lambda (self k)
183 (define k (if (string? k) (string->symbol k) k))
184 (__getattribute__ self k)))
185
186 (define __iter__
187 (lambda (self)
188 (define m (_m self))
189 ((make-generator ()
190 (lambda (yield)
191 (define l '())
192 (define (f k v) (set! l (cons (list (symbol->string k) v) l)))
193 (module-for-each f m)
194 (let lp ((l l))
195 (if (pair? l)
196 (begin
197 (apply yield (car l))
198 (lp (cdr l)))))))))))
199
200
201
202 (define-syntax import
203 (lambda (x)
204 (syntax-case x ()
205 ((_ (a ...) var)
206 #`(import-f #,(case (syntax-local-binding #'var)
207 ((lexical)
208 #'var)
209 ((global)
210 #'(if (module-defined? (current-module)
211 (syntax->datum #'var))
212 var
213 #f))
214 (else
215 #f)) a ...)))))
216
217 (define (m? x) ((@ (language python module python) isinstance) x Module))
218 (define (import-f x f . l)
219 (if x
220 (if (m? x)
221 (begin (apply (rawref x '__update__) l) x)
222 (apply f l))
223 (apply f l)))