Author: Juergen Boemmels <boemm...@web.de>
Branch:
Changeset: r37:046b82d2ef4c
Date: 2012-01-09 22:07 +0100
http://bitbucket.org/pypy/lang-scheme/changeset/046b82d2ef4c/
Log: Stubbing of case, basic tests work
diff --git a/scheme/r5rs_derived_expr.ss b/scheme/r5rs_derived_expr.ss
--- a/scheme/r5rs_derived_expr.ss
+++ b/scheme/r5rs_derived_expr.ss
@@ -39,3 +39,18 @@
(let ((x test1))
(if x x (or test2 ...))))))
+(define-syntax case
+ (syntax-rules (else)
+;;; XXX this check does not work yet
+; ((case (key ...) clauses ...)
+; (let ((atom-key (key ...)))
+; (case atom-key clauses ...)))
+ ((case key (else expr1 expr2 ...))
+ (begin expr1 expr2 ...))
+ ((case key ((atoms ...) expr1 expr2 ...))
+ (if (memv key '(atoms ...))
+ (begin expr1 expr2 ...)))
+ ((case key ((atoms ...) expr1 expr2 ...) clause2 clause3 ...)
+ (if (memv key '(atoms ...))
+ (begin expr1 expr2 ...)
+ (case key clause2 clause3 ...)))))
diff --git a/scheme/test/test_eval.py b/scheme/test/test_eval.py
--- a/scheme/test/test_eval.py
+++ b/scheme/test/test_eval.py
@@ -1005,3 +1005,20 @@
w_res = eval_noctx("""(cddddr '((((a b) c d) (e f) g h)
((i j) k l) (m n) o p))""")
assert w_res.equal(parse_("(p)"))
+
+def test_case():
+ w_res = eval_noctx("""
+ (case (* 2 3)
+ ((2 3 5 7) 'prime)
+ ((1 4 6 8 9) 'composite))
+ """)
+ assert w_res.eq(symbol("composite"))
+
+ w_res = eval_noctx("""
+ (case (car '(c d))
+ ((a e i o u) 'vowel)
+ ((w y) 'semivowel)
+ (else 'consonant))
+ """)
+ assert w_res.eq(symbol("consonant"))
+
_______________________________________________
pypy-commit mailing list
pypy-commit@python.org
http://mail.python.org/mailman/listinfo/pypy-commit
