--- old/CHANGELOG	Wed Aug 10 15:26:18 2005
+++ CHANGELOG	Fri Aug 12 13:35:20 2005
@@ -26,3 +26,15 @@
 Alway decref exception and exceptionvalue in throw (they can't be NULL).
 Removed extraneous lines in newobj.c.
 Fixed missing throwoom() in new_word.
+
+2005-08-12: 1.4: Removed float.c.
+Added args-of-func and prog-of-func functions.
+Removed void *p from value union in struct obj.
+Moved car, cdr, and cons functions from preload.lisp to cons.c.
+Removed CADR/CADDR/CDDR macros from lisp.h.
+Added per-objtype eqv? function to objtype struct.
+Moved real_eqv from word.c to util.c.
+Added eqv? support to cons.c, func.c, and quote.c.
+exit-loop now takes optional arguments whose progn is the loop's return value.
+Added unique-word function to word.c and switch macro to preload.lisp.
+Cleaned up Makefile.
--- old/Makefile	Mon Jul 18 20:26:08 2005
+++ Makefile	Fri Aug 12 13:41:21 2005
@@ -1,11 +1,10 @@
 #!/usr/bin/make
 CC=gcc
 CFLAGS=-O2 -Wall -Werror
-#CFLAGS+=-g -DDEBUG
-SRCS=builtin.c cons.c float.c func.c integer.c main.c nil.c quote.c rawfunc.c reader.c scope.c stream.c string.c throw.c util.c word.c
+SRCS=builtin.c cons.c func.c integer.c main.c nil.c quote.c rawfunc.c reader.c scope.c stream.c string.c throw.c util.c word.c
 BUILDDIR=obj/
-VERSION=1.3
-DISTFILES=CHANGELOG Makefile lisp.h $(SRCS) preload.lisp
+VERSION=1.4
+-include .local.Makefile
 
 $(BUILDDIR)mikelisp : $(SRCS:%.c=$(BUILDDIR)%.o) lisp.h
 	$(CC) $(CFLAGS) -o $@ $(SRCS:%.c=$(BUILDDIR)%.o)
@@ -17,16 +16,3 @@
 clean :
 	rm -f $(BUILDDIR)mikelisp $(BUILDDIR)*.o
 
-tar : mikelisp-$(VERSION).tar.gz
-	
-mikelisp-$(VERSION).tar.gz : $(DISTFILES)
-	ln -s . mikelisp-$(VERSION)
-	tar -czf mikelisp-$(VERSION).tar.gz $(DISTFILES:%=mikelisp-$(VERSION)/%)
-	rm mikelisp-$(VERSION)
-
-patch : mikelisp-$(VERSION).patch
-	
-mikelisp-$(VERSION).patch : $(DISTFILES)
-	ln -s /www/html/mikelisp old
-	for f in $(DISTFILES);do diff -u old/$$f $$f;done > $@ || true
-	rm old
--- old/lisp.h	Mon Jul 25 17:01:04 2005
+++ lisp.h	Fri Aug 12 13:30:56 2005
@@ -1,4 +1,4 @@
-/* lisp.h   by Michael Thorpe   2005-07-25 */
+/* lisp.h   by Michael Thorpe   2005-08-12 */
 
 #ifndef OBJ_H
 #define OBJ_H
@@ -17,6 +17,7 @@
 	void (*dropobj)(obj *); /* Called when object is to be discarded */
 	obj *(*evaluate)(scope *,obj *);
 	obj *(*applyfunc)(scope *,obj *,obj *);
+	int (*eqv)(obj *,obj *);
 };
 
 union rawfuncptr {
@@ -63,7 +64,6 @@
 			unsigned int closable:1;
 			FILE *f;
 		} stream;
-		void *p;
 	} value;
 #ifdef DEBUG
 	obj *prev,*next;
@@ -72,7 +72,6 @@
 
 extern objtype
 	cons_objtype,
-	float_objtype,
 	func_objtype,
 	integer_objtype,
 	nil_objtype,
@@ -94,10 +93,11 @@
 /* cons.c */
 #define CAR(o) ((o)->value.c.a)
 #define CDR(o) ((o)->value.c.d)
-#define CADR(o) CAR(CDR(o))
-#define CADDR(o) CAR(CDR(CDR(o)))
-#define CDDR(o) CDR(CDR(o))
 obj *newlist(unsigned long length);
