Merge branch 'master' of https://gitlab.com/python-on-guile/python-on-guile
[software/python-on-guile.git] / modules / language / python / spec.scm
1 (define-module (language python spec)
2 #:use-module (language python guilemod)
3 #:use-module (parser stis-parser lang python3-parser)
4 #:use-module ((language python module python) #:select ())
5 #:use-module (language python compile)
6 #:use-module (language python completer)
7 #:use-module (rnrs io ports)
8 #:use-module (ice-9 pretty-print)
9 #:use-module (ice-9 readline)
10 #:use-module (system base compile)
11 #:use-module (system base language)
12 #:use-module (language scheme compile-tree-il)
13 #:use-module (language scheme decompile-tree-il)
14 #:use-module (ice-9 rdelim)
15 #:export (python))
16
17 ;;;
18 ;;; Language definition
19 ;;;
20
21
22 (define (pr . x)
23 (define port (open-file "/home/stis/src/python-on-guile/log.txt" "a"))
24 (with-output-to-port port
25 (lambda ()
26 (pretty-print x) (car (reverse x))))
27 (close port)
28 (car (reverse x)))
29
30 (define (c int x) (pr (comp int (pr (p (pr x))))))
31 (define (cc int port x)
32 (if (equal? x "") (read port) (c int x)))
33
34 (define (e x) (eval (c #t x) (current-module)))
35
36
37 (define (int)
38 (catch #t
39 (lambda ()
40 (if (fluid-ref (@@ (system base compile) %in-compile))
41 #f
42 #t))
43 (lambda x #f)))
44
45 (define (in)
46 (catch #t
47 (lambda ()
48 (fluid-set! (@@ (system base compile) %in-compile) #t))
49 (lambda x #f)))
50
51 (define mapper (make-weak-key-hash-table))
52
53 (define python-reader-wrap
54 (lambda (port env)
55 (if (int)
56 (cc #t port (read-line port))
57 (let lp ((port2 (hash-ref mapper port)))
58 (if port2
59 (read port2)
60 (let ((port2
61 (open-input-string (cc #f port (read-string port)))))
62 (use-modules (language python guilemod))
63 (in)
64 (hash-set! mapper port port2)
65 (lp port2)))))))
66
67 (catch #t
68 (lambda ()
69 (set! (@@ (ice-9 readline) *readline-completion-function*)
70 (complete-fkn e)))
71 (lambda x #f))
72
73 (define-language python
74 #:title "python"
75 #:reader python-reader-wrap
76 #:compilers `((tree-il . ,compile-tree-il))
77 #:decompilers `((tree-il . ,decompile-tree-il))
78 #:evaluator (lambda (x module) (primitive-eval x))
79 #:printer write
80 #:make-default-environment
81 (lambda ()
82 ;; Ideally we'd duplicate the whole module hierarchy so that `set!',
83 ;; `fluid-set!', etc. don't have any effect in the current environment.
84 (let ((m (make-fresh-user-module)))
85 ;; Provide a separate `current-reader' fluid so that
86 ;; compile-time changes to `current-reader' are
87 ;; limited to the current compilation unit.
88 (module-define! m 'current-reader (make-fluid))
89
90 ;; Default to `simple-format', as is the case until
91 ;; (ice-9 format) is loaded. This allows
92 ;; compile-time warnings to be emitted when using
93 ;; unsupported options.
94 (module-set! m 'format simple-format)
95
96 m)))