summaryrefslogtreecommitdiff
path: root/modules/language/python/spec.scm
blob: c2f15bf5608db78679ef738e34a598a98caf1bad (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
96
97
98
99
100
101
102
103
104
105
106
107
(define-module (language python spec)
  #:use-module (language python guilemod)
  #:use-module ((parser stis-parser lang python3-parser)
                #:prefix python-parser:)
  #:use-module ((language python module python) #:select ())
  #:use-module (language python compile)
  #:use-module (language python completer)
  #:use-module (rnrs io ports)
  #:use-module (ice-9 pretty-print)
  #:use-module (ice-9 readline)
  #:use-module (system base compile)
  #:use-module (system base language)
  #:use-module (language scheme compile-tree-il)
  #:use-module (language scheme decompile-tree-il)
  #:use-module (ice-9 rdelim)
  #:export (python *python-debug*))

;;;
;;; Language definition
;;;

(define *python-debug* #f)
(define (trace . x)
  (when *python-debug*
    (let ()
      (define port (open-file "python-log.txt" "a"))
      (with-output-to-port port
        (lambda ()
          (pretty-print x) (car (reverse  x))))
      (close port)))
  (car (reverse x)))

(define (logging-compile int? exp)
  "Compile the Python expression EXP while optionally logging
intermediate values."
  (trace (comp int? (trace (python-parser:p (trace exp))))))

(define (read-or-compile int? port exp)
  "Compile the Python expression EXP or read a new one from PORT."
  (if (string-null? exp)
      (read port)
      (logging-compile int? exp)))

(define (python-eval exp)
  "Evaluate the Python expression EXP."
  (eval (logging-compile #t exp)
        (current-module)))

(define (ignore-errors proc)
  "Run PROC and ignore all errors."
  (catch #t (lambda () (proc)) (const #f)))

(define (int)
  (ignore-errors
   (lambda ()
     (not (fluid-ref (@@ (system base compile) %in-compile))))))

(define (in)
  (ignore-errors
   (lambda ()
     (fluid-set! (@@ (system base compile) %in-compile) #t))))

(define mapper (make-weak-key-hash-table))

(define python-reader-wrap
  (lambda (port env)
    (if (int)
        (read-or-compile #t port (read-line port))
        (let lp ((port2 (hash-ref mapper port)))
          (if port2
              (read port2)
              (let ((port2
                     (open-input-string (read-or-compile #f port (read-string port)))))
                (use-modules (language python guilemod))
                (in)
                (hash-set! mapper port port2)
                (lp port2)))))))

(ignore-errors
 (lambda ()
   (set! (@@ (ice-9 readline) *readline-completion-function*)
         (complete-python python-eval))))

(define-language python
  #:title	"python"
  #:reader      python-reader-wrap
  #:compilers   `((tree-il . ,compile-tree-il))
  #:decompilers `((tree-il . ,decompile-tree-il))
  #:evaluator	(lambda (x module) (primitive-eval x))
  #:printer	write
  #:make-default-environment
  (lambda ()
    ;; Ideally we'd duplicate the whole module hierarchy so that `set!',
    ;; `fluid-set!', etc. don't have any effect in the current environment.
    (let ((m (make-fresh-user-module)))                    
      ;; Provide a separate `current-reader' fluid so that
      ;; compile-time changes to `current-reader' are
      ;; limited to the current compilation unit.
      (module-define! m 'current-reader (make-fluid))
      
      ;; Default to `simple-format', as is the case until
      ;; (ice-9 format) is loaded.  This allows
      ;; compile-time warnings to be emitted when using
      ;; unsupported options.
      (module-set! m 'format simple-format)
      
      m)))