finishing the os module
[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)
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)))
54 (_make self pre nm))))
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)))
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)))))
75
76
77 ((self l nm)
78 (_cont self #f l #f nm))
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)
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 (set self '_export (module-public-interface _module))
129 (set self '_module _module)
130 (hash-set! _modules l self))))))
131
132 (define __getattribute__
133 (lambda (self k)
134 (define (fail)
135 (raise KeyError "getattr in Module"))
136
137 (if (rawref self '_module)
138 (let ((k (_k k))
139 (m (_m self)))
140 (let ((x (pk (module-ref m k e))))
141 (if (eq? e x)
142 (fail)
143 x)))
144 (fail))))
145
146 (define __setattr__
147 (lambda (self k v)
148 (let ((k (_k k))
149 (fail (lambda () (raise KeyError "getattr in Module" k))))
150 (if (rawref self k)
151 (fail)
152 (aif m (rawref self '_module)
153 (catch #t
154 (lambda ()
155 (if (module-defined? m k)
156 (module-set! m k v)
157 (module-define! m k v)))
158 (lambda x (fail)))
159 (fail))))))
160
161 (define __delattr__
162 (lambda (self k)
163 (define (fail) (raise KeyError "getattr in Module"))
164 (aif m (rawref self '_module)
165 (let ((k (_k k)))
166 (if (module-defined? m k)
167 (module-remove! m k)
168 (raise KeyError "delattr of missing key in Module")))
169 (fail))))
170
171 (define __repr__
172 (lambda (self) (format #f "Module(~a)" (ref self '__name__))))
173
174 (define __getitem__
175 (lambda (self k)
176 (define k (if (string? k) (string->symbol k) k))
177 (__getattribute__ self k)))
178
179 (define __iter__
180 (lambda (self)
181 (define m (_m self))
182 ((make-generator ()
183 (lambda (yield)
184 (define l '())
185 (define (f k v) (set! l (cons (list (symbol->string k) v) l)))
186 (module-for-each f m)
187 (let lp ((l l))
188 (if (pair? l)
189 (begin
190 (apply yield (car l))
191 (lp (cdr l)))))))))))
192
193
194
195 (define-syntax import
196 (lambda (x)
197 (syntax-case x ()
198 ((_ (a ...) var)
199 #`(import-f #,(case (syntax-local-binding #'var)
200 ((lexical)
201 #'var)
202 ((global)
203 #'(if (module-defined? (current-module)
204 (syntax->datum #'var))
205 var
206 #f))
207 (else
208 #f)) a ...)))))
209
210 (define (m? x) ((@ (language python module python) isinstance) x Module))
211 (define (import-f x f . l)
212 (if x
213 (if (m? x)
214 (begin (apply (rawref x '__update__) l) x)
215 (apply f l))
216 (apply f l)))