Author: Juergen Boemmels <boemm...@web.de>
Branch:
Changeset: r35:d254d5ae04cf
Date: 2012-01-09 00:47 +0100
http://bitbucket.org/pypy/lang-scheme/changeset/d254d5ae04cf/
Log: Implement 'cadr' and friends (all 28 versions)
diff --git a/scheme/procedure.py b/scheme/procedure.py
--- a/scheme/procedure.py
+++ b/scheme/procedure.py
@@ -177,6 +177,89 @@
raise WrongArgType(w_pair, "Pair")
return w_pair.cdr
+class CarCdrCombination(W_Procedure):
+ def procedure(self, ctx, lst):
+ if len(lst) != 1:
+ raise WrongArgsNumber
+ w_pair = lst[0]
+ return self.do_oper(w_pair)
+
+ def do_oper(self, w_pair):
+ raise NotImplementedError
+
+def gen_cxxxr_class(proc_name, oper_lst):
+ class Cxxxr(CarCdrCombination):
+ pass
+
+ src_block = """
+ w_iter = w_pair
+ """
+ oper_lst.reverse()
+ for oper in oper_lst:
+ src_block += """
+ if not isinstance(w_iter, W_Pair):
+ raise WrongArgType(w_iter, "Pair")
+ """
+ if oper == "car":
+ src_block += """
+ w_iter = w_iter.car
+ """
+ elif oper == "cdr":
+ src_block += """
+ w_iter = w_iter.cdr
+ """
+ else:
+ raise ValueError("oper must 'car' or 'cdr'")
+
+ src_block += """
+ return w_iter
+ """
+
+ local_locals = {}
+ attr_name = "do_oper"
+
+ code = py.code.Source(("""
+ def %s(self, w_pair):
+ from scheme.object import W_Pair, WrongArgType
+ """ % attr_name) + src_block)
+
+ exec code.compile() in local_locals
+ local_locals[attr_name]._annspecialcase_ = 'specialize:argtype(1)'
+ setattr(Cxxxr, attr_name, local_locals[attr_name])
+
+ Cxxxr._symbol_name = proc_name
+ Cxxxr.__name__ = proc_name.capitalize()
+ return Cxxxr
+
+Caar = gen_cxxxr_class("caar", ['car', 'car'])
+Cadr = gen_cxxxr_class("cadr", ['car', 'cdr'])
+Cdar = gen_cxxxr_class("cdar", ['cdr', 'car'])
+Cddr = gen_cxxxr_class("cddr", ['cdr', 'cdr'])
+Caaar = gen_cxxxr_class("caaar", ['car', 'car', 'car'])
+Caadr = gen_cxxxr_class("caadr", ['car', 'car', 'cdr'])
+Cadar = gen_cxxxr_class("cadar", ['car', 'cdr', 'car'])
+Caddr = gen_cxxxr_class("caddr", ['car', 'cdr', 'cdr'])
+Cdaar = gen_cxxxr_class("cdaar", ['cdr', 'car', 'car'])
+Cdadr = gen_cxxxr_class("cdadr", ['cdr', 'car', 'cdr'])
+Cddar = gen_cxxxr_class("cddar", ['cdr', 'cdr', 'car'])
+Cdddr = gen_cxxxr_class("cdddr", ['cdr', 'cdr', 'cdr'])
+Caaaar = gen_cxxxr_class("caaaar", ['car', 'car', 'car', 'car'])
+Caaadr = gen_cxxxr_class("caaadr", ['car', 'car', 'car', 'cdr'])
+Caadar = gen_cxxxr_class("caadar", ['car', 'car', 'cdr', 'car'])
+Caaddr = gen_cxxxr_class("caaddr", ['car', 'car', 'cdr', 'cdr'])
+Cadaar = gen_cxxxr_class("cadaar", ['car', 'cdr', 'car', 'car'])
+Cadadr = gen_cxxxr_class("cadadr", ['car', 'cdr', 'car', 'cdr'])
+Caddar = gen_cxxxr_class("caddar", ['car', 'cdr', 'cdr', 'car'])
+Cadddr = gen_cxxxr_class("cadddr", ['car', 'cdr', 'cdr', 'cdr'])
+Cdaaar = gen_cxxxr_class("cdaaar", ['cdr', 'car', 'car', 'car'])
+Cdaadr = gen_cxxxr_class("cdaadr", ['cdr', 'car', 'car', 'cdr'])
+Cdadar = gen_cxxxr_class("cdadar", ['cdr', 'car', 'cdr', 'car'])
+Cdaddr = gen_cxxxr_class("cdaddr", ['cdr', 'car', 'cdr', 'cdr'])
+Cddaar = gen_cxxxr_class("cddaar", ['cdr', 'cdr', 'car', 'car'])
+Cddadr = gen_cxxxr_class("cddadr", ['cdr', 'cdr', 'car', 'cdr'])
+Cdddar = gen_cxxxr_class("cdddar", ['cdr', 'cdr', 'cdr', 'car'])
+Cddddr = gen_cxxxr_class("cddddr", ['cdr', 'cdr', 'cdr', 'cdr'])
+
class SetCar(W_Procedure):
_symbol_name = "set-car!"
@@ -270,9 +353,11 @@
(w_procedure, w_lst) = lst
if not isinstance(w_procedure, W_Procedure):
+ #print w_procedure.to_repr(), "is not a procedure"
raise WrongArgType(w_procedure, "Procedure")
if not isinstance(w_lst, W_List):
+ #print w_lst.to_repr(), "is not a list"
raise WrongArgType(w_lst, "List")
return w_procedure.call_tr(ctx, w_lst)
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
@@ -888,3 +888,100 @@
py.test.raises(WrongArgType, eval_noctx, "(assq 1 2)")
py.test.raises(WrongArgsNumber, eval_noctx, "(assq 1 '(1 2) '(3 4))")
+def test_cxxxr():
+ w_res = eval_noctx("(caar '((a b) c d))")
+ assert w_res.equal(parse_("a"))
+
+ w_res = eval_noctx("(cadr '((a b) c d))")
+ assert w_res.equal(parse_("c"))
+
+ w_res = eval_noctx("(cdar '((a b) c d))")
+ assert w_res.equal(parse_("(b)"))
+
+ w_res = eval_noctx("(cddr '((a b) c d))")
+ assert w_res.equal(parse_("(d)"))
+
+ w_res = eval_noctx("(caaar '(((a b) c d) (e f) g h))")
+ assert w_res.equal(parse_("a"))
+
+ w_res = eval_noctx("(caadr '(((a b) c d) (e f) g h))")
+ assert w_res.equal(parse_("e"))
+
+ w_res = eval_noctx("(cadar '(((a b) c d) (e f) g h))")
+ assert w_res.equal(parse_("c"))
+
+ w_res = eval_noctx("(caddr '(((a b) c d) (e f) g h))")
+ assert w_res.equal(parse_("g"))
+
+ w_res = eval_noctx("(cdaar '(((a b) c d) (e f) g h))")
+ assert w_res.equal(parse_("(b)"))
+
+ w_res = eval_noctx("(cdadr '(((a b) c d) (e f) g h))")
+ assert w_res.equal(parse_("(f)"))
+
+ w_res = eval_noctx("(cddar '(((a b) c d) (e f) g h))")
+ assert w_res.equal(parse_("(d)"))
+
+ w_res = eval_noctx("""(caaaar '((((a b) c d) (e f) g h)
+ ((i j) k l) (m n) o p))""")
+ assert w_res.equal(parse_("a"))
+
+ w_res = eval_noctx("""(caaadr '((((a b) c d) (e f) g h)
+ ((i j) k l) (m n) o p))""")
+ assert w_res.equal(parse_("i"))
+
+ w_res = eval_noctx("""(caadar '((((a b) c d) (e f) g h)
+ ((i j) k l) (m n) o p))""")
+ assert w_res.equal(parse_("e"))
+
+ w_res = eval_noctx("""(caaddr '((((a b) c d) (e f) g h)
+ ((i j) k l) (m n) o p))""")
+ assert w_res.equal(parse_("m"))
+
+ w_res = eval_noctx("""(cadaar '((((a b) c d) (e f) g h)
+ ((i j) k l) (m n) o p))""")
+ assert w_res.equal(parse_("c"))
+
+ w_res = eval_noctx("""(cadadr '((((a b) c d) (e f) g h)
+ ((i j) k l) (m n) o p))""")
+ assert w_res.equal(parse_("k"))
+
+ w_res = eval_noctx("""(caddar '((((a b) c d) (e f) g h)
+ ((i j) k l) (m n) o p))""")
+ assert w_res.equal(parse_("g"))
+
+ w_res = eval_noctx("""(cadddr '((((a b) c d) (e f) g h)
+ ((i j) k l) (m n) o p))""")
+ assert w_res.equal(parse_("o"))
+
+ w_res = eval_noctx("""(cdaaar '((((a b) c d) (e f) g h)
+ ((i j) k l) (m n) o p))""")
+ assert w_res.equal(parse_("(b)"))
+
+ w_res = eval_noctx("""(cdaadr '((((a b) c d) (e f) g h)
+ ((i j) k l) (m n) o p))""")
+ assert w_res.equal(parse_("(j)"))
+
+ w_res = eval_noctx("""(cdadar '((((a b) c d) (e f) g h)
+ ((i j) k l) (m n) o p))""")
+ assert w_res.equal(parse_("(f)"))
+
+ w_res = eval_noctx("""(cdaddr '((((a b) c d) (e f) g h)
+ ((i j) k l) (m n) o p))""")
+ assert w_res.equal(parse_("(n)"))
+
+ w_res = eval_noctx("""(cddaar '((((a b) c d) (e f) g h)
+ ((i j) k l) (m n) o p))""")
+ assert w_res.equal(parse_("(d)"))
+
+ w_res = eval_noctx("""(cddadr '((((a b) c d) (e f) g h)
+ ((i j) k l) (m n) o p))""")
+ assert w_res.equal(parse_("(l)"))
+
+ w_res = eval_noctx("""(cdddar '((((a b) c d) (e f) g h)
+ ((i j) k l) (m n) o p))""")
+ assert w_res.equal(parse_("(h)"))
+
+ 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)"))
_______________________________________________
pypy-commit mailing list
pypy-commit@python.org
http://mail.python.org/mailman/listinfo/pypy-commit
