diff options
author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2019-03-12 21:32:43 +0100 |
---|---|---|
committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2019-03-12 21:32:43 +0100 |
commit | db36b6633b5ccd709eac44635ca88e8683ddb4e3 (patch) | |
tree | 7bbc9df1036b0a7733ea45f3dd74a199929176e1 /modules | |
parent | 1e823a1762088e6a4fbf5bc0791d61b9d6c4b013 (diff) |
remove old stuff
Diffstat (limited to 'modules')
-rw-r--r-- | modules/Makefile.am | 1 | ||||
-rw-r--r-- | modules/language/python/class.scm | 71 | ||||
-rw-r--r-- | modules/language/python/expr.scm | 106 | ||||
-rw-r--r-- | modules/language/python/python.scm | 265 |
4 files changed, 0 insertions, 443 deletions
diff --git a/modules/Makefile.am b/modules/Makefile.am index 1f81572..de8b03e 100644 --- a/modules/Makefile.am +++ b/modules/Makefile.am @@ -27,7 +27,6 @@ SOURCES = \ language/python/set.scm \ language/python/dir.scm \ language/python/checksum.scm \ - language/python/expr.scm \ language/python/format2.scm \ language/python/procedure.scm \ language/python/property.scm \ diff --git a/modules/language/python/class.scm b/modules/language/python/class.scm deleted file mode 100644 index 41ed09a..0000000 --- a/modules/language/python/class.scm +++ /dev/null @@ -1,71 +0,0 @@ -(define-module (language python class) - #:export (class_+ class_- class_* class_// class_% - class_power class_<< class_>> class_ior - class_xor class_band)) - -(define-syntax-rule (class-ref x) (struct-ref x 0)) -(define-syntax-rule (class-num x) (struct-ref x 1)) -(define-syntax-rule (class-log x) (struct-ref x 2)) -(define-syntax-rule (class-map x) (struct-ref x 3)) - -(define-syntax-rule (mkref +-ref n) - (define-syntax-rule (+-ref x) (vector-ref x n))) - -(mkref +-ref 0) -(mkref --ref 1) -(mkref *-ref 2) -(mkref /-ref 3) -(mkref //-ref 4) -(mkref %-ref 5) -(mkref **-ref 6) -(mkref <<-ref 7) -(mkref >>-ref 8) - -(mkref ior-ref 0) -(mkref xor-ref 1) -(mkref and-ref 2) - -(define-syntax-rule (class-lookup class key ) - (hashq-ref (class-map class) key #f)) - -(define-syntax-rule (meta-mk mk-num class-num) -(define-syntax-rule (mk-num class_+ __add__ __radd__ +-ref err) - (define (class_+ x y) - (let* ((cl (class-ref x)) - (r (class-num cl))) - (define (f) - (let ((rrr (class-lookup cl '__add__))) - (if rrr - (rrr x y) - (if (class? y) - (let* ((cl (class-ref y)) - (rrrr (class-lookup cl '__radd__))) - (if rrrr - (rrrr y x) - (err))) - (err))))) - - (if r - (let ((rr (+-ref r))) - (if rr - (rr x y) - (f))) - (f)))))) - -(meta-mk mk-num class-num) -(meta-mk mk-log class-log) - -(define (err) (error "could not do artithmetic ops")) - -(mk-num class_+ __add__ __radd__ +-ref err) -(mk-num class_- __sub__ __rsub__ --ref err) -(mk-num class_* __mul__ __rmul__ *-ref err) -(mk-num class_/ __div__ __rdiv__ /-ref err) -(mk-num class_// __floordiv__ __rfloordiv__ //-ref err) -(mk-num class_% __divmod__ __rdivmod__ %-ref err) -(mk-num class_power __pow__ __rpow__ **-ref err) -(mk-num class_<< __lshift__ __rlshift__ <<-ref err) -(mk-num class_>> __rshift__ __rrshift__ >>-ref err) -(mk-log class_ior __or__ __ror__ ior-ref err) -(mk-log class_xor __xor__ __rxor__ xor-ref err) -(mk-log class_band __and__ __rand__ and-ref err) diff --git a/modules/language/python/expr.scm b/modules/language/python/expr.scm deleted file mode 100644 index 81c2cbe..0000000 --- a/modules/language/python/expr.scm +++ /dev/null @@ -1,106 +0,0 @@ -(define-module (language python expr) - #:use-module (language python class) - #:export (py-true? to-py py-or py-and py-not py_== - py_>= py_<= py_< py_> py_<> py_!= py_in py_notin py_is - py_isnot py_bor py_xor py_band py-<< py->> py-+ py-- - py-* py-/ py-% py-// py-u+ py-u- py-u~ py-power - )) - - -(define-syntax-rule (py-true? x) (eq? x 'True)) -(define-syntax-rule (to-py x) (if x 'True 'false)) -(define-syntax-rule (py-or x ...) (to-py (or (py-true? x) ...))) -(define-syntax-rule (py-and x ...) (to-py (and (py-true? x) ...))) -(define-syntax-rule (py-not x) (if (py-true? x) 'False 'True)) - -(define-syntax-rule (py_== x y) - (if (struct? x) - (if (class? x) - (class_== x y) - (to-py (equal? x y))) - (to-py (equal? x y)))) - -(define-syntax-rule (mk-comp py_>= >= class_>=) - (define-syntax-rule (py_>= x y) - (if (number? x) - (to-py (>= x y)) - (if (class? x) - (class_>= x y) - 'False)))) - -(mk-comp py_>= >= class_>=) -(mk-comp py_<= <= class_<=) -(mk-comp py_< < class_<) -(mk-comp py_> > class_>) - -(define-syntax-rule (<> x y) (not (= x y))) -(mk-comp py_<> <> class_<>) -(mk-comp py_!= <> class_<>) - - -(define-syntax-rule (py_in x y) - (cond - ((struct? y) - (if (class? y) - (to-py (class_in y x)) - 'False)) - ((pair? y) - (list-in x y)) - ((vector? y) - (vector-in x y)) - (else - 'False))) - -(define-syntax-rule (py_notin x y) - (cond - ((struct? y) - (if (class? y) - (to-py (not (class_in y x))) - 'True)) - ((pair? y) - (to-py (list-in x y))) - ((vector? y) - (to-py (vector-in x y))) - (else - 'True))) - -(define-syntax-rule (py_is x y) - (to-py (and (class? x) (class? y) (eq? (class-ref x) (class-ref y))))) - -(define-syntax-rule (py_isnot x y) - (to-py (not (and (class? x) (class? y) (eq? (class-ref x) (class-ref y)))))) - -(define-syntax-rule (mk-num py_>= >= class_>=) - (define-syntax-rule (py_>= x . y) - (if (number? x) - (>= x . y) - (if (class? x) - (class_>= x . y) - (error "wrong numerics"))))) - -(mk-num py_bor logior class_ior) -(mk-num py_xor logxor class_xor) -(mk-num py_band logand class_band) -(mk-num py-<< ash class_<<) -(define-syntax-rule (rash x y) (ash x (- y))) -(mk-num py->> rash class_>>) -(mk-num py-+ + class_+) -(mk-num py-- - class_-) -(mk-num py-* * class_*) -(mk-num py-/ / class_/) -(mk-num py-% modulo class_%) -(mk-num py-// truncate-quotient class_//) - -(define-syntax-rule (mk-unum py_>= >= class_>=) - (define-syntax-rule (py_>= x) - (if (number? x) - (>= x) - (if (class? x) - (class_>= x) - (error "wrong numerics"))))) - -(mk-unum py-u+ + class_u+) -(mk-unum py-u- - class_u-) -(mk-unum py-u~ lognot class_u~) - -(mk-num py-power expt class_power) 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))))) - - - - - - - - - - |