diff options
Diffstat (limited to 'modules/language/python/compile.scm')
| -rw-r--r-- | modules/language/python/compile.scm | 70 |
1 files changed, 49 insertions, 21 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index de4299d..bbeb069 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -716,6 +716,41 @@ (define inhibit-finally #f) (define decorations (make-fluid '())) (define tagis (make-hash-table)) + +(define (lr as) + (lambda (vs x) + (define (eval p a b) ((cdr (assoc p as)) a b)) + (define (expit x) + (match x + ((#:e e) e) + (x (exp vs x)))) + (let lp ((x x)) + (match x + ((p a b) + (if (assoc p as) + (match b + ((q c d) + (if (assoc q as) + (lp (list q (list #:e (lp (list p a c))) d)) + (eval p (expit a) (expit b)))) + (_ (eval p (expit a) (expit b)))) + (expit x))) + (_ (expit x)))))) + +(define (mklr x) + (lambda (a b) + (list x a b))) + +(define (f% s a) + (if (string? s) + (list (F2 'format) s a) + (list (N 'py-mod) s a))) + +(define lr+ (lr `((#:+ . ,(mklr (G '+))) (#:- . ,(mklr (G '-)))))) +(define lr* (lr `((#:* . ,(mklr (G '*))) (#:/ . ,(mklr (N 'py-/))) + (#:% . ,f%) (#:// . ,(mklr (N 'py-floordiv)))))) + + (define-syntax-rule (gen-table x vs (tag code ...) ...) (begin (hash-set! tagis tag @@ -780,35 +815,28 @@ (#:+ - ((_ . l) - (cons '+ (map (g vs exp) l)))) - + (x + (lr+ vs x))) (#:- - ((_ . l) - (cons '- (map (g vs exp) l)))) + (x + (lr+ vs x))) (#:* - ((_ . l) - (cons '* (map (g vs exp) l)))) + (x + (lr* vs x))) (#:/ - ((_ . l) - (cons (N 'py-/) (map (g vs exp) l)))) - + (x + (lr* vs x))) + (#:% - ((_ s a) - (let ((s (exp vs s)) - (a (exp vs a))) - (if (string? s) - (list (F2 'format) s a) - (list (N 'py-mod) s a)))) - ((_ . l) - (cons (N 'py-mod) (map (g vs exp) l)))) + (x + (lr* vs x))) (#:// - ((_ . l) - (cons (N 'py-floordiv) (map (g vs exp) l)))) - + (x + (lr* vs x))) + (#:<< ((_ . l) (cons (N 'py-lshift) (map (g vs exp) l)))) |