From db36b6633b5ccd709eac44635ca88e8683ddb4e3 Mon Sep 17 00:00:00 2001 From: Stefan Israelsson Tampe Date: Tue, 12 Mar 2019 21:32:43 +0100 Subject: remove old stuff --- modules/language/python/python.scm | 265 ------------------------------------- 1 file changed, 265 deletions(-) delete mode 100644 modules/language/python/python.scm (limited to 'modules/language/python/python.scm') diff --git a/modules/language/python/python.scm b/modules/language/python/python.scm deleted file mode 100644 index e8621ad..0000000 --- a/modules/language/python/python.scm +++ /dev/null @@ -1,265 +0,0 @@ -(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 (syntax->datum #'y)))))))) - -(define-syntax compile-python-file - (lambda (x) - (syntax-case x () - ((_ y) - (if (string? (syntax->datum #'y)) - (with-input-from-file (syntax->datum #'y) - (lambda () (compile-python1 x (python-parser)))) - #f))))) - - - - - - - - - - -- cgit v1.2.3