diff options
Diffstat (limited to 'modules/language/python/compile.scm')
| -rw-r--r-- | modules/language/python/compile.scm | 56 |
1 files changed, 35 insertions, 21 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index 86b30dc..d715c8d 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -344,6 +344,15 @@ ((#:lambdef . _) vs) + ((#:comma a) + (scope a vs)) + + ((#:comma a . l) + (union + (scope a vs) + (scope (cons #:comma l) vs))) + + ((#:with (l ...) code) (scope code (union vs (let lp ((l l)) @@ -408,7 +417,7 @@ (() '())))))) (scope final (scope code vs)))) - + ((#:expr-stmt l (#:assign k . u)) (union (union (fold (lambda (x s) @@ -1108,7 +1117,7 @@ (#:suite ((_ #:stmt . l) (cons* (G 'begin) `(,(G 'values)) (map (g vs exp) l))) - ((_ . l) (cons* (G 'begin) `(,(G 'values)) (map (g vs exp) l)))) + ((_ . l) (list (G 'begin) `(,(G 'values)) (map (g vs exp) l)))) (#:classdef ((_ class parents code) @@ -1149,7 +1158,13 @@ (#:scm ((_ (#:string _ s)) (with-input-from-string s read))) - + + (#:comma + ((_ a) + (exp vs a)) + ((_ a . l) + `(,(G 'begin) ,(exp vs a) ,(exp vs (cons #:comma l))))) + (#:import ((_ (#:from (() . nm) . #f)) (let* ((xl (map (lambda (nm) (exp vs nm)) nm)) @@ -1638,9 +1653,7 @@ (#:stmt ((_ l) - (if (> (length l) 1) - (cons cvalues (map (g vs exp) l)) - (exp vs (car l))))) + (exp vs l))) (#:expr-stmt ((_ (l ...) (#:assign)) @@ -1711,7 +1724,7 @@ `(,(G 'if) (,(G 'not) (,(G 'and) ,@(map (lambda (x) `(,(C 'boolit) ,(exp vs x))) x))) - (,(C 'raise) ,(C 'AssertionError) ',f ,n ,m)))) + (,(C 'raise) ,(C 'AssertionError) (,(G 'quote) ,f) ,n ,m)))) @@ -1829,7 +1842,7 @@ (define (exp vs x) - (match x + (match (pr x) ((e) (exp vs e)) ((tag . l) @@ -1852,12 +1865,13 @@ (define start (match x (((#:stmt - ((#:expr-stmt + (#:comma + (#:expr-stmt ((#:test (#:power #f - (#:identifier "module" . _) - ((#:arglist arglist)) - . #f) #f)) + (#:identifier "module" . _) + ((#:arglist arglist)) + . #f) #f)) (#:assign)))) . rest) (let () @@ -1866,7 +1880,7 @@ (exp '() x)) arglist)) - `((,(G 'define-module) (language python module ,@args) + `((define-module (language python module ,@args) #:pure #:use-module ((guile) #:select (@ @@ pk let* lambda call-with-values case-lambda @@ -1892,7 +1906,7 @@ (let* ((globs (get-globals x)) (e (map (g globs exp) x))) - `(,(G 'begin) + `(begin ,@start (,(G 'define) ,fnm (,(G 'make-hash-table))) ,@(map (lambda (s) @@ -1971,7 +1985,7 @@ (define (is-ec ret x tail tags) (match x - (((@ (guile) 'cond) (p a ... b) ...) + ((('@ ('guile) 'cond) (p a ... b) ...) (or (or-map (lambda (x) (or-map (lambda (x) (is-ec ret x #f tags)) x)) a) @@ -1988,12 +2002,12 @@ (or-map (lambda (x) (is-ec ret x #f tags)) a) (is-ec ret b tail tags))) - (((@ (guile) 'begin) a ... b) + ((('@ ('guile) 'begin) a ... b) (or (or-map (lambda (x) (is-ec ret x #f tags)) a) (is-ec ret b tail tags))) - (((@ (guile) 'let) lp ((y x) ...) a ... b) (=> next) + ((('@ ('guile) 'let) lp ((y x) ...) a ... b) (=> next) (if (symbol? lp) (or (or-map (lambda (x) (is-ec ret x #f tags)) x) @@ -2001,7 +2015,7 @@ (is-ec ret b tail tags)) (next))) - (((@ (guile) 'let) ((y x) ...) a ... b) + ((('@ ('guile) 'let) ((y x) ...) a ... b) (or (or-map (lambda (x) (is-ec ret x #f tags)) x) (or-map (lambda (x) (is-ec ret x #f tags)) a) @@ -2013,16 +2027,16 @@ (or-map (lambda (x) (is-ec ret x #f tags)) a) (is-ec ret b tail tags))) - (((@ (guile) 'define) . _) + ((('@ ('guile) 'define) . _) #f) - (((@ (guile) 'if) p a b) + ((('@ ('guile) 'if) p a b) (or (is-ec ret p #f tags) (is-ec ret a tail tags) (is-ec ret b tail tags))) - (((@ (guile) 'if) p a) + ((('@ ('guile) 'if) p a) (or (is-ec ret #'p #f tags) (is-ec ret #'a tail tags))) |