--- old/CHANGELOG	Fri Aug 12 13:47:51 2005
+++ CHANGELOG	Sat Aug 13 20:44:19 2005
@@ -38,3 +38,13 @@
 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.
+Words which are eqv? are now always eq? as well.
+
+2005-08-13: 1.5: Declared tryit() static.
+read_object() now checks that the given stream is readable.
+Fixed substring()'s behavior when length<=0 or offset<0.
+Substring now accepts #f for length to go to the end of the string.
+Changed the return value of macro-define to be the macro's name.
+Changed dprint to allow for multiple arguments.
+Removed many uses of real_eqv as eqv? words are now eq?.
+Implemented eqv? in preload.lisp and removed it from the .h and .c's.
--- old/Makefile	Fri Aug 12 13:41:21 2005
+++ Makefile	Fri Aug 12 13:49:53 2005
@@ -3,7 +3,7 @@
 CFLAGS=-O2 -Wall -Werror
 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.4
+VERSION=1.5
 -include .local.Makefile
 
 $(BUILDDIR)mikelisp : $(SRCS:%.c=$(BUILDDIR)%.o) lisp.h
--- old/lisp.h	Fri Aug 12 13:30:56 2005
+++ lisp.h	Sat Aug 13 20:41:37 2005
@@ -1,4 +1,4 @@
-/* lisp.h   by Michael Thorpe   2005-08-12 */
+/* lisp.h   by Michael Thorpe   2005-08-13 */
 
 #ifndef OBJ_H
 #define OBJ_H
@@ -17,7 +17,6 @@
 	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 {
@@ -185,7 +184,6 @@
 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();
--- old/builtin.c	Wed Aug 10 14:43:47 2005
+++ builtin.c	Sat Aug 13 20:41:51 2005
@@ -1,4 +1,4 @@
-/* builtin.c   by Michael Thorpe   2005-08-10 */
+/* builtin.c   by Michael Thorpe   2005-08-13 */
 
 #include <ctype.h>
 #include <limits.h>
@@ -145,15 +145,6 @@
 	return(incref((a==b)?&trueobj:&nilobj));
 }
 
-static obj *eqv(obj *a,obj *b) {
-	int i;
-
-	i=real_eqv(a,b);
-	decref(a);
-	decref(b);
-	return(incref(i?&trueobj:&nilobj));
-}
-
 static obj *ifelse(scope *s,obj *cond,obj *iftrue,obj *iffalse) {
 	decref(cond);
 	if(cond==&nilobj) {
@@ -224,7 +215,7 @@
 			decref(p);
 			continue;
 		}
-		if(!real_eqv(exception,nextloop))
+		if(exception != nextloop)
 			break;
 		decref(exception);
 		exception=incref(&nilobj);
@@ -233,7 +224,7 @@
 	}
 	decref(o);
 	decscoperef(s);
-	if(real_eqv(exception,exitloop)) {
+	if(exception==exitloop) {
 		decref(exception);
 		exception=incref(&nilobj);
 		p=exceptionvalue;
@@ -441,7 +432,6 @@
 	|| store_builtin_ns2("bit-or",bitor)
 	|| store_builtin_ns2("bit-xor",bitxor)
 	|| store_builtin_ns2("eq?",eq)
-	|| store_builtin_ns2("eqv?",eqv)
 	|| store_builtin_s3("#ifelse",ifelse)
 	|| store_builtin_ns1("isascii",isasciip)
 	|| store_builtin_ns1("isdigit",isdigitp)
--- old/cons.c	Fri Aug 12 10:01:37 2005
+++ cons.c	Sat Aug 13 20:42:00 2005
@@ -1,4 +1,4 @@
-/* cons.c   by Michael Thorpe   2005-08-12 */
+/* cons.c   by Michael Thorpe   2005-08-13 */
 
 #include <stdlib.h>
 #include <string.h>
@@ -170,10 +170,6 @@
 	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)
@@ -186,7 +182,6 @@
 	name: "cons",
 	tostring: cons_tostring,
 	dropobj: decref_cons,
-	evaluate: cons_evaluate,
-	eqv: cons_eqv
+	evaluate: cons_evaluate
 };
 
--- old/func.c	Fri Aug 12 09:55:51 2005
+++ func.c	Sat Aug 13 20:42:09 2005
@@ -1,4 +1,4 @@
-/* func.c   by Michael Thorpe   2005-08-12 */
+/* func.c   by Michael Thorpe   2005-08-13 */
 
 #include <string.h>
 #include "lisp.h"
@@ -97,10 +97,6 @@
 	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))
@@ -112,6 +108,5 @@
 	name: "func",
 	tostring: func_tostring,
 	dropobj: drop_func,
