fix misscompilation of while loops
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Tue, 11 Dec 2018 21:47:14 +0000 (22:47 +0100)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Tue, 11 Dec 2018 21:47:14 +0000 (22:47 +0100)
modules/language/python/compile.scm
modules/language/python/module/g.py [deleted file]
modules/language/python/spec.scm

index 06e529b94cfde6179b4bea46b2725b3db6a54963..973ae3a99c4884abda27a1a60eeb8ccf66e7716c 100644 (file)
 (define-inlinable (H   x) `(@  (language python hash)    ,x))
 (define-inlinable (W   x) `(@  (language python with)    ,x))
 
 (define-inlinable (H   x) `(@  (language python hash)    ,x))
 (define-inlinable (W   x) `(@  (language python with)    ,x))
 
+(define (mk/ec x) x)
+
+(define-syntax-rule (let/ecx c a ...)
+  (let/ec c a ...))
+
+(define-syntax-rule (let/ect c a ...)
+  (let/ec c ((mk/ec (lambda (c) a ...)) c)))
+
+(eval-when (compile eval load)
+  (if (equal? (effective-version) "3.0")
+      (module-set! (current-module) 'let/ecx
+                   (module-ref (current-module) 'let/ect))))
+                   
 (define exit-prompt (make-prompt-tag))
 (define exit-fluid  (make-fluid #f))
 
 (define exit-prompt (make-prompt-tag))
 (define exit-fluid  (make-fluid #f))
 
                      (let ((v   (gensym "v"))
                            (x   (string->symbol x))
                            (lp  (gensym "lp")))
                      (let ((v   (gensym "v"))
                            (x   (string->symbol x))
                            (lp  (gensym "lp")))
-                       `(,(C 'let/ec) break-ret
+                       `(,(C 'let/ecx) break-ret
                          (,(G 'let) ((,v ,(exp vs arg)))
                            (,(G 'let) ,lp ((,x 0))
                                 (,(G 'if) (< ,x ,v)
                                     (,(G 'begin)
                          (,(G 'let) ((,v ,(exp vs arg)))
                            (,(G 'let) ,lp ((,x 0))
                                 (,(G 'if) (< ,x ,v)
                                     (,(G 'begin)
-                                      (,(C 'let/ec) continue-ret
-                                       (,(C 'with-sp) ((continue (,cvalues))
+                                      (,(C 'let/ecx) continue-ret
+                                       (,(C 'with-sp) ((continue (continue-ret))
                                                        (break    (break-ret)))
                                         ,code2))
                                       (,lp (+ ,x 1))))))))
                                                        (break    (break-ret)))
                                         ,code2))
                                       (,lp (+ ,x 1))))))))
                      (let ((v   (gensym "v"))
                            (x   (string->symbol x))
                            (lp  (gensym "lp")))
                      (let ((v   (gensym "v"))
                            (x   (string->symbol x))
                            (lp  (gensym "lp")))
-                       `(,(C 'let/ec) break-ret
+                       `(,(C 'let/ecx) break-ret
                          (,(G 'let) ((,v ,(exp vs arg)))
                            (,(G 'let) ,lp ((,x 0))
                                 (,(G 'if) (< ,x ,v)
                          (,(G 'let) ((,v ,(exp vs arg)))
                            (,(G 'let) ,lp ((,x 0))
                                 (,(G 'if) (< ,x ,v)
                        (x    (string->symbol x))
                        (lp  (gensym "lp")))
                    (if p
                        (x    (string->symbol x))
                        (lp  (gensym "lp")))
                    (if p
-                       `(,(C 'let/ec) break-ret
+                       `(,(C 'let/ecx) break-ret
                          (,(G 'let) ((,v1 ,(exp vs arg1))
                                      (,v2 ,(exp vs arg2)))
                            (,(G 'let) ,lp ((,x ,v1))
                                 (,(G 'if) (< ,x ,v2)
                                     (,(G 'begin)
                          (,(G 'let) ((,v1 ,(exp vs arg1))
                                      (,v2 ,(exp vs arg2)))
                            (,(G 'let) ,lp ((,x ,v1))
                                 (,(G 'if) (< ,x ,v2)
                                     (,(G 'begin)
-                                      (,(C 'let/ec) continue-ret
-                                       (,(C 'with-sp) ((continue (,cvalues))
+                                      (,(C 'let/ecx) continue-ret
+                                       (,(C 'with-sp) ((continue (continue-ret))
                                                        (break    (break-ret)))
                                         ,code2))
                                       (,lp (+ ,x 1)))))))
                                                        (break    (break-ret)))
                                         ,code2))
                                       (,lp (+ ,x 1)))))))
-                       `(,(C 'let/ec) break-ret
+                       `(,(C 'let/ecx) break-ret
                          (,(G 'let) ((,v1 ,(exp vs arg1))
                                      (,v2 ,(exp vs arg2)))
                            (,(G 'let) ,lp ((,x ,v1))
                          (,(G 'let) ((,v1 ,(exp vs arg1))
                                      (,v2 ,(exp vs arg2)))
                            (,(G 'let) ,lp ((,x ,v1))
                        (x    (string->symbol x))
                        (lp  (gensym "lp")))
                    (if p
                        (x    (string->symbol x))
                        (lp  (gensym "lp")))
                    (if p
-                       `(,(C 'let/ec) break-ret
+                       `(,(C 'let/ecx) break-ret
                          (,(G 'let) ((,v1 ,(exp vs arg1))
                                      (,st ,(exp vs arg3))  
                                      (,v2 ,(exp vs arg2)))
                          (,(G 'let) ((,v1 ,(exp vs arg1))
                                      (,st ,(exp vs arg3))  
                                      (,v2 ,(exp vs arg2)))
                                (,(G 'let) ,lp ((,x ,v1))
                                     (,(G 'if) (< ,x ,v2)
                                         (,(G 'begin)
                                (,(G 'let) ,lp ((,x ,v1))
                                     (,(G 'if) (< ,x ,v2)
                                         (,(G 'begin)
-                                          (,(C 'let/ec) continue-ret
+                                          (,(C 'let/ecx) continue-ret
                                            (,(C 'with-sp)
                                            (,(C 'with-sp)
-                                            ((continue (,cvalues))
+                                            ((continue (continue-ret))
                                              (break    (break-ret)))
                                             ,code2))
                                           (,lp (+ ,x ,st)))))
                                              (break    (break-ret)))
                                             ,code2))
                                           (,lp (+ ,x ,st)))))
                                    (,(G 'let) ,lp ((,x ,v1))
                                         (,(G 'if) (> ,x ,v2)
                                             (,(G 'begin)
                                    (,(G 'let) ,lp ((,x ,v1))
                                         (,(G 'if) (> ,x ,v2)
                                             (,(G 'begin)
-                                              (,(C 'let/ec) continue-ret
+                                              (,(C 'let/ecx) continue-ret
                                                (,(C 'with-sp)
                                                (,(C 'with-sp)
-                                                ((continue (,cvalues))
+                                                ((continue (continue-ret))
                                                  (break    (break-ret)))
                                                 ,code2))
                                               (,lp (+ ,x ,st)))))
                                    (,(G 'error)
                                     "range with step 0 not allowed")))))
                                                  (break    (break-ret)))
                                                 ,code2))
                                               (,lp (+ ,x ,st)))))
                                    (,(G 'error)
                                     "range with step 0 not allowed")))))
-                       `(,(C 'let/ec) break-ret
+                       `(,(C 'let/ecx) break-ret
                          (,(G 'let) ((,v1 ,(exp vs arg1))
                                      (,st ,(exp vs arg3))
                                      (,v2 ,(exp vs arg2)))
                          (,(G 'let) ((,v1 ,(exp vs arg1))
                                      (,st ,(exp vs arg3))
                                      (,v2 ,(exp vs arg2)))
           (code2 (exp vs code))
           (p     (is-ec #t code2 #t (list (C 'continue)))))
      (if p
           (code2 (exp vs code))
           (p     (is-ec #t code2 #t (list (C 'continue)))))
      (if p
-         `(,(C 'let/ec) break-ret
+         `(,(C 'let/ecx) break-ret
            (,(G 'let) ,lp ()
             (,(G 'if) (,(C 'boolit) ,(exp vs test))
                 (,(G 'begin)
            (,(G 'let) ,lp ()
             (,(G 'if) (,(C 'boolit) ,(exp vs test))
                 (,(G 'begin)
-                  (,(C 'let/ec) continue-ret
-                   (,(C 'with-sp) ((continue (,cvalues))
+                  (,(C 'let/ecx) continue-ret
+                   (,(C 'with-sp) ((continue (continue-ret))
                                    (break    (break-ret)))                    
                     ,code2))
                   (,lp)))))
 
                                    (break    (break-ret)))                    
                     ,code2))
                   (,lp)))))
 
-         `(,(C 'let/ec) break-ret
+         `(,(C 'let/ecx) break-ret
            (,(G 'let) ,lp ()
             (,(G 'if) (,(C 'boolit) ,(exp vs test))
                 (,(G 'begin)
            (,(G 'let) ,lp ()
             (,(G 'if) (,(C 'boolit) ,(exp vs test))
                 (,(G 'begin)
           (code2 (exp vs code))
           (p     (is-ec #t code2 #t (list (C 'continue)))))
      (if p
           (code2 (exp vs code))
           (p     (is-ec #t code2 #t (list (C 'continue)))))
      (if p
-         `(,(C 'let/ec) break-ret
+         `(,(C 'let/ecx) break-ret
            (,(G 'let) ,lp ()
             (,(G 'if) (,(C 'boolit) ,(exp vs test))
                 (,(G 'begin)
            (,(G 'let) ,lp ()
             (,(G 'if) (,(C 'boolit) ,(exp vs test))
                 (,(G 'begin)
-                  (,(C 'let/ec) ,(C 'continue-ret)
-                   (,(C 'with-sp) ((continue (,cvalues))
+                  (,(C 'let/ecx) ,(C 'continue-ret)
+                   (,(C 'with-sp) ((continue (continue-ret))
                                    (break    (break-ret)))
                     ,code2))
                   (,lp))
                 ,(exp vs else))))
                                    (break    (break-ret)))
                     ,code2))
                   (,lp))
                 ,(exp vs else))))
-         `(,(C 'let/ec) break-ret
+         
+         `(,(C 'let/ecx) break-ret
            (,(G 'let) ,lp ()
              (,(G 'if) (,(C 'boolit) ,(exp vs test))
                  (,(G 'begin)
            (,(G 'let) ,lp ()
              (,(G 'if) (,(C 'boolit) ,(exp vs test))
                  (,(G 'begin)
-                   (,(C 'with-sp) ((break    (break-ret)))
+                   (,(C 'with-sp) ((break (break-ret)))
                     ,code2)
                    (,lp))
                  ,(exp vs else))))))))
                     ,code2)
                    (,lp))
                  ,(exp vs else))))))))
      (C 'continue))
     (x x)))
 
      (C 'continue))
     (x x)))
 
-(define (comp x)
+(define (comp in x)
+  (define (strit x)
+    (if in
+        x
+        (with-output-to-string
+          (lambda ()
+            (let lp ((x x))
+              (if (pair? x)
+                  (begin
+                    (format #t "~s~%" (car x))
+                    (lp (cdr x)))))))))
+  
   (define start
     (match x
       (((#:stmt
   (define start
     (match x
       (((#:stmt
         (define name (string-join (map symbol->string args) "."))
         
          `((define-module (language python module ,@args)
         (define name (string-join (map symbol->string args) "."))
         
          `((define-module (language python module ,@args)
-            #:pure
-            #:use-module ((guile) #:select
-                          (@ @@ pk let* lambda call-with-values case-lambda
-                                   set! = * + - < <= > >= / pair? fluid-set!
-                                   fluid-ref
-                                   syntax-rules let-syntax abort-to-prompt))
-            #:use-module (language python module python)
-            #:use-module ((language python compile) #:select (pks))
-            #:use-module (language python exceptions)
-           #:use-module ((oop goops) #:select (<complex> <real> <fraction> <integer> <number>)))
+             #:pure
+             #:use-module ((guile) #:select
+                           (@ @@ pk let* lambda call-with-values case-lambda
+                                    set! = * + - < <= > >= / pair? fluid-set!
+                                    fluid-ref
+                                    syntax-rules let-syntax abort-to-prompt))
+             #:use-module (language python module python)
+             #:use-module ((language python compile) #:select (pks))
+             #:use-module (language python exceptions)
+             #:use-module ((oop goops) #:select (<complex> <real> <fraction> <integer> <number>)))
            (,(G 'define) __doc__    #f)
           (,(G 'define) __name__   ,name)
            (,(G 'define) __module__ (,(G 'quote)
            (,(G 'define) __doc__    #f)
           (,(G 'define) __name__   ,name)
            (,(G 'define) __module__ (,(G 'quote)
       (x '())))
 
   (fluid-set! ignore '())
       (x '())))
 
   (fluid-set! ignore '())
-  (pr
-  (if (fluid-ref (@@ (system base compile) %in-compile))
-      (begin
-       (if (fluid-ref (@@ (system base compile) %in-compile))
-           (set! s/d (C 'qset!))
-           (set! s/d (C 'define-)))
-  
-       (if (pair? start)
-           (set! x (cdr x)))
-
-       (let* ((globs (get-globals x))
-              (e.doc (with-fluids ((*doc* #f))
-                        (let ((r (map (g globs exp) x)))
-                          (cons r (get-doc)))))
-               (e     (car e.doc))
-               (doc   (cdr e.doc)))
-          
-         `(begin
-            ,@start
-            (,(G 'define) ,fnm (,(G 'make-hash-table)))
-            ,@(map (lambda (s)
-                     (if (member s (fluid-ref ignore))
-                         `(,cvalues)
-                         `(,(C 'var) ,s)))
-                    (cons '__doc__ globs))
-             (,(G 'set!) __doc__ ,doc)
-            ,@e
-            (,(C 'export-all)))))
 
 
-      (begin
-       (if (fluid-ref (@@ (system base compile) %in-compile))
-           (set! s/d 'set!)
-           (set! s/d (C 'define-)))
+  (strit
+   (pr
+    (if (fluid-ref (@@ (system base compile) %in-compile))
+        (begin
+          (if (fluid-ref (@@ (system base compile) %in-compile))
+              (set! s/d (C 'qset!))
+              (set! s/d (C 'define-)))
+          
+          (if (pair? start)
+              (set! x (cdr x)))
+          
+          (let* ((globs (get-globals x))
+                 (e.doc (with-fluids ((*doc* #f))
+                          (let ((r (map (g globs exp) x)))
+                            (cons r (get-doc)))))
+                 (e     (car e.doc))
+                 (doc   (cdr e.doc)))
+          
+            `(,@start
+              (,(G 'define) ,fnm (,(G 'make-hash-table)))
+              ,@(map (lambda (s)
+                       (if (member s (fluid-ref ignore))
+                           `(,cvalues)
+                           `(,(C 'var) ,s)))
+                     (cons '__doc__ globs))
+              (,(G 'set!) __doc__ ,doc)
+              ,@e
+              (,(C 'export-all)))))
+
+        (begin
+          (if (fluid-ref (@@ (system base compile) %in-compile))
+              (set! s/d 'set!)
+              (set! s/d (C 'define-)))
   
   
-        (if (pair? start)
-            (set! x (cdr x)))
+          (if (pair? start)
+              (set! x (cdr x)))
         
         
-        (let* ((globs (get-globals x))
-               (res   (gensym "res"))
-               (e     (map (g globs exp) x)))
-          `(,(G 'begin)
-            ,@start
-            ,@(map (lambda (s)
-                     (if (member s (fluid-ref ignore))
-                         `(,cvalues)
-                         `(,(C 'var) ,s))) globs)
-            (,(C 'with-exit) ,@e)))))))
-              
-                    
-
-
+          (let* ((globs (get-globals x))
+                 (res   (gensym "res"))
+                 (e     (map (g globs exp) x)))
+            `(begin
+               ,@start
+              ,@(map (lambda (s)
+                       (if (member s (fluid-ref ignore))
+                           `(,cvalues)
+                           `(,(C 'var) ,s))) globs)
+              (,(C 'with-exit) ,@e))))))))
+  
 (define-syntax-parameter break
   (lambda (x) #'(values)))
 
 (define-syntax-parameter break
   (lambda (x) #'(values)))
 
       ((_ ret  l)
        (let ((code (analyze #'ret #'l)))
          (if (is-ec #'ret #'l #t)
       ((_ ret  l)
        (let ((code (analyze #'ret #'l)))
          (if (is-ec #'ret #'l #t)
-             #`(let/ec ret l)
+             #`(let/ecx ret l)
              code))))))
 
 (define void (list 'void))
              code))))))
 
 (define void (list 'void))
       ((_ (x) (a) code #f #f)
        (with-syntax ((x (replace_ xx #'x)))
          #'(if (pair? a)
       ((_ (x) (a) code #f #f)
        (with-syntax ((x (replace_ xx #'x)))
          #'(if (pair? a)
-              (let/ec break-ret
+              (let/ecx break-ret
                 (let lp ((l a))
                   (if (pair? l)
                       (begin
                 (let lp ((l a))
                   (if (pair? l)
                       (begin
       ((_ (x) (a) code #f #t)
        (with-syntax ((x (replace_ xx #'x)))
           #'(if (pair? a)
       ((_ (x) (a) code #f #t)
        (with-syntax ((x (replace_ xx #'x)))
           #'(if (pair? a)
-               (let/ec break-ret
+               (let/ecx break-ret
                    (let lp ((l a))
                     (if (pair? l)
                         (begin
                    (let lp ((l a))
                     (if (pair? l)
                         (begin
-                          (let/ec continue-ret
+                          (let/ecx continue-ret
                             (set! x (car l))
                             (with-sp ((continue (continue-ret))
                                       (break    (break-ret)))                     
                             (set! x (car l))
                             (with-sp ((continue (continue-ret))
                                       (break    (break-ret)))                     
       ((_ (x) (a) code next #f)
        (with-syntax ((x (replace_ xx #'x)))
           #'(if (pair? a)
       ((_ (x) (a) code next #f)
        (with-syntax ((x (replace_ xx #'x)))
           #'(if (pair? a)
-               (let/ec break-ret
+               (let/ecx break-ret
                    (let lp ((l a))
                      (if (pair? l)
                          (begin
                    (let lp ((l a))
                      (if (pair? l)
                          (begin
       ((_ (x) (a) code next #t)
        (with-syntax ((x (replace_ xx #'x)))
           #'(if (pair? a)
       ((_ (x) (a) code next #t)
        (with-syntax ((x (replace_ xx #'x)))
           #'(if (pair? a)
-               (let/ec break-ret
+               (let/ecx break-ret
                   (let lp ((l a))
                     (if (pair? l)
                   (let lp ((l a))
                     (if (pair? l)
-                        (let/ec continue-ret
+                        (let/ecx continue-ret
                             (set! x (car l))
                            (with-sp ((continue (continue-ret))
                                      (break    (break-ret)))
                             (set! x (car l))
                            (with-sp ((continue (continue-ret))
                                      (break    (break-ret)))
        #'(let ((inv (wrap-in in)))
            (clet (yy ...)
               (let lp ()
        #'(let ((inv (wrap-in in)))
            (clet (yy ...)
               (let lp ()
-                (let/ec break-ret
+                (let/ecx break-ret
                   (catch StopIteration
                     (lambda ()
                       (call-with-values (lambda () (next inv))
                         (clambda (xx ...)
                           (cset! yy xx) ...
                   (catch StopIteration
                     (lambda ()
                       (call-with-values (lambda () (next inv))
                         (clambda (xx ...)
                           (cset! yy xx) ...
-                          (let/ec continue-ret
+                          (let/ecx continue-ret
                             (with-sp ((break     (break-ret))
                                       (continue  (continue-ret)))
                                      code))
                             (with-sp ((break     (break-ret))
                                       (continue  (continue-ret)))
                                      code))
         #'(let ((inv (wrap-in in)) ...)
             (clet (yy ...)
               (let lp ()
         #'(let ((inv (wrap-in in)) ...)
             (clet (yy ...)
               (let lp ()
-                (let/ec break-ret
+                (let/ecx break-ret
                   (catch StopIteration
                     (lambda ()
                       (call-with-values (lambda () (values (next inv) ...))
                         (clambda (xx ...)
                           (cset! yy xx) ...
                   (catch StopIteration
                     (lambda ()
                       (call-with-values (lambda () (values (next inv) ...))
                         (clambda (xx ...)
                           (cset! yy xx) ...
-                          (let/ec continue-ret
+                          (let/ecx continue-ret
                             (with-sp ((break     (break-ret))
                                       (continue  (continue-ret)))
                                      code))
                             (with-sp ((break     (break-ret))
                                       (continue  (continue-ret)))
                                      code))
            (if (syntax->datum #'p)
                #'(let ((inv (wrap-in in)))
                    (clet (yy ...)
            (if (syntax->datum #'p)
                #'(let ((inv (wrap-in in)))
                    (clet (yy ...)
-                     (let/ec break-ret
+                     (let/ecx break-ret
                        (catch StopIteration
                          (lambda ()
                            (let lp ()
                              (call-with-values (lambda () (next inv))
                                (clambda (xx ...)
                                  (cset! yy xx) ...
                        (catch StopIteration
                          (lambda ()
                            (let lp ()
                              (call-with-values (lambda () (next inv))
                                (clambda (xx ...)
                                  (cset! yy xx) ...
-                                 (let/ec continue-ret
+                                 (let/ecx continue-ret
                                    (with-sp ((break     (break-ret))
                                              (continue  (continue-ret)))
                                             code))
                                    (with-sp ((break     (break-ret))
                                              (continue  (continue-ret)))
                                             code))
              
                    #'(let ((inv (wrap-in in)))
                        (clet (yy ...)
              
                    #'(let ((inv (wrap-in in)))
                        (clet (yy ...)
-                             (let/ec break-ret
+                             (let/ecx break-ret
                                (catch StopIteration
                                  (lambda ()
                                    (let lp ()
                                (catch StopIteration
                                  (lambda ()
                                    (let lp ()
          (if (syntax->datum #'p)
              #'(clet (yy ...)
                  (let ((inv (wrap-in in)) ...)               
          (if (syntax->datum #'p)
              #'(clet (yy ...)
                  (let ((inv (wrap-in in)) ...)               
-                   (let/ec break-ret
+                   (let/ecz break-ret
                      (catch StopIteration
                        (lambda ()
                          (let lp ()
                            (call-with-values (lambda () get)
                              (clambda (xx ...)
                                (cset! yy xx) ...
                      (catch StopIteration
                        (lambda ()
                          (let lp ()
                            (call-with-values (lambda () get)
                              (clambda (xx ...)
                                (cset! yy xx) ...
-                               (let/ec continue-ret
+                               (let/ecx continue-ret
                                  (with-sp ((break     (break-ret))
                                            (continue  (continue-ret)))
                                           code))
                                  (with-sp ((break     (break-ret))
                                            (continue  (continue-ret)))
                                           code))
              
                  #'(clet (yy ...)
                      (let ((inv (wrap-in in)) ...)
              
                  #'(clet (yy ...)
                      (let ((inv (wrap-in in)) ...)
-                       (let/ec break-ret
+                       (let/ecx break-ret
                          (catch StopIteration
                            (lambda ()
                              (let lp ()
                          (catch StopIteration
                            (lambda ()
                              (let lp ()
                         (call-with-prompt
                          ab
                          (lambda ()
                         (call-with-prompt
                          ab
                          (lambda ()
-                           (let/ec return                          
+                           (let/ecx return                          
                              (apply code x))
                            (slot-set! obj 'closed #t)
                            (throw StopIteration))
                              (apply code x))
                            (slot-set! obj 'closed #t)
                            (throw StopIteration))
   (if (module-defined? mod '__all__)
       (begin
         (module-export! mod
   (if (module-defined? mod '__all__)
       (begin
         (module-export! mod
-        (for ((x : (module-ref mod '__all__))) ((l '()))
-             (let ((x (string->symbol (scm-str x))))
-               (if (module-locally-bound? mod x)
-                   (cons x l)
-                   l))
+          (for ((x : (module-ref mod '__all__))) ((l '()))
+               (let ((x (string->symbol (scm-str x))))
+                 (if (module-locally-bound? mod x)
+                     (cons x l)
+                     l))
                #:final l))
         (module-re-export! mod
           (for ((x : (module-ref mod '__all__))) ((l '()))
                #:final l))
         (module-re-export! mod
           (for ((x : (module-ref mod '__all__))) ((l '()))
diff --git a/modules/language/python/module/g.py b/modules/language/python/module/g.py
deleted file mode 100644 (file)
index dafef95..0000000
+++ /dev/null
@@ -1,9 +0,0 @@
-module(g)
-
-class A(dict):
-    def __getitem__(self,k):
-        pk(k)
-        return super().__getitem__(k)
-
-
-__all__= ['A']
index 8291a144556f560b173bb072cd340b298975f235..46ac186edec1bd754a912231b7c17c7910cede40 100644 (file)
@@ -18,6 +18,7 @@
 ;;; Language definition
 ;;;
 
 ;;; Language definition
 ;;;
 
+
 (define (pr . x)
   (define port (open-file "/home/stis/src/python-on-guile/log.txt" "a"))
   (with-output-to-port port
 (define (pr . x)
   (define port (open-file "/home/stis/src/python-on-guile/log.txt" "a"))
   (with-output-to-port port
   (close port)
   (car (reverse x)))
 
   (close port)
   (car (reverse x)))
 
-(define (c x) (pr (comp (pr (p (pr x))))))
-(define (cc port x)
-  (if (equal? x "") (read port) (c x)))
+(define (c int x) (pr (comp int (pr (p (pr x))))))
+(define (cc int port x)
+  (if (equal? x "") (read port) (c int x)))
+
+(define (e x) (eval (c #t x) (current-module)))
 
 
-(define (e x) (eval (c x) (current-module)))
+
+(define (int)
+  (catch #t
+    (lambda ()
+      (if (fluid-ref (@@ (system base compile) %in-compile))
+          #f
+          #t))
+    (lambda x #f)))
+
+(define (in)
+  (catch #t
+    (lambda ()
+      (fluid-set! (@@ (system base compile) %in-compile) #t))
+    (lambda x #f)))
+
+(define mapper (make-weak-key-hash-table))
+
+(define python-reader-wrap
+  (lambda (port env)
+    (if (int)
+        (cc #t port (read-line port))
+        (let lp ((port2 (hash-ref mapper port)))
+          (if port2
+              (read port2)
+              (let ((port2
+                     (open-input-string (cc #f port (read-string port)))))
+                (use-modules (language python guilemod))
+                (in)
+                (hash-set! mapper port port2)
+                (lp port2)))))))
 
 (catch #t
   (lambda ()
 
 (catch #t
   (lambda ()
 
 (define-language python
   #:title      "python"
 
 (define-language python
   #:title      "python"
-  #:reader      (lambda (port env)
-                  (if (not (fluid-ref (@@ (system base compile) %in-compile)))
-                      (cc port (read-line port))
-                      (cc port (read-string port))))
-
+  #:reader      python-reader-wrap
   #:compilers   `((tree-il . ,compile-tree-il))
   #:decompilers `((tree-il . ,decompile-tree-il))
   #:evaluator  (lambda (x module) (primitive-eval x))
   #:compilers   `((tree-il . ,compile-tree-il))
   #:decompilers `((tree-il . ,decompile-tree-il))
   #:evaluator  (lambda (x module) (primitive-eval x))