blob: a54ea648ead3494555ea23dde7b2ac5dcc98ebc5 (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
(define-module (language python eval)
#:use-module (parser stis-parser lang python3-parser)
#:use-module (language python exceptions)
#:use-module ((ice-9 local-eval) #:select ((the-environment . locals)))
#:re-export (locals)
#:replace (eval)
#:export (local-eval local-compile globals compile exec))
(define seval (@ (guile) eval))
(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
(define-syntax-rule (L x) (@@ (ice-9 local-eval) x))
(define MM (list 'error))
(define (M mod)
(let ((l '()))
(module-for-each
(lambda (k v)
(if (not (eq? (variable-ref v) MM))
(set! l (cons (symbol->string k) l))))
mod)
l))
(define-syntax globals
(lambda (x)
(syntax-case x ()
((g)
#'(M ((L env-module) (locals g)))))))
(define* (local-eval x locals globals)
"Evaluate the expression @var{x} within the local environment @var{local} and
global environment @var{global}."
(if locals
(if globals
(apply (seval ((L local-wrap) x locals) globals)
((L env-boxes) locals))
(apply (seval ((L local-wrap) x locals) ((L env-module) locals))
((L env-boxes) locals)))
(seval x (current-module))))
(define* (local-compile x locals globals #:key (opts '()))
"Compile the expression @var{x} within the local environment @var{local} and
global environment @var{global}."
(if locals
(if globals
(apply ((@ (system base compile) compile)
((L local-wrap) x locals) #:env globals
#:from 'scheme #:opts opts)
((L env-boxes) locals))
(apply ((@ (system base compile) compile) ((L local-wrap) x locals)
#:env ((L env-module) locals)
#:from 'scheme #:opts opts)
((L env-boxes) locals)))
((@ (system base compile) compile) x #:env (current-module)
#:from 'scheme #:opts opts)))
(define-syntax eval
(lambda (x)
(syntax-case x ()
((eval x)
#'(eval0 x (locals eval)))
((eval x . l)
#'(eval0 x . l)))))
(define* (eval0 x #:optional (locals #f) (globals #f))
(cond
((string? x)
(aif xp (p x)
(aif cp (comp xp)
(local-eval cp locals globals)
(raise SyntaxError))
(raise SyntaxError)))
((pair? x)
(local-eval x locals globals))))
(define* (compile x filename mode
#:optional (flags 0) (dont_inherit #f) (optiomize -1))
(aif xp (p x)
(aif cp (comp xp)
cp
(raise SyntaxError))
(raise SyntaxError)))
(define-syntax exec
(lambda (x)
(syntax-case x ()
((exec x)
#'(eval0 x (locals exec)))
((exec x . l)
#'(exec0 x . l)))))
(define* (exec0 x #:optional (locals #f) (globals #f))
(local-eval x locals globals))
|
