From 947f0ecbdeb98e4b5f53c68cb62e7d9cfcf03c60 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <matthias@benkard.de>
Date: Tue, 8 Jul 2008 15:48:56 +0200
Subject: Replace SET-CAR and SET-CDR with RPLACA and RPLACD.

---
 MLKPackage.m        |  4 ++--
 MLKRoot.m           | 14 ++++++++------
 list-functions.lisp | 15 ++++++++++++++-
 3 files changed, 24 insertions(+), 9 deletions(-)

diff --git a/MLKPackage.m b/MLKPackage.m
index 00d6344..cae3416 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -90,8 +90,8 @@ static NSMutableDictionary *packages = nil;
   
   [sys export:[sys intern:@"CAR"]];
   [sys export:[sys intern:@"CDR"]];
-  [sys export:[sys intern:@"SET-CAR"]];
-  [sys export:[sys intern:@"SET-CDR"]];
+  [sys export:[sys intern:@"RPLACA"]];
+  [sys export:[sys intern:@"RPLACD"]];
   [sys export:[sys intern:@"CONS"]];
   [sys export:[sys intern:@"LOAD"]];
   [sys export:[sys intern:@"EQ"]];
diff --git a/MLKRoot.m b/MLKRoot.m
index 880b4e5..f6ee730 100644
--- a/MLKRoot.m
+++ b/MLKRoot.m
@@ -121,16 +121,18 @@ static id truify (BOOL value)
   return [NSArray arrayWithObject:nullify([denullify([args objectAtIndex:0]) cdr])];
 }
 
-+(NSArray *) set_car:(NSArray *)args
++(NSArray *) rplaca:(NSArray *)args
 {
-  [[args objectAtIndex:0] setCar:denullify([args objectAtIndex:1])];
-  return [NSArray arrayWithObject:[args objectAtIndex:1]];
+  MLKCons *cons = [args objectAtIndex:0];
+  [cons setCar:denullify([args objectAtIndex:1])];
+  RETURN_VALUE (cons);
 }
 
-+(NSArray *) set_cdr:(NSArray *)args
++(NSArray *) rplacd:(NSArray *)args
 {
-  [[args objectAtIndex:0] setCdr:denullify([args objectAtIndex:1])];
-  return [NSArray arrayWithObject:[args objectAtIndex:1]];
+  MLKCons *cons = [args objectAtIndex:0];
+  [cons setCdr:denullify([args objectAtIndex:1])];
+  RETURN_VALUE (cons);  
 }
 
 +(NSArray *) cons:(NSArray *)args
diff --git a/list-functions.lisp b/list-functions.lisp
index 9593118..464a9a4 100644
--- a/list-functions.lisp
+++ b/list-functions.lisp
@@ -163,6 +163,19 @@
 ;(%deftype null args '(satisfies null))
 
 
+;;;;-----------------------------------------------------------------
+;;;; ACCESSORS
+;;;;-----------------------------------------------------------------
+(shadow '(rplaca rplacd))
+(unexport '(sys::rplaca sys::rplacd) (find-package :sys))
+
+(%defun rplaca args
+  (sys::rplaca (first args) (second args)))
+
+(%defun rplacd args
+  (sys::rplacd (first args) (second args)))
+
+
 ;;;;-----------------------------------------------------------------
 (export '(cons car cdr list* first second third fourth fifth sixth
-          seventh eigthth ninth tenth consp listp null))
+          seventh eigthth ninth tenth consp listp null rplaca rplacd))
-- 
cgit v1.2.3