a commit
[software/python-on-guile.git] / modules / language / python / python.scm
1 (define-module (language python python)
2 #:use-module (language python parser)
3 #:use-module (language python expr)
4 #:use-module (ice-9 match)
5 #:export (compile-python-string compile-python-file))
6
7 ;;; VARIABLES ----------------------------------------------------------------
8 (define (find-global-variables vars tree)
9 (define (for-each* f l)
10 (match l
11 ((x . l)
12 (f x)
13 (for-each* f l))
14 (x
15 (f x))))
16
17 (define (local tree)
18 (match tree
19 ((#:global l)
20 (for-each*
21 (lambda (x) (hash-set! vars x #t)) l))
22 ((x . l)
23 (for-each* local tree))
24 (_
25 #t)))
26
27 (define (collect tree)
28 (match tree
29 ((#:lambdef . _)
30 #t)
31 ((#:identifier . l)
32 (hash-set! vars tree #t))
33 ((_ . _)
34 (for-each* collect tree))
35 (_
36 #t)))
37
38 (let lp ((tree tree))
39 (match tree
40 ((#:def . l)
41 (for-each* local l))
42 ((#:lambdef . l)
43 (for-each* local l))
44 ((#:class . l)
45 (for-each* local l))
46 ((#:expr-stmt
47 a (#:assign x ... e))
48 (collect a)
49 (collect x))
50 ((x . l)
51 (for-each* lp tree))
52 (_
53 #t))))
54 ;; COMPILATION
55
56 (define (expr stx out tree)
57 (define (expr-lhs tree)
58 (match tree
59 ((#:test (#:power (#:identifier v . _)))
60 (datum->syntax stx (string->symbol v)))))
61
62
63 (define (expr-rhs tree)
64 (define (comp-tr op)
65 (match op
66 ("notin" #'py-notin)
67 ("isnot" #'py-isnot)
68 ("==" #'py_==)
69 (">=" #'py_>=)
70 ("<=" #'py_<=)
71 ("<>" #'py_<>)
72 ("!=" #'py_!=)
73 ("in" #'py_in)
74 ("is" #'py_is)
75 ("<" #'py_< )
76 (">" #'py_> )))
77
78 (let lp ((tree tree))
79 (match tree
80 ((#:test x #f)
81 (lp x))
82 ((#:test x (a b))
83 #`(if #,(py-true? (lp a)) #,(lp x) #,(lp b)))
84 ((#:or x . y)
85 #`(py-or #,(lp x) #,@(map lp y)))
86 ((#:and x y)
87 #`(py-and #,(lp x) #,@(map lp y)))
88 ((#:not x)
89 #`(py-not #,(lp x)))
90 ((#:comp x)
91 (lp x))
92 ((#:comp x (op . y) . l)
93 #'(#,(comp-tr op) #,(lp x) #,(lp (cons* #:comp y l))))
94 ((#:bor x y)
95 #`(py-bor #,(lp x) #,@(map lp y)))
96 ((#:bxor x y)
97 #`(py-bxor #,(lp x) #,@(map lp y)))
98 ((#:xand x y)
99 #`(py-band #,(lp x) #,@(map lp y)))
100 ((#:<< x y)
101 #`(py-<< #,(lp x) #,@(map lp y)))
102 ((#:>> x y)
103 #`(py->> #,(lp x) #,@(map lp y)))
104 ((#:+ x y)
105 #`(py-+ #,(lp x) #,@(map lp y)))
106 ((#:- x y)
107 #`(py-- #,(lp x) #,@(map lp y)))
108 ((#:* x y)
109 #`(py-* #,(lp x) #,@(map lp y)))
110 ((#:/ x y)
111 #`(py-/ #,(lp x) #,@(map lp y)))
112 ((#:// x y)
113 #`(py-// #,(lp x) #,@(map lp y)))
114 ((#:% x y)
115 #`(py-% #,(lp x) #,@(map lp y)))
116 ((#:u+ x)
117 #`(py-u+ #,(lp x)))
118 ((#:u- x)
119 #`(py-u- #,(lp x)))
120 ((#:u~ x)
121 #`(py-u~ #,(lp x)))
122 ((#:power x trailer . #f)
123 (compile-trailer trailer (lp x)))
124 ((#:power x trailer . l)
125 #'(py-power ,#(compile-trailer trailer (lp x)) #,(lp l)))
126 ((#:identifier x . _)
127 (datum->syntax stx (string->symbol x)))
128 ((not (_ . _))
129 tree))))
130
131
132
133 (lambda (tree)
134 (match tree
135 ((test1 (#:assign))
136 (expr-rhs test1))
137 ((test1 (#:assign tests ... last))
138 (with-syntax (((rhs ...) (map expr-rhs last))
139 ((lhs1 ...) (map expr-lhs test1))
140 (((lhs ...) ...) (reverse (map (lambda (l)
141 (map expr-lhs l))
142 tests))))
143 (with-syntax (((v ...) (generate-temporaries #'(lhs1 ...))))
144 (out #'(call-with-values (lambda () (values rhs ...))
145 (lambda (v ...)
146 (begin
147 (set! lhs v) ...)
148 ...
149 (set! lhs1 v) ...)))))))))
150
151
152 (define (compile-outer state out tree)
153 (define (compile-stmt state tree)
154 (match tree
155 ((#:expr-stmt l)
156 (compile-expr l))
157
158 ((#:del l)
159 (compile-del l))
160
161 (#:pass
162 (out #'(if #f #f)))
163
164 (#:break
165 (break out))
166
167 (#:continue
168 (continue out))
169
170 ((#:return . l)
171 (compile-return state l))
172
173 ((#:raise . l)
174 (compile-raise state l))
175
176 ((#:import l)
177 (compile-import state l))
178
179 ((#:global . _)
180 #t)
181
182 ((#:nonlocal . _)
183 #t)
184
185 ((#:assert . l)
186 (compile-assert state l))))
187
188 (match tree
189 ((#:stmt x)
190 (for-each* compile-stmt tree))
191 ((#:if . l)
192 (compile-if state l))
193 ((#:while . l)
194 (compile-while state l))
195 ((#:for . l)
196 (compile-for state l))
197 ((#:try . l)
198 (compile-try state l))
199 ((#:with . l)
200 (compile-with state l))
201 ((#:def . l)
202 (compile-def state l))
203 ((#:decorated . l)
204 (compile-decorated state l))))
205
206
207 (define (compile-python0 stx tree output)
208 (define global-variables (make-hash-table))
209
210 (find-global-variables global-variables tree)
211 (set! all-variables
212 (hash-fold
213 (lambda (k v e)
214 (match k
215 ((_ v . _)
216 (cons (datum->syntax stx (string->symbol v)) e))))
217 '() global-variables))
218 (set! all-globals
219 (hash-fold
220 (lambda (k v e)
221 (match k
222 ((_ v)
223 (cons (datum->syntax stx (string->symbol v)) e))))
224 '() global-variables))
225
226 (output (with-syntax (((v ...) all-variables))
227 #'(begin (define v (if #f #f)) ...)))
228
229 (output (with-syntax (((v ...) all-globals))
230 #'(export v ...)))
231
232 (output #`(begin #,@(compile-outer))))
233
234
235 (define (compile-python1 stx tree)
236 (let ((out '()))
237 (define (out x) (set! out (cons x out)))
238 (compile-python0 stx tree out)
239 (cons* #'begin (reverse out))))
240
241 (define-syntax compile-python-string
242 (lambda (x)
243 (syntax-case x ()
244 ((_ y)
245 (if (string? (syntax->datum #'y))
246 (compile-python1 x (python-parser (syntax->datum #'y))))))))
247
248 (define-syntax compile-python-file
249 (lambda (x)
250 (syntax-case x ()
251 ((_ y)
252 (if (string? (syntax->datum #'y))
253 (with-input-from-file (syntax->datum #'y)
254 (lambda () (compile-python1 x (python-parser))))
255 #f)))))
256
257
258
259
260
261
262
263
264
265