+int cons_init();
+
+/* func.c */
+int func_init();
 
 /* integer.c */
 extern obj trueobj;
@@ -185,6 +185,7 @@
 void drop_object(obj *o);
 obj *evaluate(scope *scope,obj *o);
 obj *newobj(objtype *type);
+int real_eqv(obj *o1,obj *o2);
 int register_objtype(objtype *type);
 #ifdef DEBUG
 void show_remaining_objects();
@@ -194,6 +195,6 @@
 
 /* word.c */
 obj *newword(const char *data,unsigned long len);
-int real_eqv(obj *o1,obj *o2);
+int word_init();
 
 #endif
--- old/cons.c	Wed Aug 10 14:45:44 2005
+++ cons.c	Fri Aug 12 10:01:37 2005
@@ -1,4 +1,4 @@
-/* cons.c   by Michael Thorpe   2005-08-10 */
+/* cons.c   by Michael Thorpe   2005-08-12 */
 
 #include <stdlib.h>
 #include <string.h>
@@ -139,10 +139,54 @@
 	return(c);
 }
 
+static obj *car(obj *o) {
+	obj *a;
+
+	if(&cons_objtype != o->type)
+		return(throwtypeerror(o));
+	a=incref(o->value.c.a);
+	decref(o);
+	return(a);
+}
+
+static obj *cdr(obj *o) {
+	obj *d;
+
+	if(&cons_objtype != o->type)
+		return(throwtypeerror(o));
+	d=incref(o->value.c.d);
+	decref(o);
+	return(d);
+}
+
+static obj *cons(obj *a,obj *d) {
+	obj *c;
+
+	c=newobj(&cons_objtype);
+	if(!c)
+		return(0);
+	c->value.c.a=a;
+	c->value.c.d=d;
+	return(c);
+}
+
+static int cons_eqv(obj *o1,obj *o2) {
+	return(real_eqv(o1->value.c.a,o2->value.c.a) && real_eqv(o1->value.c.d,o2->value.c.d));
+}
+
+int cons_init() {
+	if(store_builtin_ns1("car",car)
+	|| store_builtin_ns1("cdr",cdr)
+	|| store_builtin_ns2("cons",cons))
+		return(1);
+	return(0);
+}
+
 objtype cons_objtype={
 	name: "cons",
 	tostring: cons_tostring,
 	dropobj: decref_cons,
-	evaluate: cons_evaluate
+	evaluate: cons_evaluate,
+	eqv: cons_eqv
 };
 
--- old/func.c	Wed Aug 10 14:46:33 2005
+++ func.c	Fri Aug 12 09:55:51 2005
@@ -1,4 +1,4 @@
-/* func.c   by Michael Thorpe   2005-08-10 */
+/* func.c   by Michael Thorpe   2005-08-12 */
 
 #include <string.h>
 #include "lisp.h"
@@ -77,10 +77,41 @@
 	decref(o->value.func.prog);
 }
 
+static obj *args_of_func(obj *o) {
+	obj *args;
+
+	if(&func_objtype != o->type)
+		throwtypeerror(o);
+	args=incref(o->value.func.args);
+	decref(o);
+	return(args);
+}
+
+static obj *prog_of_func(obj *o) {
+	obj *prog;
+
+	if(&func_objtype != o->type)
+		throwtypeerror(o);
+	prog=incref(o->value.func.prog);
+	decref(o);
+	return(prog);
+}
+
+static int func_eqv(obj *o1,obj *o2) {
+	return(real_eqv(o1->value.func.args,o2->value.func.args) && real_eqv(o1->value.func.prog,o2->value.func.prog));
+}
+
+int func_init() {
+	if(store_builtin_ns1("args-of-func",args_of_func)
+	|| store_builtin_ns1("prog-of-func",prog_of_func))
+		return(1);
+	return(0);
+}
+
 objtype func_objtype={
 	name: "func",
 	tostring: func_tostring,
 	dropobj: drop_func,
-	applyfunc: applyfunc
+	applyfunc: applyfunc,
+	eqv: func_eqv
 };
-
--- old/integer.c	Mon Jul 25 17:03:00 2005
+++ integer.c	Fri Aug 12 11:21:57 2005
@@ -1,4 +1,4 @@
-/* integer.c   by Michael Thorpe   2005-07-25 */
+/* integer.c   by Michael Thorpe   2005-08-12 */
 
 #include <stdio.h>
 #include "lisp.h"
