diff options
Diffstat (limited to 'modules')
-rw-r--r-- | modules/language/python/compile.scm | 243 | ||||
-rw-r--r-- | modules/language/python/module/collections.scm | 12 | ||||
-rw-r--r-- | modules/language/python/module/difflib.py | 2 |
3 files changed, 150 insertions, 107 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index 43db80f..e56ae7e 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -126,6 +126,11 @@ (pretty-print (syntax->datum x)) x) +(define (gv x) + (if (equal? x '_) + (gensym "_") + x)) + (define (gen-sel vs e item) (match e (#f item) @@ -135,7 +140,8 @@ (((#:power #f (#:tuple . l) . _)) (lp l)) (_ - `(,(F 'for) ((,@(map (g vs exp) for-e) : ,(exp vs in-e))) () + `(,(F 'for) ((,@(map (lambda (x) (gv ((g vs exp) x))) for-e) + : ,(exp vs in-e))) () ,(gen-sel vs cont item)))))) ((#:cif cif cont) `(if ,(exp vs cif) @@ -2021,141 +2027,169 @@ ((x ...) (map gen-temp #'(x ...))) (x (car (generate-temporaries (list #'x)))))) +(define (replace_ stx l) + (let lp ((l l)) + (syntax-case l () + ((a . l) (cons (lp #'a) (lp #'l))) + (x + (if (equal? (syntax->datum #'x) '_) + (datum->syntax stx (gensym "_")) + #'x))))) + +(define-syntax with-syntax* + (syntax-rules () + ((_ () code) code) + ((_ () . code) (begin . code)) + ((_ (x . l) . code) + (with-syntax (x) (with-syntax* l . code))))) + (define-syntax cfor - (lambda (x) - (syntax-case x () + (lambda (xx) + (syntax-case xx () ((_ (x ...) in code next p) (or-map pair? #'(x ...)) #'(for-adv (x ...) in code next p)) ((_ (x) (a) code #f #f) - #'(if (pair? a) - (let/ec break-ret - (let lp ((l a)) - (if (pair? l) - (begin - (set! x (car l)) - (with-sp ((continue (values)) - (break (break-ret))) + (with-syntax ((x (replace_ xx #'x))) + #'(if (pair? a) + (let/ec break-ret + (let lp ((l a)) + (if (pair? l) + (begin + (set! x (car l)) + (with-sp ((continue (values)) + (break (break-ret))) code) - (lp (cdr l)))))) - (for/adv1 (x) (a) code #f #f))) - - ((_ (x) (a) code #f #t) - #'(if (pair? a) - (let/ec break-ret - (let lp ((l a)) - (if (pair? l) - (begin - (let/ec continue-ret - (set! x (car l)) - (with-sp ((continue (continue-ret)) - (break (break-ret))) - code)) - (lp (cdr l)))))) - (for/adv1 (x) (a) code #f #t))) - - ((_ (x) (a) code next #f) - #'(if (pair? a) - (let/ec break-ret - (let lp ((l a)) - (if (pair? l) - (begin - (set! x (car l)) - (with-sp ((continue (values)) - (break (break-ret))) - code)) - (lp (cdr l)))) - next) - (for/adv1 (x) (a) code next #f))) - - ((_ (x) (a) code next #t) - #'(if (pair? a) - (let/ec break-ret - (let lp ((l a)) - (if (pair? l) - (let/ec continue-ret - (set! x (car l)) - (with-sp ((continue (continue-ret)) - (break (break-ret))) - code)) - (lp (cdr l)))) - next) - (for/adv1 (x) (a) code next #f))) + (lp (cdr l)))))) + (for/adv1 (x) (a) code #f #f)))) + + ((_ (x) (a) code #f #t) + (with-syntax ((x (replace_ xx #'x))) + #'(if (pair? a) + (let/ec break-ret + (let lp ((l a)) + (if (pair? l) + (begin + (let/ec continue-ret + (set! x (car l)) + (with-sp ((continue (continue-ret)) + (break (break-ret))) + code)) + (lp (cdr l)))))) + (for/adv1 (x) (a) code #f #t)))) + + ((_ (x) (a) code next #f) + (with-syntax ((x (replace_ xx #'x))) + #'(if (pair? a) + (let/ec break-ret + (let lp ((l a)) + (if (pair? l) + (begin + (set! x (car l)) + (with-sp ((continue (values)) + (break (break-ret))) + code)) + (lp (cdr l)))) + next) + (for/adv1 (x) (a) code next #f)))) + + ((_ (x) (a) code next #t) + (with-syntax ((x (replace_ xx #'x))) + #'(if (pair? a) + (let/ec break-ret + (let lp ((l a)) + (if (pair? l) + (let/ec continue-ret + (set! x (car l)) + (with-sp ((continue (continue-ret)) + (break (break-ret))) + code)) + (lp (cdr l)))) + next) + (for/adv1 (x) (a) code next #f)))) - ((_ x a code next p) - #'(for/adv1 x a code next p))))) + ((_ x a code next p) + #'(for/adv1 x a code next p))))) (define-syntax for/adv1 - (lambda (x) - (syntax-case x () - ((_ (x ...) (in) code #f #f) - (with-syntax ((inv (gentemp #'in)) - ((xx ...) (gen-temp #'(x ...)))) - #'(let ((inv (wrap-in in))) + (lambda (zz) + (syntax-case zz () + ((_ (xy ...) (in) code #f #f) + (with-syntax* ((inv (gentemp #'in)) + ((yy ...) (replace_ zz #'(xy ...))) + ((xx ...) (gen-temp #'(yy ...)))) + #'(let ((inv (wrap-in in))) + (clet (yy ...) (catch StopIteration (lambda () (let lp () (call-with-values (lambda () (next inv)) (clambda (xx ...) - (cset! x xx) ... + (cset! yy xx) ... (with-sp ((break (values)) (continue (values))) code (lp)))))) - (lambda z (values)))))) + (lambda z (values))))))) - ((_ (x ...) (in ...) code #f #f) - (with-syntax (((inv ...) (generate-temporaries #'(in ...))) - ((xx ...) (gen-temp #'(x ...)))) + ((_ (xy ...) (in ...) code #f #f) + (with-syntax* (((inv ...) (generate-temporaries #'(in ...))) + ((yy ...) (replace_ zz #'(xy ...))) + ((xx ...) (gen-temp #'(yy ...)))) #'(let ((inv (wrap-in in)) ...) + (clet (yy ...) (catch StopIteration (lambda () (let lp () (call-with-values (lambda () (values (next inv) ...)) (clambda (xx ...) - (cset! x xx) ... + (cset! yy xx) ... (with-sp ((break (values)) (continue (values))) code (lp)))))) - (lambda z (values)))))) - - ((_ (x ...) (in) code #f #t) - (with-syntax ((inv (gentemp #'in)) - ((xx ...) (gen-temp #'(x ...)))) - #'(let ((inv (wrap-in in))) + (lambda z (values))))))) + + ((_ (xy ...) (in) code #f #t) + (with-syntax* ((inv (gentemp #'in)) + ((yy ...) (replace_ zz #'(xy ...))) + ((xx ...) (gen-temp #'(yy ...)))) + #'(let ((inv (wrap-in in))) + (clet (yy ...) (let lp () (let/ec break-ret (catch StopIteration (lambda () (call-with-values (lambda () (next inv)) (clambda (xx ...) - (cset! x xx) ... + (cset! yy xx) ... (let/ec continue-ret (with-sp ((break (break-ret)) (continue (continue-ret))) code)) (lp)))) - (lambda z (values)))))))) - - ((_ (x ...) (in ...) code #f #t) - (with-syntax (((inv ...) (generate-temporaries #'(in ...))) - ((xx ...) (gen-temp #'(x ...)))) - #'(let ((inv (wrap-in in)) ...) + (lambda z (values))))))))) + + ((_ (xy ...) (in ...) code #f #t) + (with-syntax* (((inv ...) (generate-temporaries #'(in ...))) + ((yy ...) (replace_ zz #'(xy ...))) + ((xx ...) (gen-temp #'(yy ...)))) + #'(let ((inv (wrap-in in)) ...) + (clet (yy ...) (let lp () (let/ec break-ret (catch StopIteration (lambda () (call-with-values (lambda () (values (next inv) ...)) (clambda (xx ...) - (cset! x xx) ... + (cset! yy xx) ... (let/ec continue-ret (with-sp ((break (break-ret)) (continue (continue-ret))) code)) (lp)))) - (lambda z (values)))))))) + (lambda z (values))))))))) ((_ (x ...) in code else #f) #'(for-adv (x ...) in code else #f)) @@ -2165,7 +2199,7 @@ (define-syntax for-adv - (lambda (x) + (lambda (zz) (define (gen x y) (if (= (length (syntax->datum x)) (= (length (syntax->datum y)))) (syntax-case x () @@ -2173,20 +2207,22 @@ (syntax-case x () ((x) #'(next x))))) - (syntax-case x () - ((_ (x ...) (in) code else p) - (with-syntax ((inv (gentemp #'in))) - (with-syntax (((xx ...) (gen-temp #'(x ...)))) + (syntax-case zz () + ((_ (xy ...) (in) code else p) + (with-syntax* ((inv (gentemp #'in)) + ((yy ...) (replace_ zz #'(xy ...))) + ((xx ...) (gen-temp #'(yy ...)))) + (if (syntax->datum #'p) #'(let ((inv (wrap-in in))) - (clet (x ...) + (clet (yy ...) (let/ec break-ret (catch StopIteration (lambda () (let lp () (call-with-values (lambda () (next inv)) (clambda (xx ...) - (cset! x xx) ... + (cset! yy xx) ... (let/ec continue-ret (with-sp ((break (break-ret)) (continue (continue-ret))) @@ -2195,26 +2231,27 @@ (lambda q else))))) #'(let ((inv (wrap-in in))) - (clet (x ...) + (clet (yy ...) (let/ec break-ret (catch StopIteration (lambda () (let lp () (call-with-values (lambda () (next inv)) (clambda (xx ...) - (cset! x xx) ... + (cset! yy xx) ... (with-sp ((break (break-ret)) (continue (values))) code) (lp))))) - (lambda e else))))))))) + (lambda e else)))))))) - ((_ (x ...) (in ...) code else p) - (with-syntax (((inv ...) (generate-temporaries #'(in ...)))) - (with-syntax ((get (gen #'(inv ...) #'(x ...))) - ((xx ...) (gen-temp #'(x ...)))) + ((_ (xy ...) (in ...) code else p) + (with-syntax* (((inv ...) (generate-temporaries #'(in ...))) + ((yy ...) (replace_ zz #'(xy ...))) + (get (gen #'(inv ...) #'(yy ...))) + ((xx ...) (gen-temp #'(yy ...)))) (if (syntax->datum #'p) - #'(clet (x ...) + #'(clet (yy ...) (let ((inv (wrap-in in)) ...) (let/ec break-ret (catch StopIteration @@ -2222,7 +2259,7 @@ (let lp () (call-with-values (lambda () get) (clambda (xx ...) - (cset! x xx) ... + (cset! yy xx) ... (let/ec continue-ret (with-sp ((break (break-ret)) (continue (continue-ret))) @@ -2230,7 +2267,7 @@ (lp))))) (lambda q else))))) - #'(clet (x ...) + #'(clet (yy ...) (let ((inv (wrap-in in)) ...) (let/ec break-ret (catch StopIteration @@ -2238,12 +2275,12 @@ (let lp () (call-with-values (lambda () get) (clambda (xx ...) - (cset! x xx) ... + (cset! yy xx) ... (with-sp ((break (break-ret)) (continue (values))) code) (lp))))) - (lambda e else)))))))))))) + (lambda e else))))))))))) (define-syntax cset! (syntax-rules () diff --git a/modules/language/python/module/collections.scm b/modules/language/python/module/collections.scm index f8b0b45..39a4d45 100644 --- a/modules/language/python/module/collections.scm +++ b/modules/language/python/module/collections.scm @@ -607,8 +607,16 @@ (let ((seen (py-set))) (if (string? field_names) - (set! field_names (string-split field_names #\,))) - + (set! field_names + (string-split field_names #\,))) + + (set! field_names + (let lp ((fs field_names)) + (if (pair? fs) + (append (string-split (car fs) #\space) + (lp (cdr fs))) + '()))) + (set! field_names (py-list (py-map scm-str field_names))) (set! typename (scm-str typename)) diff --git a/modules/language/python/module/difflib.py b/modules/language/python/module/difflib.py index 8d9d365..e0aa831 100644 --- a/modules/language/python/module/difflib.py +++ b/modules/language/python/module/difflib.py @@ -2091,5 +2091,3 @@ def _test(): import doctest, difflib return doctest.testmod(difflib) -if __name__ == "__main__": - _test() |