remove old stuff
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Tue, 12 Mar 2019 20:32:43 +0000 (21:32 +0100)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Tue, 12 Mar 2019 20:32:43 +0000 (21:32 +0100)
modules/Makefile.am
modules/language/python/class.scm [deleted file]
modules/language/python/expr.scm [deleted file]
modules/language/python/python.scm [deleted file]

index 1f81572..de8b03e 100644 (file)
@@ -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 (file)
index 41ed09a..0000000
+++ /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 (file)
index 81c2cbe..0000000
+++ /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 (file)
index e8621ad..0000000
+++ /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)))))
-          
-          
-          
-
-
-  
-  
-  
-    
-