quick generator constructions in stead of tupples
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sun, 26 Aug 2018 19:31:44 +0000 (21:31 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sun, 26 Aug 2018 19:31:44 +0000 (21:31 +0200)
modules/language/python/compile.scm
modules/language/python/def.scm

index 50eacb6869bd481436cb54e315b7f629ce8e5b08..39597bc9634c7ad4968d7eea8e87bbce08bf25a3 100644 (file)
 (define (get-kwarg vs arg)
   (let lp ((arg arg))
     (match arg
-      (((#:comp . (and x (_ (#:cfor . _) . _))) . arg2)
-       (cons `(* ,(exp vs `(#:tuple ,@x))) (lp arg2)))
       (((#:* a) . arg)
        (cons `(* ,(exp vs a)) (lp arg)))
       (((#:** a) . arg)
      ,@(if else `((else ,(exp vs else))) '()))))
     
  (#:suite
-  ((_ . l) (cons (G 'begin) (map (g vs exp) l))))
+  ((_ #:stmt  . l) (cons* (G 'begin) `(,(G 'values)) (map (g vs exp) l)))
+  ((_         . l) (cons* (G 'begin) `(,(G 'values)) (map (g vs exp) l))))
     
  (#:classdef
    ((_ class parents code)
                             (((#:starexpr . l) . _)
                              `(,(L 'to-list) ,(exp vs l)))
                             ((x . l)
-                             `(,(G 'cons) ,(exp vs x) ,(lp l))))))))
+                            `(,(G 'cons) ,(exp vs x) ,(lp l))))))))
  (#:tuple
   ((_ x (and e (#:cfor . _)))
-   (let ((l  (gensym "l")))
-     `(,(G 'let) ((,l (,(G 'quote) ())))
-       ,(gen-sel vs e `(set! ,l (,(G 'cons) ,(exp vs x) ,l)))
-       (,(G 'reverse) ,l))))
-
+   (exp vs (list #:comp x e)))
+  
   ((_ . l)
    (let lp ((l l))
      (match l
                   
                            
  (#:comp
+  ((_ x (and e (#:cfor . _)) . _)
+   (let ((yield (gensym "yield")))
+     `((,(Y 'make-generator) ()
+        (lambda (,yield)
+          ,(gen-sel vs e `(,yield ,(exp vs x))))))))
+  
   ((_ x #f)
    (exp vs x))
 
 (define-syntax with-return
   (lambda (x)
     (define (analyze ret x)
-      (syntax-case x (let-syntax @)
+      (syntax-case x (let-syntax let* @ @@)
         ((cond- (p a ... b) ...)
          (equal? (syntax->datum #'cond-)
                  '(@ (guile) cond))
         
         (((_ _ with-self-) u v a ... b)         
          (equal? (syntax->datum #'with-self-)
-                 '(@@ (language python compile) with-self))
+                 'with-self)
          #`(with-self u v a ... #,(analyze ret #'b)))
         
         ((let-syntax v a ... b)
         (x #'x)))
   
     (define (is-ec ret x tail)
-      (syntax-case x (let-syntax with-self let* @@ @)
+      (syntax-case x (let-syntax let* @@ @)
         (((@ (guile) cond) (p a ... b) ...)
          (equal? (syntax->datum #'cond)
-                 '(@ (guile) cond))
+                 'cond)
          (or
           (or-map (lambda (x) (is-ec ret x #f))
                   #'(a ... ...))
         
         (((_ _ with-self) u v a ... b)
          (equal? (syntax->datum #'with-self)
-                 '(@@ (language python compile) with-self))         
+                 'with-self)
          (or
           (or-map (lambda (x) (is-ec ret x #f)) #'(a ...))
           (is-ec ret #'b tail)))
           (equal? (syntax->datum #'let)
                   'let)
           (symbol? (syntax->datum #'lp)))
+
          (or
           (or-map (lambda (x) (is-ec ret x #f)) #'(x ...))
           (or-map (lambda (x) (is-ec ret x #f)) #'(a ...))
         (((@ (guile) let) ((y x) ...) a ... b)
          (equal? (syntax->datum #'let)
                  'let)
-
          (or
           (or-map (lambda (x) (is-ec ret x #f)) #'(x ...))
           (or-map (lambda (x) (is-ec ret x #f)) #'(a ...))
index f5466ad1009fe56d46887587dfa1b2537d343cd0..7622b7af3b7fff5ea6e863c0a4e87a9b70c7d0b7 100644 (file)
@@ -2,6 +2,7 @@
   #:use-module (oop pf-objects)
   #:use-module (language python for)
   #:use-module (language python list)
+  #:use-module (language python exceptions)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-11)
   #:export (def lam py-apply))