summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>2018-08-26 21:31:44 +0200
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>2018-08-26 21:31:44 +0200
commit34ca3d2231a96e484c9b7114dc73c82f5ea4db60 (patch)
treeb4535d35c79df1d74f4324198da9ad26a1660f69
parent5fe84a36b844c41193546b296f71c5cc067f231c (diff)
quick generator constructions in stead of tupples
-rw-r--r--modules/language/python/compile.scm32
-rw-r--r--modules/language/python/def.scm1
2 files changed, 18 insertions, 15 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index 50eacb6..39597bc 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -533,8 +533,6 @@
(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)
@@ -1005,7 +1003,8 @@
,@(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)
@@ -1504,14 +1503,11 @@
(((#: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
@@ -1706,6 +1702,12 @@
(#: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))
@@ -1932,7 +1934,7 @@
(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))
@@ -1941,7 +1943,7 @@
(((_ _ 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)
@@ -1987,10 +1989,10 @@
(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 ... ...))
@@ -1999,7 +2001,7 @@
(((_ _ 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)))
@@ -2022,6 +2024,7 @@
(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 ...))
@@ -2030,7 +2033,6 @@
(((@ (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 ...))
diff --git a/modules/language/python/def.scm b/modules/language/python/def.scm
index f5466ad..7622b7a 100644
--- a/modules/language/python/def.scm
+++ b/modules/language/python/def.scm
@@ -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))