--- old/CHANGELOG Fri Aug 26 07:14:19 2005 +++ CHANGELOG Sun Mar 12 11:52:05 2006 @@ -1,4 +1,4 @@ -2005-07-13: 1.0: Initial release. Has basic I/O and a "soft" repl loop +2005-07-13: 1.0: Initial release. Has basic I/O and a "soft" repl loop. (i.e., one written in lisp). 2005-07-15: 1.1: General cleanup and refcount bug fix in builtin.c. @@ -55,3 +55,9 @@ Removed define-local. Changed define_local into real_define and made it not decref its arguments. Removed subscope. + +2006-03-12: 1.7: Added defined? macro. +Changed #map to take a variable name to use as mapvar. +Added #set. +Changed #define to throw an error if the name is already defined. +Changed #define to only deal with globalscope. --- old/Makefile Fri Aug 26 07:12:28 2005 +++ Makefile Fri Aug 26 07:16:47 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.6 +VERSION=1.7 -include .local.Makefile $(BUILDDIR)mikelisp : $(SRCS:%.c=$(BUILDDIR)%.o) lisp.h --- old/lisp.h Fri Aug 26 00:54:43 2005 +++ lisp.h Sun Mar 12 11:47:47 2006 @@ -1,4 +1,4 @@ -/* lisp.h by Michael Thorpe 2005-08-26 */ +/* lisp.h by Michael Thorpe 2006-03-12 */ #ifndef OBJ_H #define OBJ_H @@ -115,7 +115,6 @@ /* scope.c */ void drop_scope(scope *scope); #define decscoperef(s) do{if(!--(s)->refcount)drop_scope(s);}while(0) -obj *define(scope *scope,obj *name,obj *value); #define incscoperef(s) ((s)->refcount++,(s)) obj *lookup(scope *scope,obj *name); scope *newscope(scope *parent); --- old/builtin.c Fri Aug 26 07:13:33 2005 +++ builtin.c Sun Mar 12 19:29:26 2006 @@ -1,4 +1,4 @@ -/* builtin.c by Michael Thorpe 2005-08-26 */ +/* builtin.c by Michael Thorpe 2006-03-12 */ #include #include @@ -8,7 +8,6 @@ static obj *exitloop; static obj *nextloop; static obj *overflowerror; -static obj *mapvar; static obj *add(obj *a,obj *b) { long result; @@ -234,7 +233,7 @@ return(0); } -static obj *map(scope *s,obj *expr,obj *list) { +static obj *map(scope *s,obj *var,obj *expr,obj *list) { obj *new,*old,*start,*tmp; unsigned long length; @@ -245,8 +244,9 @@ for(new=list;&cons_objtype==new->type;new=new->value.c.d) length++; if(!length) { - if(real_define(s,mapvar,list)) + if(real_define(s,var,list)) goto fail_nostart; + decref(var); decref(list); return(evaluate(s,expr)); } @@ -256,7 +256,7 @@ new=start; old=list; while(1) { - if(real_define(s,mapvar,CAR(old))) + if(real_define(s,var,CAR(old))) goto fail; tmp=evaluate(incscoperef(s),incref(expr)); if(!tmp) @@ -269,7 +269,7 @@ new=CDR(new); } if(&nilobj != old) { - if(real_define(s,mapvar,old)) + if(real_define(s,var,old)) goto fail; tmp=evaluate(incscoperef(s),incref(expr)); if(!tmp) @@ -278,6 +278,7 @@ CDR(new)=tmp; } decscoperef(s); + decref(var); decref(expr); decref(list); return(start); @@ -286,6 +287,7 @@ fail_nostart: decscoperef(s); fail_noscope: + decref(var); decref(expr); decref(list); return(0); @@ -402,7 +404,6 @@ || !(exitloop=newword("exit-loop",9)) || !(nextloop=newword("next-loop",9)) || !(overflowerror=newword("overflow",8)) - || !(mapvar=newword("#object",7)) || store_builtin_ns2("*",mul) || store_builtin_ns2("+",add) || store_builtin_ns2("-",sub) @@ -424,10 +425,10 @@ || store_builtin_ns1("isspace",isspacep) || store_builtin_ns2("#lambda",lambda) || store_builtin_s1("#loop",loop) - || store_builtin_s2("#map",map) + || store_builtin_s3("#map",map) || store_builtin_s2("#prog2of2",prog2of2) || store_builtin_ns1("->string",tostring)) return(1); - INC_KNOWN_OBJECTS(5); + INC_KNOWN_OBJECTS(4); return(0); } --- old/scope.c Fri Aug 26 00:54:43 2005 +++ scope.c Sun Mar 12 11:47:11 2006 @@ -1,4 +1,4 @@ -/* scope.c by Michael Thorpe 2005-08-26 */ +/* scope.c by Michael Thorpe 2006-03-12 */ #include #include @@ -19,7 +19,7 @@ static scope topscope={1,0,0}; scope *globalscope=0; -static obj *undefined_error; +static obj *already_defined_error,*undefined_error; /* real_lookup doesn't decref/incref anything */ static entry *real_lookup(scope *scope,obj *name) { @@ -36,15 +36,13 @@ return(0); } -obj *define(scope *s,obj *name,obj *value) { +obj *define(obj *name,obj *value) { entry *e; - e=real_lookup(s,name); - decscoperef(s); + e=real_lookup(globalscope,name); if(e) { - decref(e->value); - e->value=value; - return(name); + decref(value); + return(throw(incref(already_defined_error),name)); } if(real_define(globalscope,name,value)) { decref(value); @@ -152,6 +150,20 @@ return(0); } +obj *set(scope *s,obj *name,obj *value) { + entry *e; + + e=real_lookup(s,name); + decscoperef(s); + if(!e) { + decref(value); + return(throw(incref(undefined_error),name)); + } + decref(e->value); + e->value=value; + return(name); +} + int store_builtin(unsigned int numargs,unsigned int wantscope,const char *name,obj *(*rawfunc)()) { obj *key,*func; int i; @@ -188,11 +200,13 @@ int scope_init() { if(!(globalscope=newscope(incscoperef(&topscope))) + || !(already_defined_error=newword("already-defined",15)) || !(undefined_error=newword("undefined",9)) - || store_builtin_s2("#define",define) - || store_builtin_s3("#let",let)) + || store_builtin_ns2("#define",define) + || store_builtin_s3("#let",let) + || store_builtin_s2("#set",set)) return(1); - INC_KNOWN_OBJECTS(1); + INC_KNOWN_OBJECTS(2); return(0); } --- old/preload.lisp Fri Aug 26 07:13:07 2005 +++ preload.lisp Sun Mar 12 19:33:58 2006 @@ -1,4 +1,4 @@ -; preload.lisp by Michael Thorpe 2005-08-26 +; preload.lisp by Michael Thorpe 2006-03-12 (#define '#f (= 1 2)) (#define '#t (= 1 1)) @@ -26,14 +26,14 @@ '(#let 'expansion (macro . cdr-o) '(#ifelse (eq? expansion dont-macro-expand) '#f - '(#define 'o (macro-expand expansion))))) + '(#set 'o (macro-expand expansion))))) '#f)) - '(#map '(macro-expand #object) o)) + '(#map 'o '(macro-expand o) o)) 'o))) (#define '#macro-define (#lambda '(macro func) '(#prog2of2 - (#define 'macroexpansions (cons (cons macro func) macroexpansions)) + (#set 'macroexpansions (cons (cons macro func) macroexpansions)) 'macro))) (#macro-define 'define @@ -67,6 +67,11 @@ '(car aaa)) 'aaa) 'aaa))) +(#macro-define 'set + (#lambda '(name . value) + '(#ifelse (pair? name) + '(list '#set (quote (car name)) (list 'lambda (cdr name) (cons 'progn value))) + '(list '#set (quote name) . value)))) (#macro-define 'catch (#lambda '(cond body handler) @@ -80,8 +85,8 @@ (#lambda 'body '(list '#loop (quote (macro-expand (cons 'progn body)))))) (#macro-define 'map - (#lambda '(mapper . args) - '(list '#map (quote (macro-expand mapper)) . args))) + (#lambda '(var mapper . args) + '(list '#map (quote var) (quote (macro-expand mapper)) . args))) (#define 'evaluate-file (#lambda '(file) @@ -123,6 +128,12 @@ (ifelse b (list 'ifelse a (cons 'and b) #f) a)) +(macro-define (defined? word) + (ifelse (eq? 'word (object-type word)) + (list 'catch ''undefined + (list 'progn word #t) + #f) + (throw 'type-error word))) (macro-define (exit-loop . value) (list 'throw ''exit-loop (cons 'progn value))) (macro-define (if bool . progs) @@ -150,8 +161,8 @@ (define (reverse/append straight newtail) (while straight - (define newtail (cons (car straight) newtail)) - (define straight (cdr straight))) + (set newtail (cons (car straight) newtail)) + (set straight (cdr straight))) newtail) (define (reverse straight) (reverse/append straight '())) @@ -165,7 +176,7 @@ (define (dprint . o) (while o (write-object #standard-out (car o)) - (define o (cdr o)) + (set o (cdr o)) (if o (write-char #standard-out 32))) (write-newline #standard-out) @@ -194,13 +205,13 @@ (define character-macros '()) (define (define-character-macro char macro) - (define character-macros (cons (cons char macro) character-macros))) + (set 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)))) + (set hash (cdr hash)))) (define (expand-string oldstring) (let ((i 0) @@ -236,10 +247,10 @@ (ifelse (eq? o '.) (ifelse reverse-list (progn - (define new-list (submacro-dot stream)) + (set new-list (submacro-dot stream)) (exit-loop)) (throw 'reader-error stream)) - (define reverse-list (cons o reverse-list)))))) + (set reverse-list (cons o reverse-list)))))) (throw 'reader-error stream)) (reverse/append reverse-list new-list))) (define-character-macro 40 macro-openparen) @@ -257,7 +268,7 @@ (define (macro-semicolon stream) (let ((c 0)) (while (and (<> c 10) (<> c 13)) - (define c (read-char stream)))) + (set c (read-char stream)))) (read-object stream)) (define-character-macro 59 macro-semicolon) @@ -278,10 +289,10 @@ ; (newtail '())) ; (while obj ; (if (eq? unquote-identifier (car obj)) -; (define newtail (cdr obj)) +; (set newtail (cdr obj)) ; (exit-loop)) -; (define stack (cons (quasiquote (car obj)) stack)) -; (define obj (cdr obj))) +; (set stack (cons (quasiquote (car obj)) stack)) +; (set obj (cdr obj))) ; (reverse/append stack newtail))) ; (quote obj)) ; obj)) @@ -291,7 +302,7 @@ (ifelse (pair? obj) (ifelse (eq? unquote-identifier (car obj)) (cdr obj) - (cons 'list (map (quasiquote #object) obj))) + (cons 'list (map obj (quasiquote obj) obj))) (quote obj)) obj)) @@ -308,20 +319,20 @@ (string (new-string 512))) (loop (if (= i (string-length string)) - (define string (expand-string string))) - (define c + (set string (expand-string string))) + (set c (catch 'end-of-file (read-char stream) (throw 'reader-error stream))) (if (= c 34) ; 34 = ASCII double quote (exit-loop)) (if (= c 92) ; 92 = ASCII backslash - (define c + (set c (catch 'end-of-file (read-char stream) (throw 'reader-error stream)))) (put-char string i c) - (define i (+ i 1))) + (set i (+ i 1))) (substring string 0 i))) (define-character-macro 34 macro-doublequote) @@ -330,11 +341,11 @@ (i 0)) (loop (if (= i (string-length buffer)) - (define buffer (expand-string buffer))) + (set buffer (expand-string buffer))) (put-char buffer i c) - (define i (+ i 1)) + (set i (+ i 1)) (catch 'end-of-file - (define c (peek-char stream)) + (set c (peek-char stream)) (exit-loop)) (if (isspace c) (exit-loop)) @@ -342,19 +353,20 @@ (exit-loop)) (if (get-using-= character-macros c) (exit-loop)) - (define c (read-char stream))) - (define buffer (substring buffer 0 i)) + (set c (read-char stream))) + (set buffer (substring buffer 0 i)) (catch 'type-error (string->integer buffer) (string->symbol buffer)))) -(define (read-object stream) - (let ((c 32)) ; 32 = ASCII space +(set (read-object stream) + (let ((c 32) ; 32 = ASCII space + (macro #f)) (while (isspace c) - (define c (read-char stream))) + (set c (read-char stream))) (unless (isascii c) (throw 'reader-error stream)) - (define macro (get-using-= character-macros c)) + (set macro (get-using-= character-macros c)) (ifelse macro (macro stream) (read-token stream c)))) @@ -379,20 +391,20 @@ (define (cars arg) ; ((1 2) (3 4)) => (1 3) (let ((stack '())) (while arg - (define stack (cons (caar arg) stack)) - (define arg (cdr arg))) + (set stack (cons (caar arg) stack)) + (set arg (cdr arg))) (reverse stack))) (define (cdrs arg) ; ((1 2) (3 4)) => ((2) (4)) (let ((stack '())) (while arg - (define stack (cons (cdar arg) stack)) - (define arg (cdr arg))) + (set stack (cons (cdar arg) stack)) + (set arg (cdr arg))) (reverse stack))) (define (cadrs arg) ; ((1 2) (3 4)) => (2 4) (let ((stack '())) (while arg - (define stack (cons (cadar arg) stack)) - (define arg (cdr arg))) + (set stack (cons (cadar arg) stack)) + (set arg (cdr arg))) (reverse stack))) (define (string-eqv? a b) @@ -401,7 +413,7 @@ (loop (if (= c 0) (exit-loop #t)) - (define c (- c 1)) + (set c (- c 1)) (if (<> (get-char a c) (get-char b c)) (exit-loop #f))) #f))) @@ -449,7 +461,7 @@ (macro-define (switch key . cases) (let ((var (unique-word))) `(progn - (define ,var ,key) + (set ,var ,key) ,(switch-handle var cases)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -471,11 +483,11 @@ (let ((scratchspace #f)) (loop (if prompt (write-string out prompt)) - (define scratchspace + (set scratchspace (catch 'end-of-file (read-object in) (progn (if prompt (write-newline out)) (exit-loop)))) - (define scratchspace + (set scratchspace (catch #f (evaluate (macro-expand scratchspace)) (progn (show-error #exception #exceptionvalue) (ifelse prompt (next-loop) (exit-loop)))))