--- old/CHANGELOG 2006-08-15 00:24:02.000000000 -0700 +++ CHANGELOG 2006-08-19 02:47:29.000000000 -0700 @@ -71,3 +71,12 @@ Added member function. Improved quasiquote to handle things like `(foo . ,(car bar)). +2006-08-19: 1.10: Deleted isasciip, isdigitp, and isspacep from builtin.c. +Deleted stream? and isinlist functions from preload.lisp. +Moved a bunch of functions below the (evaluate-file #preload.lisp) line. +Moved member and load-file to better places in preload.lisp. +Cleaned up documentation in preload.lisp. +Added close-parenthesis and used it in place of '). +Added isascii? and isspace? functions to preload.lisp. +Changed definition of let@ to evaluate in order. + --- old/Makefile 2006-07-14 21:50:16.000000000 -0700 +++ Makefile 2006-08-15 00:24:40.000000000 -0700 @@ -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.9 +VERSION=1.10 -include .local.Makefile $(BUILDDIR)mikelisp : $(SRCS:%.c=$(BUILDDIR)%.o) lisp.h --- old/builtin.c 2006-03-12 19:29:26.000000000 -0800 +++ builtin.c 2006-08-19 02:23:55.000000000 -0700 @@ -1,4 +1,4 @@ -/* builtin.c by Michael Thorpe 2006-03-12 */ +/* builtin.c by Michael Thorpe 2006-08-19 */ #include #include @@ -155,42 +155,6 @@ } } -static obj *isasciip(obj *a) { - int result; - - if(a->type != &integer_objtype) - return(throwtypeerror(a)); - if(a->value.i<0 || a->value.i>UCHAR_MAX) - return(throwrangecheck(a)); - result=isascii((int)a->value.i); - decref(a); - return(incref(result?&trueobj:&nilobj)); -} - -static obj *isdigitp(obj *a) { - int result; - - if(a->type != &integer_objtype) - return(throwtypeerror(a)); - if(a->value.i<0 || a->value.i>UCHAR_MAX) - return(throwrangecheck(a)); - result=isdigit((int)a->value.i); - decref(a); - return(incref(result?&trueobj:&nilobj)); -} - -static obj *isspacep(obj *a) { - int result; - - if(a->type != &integer_objtype) - return(throwtypeerror(a)); - if(a->value.i<0 || a->value.i>UCHAR_MAX) - return(throwrangecheck(a)); - result=isspace((int)a->value.i); - decref(a); - return(incref(result?&trueobj:&nilobj)); -} - static obj *lambda(obj *args,obj *prog) { obj *o; @@ -420,9 +384,6 @@ || store_builtin_ns2("bit-xor",bitxor) || store_builtin_ns2("eq?",eq) || store_builtin_s3("#ifelse",ifelse) - || store_builtin_ns1("isascii",isasciip) - || store_builtin_ns1("isdigit",isdigitp) - || store_builtin_ns1("isspace",isspacep) || store_builtin_ns2("#lambda",lambda) || store_builtin_s1("#loop",loop) || store_builtin_s3("#map",map) --- old/preload.lisp 2006-08-15 00:20:19.000000000 -0700 +++ preload.lisp 2006-08-19 02:40:42.000000000 -0700 @@ -1,9 +1,8 @@ -; preload.lisp by Michael Thorpe 2006-08-15 +; preload.lisp by Michael Thorpe 2006-08-19 (#define '#f (= 1 2)) (#define '#t (= 1 1)) (#define 'pair? (#lambda '(o) '(eq? 'cons (object-type o)))) -(#define 'stream? (#lambda '(o) '(eq? 'stream (object-type o)))) (#define 'list (#lambda 'aaa 'aaa)) (#define 'get @@ -36,28 +35,6 @@ (#set 'macroexpansions (cons (cons macro func) macroexpansions)) 'macro))) -(#macro-define 'define - (#lambda '(name . value) - '(#ifelse (pair? name) - '(list '#define (quote (car name)) (list 'lambda (cdr name) (cons 'progn value))) - '(list '#define (quote name) . value)))) -(#macro-define 'lambda - (#lambda '(args . prog) - '(list '#lambda (quote args) (quote (macro-expand (cons 'progn prog)))))) -(#macro-define 'let - (#lambda '(vars . prog) - '(#ifelse (pair? vars) - '(list - '#let - (quote (car (car vars))) - (cons 'progn (cdr (car vars))) - (quote (macro-expand (cons 'let (cons (cdr vars) prog))))) - '(cons 'progn prog)))) -(#macro-define 'macro-define - (#lambda '(name . value) - '(#ifelse (pair? name) - '(list '#macro-define (quote (car name)) (list 'lambda (cdr name) (cons 'progn value))) - '(list '#macro-define (quote name) . value)))) (#macro-define 'progn (#lambda 'aaa '(#ifelse aaa @@ -67,26 +44,14 @@ '(car aaa)) 'aaa) 'aaa))) -(#macro-define 'set +(#macro-define 'lambda + (#lambda '(args . prog) + '(list '#lambda (quote args) (quote (macro-expand (cons 'progn prog)))))) +(#macro-define 'macro-define (#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) - '(list '#catch cond - (quote (macro-expand body)) - (quote (macro-expand handler))))) -(#macro-define 'ifelse - (#lambda '(cond iftrue iffalse) - '(list '#ifelse cond (quote (macro-expand iftrue)) (quote (macro-expand iffalse))))) -(#macro-define 'loop - (#lambda 'body - '(list '#loop (quote (macro-expand (cons 'progn body)))))) -(#macro-define 'map - (#lambda '(var mapper . args) - '(list '#map (quote var) (quote (macro-expand mapper)) . args))) + '(list '#macro-define (quote (car name)) (list 'lambda (cdr name) (cons 'progn value))) + '(list '#macro-define (quote name) . value)))) (#define 'evaluate-file (#lambda '(file) @@ -100,6 +65,40 @@ ;;; From this point on we're operating on our own repl (minus the printing) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(macro-define (ifelse cond iftrue iffalse) + (list '#ifelse cond (quote (macro-expand iftrue)) (quote (macro-expand iffalse)))) +(macro-define (define name . value) + (ifelse (pair? name) + (list '#define (quote (car name)) (list 'lambda (cdr name) (cons 'progn value))) + (list '#define (quote name) . value))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Now we have ifelse, progn, and the ability to make functions and macros ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(macro-define (catch cond body handler) + (list '#catch cond + (quote (macro-expand body)) + (quote (macro-expand handler)))) +(macro-define (let vars . prog) + (ifelse (pair? vars) + (list + '#let + (quote (car (car vars))) + (cons 'progn (cdr (car vars))) + (quote (macro-expand (cons 'let (cons (cdr vars) prog))))) + (cons 'progn prog))) +(macro-define (loop . body) + (list '#loop (quote (macro-expand (cons 'progn body))))) +(macro-define (set name . value) + (ifelse (pair? name) + (list '#set (quote (car name)) (list 'lambda (cdr name) (cons 'progn value))) + (list '#set (quote name) . value))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Now we also have catch, let, loop, and set ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (macro-define (+ . aaa) (ifelse (pair? (cdr aaa)) (ifelse (pair? (cdr (cdr aaa))) @@ -140,16 +139,8 @@ (list 'ifelse bool (cons 'progn progs) #f)) -(define (member item list) - (ifelse list - (ifelse (pair? list) - (ifelse (eq? item (car list)) - list - (member item (cdr list))) - (ifelse (eq? item list) - list - #f)) - #f)) +(macro-define (map var mapper . args) + (list '#map (quote var) (quote (macro-expand mapper)) . args)) (macro-define (next-loop) (list 'throw ''next-loop #f)) (macro-define (not a) (list 'ifelse a #f #t)) (macro-define (or a . b) @@ -169,6 +160,21 @@ (cons 'progn body) (list 'throw ''exit-loop #f)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Now we have all our macros defined; next come some functions ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (member item list) + (ifelse list + (ifelse (pair? list) + (ifelse (eq? item (car list)) + list + (member item (cdr list))) + (ifelse (eq? item list) + list + #f)) + #f)) + (define (reverse/append straight newtail) (while straight (set newtail (cons (car straight) newtail)) @@ -196,18 +202,21 @@ ;;; Now we reimplement the reader and read-object ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; ; This object is placed in the CAR of a cons to indicate that quasiquote ; should replace the cons with the CDR of the cons (but not quoted). ; For example, if read-object is about to read: ; ,bar ; it will call macro-comma, which calls read-object, gets bar, and returns: -; ('(unquote . identifier) . bar) +; (unquote-identifier . bar) +; where unquote-identifier is the value defined below, and bar is the +; literal atom read. ; ; If read-object is called where the stream starts with: ; `(foo ,bar baz) ; then the backtick will be read, macro-backtick will call read-object and ; pass the following to quasiquote: -; (foo ('(unquote . identifier) . bar) baz) +; (foo (unquote-identifier . bar) baz) ; Then quasiquote will do its thing and return: ; (list 'foo bar 'baz) ; @@ -241,12 +250,17 @@ (throw 'reader-error stream))) (define-character-macro 39 macro-singlequote) +; +; This will be returned by read-object when a close parenthesis is read. +; +(define close-parenthesis '(close . parenthesis)) + ; FIXME: We should use peek-char so the stream will point to the offending ; token if it's not a close parenthesis (define (submacro-dot stream) (catch 'end-of-file (let ((o (read-object stream))) - (ifelse (not (eq? ') (read-object stream))) + (ifelse (not (eq? close-parenthesis (read-object stream))) (throw 'reader-error stream) o)) (throw 'reader-error stream))) @@ -257,7 +271,7 @@ (catch 'end-of-file (loop (let ((o (read-object stream))) - (ifelse (eq? o ')) + (ifelse (eq? o close-parenthesis) (exit-loop) (ifelse (eq? o '.) (ifelse reverse-list @@ -271,7 +285,7 @@ (define-character-macro 40 macro-openparen) (define (macro-closeparen stream) - ')) + close-parenthesis) (define-character-macro 41 macro-closeparen) (define (macro-comma stream) @@ -328,6 +342,11 @@ (substring string 0 i))) (define-character-macro 34 macro-doublequote) +(define (isspace c) ; space, FF, NL, CR, and horizontal and vertical tabs + (or (= c 32) (and (< 8 c) (< c 14)))) +(define (isascii c) ; space through tilde + (and (< 31 c) (< c 127))) + (define (read-token stream c) (let ((buffer (new-string 512)) (i 0)) @@ -363,9 +382,9 @@ (macro stream) (read-token stream c)))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Some more utility routines ;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; At this point we're running on our own read-object ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (macro-define (caar o) `(car (car ,o))) (macro-define (cadr o) `(car (cdr ,o))) @@ -399,24 +418,26 @@ (set arg (cdr arg))) (reverse stack))) +(define (load-file filename) + (evaluate-file (open-file filename "r"))) + ; ; my let@ is like Lisp's let, whereas my let is like Lisp's let*. ; (macro-define (let@ vars . body) (ifelse vars (ifelse (cdr vars) - (let ((varnames (reverse (cdr (cars vars)))) - (firstvar (caar vars))) - (set body (list 'progn `(set ,firstvar (car ,firstvar)) . body)) + (let ((varnames (cars (cdr vars))) + (firstvar (caar vars)) + (value firstvar) + (values #f)) (while varnames - (set body - `(let ((,(car varnames) (car ,firstvar))) - (set ,firstvar (cdr ,firstvar)) - ,body)) + (set value `(cdr ,value)) + (set values `((,(car varnames) (car ,value)) . ,values)) (set varnames (cdr varnames))) `(let - ((,firstvar ,(cons 'list (reverse (cadrs vars))))) - ,body)) + ((,firstvar (list . ,(cadrs vars))) . ,(reverse values)) + (progn (set ,firstvar (car ,firstvar)) . ,body))) (list 'let vars . body)) (list 'progn . body))) @@ -449,7 +470,7 @@ #f)))))))) ; -; switch (takes the place of case) +; switch (takes the place of cond) ; ; Format: ; (switch key @@ -481,12 +502,6 @@ ; bind operates similar to the PostScript bind operator. It recursively ; looks up all words and substitutes the values of the words it finds. ; -(define (isinlist item list) - (ifelse (pair? list) - (ifelse (eq? item (car list)) - #t - (isinlist item (cdr list))) - (eq? item list))) (define (bind bind#obj . bind#nowords) (switch (object-type bind#obj) (('cons) (map a (bind a . bind#nowords) bind#obj)) @@ -495,7 +510,7 @@ (#lambda bind#nowords (bind (prog-of-func bind#obj) . bind#nowords))) (('quote) (quote (bind (evaluate bind#obj) . bind#nowords))) (('word) - (ifelse (isinlist bind#obj bind#nowords) + (ifelse (member bind#obj bind#nowords) bind#obj (catch 'undefined (evaluate bind#obj) bind#obj))) (else bind#obj))) @@ -504,9 +519,6 @@ ;;; And here's our repl ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (load-file filename) - (evaluate-file (open-file filename "r"))) - (define (show-error error errorvalue) (write-newline #standard-out) (write-string #standard-out "EXCEPTION: ")