[pypy-commit] lang-scheme default: Implement member & friends

[boemmels]

Author: Juergen Boemmels <boemmels at web.de>
Branch: 
Changeset: r36:a93db4dbd6b0
Date: 2012-01-09 21:33 +0100
http://bitbucket.org/pypy/lang-scheme/changeset/a93db4dbd6b0/

Log:	Implement member & friends

diff --git a/scheme/procedure.py b/scheme/procedure.py
--- a/scheme/procedure.py
+++ b/scheme/procedure.py
@@ -491,6 +491,9 @@
 
         return w_false
 
+    def compare(self, w_obj1, w_obj2):
+        raise NotImplementedError
+
 class Assq(AssocX):
     _symbol_name = "assq"
 
@@ -511,6 +514,49 @@
 
 
 ##
+# Member function
+##
+class MemX(W_Procedure):
+    def procedure(self, ctx, lst):
+        if len(lst) != 2:
+            raise WrongArgsNumber
+
+        (w_obj, w_lst) = lst
+
+        w_iter = w_lst
+        while w_iter is not w_nil:
+            if not isinstance(w_iter, W_Pair):
+                raise WrongArgType(w_lst, "List")
+
+            if self.compare(w_obj, w_iter.car):
+                return w_iter
+
+            w_iter = w_iter.cdr
+
+        return w_false
+
+    def compare(self, w_obj1, w_obj2):
+        raise NotImplementedError
+        
+class Memq(MemX):
+    _symbol_name = "memq"
+
+    def compare(self, w_obj1, w_obj2):
+        return w_obj1.eq(w_obj2)
+
+class Memv(MemX):
+    _symbol_name = "memv"
+
+    def compare(self, w_obj1, w_obj2):
+        return w_obj1.eqv(w_obj2)
+
+class Member(MemX):
+    _symbol_name = "member"
+
+    def compare(self, w_obj1, w_obj2):
+        return w_obj1.equal(w_obj2)
+
+##
 # Equivalnece Predicates
 ##
 class EquivalnecePredicate(W_Procedure):
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,7 +888,27 @@
     py.test.raises(WrongArgType, eval_noctx, "(assq 1 2)")
     py.test.raises(WrongArgsNumber, eval_noctx, "(assq 1 '(1 2) '(3 4))")
 
-def test_cxxxr():
+def test_member():
+    w_res = eval_noctx("(memq 'a '(a b c))")
+    assert w_res.equal(parse_("(a b c)"))
+
+    w_res = eval_noctx("(memq 'b '(a b c))")
+    assert w_res.equal(parse_("(b c)"))
+
+    w_res = eval_noctx("(memq 'd '(a b c))")
+    assert w_res.eq(w_false)
+
+    w_res = eval_noctx("(memv 10 (list 11 10 9))")
+    assert w_res.equal(parse_("(10 9)"))
+
+    w_res = eval_noctx("(member '(c d) '((a b) (c d) (e f)))")
+    assert w_res.equal(parse_("((c d) (e f))"))
+
+    py.test.raises(WrongArgType, eval_noctx, "(member 1 2)")
+    py.test.raises(WrongArgsNumber, eval_noctx, "(memq 1)")
+    py.test.raises(WrongArgsNumber, eval_noctx, "(memq 1 2 3)")
+
+def test_cadadr():
     w_res = eval_noctx("(caar '((a b) c d))")
     assert w_res.equal(parse_("a"))