[pypy-svn] r45178 - in pypy/dist/pypy/lang/scheme: . test

[jlg at codespeak.net]

Author: jlg
Date: Wed Jul 18 12:11:45 2007
New Revision: 45178

Modified:
   pypy/dist/pypy/lang/scheme/execution.py
   pypy/dist/pypy/lang/scheme/object.py
   pypy/dist/pypy/lang/scheme/test/test_eval.py
Log:
set-car! set-cdr! implemented

Modified: pypy/dist/pypy/lang/scheme/execution.py
==============================================================================
--- pypy/dist/pypy/lang/scheme/execution.py	(original)
+++ pypy/dist/pypy/lang/scheme/execution.py	Wed Jul 18 12:11:45 2007
@@ -21,6 +21,8 @@
         'cons': Cons,
         'car': Car,
         'cdr': Cdr,
+        'set-car!': SetCar,
+        'set-cdr!': SetCdr,
         'list': List,
         'quit': Quit,
             #comparisons

Modified: pypy/dist/pypy/lang/scheme/object.py
==============================================================================
--- pypy/dist/pypy/lang/scheme/object.py	(original)
+++ pypy/dist/pypy/lang/scheme/object.py	Wed Jul 18 12:11:45 2007
@@ -190,7 +190,7 @@
         if not isinstance(oper, W_Callable):
             raise NotCallable(oper)
 
-        #a propper (oper args ...) call
+        #a proper (oper args ...) call
         # self.cdr has to be a proper list
         cdr = self.cdr
         if isinstance(cdr, W_List):
@@ -471,6 +471,26 @@
             raise WrongArgType(w_pair, "Pair")
         return w_pair.cdr
 
+class SetCar(W_Procedure):
+    def procedure(self, crx, lst):
+        w_pair = lst[0]
+        w_obj = lst[1]
+        if not isinstance(w_pair, W_Pair):
+            raise WrongArgType(w_pair, "Pair")
+
+        w_pair.car = w_obj
+        return w_obj
+
+class SetCdr(W_Procedure):
+    def procedure(self, crx, lst):
+        w_pair = lst[0]
+        w_obj = lst[1]
+        if not isinstance(w_pair, W_Pair):
+            raise WrongArgType(w_pair, "Pair")
+
+        w_pair.cdr = w_obj
+        return w_obj #unspec
+
 class Quit(W_Procedure):
     def procedure(self, ctx, lst):
         raise SchemeQuit
@@ -556,7 +576,7 @@
         if isinstance(w_first, W_Identifier):
             w_val = w_second.car.eval(ctx)
             ctx.set(w_first.name, w_val)
-            return w_val
+            return w_val #unspec
         elif isinstance(w_first, W_Pair):
             #we have lambda definition here!
             w_name = w_first.car
@@ -567,7 +587,7 @@
             body = w_second
             w_lambda = W_Lambda(formals, body, ctx, pname=w_name.name)
             ctx.set(w_name.name, w_lambda)
-            return w_lambda
+            return w_lambda #unspec
         else:
             raise WrongArgType(w_first, "Identifier")
 
@@ -581,7 +601,7 @@
 
         w_val = lst.get_cdr_as_pair().car.eval(ctx)
         ctx.sete(w_identifier.name, w_val)
-        return w_val
+        return w_val #unspec
 
 class MacroIf(W_Macro):
     def call_tr(self, ctx, lst):

Modified: pypy/dist/pypy/lang/scheme/test/test_eval.py
==============================================================================
--- pypy/dist/pypy/lang/scheme/test/test_eval.py	(original)
+++ pypy/dist/pypy/lang/scheme/test/test_eval.py	Wed Jul 18 12:11:45 2007
@@ -543,3 +543,30 @@
     eval_expr(ctx, "(loop 2000)")
     assert ctx.get("a").to_number() == 2001
 
+def test_setcar():
+    ctx = ExecutionContext()
+    w_pair = eval_expr(ctx, "(define lst '(1 2 3 4))")
+    eval_expr(ctx, "(set-car! lst 11)")
+    assert w_pair is eval_expr(ctx, "lst")
+    assert eval_expr(ctx, "(car lst)").to_number() == 11
+
+    eval_expr(ctx, "(set-car! (cdr lst) 12)")
+    assert eval_expr(ctx, "(car (cdr lst))").to_number() == 12
+
+def test_setcdr():
+    ctx = ExecutionContext()
+    w_pair = eval_expr(ctx, "(define lst '(1 2 3 4))")
+    eval_expr(ctx, "(set-cdr! lst (cdr (cdr lst)))")
+    w_lst = eval_expr(ctx, "lst")
+    assert w_pair is w_lst
+    assert w_lst.to_string() == "(1 3 4)"
+
+    eval_expr(ctx, "(set-cdr! (cdr lst) '(12))")
+    w_lst = eval_expr(ctx, "lst")
+    assert w_lst.to_string() == "(1 3 12)"
+
+    #warning circural list
+    eval_expr(ctx, "(set-cdr! (cdr (cdr lst)) lst)")
+    w_lst = eval_expr(ctx, "lst")
+    assert w_lst is eval_expr(ctx, "(cdr (cdr (cdr lst)))")
+