diff options
Diffstat (limited to 'modules/language/python')
-rw-r--r-- | modules/language/python/compile.scm | 873 |
1 files changed, 451 insertions, 422 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index 9467413..6dd12a5 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -50,6 +50,8 @@ (define (C x) `(@@ (language python compile) ,x)) (define (Y x) `(@@ (language python yield) ,x)) +(define (T x) `(@@ (language python try) ,x)) +(define (F x) `(@@ (language python for) ,x)) (define (O x) `(@@ (oop pf-objects) ,x)) (define (G x) `(@ (guile) ,x)) @@ -219,476 +221,503 @@ (define inhibit-finally #f) -(define (exp vs x) - (match (pr x) - ((#:power _ (x) () . #f) - (exp vs x)) - ((#:power _ x () . #f) - (exp vs x)) - - - ;; Function calls (x1:x1.y.f(1) + x2:x2.y.f(2)) will do functional calls - ((#:power #f vf trailer . **) - (let () - (define (pw x) - (if ** - `(expt ,x ,(exp vs **)) - x)) - (pw - (let lp ((e (exp vs vf)) (trailer trailer)) - (match trailer - (() - e) - ((#f) - (list e)) - ((x . trailer) - (match (pr x) +(define tagis (make-hash-table)) +(define-syntax-rule (gen-table x vs (tag code ...) ...) + (begin + (hash-set! tagis tag + (lambda (x vs) + (match x code ...))) + + ...)) + +(gen-table x vs + (#:power + ((#:power _ (x) () . #f) + (exp vs x)) + ((#:power _ x () . #f) + (exp vs x)) + ((#:power #f vf trailer . **) + (let () + (define (pw x) + (if ** + `(expt ,x ,(exp vs **)) + x)) + (pw + (let lp ((e (exp vs vf)) (trailer trailer)) + (match trailer + (() + e) + ((#f) + (list e)) + ((x . trailer) + (match (pr x) ((#:identifier . _) (lp `(,(O 'ref) ,e ',(exp vs x) #f) trailer)) ((#:arglist args #f #f) (lp `(,e ,@(map (g vs exp) args)) trailer)) - (_ (error "unhandled trailer"))))))))) - - ((#:identifier x . _) - (string->symbol x)) - - ((#:string #f x) - x) + (_ (error "unhandled trailer")))))))))) + + (#:identifier + ((#:identifier x . _) + (string->symbol x))) + + (#:string + ((#:string #f x) + x)) + + (#:+ + ((_ . l) + (cons '+ (map (g vs exp) l)))) + (#:- + ((_ . l) + (cons '- (map (g vs exp) l)))) + (#:* + ((_ . l) + (cons '* (map (g vs exp) l)))) + (#:/ + ((_ . l) + (cons '/ (map (g vs exp) l)))) + + (#:% + ((_ . l) + (cons 'modulo (map (g vs exp) l)))) - (((and x (or #:+ #:- #:* #:/)) . l) - (cons (keyword->symbol x) (map (g vs exp) l))) + (#:// + ((_ . l) + (cons 'floor-quotient (map (g vs exp) l)))) - ((#:% . l) - (cons 'modulo (map (g vs exp) l))) - - ((#:// . l) - (cons 'floor-quotient (map (g vs exp) l))) + (#:<< + ((_ . l) + (cons (C '<<) (map (g vs exp) l)))) - ((#:<< . l) - (cons (C '<<) (map (g vs exp) l))) + (#:>> + ((_ . l) + (cons (C '>>) (map (g vs exp) l)))) - ((#:>> . l) - (cons (C '>>) (map (g vs exp) l))) - - ((#:u~ x) - (list 'lognot (exp vs x))) + (#:u~ + ((_ x) + (list 'lognot (exp vs x)))) - ((#:band . l) - (cons 'logand (map (g vs exp) l))) + (#:band + ((_ . l) + (cons 'logand (map (g vs exp) l)))) - ((#:bxor . l) - (cons 'logxor (map (g vs exp) l))) + (#:bxor + ((_ . l) + (cons 'logxor (map (g vs exp) l)))) - ((#:bor . l) - (cons 'logior (map (g vs exp) l))) + (#:bor + ((_ . l) + (cons 'logior (map (g vs exp) l)))) - ((#:not x) - (list 'not (exp vs x))) + (#:not + ((_ x) + (list 'not (exp vs x)))) - ((#:or . x) - (cons 'or (map (g vs exp) x))) + (#:or + ((_ . x) + (cons 'or (map (g vs exp) x)))) - ((#:and . x) - (cons 'and (map (g vs exp) x))) + (#:and + ((_ . x) + (cons 'and (map (g vs exp) x)))) - ((#:test e1 #f) - (exp vs e1)) + (#:test + ((_ e1 #f) + (exp vs e1)) - ((#:test e1 e2 e3) - (list 'if (exp vs e2) (exp vs e1) (exp vs e3))) + ((_ e1 e2 e3) + (list 'if (exp vs e2) (exp vs e1) (exp vs e3)))) - ((#:if test a ((tests . as) ...) . else) - `(,(G 'cond) - (,(exp vs test) ,(exp vs a)) - ,@(map (lambda (p a) (list (exp vs p) (exp vs a))) tests as) - ,@(if else `((else ,(exp vs else))) '()))) - - ((#:suite . l) (cons 'begin (map (g vs exp) l))) - (#:True #t) - (#:False #f) - (#:pass `(values)) - ((#:while test code . #f) - (let ((lp (gensym "lp"))) - `(let ,lp () - (if ,(exp vs test) - (begin - ,(exp vs code) - (,lp)))))) - ((#:classdef (#:identifier class . _) parents defs) - (with-fluids ((is-class? #t)) - (let () - (define (filt l) - (reverse - (fold (lambda (x s) - (match x - ((or 'fast 'functional) s) - (x (cons x s)))) - '() l))) - (define (is-functional l) - (fold (lambda (x pred) - (if pred - pred - (match x - ('functional #t) - (_ #f)))) - #f l)) - (define (is-fast l) - (fold (lambda (x pred) - (if pred - pred - (match x - ('fast #t) - (_ #f)))) - #f l)) - - - (let* ((class (string->symbol class)) - (parents (match parents - (() - '()) - (#f - '()) - ((#:arglist args . _) - (map (g vs exp) args)))) - (is-func (is-functional parents)) - (is-fast (is-fast parents)) - (kind (if is-func - (if is-fast - 'mk-pf-class - 'mk-pyf-class) - (if is-fast - 'mk-p-class - 'mk-py-class))) - (parents (filt parents))) - `(define ,class (,(O kind) - ,class - ,(map (lambda (x) `(,(O 'get-class) ,x)) parents) - #:const - ,(match (exp vs defs) - (('begin . l) - l) - ((('begin . l)) - l) - (l l)) - #:dynamic - ())))))) - - ((#:import ((() nm) . #f)) - `(use-modules (language python module ,(exp vs nm)))) - - (#:break - (C 'break)) + (#:if + ((_ test a ((tests . as) ...) . else) + `(,(G 'cond) + (,(exp vs test) ,(exp vs a)) + ,@(map (lambda (p a) (list (exp vs p) (exp vs a))) tests as) + ,@(if else `((else ,(exp vs else))) '())))) - (#:continue - (C 'continue)) + (#:suite + ((_ . l) (cons 'begin (map (g vs exp) l)))) - ((#:for e in code . #f) - (=> next) - (match e - (((#:power #f (#:identifier x . _) () . #f)) - (match in - (((#:test power . _)) - (match power - ((#:power #f - (#:identifier "range" . _) - ((#:arglist arglist . _)) - . _) - (match arglist - ((arg) - (let ((v (gensym "v")) - (x (string->symbol x)) - (lp (gensym "lp"))) - `(let ((,v ,(exp vs arg))) - (let ,lp ((,x 0)) - (if (< ,x ,v) - (begin - ,(exp vs code) - (,lp (+ ,x 1)))))))) - ((arg1 arg2) - (let ((v1 (gensym "va")) - (v2 (gensym "vb")) - (lp (gensym "lp"))) - `(let ((,v1 ,(exp vs arg1)) - (,v2 ,(exp vs arg2))) - (let ,lp ((,x ,v1)) - (if (< ,x ,v2) - (begin - ,(exp vs code) - (,lp (+ ,x 1)))))))) - ((arg1 arg2 arg3) - (let ((v1 (gensym "va")) - (v2 (gensym "vb")) - (st (gensym "vs")) - (lp (gensym "lp"))) - `(let ((,v1 ,(exp vs arg1)) - (,st ,(exp vs arg2)) - (,v2 ,(exp vs arg3))) - (if (> st 0) - (let ,lp ((,x ,v1)) - (if (< ,x ,v2) - (begin - ,(exp vs code) - (,lp (+ ,x ,st))))) - (if (< st 0) - (let ,lp ((,x ,v1)) - (if (> ,x ,v2) - (begin - ,(exp vs code) - (,lp (+ ,x ,st))))) - (error "range with step 0 not allowed")))))) - (_ (next)))) - (_ (next)))) - (_ (next)))) - (_ (next)))) - - ((#:for es in code . else) - (let* ((es2 (map (g vs exp) es)) - (vs2 (union es2 vs)) - (code2 (exp vs2 code)) - (p (is-ec #t code2 #t (list (C 'break) (C 'continue)))) - (else2 (if else (exp vs2 else) #f)) - (in2 (map (g vs exp) in))) - (list (C 'for) es2 in2 code2 else2 p))) - - ((#:while test code else) + (#:classdef + ((_ (#:identifier class . _) parents defs) + (with-fluids ((is-class? #t)) + (let () + (define (filt l) + (reverse + (fold (lambda (x s) + (match x + ((or 'fast 'functional) s) + (x (cons x s)))) + '() l))) + (define (is-functional l) + (fold (lambda (x pred) + (if pred + pred + (match x + ('functional #t) + (_ #f)))) + #f l)) + (define (is-fast l) + (fold (lambda (x pred) + (if pred + pred + (match x + ('fast #t) + (_ #f)))) + #f l)) + + + (let* ((class (string->symbol class)) + (parents (match parents + (() + '()) + (#f + '()) + ((#:arglist args . _) + (map (g vs exp) args)))) + (is-func (is-functional parents)) + (is-fast (is-fast parents)) + (kind (if is-func + (if is-fast + 'mk-pf-class + 'mk-pyf-class) + (if is-fast + 'mk-p-class + 'mk-py-class))) + (parents (filt parents))) + `(define ,class (,(O kind) + ,class + ,(map (lambda (x) `(,(O 'get-class) ,x)) parents) + #:const + ,(match (exp vs defs) + (('begin . l) + l) + ((('begin . l)) + l) + (l l)) + #:dynamic + ()))))))) + + (#:import + ((_ ((() nm) . #f)) + `(use-modules (language python module ,(exp vs nm))))) + + (#:for + ((_ e in code . #f) + (=> next) + (match e + (((#:power #f (#:identifier x . _) () . #f)) + (match in + (((#:test power . _)) + (match power + ((#:power #f + (#:identifier "range" . _) + ((#:arglist arglist . _)) + . _) + (match arglist + ((arg) + (let ((v (gensym "v")) + (x (string->symbol x)) + (lp (gensym "lp"))) + `(let ((,v ,(exp vs arg))) + (let ,lp ((,x 0)) + (if (< ,x ,v) + (begin + ,(exp vs code) + (,lp (+ ,x 1)))))))) + ((arg1 arg2) + (let ((v1 (gensym "va")) + (v2 (gensym "vb")) + (lp (gensym "lp"))) + `(let ((,v1 ,(exp vs arg1)) + (,v2 ,(exp vs arg2))) + (let ,lp ((,x ,v1)) + (if (< ,x ,v2) + (begin + ,(exp vs code) + (,lp (+ ,x 1)))))))) + ((arg1 arg2 arg3) + (let ((v1 (gensym "va")) + (v2 (gensym "vb")) + (st (gensym "vs")) + (lp (gensym "lp"))) + `(let ((,v1 ,(exp vs arg1)) + (,st ,(exp vs arg2)) + (,v2 ,(exp vs arg3))) + (if (> st 0) + (let ,lp ((,x ,v1)) + (if (< ,x ,v2) + (begin + ,(exp vs code) + (,lp (+ ,x ,st))))) + (if (< st 0) + (let ,lp ((,x ,v1)) + (if (> ,x ,v2) + (begin + ,(exp vs code) + (,lp (+ ,x ,st))))) + (error "range with step 0 not allowed")))))) + (_ (next)))) + (_ (next)))) + (_ (next)))) + (_ (next)))) + + ((_ es in code . else) + (let* ((es2 (map (g vs exp) es)) + (vs2 (union es2 vs)) + (code2 (exp vs2 code)) + (p (is-ec #t code2 #t (list (C 'break) (C 'continue)))) + (else2 (if else (exp vs2 else) #f)) + (in2 (map (g vs exp) in))) + (list (C 'for) es2 in2 code2 else2 p)))) + + + (#:while + ((_ test code . #f) + (let ((lp (gensym "lp"))) + `(let ,lp () + (if ,(exp vs test) + (begin + ,(exp vs code) + (,lp)))))) + + ((_ test code else) (let ((lp (gensym "lp"))) `(let ,lp () (if test (begin ,(exp vs code) (,lp)) - ,(exp vs else))))) - - ((#:try x (or #f ()) #f . fin) - `(dynamic-wind - (lambda () #f) - (lambda () ,(exp vs x)) - (lambda () - (if (not ,(C 'inhibit-finally)) - ,(exp vs fin))))) - - ((#:subexpr . l) - (exp vs l)) + ,(exp vs else)))))) + + (#:try + ((_ x (or #f ()) #f . fin) + (if fin + `(,(T 'try) ,(exp vs x) #:finally (lambda () fin)) + (exp vs x))) - ((#:try x exc else . fin) - (define (guard x) - (if fin - `(dynamic-wind - (lambda () #f) - (lambda () ,x) - (lambda () - (if (not ,(C 'inhibit-finally)) - ,(exp vs fin)))) - x)) - (define tag (gensym "tag")) - (define o (gensym "o")) - (define l (gensym "l")) - (guard - `(catch #t - (lambda () ,(exp vs x)) - (lambda (,tag ,o . ,l) - ,(let lp ((it (if else (exp vs else) `(apply throw 'python - ,tag ,o ,l))) - (exc exc)) - (match exc - ((((test . #f) code) . exc) - (lp `(if (,(O 'testex) ,tag ,o ,(exp vs test) ,l) - ,(exp vs code) - ,it) - exc)) - ((((test . as) code) . exc) - (let ((a (exp vs as))) - (lp `(if (,(O 'testex) ,tag ,o ,(exp vs test) ,l) - (let ((,a ,o)) - (,(O 'set) ,a '__excargs__ ,l) - ,(exp vs code)) - ,it) - exc))) - (() - it))))))) - - ((#:raise #f . #f) - `(throw 'python (,(O 'Exception)))) - ((#:raise code . #f) - (let ((c (gensym "c"))) - `(throw 'python - (let ((,c ,(exp vs code))) - (if (,(O 'pyclass?) ,c) - (,c) - ,c))))) + ((_ x exc else . fin) + `(,(T 'try) ,(exp vs x) + ,@(let lp ((exc exc) (r (if else (exp vs else) '()))) + (match exc + ((((test . #f) code) . exc) + (lp exc (cons `(#:except ,(exp vs code)) r))) + + ((((test . as) code) . exc) + (let ((l (gensym "l"))) + (lp exc + (cons + `(#:except ,(exp vs test) => (lambda (,(exp vs as) . ,l) + ,(exp vs code))) + r)))) + (() + (reverse r)))) + ,@(if fin `(#:finally (lambda () ,(exp vs fin))) '())))) + + (#:subexpr + ((_ . l) + (exp vs l))) + + (#:raise + ((_ #f . #f) + `(,(T 'raise) (,(O 'Exception)))) - ((#:raise code . from) - (let ((o (gensym "o")) - (c (gensym "c"))) - `(throw 'python - (let ((,c ,(exp vs code))) - (let ((,o (if (,(O 'pyclass?) ,c) - (,c) - ,c))) - (,(O 'set) ,o '__cause__ ,(exp vs from)) - ,o))))) + ((_ code . #f) + `(,(T 'raise) ,(exp vs code))) + + ((_ code . from) + (let ((o (gensym "o")) + (c (gensym "c"))) + `(,(T 'raise) + (let ((,c ,(exp vs code))) + (let ((,o (if (,(O 'pyclass?) ,c) + (,c) + ,c))) + (,(O 'set) ,o '__cause__ ,(exp vs from)) + ,o)))))) - ((#:yield args) - (let ((f (gensym "f"))) - `(begin - (fluid-set! ,(Y 'in-yield) #t) - (let ((,f (scm.yield ,@(gen-yargs vs args)))) - (,f))))) + (#:yield + ((_ args) + (let ((f (gensym "f"))) + `(begin + (fluid-set! ,(Y 'in-yield) #t) + (let ((,f (scm.yield ,@(gen-yargs vs args)))) + (,f))))) - ((#:yield f args) - (let ((f (gen-yield (exp vs f))) - (g (gensym "f"))) - `(begin - (set! ,(C 'inhibit-finally) #t) - (let ((,g (,f ,@(gen-yargs vs args)))) - (,g))))) + ((_ f args) + (let ((f (gen-yield (exp vs f))) + (g (gensym "f"))) + `(begin + (set! ,(C 'inhibit-finally) #t) + (let ((,g (,f ,@(gen-yargs vs args)))) + (,g)))))) - ((#:def f - (#:types-args-list - args - #f #f) - #f - code) - (let* ((c? (fluid-ref is-class?)) - (f (exp vs f)) - (y? (is-yield f #f code)) - (r (gensym "return")) - (as (map (lambda (x) (match x - ((((#:identifier x . _) . #f) #f) - (string->symbol x)))) - args)) - (ab (gensym "ab")) - (vs (union as vs)) - (ns (scope code vs)) - (df (defs code '())) - (ex (gensym "ex")) - (y 'scm.yield) - (y.f (gen-yield f)) - (ls (diff (diff ns vs) df))) - - (define (mk code) - `(let-syntax ((,y (syntax-rules () - ((_ . args) - (abort-to-prompt ,ab . args)))) - (,y.f (syntax-rules () - ((_ . args) - (abort-to-prompt ,ab . args))))) - ,code)) - - (with-fluids ((is-class? #f)) - (if c? - (if y? - `(define ,f - (,(C 'def-wrap) ,y? ,f ,ab - (lambda (,@as) - (,(C 'with-return) ,r - ,(mk `(let ,(map (lambda (x) (list x #f)) ls) - ,(with-fluids ((return r)) - (exp ns code)))))))) - - `(define ,f - (letrec ((,f - (case-lambda - ((,ex ,@as) - (,f ,@as)) - ((,@as) - (,(C 'with-return) ,r - ,(mk `(let ,(map (lambda (x) (list x #f)) ls) - ,(with-fluids ((return r)) - (exp ns code))))))))) - ,f))) - - (if y? - `(define ,f - (,(C 'def-wrap) ,y? ,f ,ab - (lambda (,@as) - (,(C 'with-return) ,r - (let ,(map (lambda (x) (list x #f)) ls) - ,(with-fluids ((return r)) - (mk - (exp ns code)))))))) - `(define ,f + (#:def + ((_ f + (#:types-args-list + args + #f #f) + #f + code) + (let* ((c? (fluid-ref is-class?)) + (f (exp vs f)) + (y? (is-yield f #f code)) + (r (gensym "return")) + (as (map (lambda (x) (match x + ((((#:identifier x . _) . #f) #f) + (string->symbol x)))) + args)) + (ab (gensym "ab")) + (vs (union as vs)) + (ns (scope code vs)) + (df (defs code '())) + (ex (gensym "ex")) + (y 'scm.yield) + (y.f (gen-yield f)) + (ls (diff (diff ns vs) df))) + + (define (mk code) + `(let-syntax ((,y (syntax-rules () + ((_ . args) + (abort-to-prompt ,ab . args)))) + (,y.f (syntax-rules () + ((_ . args) + (abort-to-prompt ,ab . args))))) + ,code)) + + (with-fluids ((is-class? #f)) + (if c? + (if y? + `(define ,f + (,(C 'def-wrap) ,y? ,f ,ab + (lambda (,@as) + (,(C 'with-return) ,r + ,(mk `(let ,(map (lambda (x) (list x #f)) ls) + ,(with-fluids ((return r)) + (exp ns code)))))))) + + `(define ,f + (letrec ((,f + (case-lambda + ((,ex ,@as) + (,f ,@as)) + ((,@as) + (,(C 'with-return) ,r + ,(mk `(let ,(map (lambda (x) (list x #f)) ls) + ,(with-fluids ((return r)) + (exp ns code))))))))) + ,f))) + + (if y? + `(define ,f + (,(C 'def-wrap) ,y? ,f ,ab (lambda (,@as) (,(C 'with-return) ,r (let ,(map (lambda (x) (list x #f)) ls) ,(with-fluids ((return r)) - (exp ns code))))))))))) - - ((#:global . _) - '(values)) + (mk + (exp ns code)))))))) + `(define ,f + (lambda (,@as) + (,(C 'with-return) ,r + (let ,(map (lambda (x) (list x #f)) ls) + ,(with-fluids ((return r)) + (exp ns code)))))))))))) + + (#:global + ((_ . _) + '(values))) - ((#:lambdef v e) - (list `lambda v (exp vs e))) - - ((#:stmt l) - (if (> (length l) 1) - (cons 'values (map (g vs exp) l)) - (exp vs (car l)))) + (#:lambdef + ((_ v e) + (list `lambda v (exp vs e)))) + + (#:stmt + ((_ l) + (if (> (length l) 1) + (cons 'values (map (g vs exp) l)) + (exp vs (car l))))) - ((#:expr-stmt (l) (#:assign)) - (exp vs l)) - - ((#:expr-stmt l type) - (=> fail) - (call-with-values - (lambda () (match type - ((#:assign u) - (values #f u)) - ((#:augassign op u) - (values op u)) - (_ (fail)))) - - (lambda (op u) - (cond - ((= (length l) (length u)) - (if (= (length l) 1) - (make-set vs op (car l) (exp vs (car u))) - (cons 'begin - (map (lambda (l u) (make-set vs op l u)) - l - (map (g vs exp) u))))) - ((and (= (length u) 1) (not op)) - (let ((vars (map (lambda (x) (gensym "v")) l))) - `(call-with-values (lambda () (exp vs (car u))) - (lambda vars - ,@(map (lambda (l v) (make-set vs op l v)) - l vars))))))))) + (#:expr-stmt + ((_ (l) (#:assign)) + (exp vs l)) + + ((_ l type) + (=> fail) + (call-with-values + (lambda () (match type + ((#:assign u) + (values #f u)) + ((#:augassign op u) + (values op u)) + (_ (fail)))) - - - ((#:return . x) - `(,(fluid-ref return) ,@(map (g vs exp) x))) - - ((#:expr-stmt + (lambda (op u) + (cond + ((= (length l) (length u)) + (if (= (length l) 1) + (make-set vs op (car l) (exp vs (car u))) + (cons 'begin + (map (lambda (l u) (make-set vs op l u)) + l + (map (g vs exp) u))))) + ((and (= (length u) 1) (not op)) + (let ((vars (map (lambda (x) (gensym "v")) l))) + `(call-with-values (lambda () (exp vs (car u))) + (lambda vars + ,@(map (lambda (l v) (make-set vs op l v)) + l vars))))))))) + + ((_ ((#:test (#:power #f (#:identifier v . _) () . #f) #f)) (#:assign (l))) (let ((s (string->symbol v))) - `(,s/d ,s ,(exp vs l)))) - - ((#:comp x #f) - (exp vs x)) - - ((#:comp x (op . y)) - (define (tr op x y) - (match op - ((or "<" ">" "<=" ">=") - (list (G (string->symbol op)) x y)) - ("!=" (list 'not (list 'equal? x y))) - ("==" (list 'equal? x y)) - ("is" (list 'eq? x y)) - ("isnot" (list 'not (list 'eq? x y))) - ("in" (list 'member x y)) - ("notin" (list 'not (list 'member x y))) - ("<>" (list 'not (list 'equal? x y))))) - (tr op (exp vs x) (exp vs y))) + `(,s/d ,s ,(exp vs l))))) + + + (#:return + ((_ . x) + `(,(fluid-ref return) ,@(map (g vs exp) x)))) + + (#:comp + ((_ x #f) + (exp vs x)) + + ((_ x (op . y)) + (define (tr op x y) + (match op + ((or "<" ">" "<=" ">=") + (list (G (string->symbol op)) x y)) + ("!=" (list 'not (list 'equal? x y))) + ("==" (list 'equal? x y)) + ("is" (list 'eq? x y)) + ("isnot" (list 'not (list 'eq? x y))) + ("in" (list 'member x y)) + ("notin" (list 'not (list 'member x y))) + ("<>" (list 'not (list 'equal? x y))))) + (tr op (exp vs x) (exp vs y))))) + +(define (exp vs x) + (match (pr x) + ((tag . l) + ((hash-ref tagis tag (lambda y (warn "not tag in tagis") x)) x vs)) + + (#:True #t) + (#:False #f) + (#:pass `(values)) + (#:break + (C 'break)) + (#:continue + (C 'continue)) (x x))) (define (comp x) |