@@ -16,9 +16,14 @@
 	return(out);
 }
 
+static int integer_eqv(obj *o1,obj *o2) {
+	return(o1->value.i==o2->value.i);
+}
+
 objtype integer_objtype={
 	name: "integer",
-	tostring: integer_tostring
+	tostring: integer_tostring,
+	eqv: integer_eqv
 };
 
 obj trueobj={&integer_objtype,{refcount:1},{i:1}};
--- old/main.c	Mon Jul 25 16:11:19 2005
+++ main.c	Fri Aug 12 13:31:10 2005
@@ -1,4 +1,4 @@
-/* main.c   by Michael Thorpe   2005-07-25 */
+/* main.c   by Michael Thorpe   2005-08-12 */
 
 #include <stdio.h>
 #include "lisp.h"
@@ -56,12 +56,15 @@
 
 	if(scope_init()
 	|| builtin_init()
+	|| cons_init()
+	|| func_init()
 	|| quote_init()
 	|| reader_init()
 	|| stream_init()
 	|| string_init()
 	|| throw_init()
-	|| util_init()) {
+	|| util_init()
+	|| word_init()) {
 		fprintf(stderr,"got bad return value from an init!\n");
 		return(1);
 	}
--- old/quote.c	Mon Jul 25 17:03:15 2005
+++ quote.c	Fri Aug 12 10:00:36 2005
@@ -1,4 +1,4 @@
-/* quote.c   by Michael Thorpe   2005-07-25 */
+/* quote.c   by Michael Thorpe   2005-08-12 */
 
 #include <string.h>
 #include "lisp.h"
@@ -45,6 +45,10 @@
 	return(q);
 }
 
+static int quote_eqv(obj *o1,obj *o2) {
+	return(real_eqv(o1->value.o,o2->value.o));
+}
+
 int quote_init() {
 	if(store_builtin_ns1("quote",quoteobj))
 		return(1);
@@ -55,6 +59,7 @@
 	name: "quote",
 	tostring: quote_tostring,
 	dropobj: drop_quote,
-	evaluate: quote_evaluate
+	evaluate: quote_evaluate,
+	eqv: quote_eqv
 };
 
--- old/string.c	Wed Aug 10 15:04:03 2005
+++ string.c	Fri Aug 12 09:56:28 2005
@@ -1,4 +1,4 @@
-/* string.c   by Michael Thorpe   2005-08-10 */
+/* string.c   by Michael Thorpe   2005-08-12 */
 
 #include <assert.h>
 #include <limits.h>
@@ -220,6 +220,14 @@
 	return(r);
 }
 
