4cfd239b91f22370b5afb67940e7bcbe3b12d424
[software/python-on-guile.git] / modules / language / python / eval.scm
1 (define-module (language python eval)
2 #:use-module (language python guilemod)
3 #:use-module (parser stis-parser lang python3-parser)
4 #:use-module (language python exceptions)
5 #:use-module (language python module)
6 #:use-module (language python try)
7 #:use-module (language python list)
8 #:use-module (language python for)
9 #:use-module (language python dict)
10 #:use-module (oop pf-objects)
11 #:use-module ((ice-9 local-eval) #:select ((the-environment . locals)))
12 #:re-export (locals)
13 #:replace (eval)
14 #:export (local-eval local-compile globals compile exec))
15
16 (define seval (@ (guile) eval))
17
18 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
19
20 (define-syntax-rule (L x) (@@ (ice-9 local-eval) x))
21
22 (define-syntax globals
23 (lambda (x)
24 (syntax-case x ()
25 ((g)
26 #'(M ((L env-module) (locals g)))))))
27
28 (define-syntax-rule (call- self item a ...)
29 (let ((class (ref self '_module)))
30 ((rawref class item) class a ...)))
31
32 (define-syntax-rule (apply- self item a ...)
33 (let ((class (ref self '_module)))
34 (apply (rawref class item) class a ...)))
35
36 (define-syntax-rule (ref- self item)
37 (let ((class (ref self '_module)))
38 (rawref class item)))
39
40
41 (define-python-class GlobalModuleWrap (dict)
42 (define __init__
43 (lambda (self module)
44 (set self '_module module)))
45
46 (define __getitem__
47 (lambda (self key)
48 (if (string? key) (set! key (string->symbol key)))
49 (call- self '__global_getitem__ key)))
50
51 (define get
52 (lambda (self key . es)
53 (if (string? key) (set! key (string->symbol key)))
54 (apply- self '__global_get__ key es)))
55
56 (define __setitem__
57 (lambda (self key val)
58 (if (string? key) (set! key (string->symbol key)))
59 (call- self '__global_setitem__ key val)))
60
61 (define __iter__
62 (lambda (self)
63 (call- self '__global_iter__)))
64
65 (define values
66 (lambda (self)
67 (for ((k v : (__iter__ self))) ((l '()))
68 (cons v l)
69 #:final l)))
70
71 (define keys
72 (lambda (self)
73 (for ((k v : (__iter__ self))) ((l '()))
74 (cons k l)
75 #:final l)))
76
77 (define __contains__
78 (lambda (self key)
79 (if (string? key) (set! key (string->symbol key)))
80 (for ((k v : (__iter__ self))) ()
81 (if (eq? k key)
82 (break #t))
83 #:final
84 #f)))
85
86 (define items __iter__)
87
88 (define __repr__
89 (lambda (self)
90 (format #f "globals(~a)" (ref- self '__name__)))))
91
92
93
94 (define MM (list 'error))
95 (define (M mod)
96 (set! mod (module-name mod))
97 (if (and (> (length mod) 3)
98 (eq? (car mod) 'language)
99 (eq? (cadr mod) 'python)
100 (eq? (caddr mod) 'module))
101 (set! mod (Module (reverse mod)
102 (reverse (cdddr mod))))
103 (set! mod (Module (reverse mod) (reverse mod))))
104
105 (GlobalModuleWrap mod))
106
107
108 (define (local-eval x locals globals)
109 "Evaluate the expression @var{x} within the local environment @var{local} and
110 global environment @var{global}."
111 (if locals
112 (apply (seval ((L local-wrap) x locals)
113 (if globals
114 globals
115 ((L env-module) locals)))
116 ((L env-boxes) locals))
117 (seval x (current-module))))
118
119 (define* (local-compile x locals globals #:key (opts '()))
120 "Compile the expression @var{x} within the local environment @var{local} and
121 global environment @var{global}."
122 (if locals
123 (apply ((@ (system base compile) compile)
124 ((L local-wrap) x locals)
125 #:env (if globals
126 globals
127 ((L env-module) locals))
128 #:from 'scheme #:opts opts)
129 ((L env-boxes) locals))
130 ((@ (system base compile) compile)
131 x
132 #:env (current-module)
133 #:from 'scheme #:opts opts)))
134
135 (define-syntax eval
136 (lambda (x)
137 (syntax-case x ()
138 ((eval x)
139 #'(eval0 x (locals eval)))
140 ((eval x . l)
141 #'(eval0 x . l)))))
142
143 (define (comp x) (error "not implemented"))
144
145 (define* (eval0 x #:optional (locals #f) (globals #f))
146 (cond
147 ((string? x)
148 (aif xp (p x)
149 (aif cp (comp xp)
150 (local-eval cp locals globals)
151 (raise SyntaxError))
152 (raise SyntaxError)))
153 ((pair? x)
154 (local-eval x locals globals))))
155
156 (define* (compile x filename mode
157 #:optional (flags 0) (dont_inherit #f) (optimize -1))
158 (aif xp (p x)
159 (aif cp (comp xp)
160 cp
161 (raise SyntaxError))
162 (raise SyntaxError)))
163
164 (define-syntax exec
165 (lambda (x)
166 (syntax-case x ()
167 ((exec x)
168 #'(eval0 x (locals exec)))
169 ((exec x . l)
170 #'(exec0 x . l)))))
171
172 (define* (exec0 x #:optional (locals #f) (globals #f))
173 (local-eval x locals globals))