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