diff options
Diffstat (limited to 'modules/language/python/#python.scm#')
| -rw-r--r-- | modules/language/python/#python.scm# | 246 |
1 files changed, 246 insertions, 0 deletions
diff --git a/modules/language/python/#python.scm# b/modules/language/python/#python.scm# new file mode 100644 index 0000000..cb36775 --- /dev/null +++ b/modules/language/python/#python.scm# @@ -0,0 +1,246 @@ +(define-module (language python python) + #:use-module (language python parser) + #:use-module (language python expr) + #:use-module (ice-9 match) + #:export (compile-python-string compile-python-file)) + +;;; VARIABLES ---------------------------------------------------------------- +(define (find-global-variables vars tree) + (define (for-each* f l) + (match l + ((x . l) + (f x) + (for-each* f l)) + (x + (f x)))) + + (define (local tree) + (match tree + ((#:global l) + (for-each* + (lambda (x) (hash-set! vars x #t)) l)) + ((x . l) + (for-each* local tree)) + (_ + #t))) + + (define (collect tree) + (match tree + ((#:lambdef . _) + #t) + ((#:identifier . l) + (hash-set! vars tree #t)) + ((_ . _) + (for-each* collect tree)) + (_ + #t))) + + (let lp ((tree tree)) + (match tree + ((#:def . l) + (for-each* local l)) + ((#:lambdef . l) + (for-each* local l)) + ((#:class . l) + (for-each* local l)) + ((#:expr-stmt + a (#:assign x ... e)) + (collect a) + (collect x)) + ((x . l) + (for-each* lp tree)) + (_ + #t)))) +;; COMPILATION + +(define (expr stx out tree) + (define (expr-lhs tree) + (match tree + ((#:test (#:power (#:identifier v . _))) + (datum->syntax stx (string->symbol v))))) + + + (define (expr-rhs tree) + (define (comp-tr op) + (match op + ("notin" #'py-notin) + ("isnot" #'py-isnot) + ("==" #'py_==) + (">=" #'py_>=) + ("<=" #'py_<=) + ("<>" #'py_<>) + ("!=" #'py_!=) + ("in" #'py_in) + ("is" #'py_is) + ("<" #'py_< ) + (">" #'py_> ))) + + (let lp ((tree tree)) + (match tree + ((#:test x #f) + (lp x)) + ((#:test x (a b)) + #`(if #,(py-true? (lp a)) #,(lp x) #,(lp b))) + ((#:or x . y) + #`(py-or #,(lp x) #,@(map lp y))) + ((#:and x y) + #`(py-and #,(lp x) #,@(map lp y))) + ((#:not x) + #`(py-not #,(lp x))) + ((#:comp x) + (lp x)) + ((#:comp x (op . y) . l) + #'(#,(comp-tr op) #,(lp x) #,(lp (cons* #:comp y l)))) + ((#:bor x y) + #`(py-bor #,(lp x) #,@(map lp y))) + ((#:bxor x y) + #`(py-bxor #,(lp x) #,@(map lp y))) + ((#:xand x y) + #`(py-band #,(lp x) #,@(map lp y))) + ((#:<< x y) + #`(py-<< #,(lp x) #,@(map lp y))) + ((#:>> x y) + #`(py->> #,(lp x) #,@(map lp y))) + ((#:+ x y) + #`(py-+ #,(lp x) #,@(map lp y))) + ((#:- x y) + #`(py-- #,(lp x) #,@(map lp y))) + ((#:* x y) + #`(py-* #,(lp x) #,@(map lp y))) + ((#:/ x y) + #`(py-/ #,(lp x) #,@(map lp y))) + ((#:// x y) + #`(py-// #,(lp x) #,@(map lp y))) + ((#:% x y) + #`(py-% #,(lp x) #,@(map lp y))) + ((#:u+ x) + #`(py-u+ #,(lp x))) + ((#:u- x) + #`(py-u- #,(lp x))) + ((#:u~ x) + #`(py-u~ #,(lp x))) + ((#:power x trailer . #f) + (compile-trailer trailer (lp x))) + ((#:power x trailer . l) + #'(py-power ,#(compile-trailer trailer (lp x)) #,(lp l))) + ((#:identifier x . _) + (datum->syntax stx (string->symbol x))) + ((not (_ . _)) + tree)))) + + + + (lambda (tree) + (match tree + ((test1 (#:assign)) + (expr-rhs test1)) + ((test1 (#:assign tests ... last)) + (with-syntax (((rhs ...) (map expr-rhs last)) + ((lhs1 ...) (map expr-lhs test1)) + (((lhs ...) ...) (reverse (map (lambda (l) + (map expr-lhs l)) + tests)))) + (with-syntax (((v ...) (generate-temporaries #'(lhs1 ...)))) + (out #'(call-with-values (lambda () (values rhs ...)) + (lambda (v ...) + (begin + (set! lhs v) ...) + ... + (set! lhs1 v) ...))))))))) + + +(define (compile-outer state out tree) + (define (compile-stmt state tree) + (match tree + ((#:expr-stmt l) + (compile-expr l)) + + ((#:del l) + (compile-del l)) + + (#:pass + (out #'(if #f #f))) + + (#:break + (break out)) + + (#:continue + (continue out)) + + ((#:return . l) + (compile-return state l)) + + ((#:raise . l) + (compile-raise state l)) + + ((#:import l) + (compile-import state l)) + + ((#:global . _) + #t) + + ((#:nonlocal . _) + #t) + + ((#:assert . l) + (compile-assert state l)))) + + (match tree + ((#:stmt x) + (for-each* compile-stmt tree)) + ((#:if . l) + (compile-if state l)) + ((#:while . l) + (compile-while state l)) + ((#:for . l) + (compile-for state l)) + ((#:try . l) + (compile-try state l)) + ((#:with . l) + (compile-with state l)) + ((#:def . l) + (compile-def state l)) + ((#:decorated . l) + (compile-decorated state l)))) + + +(define (compile-python0 stx tree output) + (define global-variables (make-hash-table)) + + (find-global-variables global-variables tree) + (set! all-variables + (hash-fold + (lambda (k v e) + (match k + ((_ v . _) + (cons (datum->syntax stx (string->symbol v)) e)))) + '() global-variables)) + (set! all-globals + (hash-fold + (lambda (k v e) + (match k + ((_ v) + (cons (datum->syntax stx (string->symbol v)) e)))) + '() global-variables)) + + (output (with-syntax (((v ...) all-variables)) + #'(begin (define v (if #f #f)) ...))) + + (output (with-syntax (((v ...) all-globals)) + #'(export v ...))) + + (output #`(begin #,@(compile-outer)))) + + +(define (compile-python1 stx tree) + (let ((out '())) + (define (out x) (set! out (cons x out))) + (compile-python0 stx tree out) + (cons* #'begin (reverse out)))) + +(define-syntax compile-python-string + (lambda (x) + (syntax-case x () + ((_ y) + (if (string? (syntax->datum #'y)) + (compile-python1 x (python-parser |