+static int string_eqv(obj *o1,obj *o2) {
+	if(o1->value.s.len != o2->value.s.len)
+		return(0);
+	if(!memcmp(o1->value.s.data,o2->value.s.data,o1->value.s.len))
+		return(1);
+	return(0);
+}
+
 int string_init() {
 	if(store_builtin_ns2("get-char",get_char)
 	|| store_builtin_ns1("new-string",new_string)
@@ -235,6 +243,7 @@
 objtype string_objtype={
 	name: "string",
 	tostring: string_tostring,
-	dropobj: drop_string
+	dropobj: drop_string,
+	eqv: string_eqv
 };
 
--- old/util.c	Wed Aug 10 15:06:00 2005
+++ util.c	Fri Aug 12 09:52:34 2005
@@ -1,4 +1,4 @@
-/* util.c   by Michael Thorpe   2005-08-10 */
+/* util.c   by Michael Thorpe   2005-08-12 */
 
 #include <stdlib.h>
 #include <string.h>
@@ -101,6 +101,16 @@
 	return(o);
 }
 
+int real_eqv(obj *o1,obj *o2) {
+	if(o1==o2)
+		return(1);
+	if(o1->type != o2->type)
+		return(0);
+	if(!o1->type->eqv)
+		return(0);
+	return((o1->type->eqv)(o1,o2));
+}
+
 int register_objtype(objtype *type) {
 	if(!type->nameobj)
 		type->nameobj=newword(type->name,strlen(type->name));
@@ -142,7 +152,6 @@
 	|| store_builtin_ns1("object-type",objtypeof)
 /* Should these should be handled in the per-type init functions? */
 	|| register_objtype(&cons_objtype)
-	|| register_objtype(&float_objtype)
 	|| register_objtype(&func_objtype)
 	|| register_objtype(&integer_objtype)
 	|| register_objtype(&nil_objtype)
--- old/word.c	Wed Aug 10 15:07:22 2005
+++ word.c	Fri Aug 12 13:31:26 2005
@@ -1,10 +1,48 @@
-/* word.c   by Michael Thorpe   2005-08-10 */
+/* word.c   by Michael Thorpe   2005-08-12 */
 
+#include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
 #include "lisp.h"
 
+#define HASH_SIZE 127
+
+struct hashentry {
+	struct hashentry *prev,*next;
+	obj *word;
+};
+
+static struct hashentry *hashtable[HASH_SIZE];
+
+static int hash(const char *data,int len) {
+	unsigned int h=0,m=1;
+
+	while(len--) {
+		h=(h+m*data++[0])%HASH_SIZE;
+		m=(m*3)%HASH_SIZE;
+	}
+	return(h);
+}
+
 static void drop_word(obj *o) {
+	int h;
+	struct hashentry *entry;
+
+	h=hash(o->value.s.data,o->value.s.len);
+	for(entry=hashtable[h];entry;entry=entry->next)
+		if(entry->word->value.s.len==o->value.s.len && !memcmp(o->value.s.data,entry->word->value.s.data,o->value.s.len))
+			break;
+	if(!entry) {
+		fprintf(stderr,"Just tried to drop a word I don't know about from %d: %.*s\n",h,(int)o->value.s.len,o->value.s.data);
+		exit(-1);
+	}
+	if(entry->prev)
+		entry->prev->next=entry->next;
+	else
+		hashtable[h]=entry->next;
+	if(entry->next)
+		entry->next->prev=entry->prev;
+	free(entry);
 	free(o->value.s.data);
 }
 
@@ -23,38 +61,66 @@
 obj *newword(const char *data,unsigned long len) {
 	obj *o;
 	char *s;
+	int h;
+	struct hashentry *entry;
 
+	h=hash(data,len);
+	for(entry=hashtable[h];entry;entry=entry->next)
+		if(entry->word->value.s.len==len && !memcmp(data,entry->word->value.s.data,len))
+			break;
+	if(entry)
+		return(incref(entry->word));
 	s=(char *)malloc(len);
 	if(!s)
 		return(throwoom());
+	entry=(struct hashentry *)malloc(sizeof(struct hashentry));
+	if(!entry) {
+		free(s);
+		return(throwoom());
+	}
 	o=newobj(&word_objtype);
 	if(!o) {
+		free(entry);
 		free(s);
 		return(0);
 	}
+	entry->word=o;
 	o->value.s.data=s;
 	o->value.s.len=len;
 	if(data)
 		memcpy(o->value.s.data,data,len);
 	else
 		memset(o->value.s.data,0,len);
+	entry->prev=0;
+	entry->next=hashtable[h];
+	if(hashtable[h])
+		hashtable[h]->prev=entry;
+	hashtable[h]=entry;
 	return(o);
 }
 
-int real_eqv(obj *o1,obj *o2) {
-	if(o1==o2)
-		return(1);
-	if(o1->type != o2->type)
-		return(0);
-	if(o1->type==&integer_objtype) {
-		if(o1->value.i==o2->value.i)
-			return(1);
-	} else if(o1->type==&string_objtype || o1->type==&word_objtype) {
-		if(o1->value.s.len != o2->value.s.len)
-			return(0);
-		if(!memcmp(o1->value.s.data,o2->value.s.data,o1->value.s.len))
-			return(1);
+obj *unique_word() {
+	int h,len;
+	struct hashentry *entry;
+	char buf[1+4+1+10+1];
+
+	while(1) {
+		len=snprintf(buf,sizeof(buf),"#word-%u",rand());
+		if(-1==len || sizeof(buf)<=len) {
+			fprintf(stderr,"unique_word ust got %d from snprintf\n",len);
+			exit(-1);
+		}
+		h=hash(buf,len);
+		for(entry=hashtable[h];entry;entry=entry->next)
+			if(entry->word->value.s.len != len || memcmp(buf,entry->word->value.s.data,len)) {
+				return(newword(buf,len));
+			}
 	}
+}
+
+int word_init() {
+	if(store_builtin_ns0("unique-word",unique_word))
+		return(1);
 	return(0);
 }
 
--- old/preload.lisp	Wed Aug 10 15:11:33 2005
+++ preload.lisp	Fri Aug 12 13:33:32 2005
@@ -1,23 +1,16 @@
-; preload.lisp   by Michael Thorpe   2005-08-10
+; preload.lisp   by Michael Thorpe   2005-08-12
 
 (#define '#f (= 1 2))
 (#define '#t (= 1 1))
-(#define 'pair? (#lambda '(o) '(eqv? 'cons (object-type o))))
-(#define 'stream? (#lambda '(o) '(eqv? 'stream (object-type o))))
-(#define 'car (#lambda '((a . d)) 'a))
-(#define 'cdr (#lambda '((a . d)) 'd))
-(#define 'caar (#lambda '(((aa . da) . rest)) 'aa))
-(#define 'cadr (#lambda '((a ad . dd)) 'ad))
-(#define 'cdar (#lambda '(((aa . da) . rest)) 'da))
-(#define 'cddr (#lambda '((a ad . dd)) 'dd))
+(#define 'pair? (#lambda '(o) '(eq? 'cons (object-type o))))
+(#define 'stream? (#lambda '(o) '(eq? 'stream (object-type o))))
 (#define 'list (#lambda 'aaa 'aaa))
-(#define 'cons (#lambda '(a b) '(list a . b)))
 
 (#define 'get
 	(#lambda '(hash item)
 		'(#ifelse hash
-			'(#ifelse (eqv? (caar hash) item)
-				'(cdar hash)
+			'(#ifelse (eqv? (car (car hash)) item)
+				'(cdr (car hash))
 				'(get (cdr hash) item))
 			'#f)))
 
@@ -138,7 +131,8 @@
 	(ifelse b
 		(list 'ifelse a (cons 'and b) #f)
 		a))
-(macro-define (exit-loop) (list 'throw ''exit-loop #f))
+(macro-define (exit-loop . value)
+	(list 'throw ''exit-loop (cons 'progn value)))
 (macro-define (if bool . progs)
 	(list 'ifelse bool
 		(cons 'progn progs)
@@ -146,7 +140,7 @@
 (macro-define (let* bindings . body)
 	(ifelse bindings
 		(list 'progn
-			(list 'define-local (caar bindings) (cons 'progn (cdar bindings)))
+			(list 'define-local (car (car bindings)) (cons 'progn (cdr (car bindings))))
 			(cons 'let* (cons (cdr bindings) body)))
 		(cons 'progn body)))
 (macro-define (next-loop) (list 'throw ''next-loop #f))
@@ -167,9 +161,6 @@
 			(cons 'progn body)
 			(list 'throw ''exit-loop #f))))
 
-(define (cadar o)
-	(car (cdr (car o))))
-
 (define (reverse/append straight newtail)
 	(while straight
 		(define-local newtail (cons (car straight) newtail))
@@ -180,25 +171,6 @@
 (define (append oldlist newtail)
 	(reverse (reverse/append oldlist newtail)))
 
-(define (cars arg) ; ((1 2) (3 4)) => (1 3)
-	(define-local stack '())
-	(while arg
-		(define-local stack (cons (caar arg) stack))
-		(define-local arg (cdr arg)))
-	(reverse stack))
-(define (cdrs arg) ; ((1 2) (3 4)) => ((2) (4))
-	(define-local stack '())
-	(while arg
-		(define-local stack (cons (cdar arg) stack))
-		(define-local arg (cdr arg)))
-	(reverse stack))
-(define (cadrs arg) ; ((1 2) (3 4)) => (2 4)
-	(define-local stack '())
-	(while arg
-		(define-local stack (cons (cadar arg) stack))
-		(define-local arg (cdr arg)))
-	(reverse stack))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Now we reimplement the reader and read-object ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -209,12 +181,11 @@
 ;   ,bar
 ; it will call macro-comma, which calls read-object, gets bar, and returns:
 ;   ('(unquote . identifier) . bar)
-; which will get translated by quasiquote into:
-;   bar
+;
 ; If read-object is called where the stream starts with:
 ;   `(foo ,bar baz)
-; then the backtick will be read and quasiquote called.  Quasiquote will
-; call read-object, which will return:
+; then the backtick will be read, macro-backtick will call read-object and
+; pass the following to quasiquote:
 ;   (foo ('(unquote . identifier) . bar) baz)
 ; Then quasiquote will do its thing and return:
 ;   (list 'foo bar 'baz)
@@ -244,7 +215,7 @@
 	(catch 'end-of-file
 		(progn
 			(define-local o (read-object stream))
-			(ifelse (not (eqv? ') (read-object stream)))
+			(ifelse (not (eq? ') (read-object stream)))
 				(throw 'reader-error stream)
 				o))
 		(throw 'reader-error stream)))
@@ -255,9 +226,9 @@
 	(catch 'end-of-file
 		(loop
 			(define-local o (read-object stream))
-			(ifelse (eqv? o '))
+			(ifelse (eq? o '))
 				(exit-loop)
-				(ifelse (eqv? o '.)
+				(ifelse (eq? o '.)
 					(ifelse reverse-list
 						(progn
 							(define-local new-list (submacro-dot stream))
@@ -265,10 +236,7 @@
 						(throw 'reader-error stream))
 					(define-local reverse-list (cons o reverse-list)))))
 		(throw 'reader-error stream))
-	(while reverse-list
-		(define-local new-list (cons (car reverse-list) new-list))
-		(define-local reverse-list (cdr reverse-list)))
-	new-list)
+	(reverse/append reverse-list new-list))
 (define-character-macro 40 macro-openparen)
 
 (define (macro-closeparen stream)
@@ -386,6 +354,71 @@
 	(ifelse macro
 		(macro stream)
 		(read-token stream c)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Some more utility routines ;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(macro-define (caar o) `(car (car ,o)))
+(macro-define (cadr o) `(car (cdr ,o)))
+(macro-define (cdar o) `(cdr (car ,o)))
+(macro-define (cddr o) `(cdr (cdr ,o)))
+(macro-define (caaar o) `(car (car (car ,o))))
+(macro-define (caadr o) `(car (car (cdr ,o))))
+(macro-define (cadar o) `(car (cdr (car ,o))))
+(macro-define (caddr o) `(car (cdr (cdr ,o))))
+(macro-define (cdaar o) `(cdr (car (car ,o))))
+(macro-define (cdadr o) `(cdr (car (cdr ,o))))
+(macro-define (cddar o) `(cdr (cdr (car ,o))))
+(macro-define (cdddr o) `(cdr (cdr (cdr ,o))))
+
+;
+; switch (takes the place of case)
+;
+; Format:
+;  (switch key
+;  	((value1) stuff1 stuff2)
+;  	((value2 value3) stuff3 stuff4 stuff5)
+;  	(else stuff6 stuff7))
+; else is required to be the last case (and defaults to #f if not present)
+;
+(define (switch-handle var cases)
+	(ifelse cases
+		(ifelse (eqv? 'else (caar cases))
+			(cons 'progn (cdar cases))
+			(ifelse (caar cases)
+				`(ifelse (eqv? ,var ,(caaar cases))
+					,(cons 'progn (cdar cases))
+					,(switch-handle var
+						(cons
+							(cons (cdaar cases) (cdar cases))
+							(cdr cases))))
+				(switch-handle var (cdr cases))))
+		#f))
+(macro-define (switch key . cases)
+	(define-local var (unique-word))
+	`(progn
+		(define-local ,var ,key)
+		,(switch-handle var cases)))
+
+(define (cars arg) ; ((1 2) (3 4)) => (1 3)
+	(define-local stack '())
+	(while arg
+		(define-local stack (cons (caar arg) stack))
+		(define-local arg (cdr arg)))
+	(reverse stack))
+(define (cdrs arg) ; ((1 2) (3 4)) => ((2) (4))
+	(define-local stack '())
+	(while arg
+		(define-local stack (cons (cdar arg) stack))
+		(define-local arg (cdr arg)))
+	(reverse stack))
+(define (cadrs arg) ; ((1 2) (3 4)) => (2 4)
+	(define-local stack '())
+	(while arg
+		(define-local stack (cons (cadar arg) stack))
+		(define-local arg (cdr arg)))
+	(reverse stack))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; And here's our repl ;;;
