1 files changed, 171 insertions, 0 deletions
diff --git a/modules/language/python/#eval.scm# b/modules/language/python/#eval.scm#
new file mode 100644
index 0000000..5328fe5
--- /dev/null
+++ b/modules/language/python/#eval.scm#
@@ -0,0 +1,171 @@
+(define-module (language python eval)
+  #:use-module (language python guilemod)
+  #:use-module (parser stis-parser lang python3-parser)
+  #:use-module (language python exceptions)
+  #:use-module (language python module)
+  #:use-module (language python try)
+  #:use-module (language python list)
+  #:use-module (language python for)
+  #:use-module (language python dict)
+  #:use-module (oop pf-objects)
+  #: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-syntax globals
+  (lambda (x)
+    (syntax-case x ()
+      ((g)
+       #'(M ((L env-module) (locals g)))))))
+
+(define-syntax-rule (call- self item a ...)
+  (let ((class (ref self '_module)))
+    ((rawref class item) class a ...)))
+
+(define-syntax-rule (apply- self item a ...)
+  (let ((class (ref self '_module)))
+    (apply (rawref class item) class a ...)))
+
+(define-syntax-rule (ref- self item)
+  (let ((class (ref self '_module)))
+    (rawref class item)))
+
+   
+(define-python-class GlobalModuleWrap (dict)
+  (define __init__
+    (lambda (self module)
+      (set self '_module module)))
+  
+  (define __getitem__
+    (lambda (self key)
+      (if (string? key) (set! key (string->symbol key)))
+      (call- self '__global_getitem__ key)))
+
+  (define get
+    (lambda (self key . es)
+      (if (string? key) (set! key (string->symbol key)))
+      (apply- self '__global_get__ key es)))
+
+  (define __setitem__
+    (lambda (self key val)
+      (if (string? key) (set! key (string->symbol key)))
+      (call- self '__global_setitem__ key val)))
+
+  (define __iter__
+    (lambda (self)
+      (call- self '__global_iter__)))
+
+  (define values
+    (lambda (self)
+      (for ((k v : (__iter__ self))) ((l '()))
+           (cons v l)
+           #:final l)))
+
+  (define keys
+    (lambda (self)
+      (for ((k v : (__iter__ self))) ((l '()))
+           (cons k l)
+           #:final l)))
+
+  (define __contains__
+    (lambda (self key)
+      (if (string? key) (set! key (string->symbol key)))
+      (for ((k v : (__iter__ self))) ()
+           (if (eq? k key)
+               (break #t))
+           #:final
+           #f)))
+  
+  (define items __iter__)
+
+  (define __repr__
+    (lambda (self)
+      (format #f "globals(~a)" (ref- self '__name__)))))
+
+  
+      
+(define MM (list 'error))
+(define (M mod)
+  (set! mod (module-name mod))
+  (if (and (> (length mod) 3)
+           (eq? (car   mod) 'language)
+           (eq? (cadr  mod) 'python)
+           (eq? (caddr mod) 'module))
+      (set! mod (Module (reverse mod)
+                        (reverse (cdddr mod))))
+      (set! mod (Module (reverse mod) (reverse mod))))
+
+  (GlobalModuleWrap mod))
+                      
+
+(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))