diff options
author | Andy Wingo <wingo@pobox.com> | 2012-03-08 13:22:09 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2012-03-08 13:22:09 +0100 |
commit | bc612809929b85fdcb39bc17a15a53c88b43a8bd (patch) | |
tree | 14444f0fb0f69cf9db6b7bf1493c780488c47093 /module/ice-9/psyntax-pp.scm | |
parent | c336514976ed3f2b2b20c56149ede7f5ec549c52 (diff) | |
parent | f740445a9b5bf0a5e5090f0a2ddaffb2b803bab7 (diff) | |
download | guile-bc612809929b85fdcb39bc17a15a53c88b43a8bd.tar.gz |
Merge remote-tracking branch 'local-2.0/stable-2.0'
Conflicts:
configure.ac
libguile/finalizers.c
libguile/finalizers.h
libguile/gc.c
libguile/gc.h
libguile/inline.c
libguile/inline.h
libguile/ports.c
libguile/smob.c
libguile/smob.h
module/ice-9/deprecated.scm
module/ice-9/r4rs.scm
Diffstat (limited to 'module/ice-9/psyntax-pp.scm')
-rw-r--r-- | module/ice-9/psyntax-pp.scm | 137 |
1 files changed, 0 insertions, 137 deletions
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index f82a14c0c..d1ad7fe27 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -2682,83 +2682,6 @@ "source expression failed to match any pattern" tmp-1))))))) -(define do - (make-syntax-transformer - 'do - 'macro - (lambda (orig-x) - (let ((tmp-1 orig-x)) - (let ((tmp ($sc-dispatch - tmp-1 - '(_ #(each (any any . any)) (any . each-any) . each-any)))) - (if tmp - (apply (lambda (var init step e0 e1 c) - (let ((tmp-1 (map (lambda (v s) - (let ((tmp-1 s)) - (let ((tmp ($sc-dispatch tmp-1 '()))) - (if tmp - (apply (lambda () v) tmp) - (let ((tmp ($sc-dispatch tmp-1 '(any)))) - (if tmp - (apply (lambda (e) e) tmp) - (syntax-violation 'do "bad step expression" orig-x s))))))) - var - step))) - (let ((tmp ($sc-dispatch tmp-1 'each-any))) - (if tmp - (apply (lambda (step) - (let ((tmp e1)) - (let ((tmp-1 ($sc-dispatch tmp '()))) - (if tmp-1 - (apply (lambda () - (list '#(syntax-object let ((top)) (hygiene guile)) - '#(syntax-object doloop ((top)) (hygiene guile)) - (map list var init) - (list '#(syntax-object if ((top)) (hygiene guile)) - (list '#(syntax-object not ((top)) (hygiene guile)) e0) - (cons '#(syntax-object begin ((top)) (hygiene guile)) - (append - c - (list (cons '#(syntax-object - doloop - ((top)) - (hygiene guile)) - step))))))) - tmp-1) - (let ((tmp-1 ($sc-dispatch tmp '(any . each-any)))) - (if tmp-1 - (apply (lambda (e1 e2) - (list '#(syntax-object let ((top)) (hygiene guile)) - '#(syntax-object doloop ((top)) (hygiene guile)) - (map list var init) - (list '#(syntax-object if ((top)) (hygiene guile)) - e0 - (cons '#(syntax-object begin ((top)) (hygiene guile)) - (cons e1 e2)) - (cons '#(syntax-object begin ((top)) (hygiene guile)) - (append - c - (list (cons '#(syntax-object - doloop - ((top)) - (hygiene guile)) - step))))))) - tmp-1) - (syntax-violation - #f - "source expression failed to match any pattern" - tmp))))))) - tmp) - (syntax-violation - #f - "source expression failed to match any pattern" - tmp-1))))) - tmp) - (syntax-violation - #f - "source expression failed to match any pattern" - tmp-1))))))) - (define quasiquote (make-syntax-transformer 'quasiquote @@ -3163,66 +3086,6 @@ "expression not valid outside of quasiquote" x)))) -(define case - (make-syntax-transformer - 'case - 'macro - (lambda (x) - (let ((tmp-1 x)) - (let ((tmp ($sc-dispatch tmp-1 '(_ any any . each-any)))) - (if tmp - (apply (lambda (e m1 m2) - (let ((tmp (let f ((clause m1) (clauses m2)) - (if (null? clauses) - (let ((tmp-1 clause)) - (let ((tmp ($sc-dispatch - tmp-1 - '(#(free-id #(syntax-object else ((top)) (hygiene guile))) - any - . - each-any)))) - (if tmp - (apply (lambda (e1 e2) - (cons '#(syntax-object begin ((top)) (hygiene guile)) (cons e1 e2))) - tmp) - (let ((tmp ($sc-dispatch tmp-1 '(each-any any . each-any)))) - (if tmp - (apply (lambda (k e1 e2) - (list '#(syntax-object if ((top)) (hygiene guile)) - (list '#(syntax-object memv ((top)) (hygiene guile)) - '#(syntax-object t ((top)) (hygiene guile)) - (list '#(syntax-object quote ((top)) (hygiene guile)) - k)) - (cons '#(syntax-object begin ((top)) (hygiene guile)) - (cons e1 e2)))) - tmp) - (syntax-violation 'case "bad clause" x clause)))))) - (let ((tmp (f (car clauses) (cdr clauses)))) - (let ((rest tmp)) - (let ((tmp clause)) - (let ((tmp ($sc-dispatch tmp '(each-any any . each-any)))) - (if tmp - (apply (lambda (k e1 e2) - (list '#(syntax-object if ((top)) (hygiene guile)) - (list '#(syntax-object memv ((top)) (hygiene guile)) - '#(syntax-object t ((top)) (hygiene guile)) - (list '#(syntax-object quote ((top)) (hygiene guile)) - k)) - (cons '#(syntax-object begin ((top)) (hygiene guile)) - (cons e1 e2)) - rest)) - tmp) - (syntax-violation 'case "bad clause" x clause)))))))))) - (let ((body tmp)) - (list '#(syntax-object let ((top)) (hygiene guile)) - (list (list '#(syntax-object t ((top)) (hygiene guile)) e)) - body)))) - tmp) - (syntax-violation - #f - "source expression failed to match any pattern" - tmp-1))))))) - (define make-variable-transformer (lambda (proc) (if (procedure? proc) |