-	applyfunc: applyfunc,
-	eqv: func_eqv
+	applyfunc: applyfunc
 };
--- old/integer.c	Fri Aug 12 11:21:57 2005
+++ integer.c	Sat Aug 13 20:42:49 2005
@@ -1,4 +1,4 @@
-/* integer.c   by Michael Thorpe   2005-08-12 */
+/* integer.c   by Michael Thorpe   2005-08-13 */
 
 #include <stdio.h>
 #include "lisp.h"
@@ -16,14 +16,9 @@
 	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,
-	eqv: integer_eqv
+	tostring: integer_tostring
 };
 
 obj trueobj={&integer_objtype,{refcount:1},{i:1}};
--- old/main.c	Fri Aug 12 13:31:10 2005
+++ main.c	Sat Aug 13 19:55:06 2005
@@ -1,9 +1,9 @@
-/* main.c   by Michael Thorpe   2005-08-12 */
+/* main.c   by Michael Thorpe   2005-08-13 */
 
 #include <stdio.h>
 #include "lisp.h"
 
-int tryit() {
+static int tryit() {
 	obj *s,*o;
 	FILE *f;
 
@@ -25,7 +25,7 @@
 		return(1);
 	while(1) {
 		o=read_object(incref(s));
-		if(!o && real_eqv(exception,eoferror)) {
+		if(!o && exception==eoferror) {
 			decref(exception);
 			decref(exceptionvalue);
 			exception=incref(&nilobj);
--- old/quote.c	Fri Aug 12 10:00:36 2005
+++ quote.c	Sat Aug 13 20:42:22 2005
@@ -1,4 +1,4 @@
-/* quote.c   by Michael Thorpe   2005-08-12 */
+/* quote.c   by Michael Thorpe   2005-08-13 */
 
 #include <string.h>
 #include "lisp.h"
@@ -45,10 +45,6 @@
 	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);
@@ -59,7 +55,6 @@
 	name: "quote",
 	tostring: quote_tostring,
 	dropobj: drop_quote,
-	evaluate: quote_evaluate,
-	eqv: quote_eqv
+	evaluate: quote_evaluate
 };
 
--- old/reader.c	Wed Aug 10 14:57:57 2005
+++ reader.c	Sat Aug 13 19:57:16 2005
@@ -1,4 +1,4 @@
-/* reader.c   by Michael Thorpe   2005-08-10 */
+/* reader.c   by Michael Thorpe   2005-08-13 */
 
 #include <ctype.h>
 #include <stdlib.h>
@@ -11,7 +11,7 @@
 
 	o=read_object(incref(stream));
 	if(!o) {
-		if(real_eqv(exception,eoferror))
+		if(exception==eoferror)
 			return(throw(incref(reader_error),stream));
 		decref(stream);
 		return(0);
@@ -25,21 +25,21 @@
 
 	tmp1=read_object(incref(stream));
 	if(!tmp1) {
-		if(real_eqv(exception,eoferror))
+		if(exception==eoferror)
 			return(throw(incref(reader_error),stream));
 		decref(stream);
 		return(0);
 	}
-	if(!real_eqv(tmp1,close_paren)) {
+	if(tmp1 != close_paren) {
 		tmp2=read_object(incref(stream));
 		if(!tmp2) {
 			decref(tmp1);
-			if(real_eqv(exception,eoferror))
+			if(exception==eoferror)
 				return(throw(incref(reader_error),stream));
 			decref(stream);
 			return(0);
 		}
-		if(real_eqv(tmp2,close_paren)) {
+		if(tmp2==close_paren) {
 			decref(stream);
 			decref(tmp2);
 			return(tmp1);
@@ -61,16 +61,16 @@
 				CDR(cur)=incref(&nilobj);
 				decref(start);
 			}
-			if(real_eqv(exception,eoferror))
+			if(exception==eoferror)
 				return(throw(incref(reader_error),stream));
 			decref(stream);
 			return(0);
 		}
-		if(real_eqv(tmp,close_paren)) {
+		if(tmp==close_paren) {
 			decref(tmp);
 			break;
 		}
-		if(real_eqv(tmp,dot_word)) {
+		if(tmp==dot_word) {
 			decref(tmp);
 			if(!cur)
 				return(throw(incref(reader_error),stream));
@@ -171,6 +171,8 @@
 
 	if(stream->type != &stream_objtype)
 		return(throwtypeerror(stream));
+	if(!stream->value.stream.readable)
+		return(throwaccesserror(stream));
 	while(1) {
 		c=real_speekc(stream);
 		if(c==-1) {
--- old/scope.c	Wed Aug 10 14:58:55 2005
+++ scope.c	Sat Aug 13 19:57:11 2005
@@ -1,4 +1,4 @@
-/* scope.c   by Michael Thorpe   2005-08-10 */
+/* scope.c   by Michael Thorpe   2005-08-13 */
 
 #include <stdlib.h>
 #include <string.h>
@@ -29,7 +29,7 @@
 		scope=globalscope;
 	while(scope) {
 		for(e=scope->firstentry;e;e=e->next)
-			if(real_eqv(e->name,name))
+			if(e->name==name)
 				return(e);
 		scope=scope->parent;
 	}
--- old/string.c	Fri Aug 12 09:56:28 2005
+++ string.c	Sat Aug 13 20:42:58 2005
@@ -1,4 +1,4 @@
-/* string.c   by Michael Thorpe   2005-08-12 */
+/* string.c   by Michael Thorpe   2005-08-13 */
 
 #include <assert.h>
 #include <limits.h>
@@ -144,44 +144,50 @@
 
 static obj *substring(obj *str,obj *offobj,obj *lenobj) {
 	obj *substr;
-	unsigned long off,len;
+	signed long off,len;
+	int no_truncate=0;
 
-	if(str->type != &string_objtype) {
+	if(&string_objtype != str->type) {
 		decref(offobj);
 		decref(lenobj);
 		return(throwtypeerror(str));
 	}
-	if(offobj->type != &integer_objtype) {
+	if(&integer_objtype==offobj->type) {
+		off=offobj->value.i;
+	} else {
 		decref(str);
 		decref(lenobj);
 		return(throwtypeerror(offobj));
 	}
-	if(lenobj->type != &integer_objtype) {
+	if(&nilobj==lenobj) {
+		no_truncate=1;
+		len=0;
+	} else if(&integer_objtype==lenobj->type) {
+		len=lenobj->value.i;
+	} else {
 		decref(str);
 		decref(offobj);
 		return(throwtypeerror(lenobj));
 	}
-	off=offobj->value.i;
-	len=lenobj->value.i;
 	if(off<0)
 		off+=str->value.s.len;
-	if(len<=0)
-		len=str->value.s.len-off-len;
 	if(off<0 || off>str->value.s.len) {
 		decref(lenobj);
 		decref(str);
 		return(throwrangecheck(offobj));
 	}
 	decref(offobj);
+	if(no_truncate || len<0)
+		len+=str->value.s.len-off;
 	if(len<0) {
 		decref(str);
 		return(throwrangecheck(lenobj));
 	}
-	decref(lenobj);
 	if(off+len<0 || off+len>str->value.s.len) {
 		decref(str);
-		return(throwrangecheck(incref(&nilobj)));
+		return(throwrangecheck(lenobj));
 	}
+	decref(lenobj);
 	substr=real_new_string(str->value.s.data+off,len);
 	decref(str);
 	return(substr);
@@ -220,14 +226,6 @@
 	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)
@@ -243,7 +241,6 @@
 objtype string_objtype={
 	name: "string",
 	tostring: string_tostring,
-	dropobj: drop_string,
-	eqv: string_eqv
+	dropobj: drop_string
 };
 
--- old/throw.c	Wed Aug 10 15:05:30 2005
+++ throw.c	Sat Aug 13 19:58:15 2005
@@ -1,4 +1,4 @@
-/* throw.c   by Michael Thorpe   2005-08-10 */
+/* throw.c   by Michael Thorpe   2005-08-13 */
 
 #include "lisp.h"
 
@@ -15,7 +15,7 @@
 	obj *e,*o,*tmp;
 
 	o=evaluate(incscoperef(s),func);
-	if(!o && (type->type==&nil_objtype || real_eqv(type,exception))) {
+	if(!o && (type==exception || type==&nilobj)) {
 		decref(type);
 		s=newscope(s);
 		if(!s) {
--- old/util.c	Fri Aug 12 09:52:34 2005
+++ util.c	Sat Aug 13 20:42:32 2005
@@ -1,4 +1,4 @@
-/* util.c   by Michael Thorpe   2005-08-12 */
+/* util.c   by Michael Thorpe   2005-08-13 */
 
 #include <stdlib.h>
 #include <string.h>
@@ -99,16 +99,6 @@
 	firstobj=o;
 #endif
 	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) {
--- old/preload.lisp	Fri Aug 12 13:33:32 2005
+++ preload.lisp	Sat Aug 13 20:40:44 2005
@@ -1,4 +1,4 @@
-; preload.lisp   by Michael Thorpe   2005-08-12
+; preload.lisp   by Michael Thorpe   2005-08-13
 
 (#define '#f (= 1 2))
 (#define '#t (= 1 1))
@@ -9,7 +9,7 @@
 (#define 'get
 	(#lambda '(hash item)
 		'(#ifelse hash
-			'(#ifelse (eqv? (car (car hash)) item)
+			'(#ifelse (eq? (car (car hash)) item)
 				'(cdr (car hash))
 				'(get (cdr hash) item))
 			'#f)))
@@ -35,7 +35,9 @@
 			'o)))
 (#define '#macro-define
 	(#lambda '(macro func)
-		'(#define 'macroexpansions (cons (cons macro func) macroexpansions))))
+		'(#prog2of2
+			(#define 'macroexpansions (cons (cons macro func) macroexpansions))
+			'macro)))
 
 (#macro-define 'define
 	(#lambda '(name . value)
@@ -95,14 +97,6 @@
 ;;; From this point on we're operating on our own repl (minus the printing) ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (write-newline file)
-	(write-char file 10))
-(define (write-object file obj)
-	(write-string file (->string obj)))
-(define (dprint o)
-	(write-object #standard-out o)
-	(write-newline #standard-out))
-
 (macro-define (+ . aaa)
 	(ifelse (pair? (cdr aaa))
 		(ifelse (pair? (cdr (cdr aaa)))
@@ -171,6 +165,19 @@
 (define (append oldlist newtail)
 	(reverse (reverse/append oldlist newtail)))
 
+(define (write-newline file)
+	(write-char file 10))
+(define (write-object file obj)
+	(write-string file (->string obj)))
+(define (dprint . o)
+	(while o
+		(write-object #standard-out (car o))
+		(define-local o (cdr o))
+		(if o
+			(write-char #standard-out 32)))
+	(write-newline #standard-out)
+	#f)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Now we reimplement the reader and read-object ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -196,6 +203,12 @@
 (define (define-character-macro char macro)
 	(define character-macros (cons (cons char macro) character-macros)))
 
+(define (get-using-= hash item)
+	(while hash
+		(if (= (car (car hash)) item)
+			(exit-loop (cdr (car hash))))
+		(define hash (cdr hash))))
+
 (define (expand-string oldstring)
 	(define-local newstring (new-string (+ 512 (string-length oldstring))))
 	(define-local i 0)
@@ -336,7 +349,7 @@
 			(exit-loop))
 		(unless (isascii c)
 			(exit-loop))
-		(if (get character-macros c)
+		(if (get-using-= character-macros c)
 			(exit-loop))
 		(define-local c (read-char stream)))
 	(define buffer (substring buffer 0 i))
@@ -350,7 +363,7 @@
 		(define-local c (read-char stream)))
 	(unless (isascii c)
 		(throw 'reader-error stream))
-	(define macro (get character-macros c))
+	(define macro (get-using-= character-macros c))
 	(ifelse macro
 		(macro stream)
 		(read-token stream c)))
@@ -384,7 +397,7 @@
 ;
 (define (switch-handle var cases)
 	(ifelse cases
-		(ifelse (eqv? 'else (caar cases))
+		(ifelse (eq? 'else (caar cases))
 			(cons 'progn (cdar cases))
 			(ifelse (caar cases)
 				`(ifelse (eqv? ,var ,(caaar cases))
@@ -400,6 +413,44 @@
 	`(progn
 		(define-local ,var ,key)
 		,(switch-handle var cases)))
+
+(define (string-equivalent a b)
+	(define-local c (string-length a))
+	(ifelse (= c (string-length b))
+		(loop
+			(if (= c 0)
+				(exit-loop #t))
+			(define-local c (- c 1))
+			(if (<> (get-char a c) (get-char b c))
+				(exit-loop #f)))
+		#f))
+; This short-circuit macro is necessary to prevent switch/eqv? from getting
+; into an endless mutual recursion loop:
+(macro-define (eqv? a b)
+	(ifelse
+		(or
+			(and (eq? 'quote (object-type a)) (eq? 'word (object-type (evaluate a))))
+			(and (eq? 'quote (object-type b)) (eq? 'word (object-type (evaluate b)))))
+		(list 'eq? a b)
+		dont-macro-expand))
+(define (eqv? a b)
+	(ifelse (eq? a b)
+		#t
+		(ifelse (eq? (object-type a) (object-type b))
+			(switch (object-type a)
+				(('integer)
+					(= a b))
+				(('cons)
+					(and
+						(eqv? (car a) (car b))
+						(eqv? (cdr a) (cdr b))))
+				(('quote)
+					(eqv? (evaluate a) (evaluate b)))
+				(('string)
+					(string-equivalent a b))
+				(else
+					#f))
+			#f)))
 
 (define (cars arg) ; ((1 2) (3 4)) => (1 3)
 	(define-local stack '())
