// (define (pair? o) (eq? (object-type o) 'cons)) // (#define 'pair? (byte-compile '(o) '(eq? (object-type o) 'cons))) // (#lambda "\x81#IOL=\x81R" '(cons)) // (#lambda "\x81#IOL=PR" '(cons)) s=new_string("\x81#IOL=PR",8); if(!s) return(1); c=INCREF(&nilobj); o=new_word("cons",4); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("pair?",5); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (quoted? o) (eq? (object-type o) 'quote)) // (#define 'quoted? (byte-compile '(o) '(eq? (object-type o) 'quote))) // (#lambda "\x81#IOL=\x81R" '(quote)) // (#lambda "\x81#IOL=PR" '(quote)) s=new_string("\x81#IOL=PR",8); if(!s) return(1); c=INCREF(&nilobj); o=new_word("quote",5); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("quoted?",7); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (word? o) (eq? (object-type o) 'word)) // (#define 'word? (byte-compile '(o) '(eq? (object-type o) 'word))) // (#lambda "\x81#IOL=\x81R" '(word)) // (#lambda "\x81#IOL=PR" '(word)) s=new_string("\x81#IOL=PR",8); if(!s) return(1); c=INCREF(&nilobj); o=new_word("word",4); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("word?",5); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (not o) (ifelse o #f #t)) // (#define 'not (byte-compile '(o) '(#ifelse o '#f '#t))) // (#lambda "\x81#I\x83\x46\x30\x82G0!\x81R" '#f) // (#lambda "\x81#I\x83\x46\x44\x30R0!PR" '#f) s=new_string("\x81#I\x83\x46\x44\x30R0!PR",12); if(!s) return(1); c=INCREF(&nilobj); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("not",3); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (get hash item) (if hash (ifelse (eq? (car (car hash)) item) (cdr (car hash)) (get (cdr hash) item)))) // (#define 'get (byte-compile '(hash item) '(#ifelse hash '(#ifelse (eq? (car (car hash)) item) '(cdr (car hash)) '(get (cdr hash) item)) '#f))) // (#lambda "\x82#\x81I\x9A\x46\x81Iaa\x81I=\x86\x46\x81Iad\x89G\x81Id\x81ILl\x82\x43\x81G0\x82R" '(get)) // (#lambda "\x82#\x81I\x9A\x46\x81Iaa\x81I=\x88\x46\x81Iad\x81PDR\x81Id\x81PLl\x82r0\x81PDR" '(get)) s=new_string("\x82#\x81I\x9A\x46\x81Iaa\x81I=\x88\x46\x81Iad\x81PDR\x81Id\x81PLl\x82r0\x81PDR",37); if(!s) return(1); c=INCREF(&nilobj); o=new_word("get",3); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("get",3); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (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 'member (byte-compile '(item list) '(#ifelse list '(#ifelse (pair? list) '(#ifelse (eq? item (car list)) 'list '(member item (cdr list))) '(#ifelse (eq? item list) 'list '#f)) '#f))) // (#lambda "\x82#I\xA7\x46Ip\x96\x46\x81I\x81Ia=\x83\x46I\x89G\x81I\x81IdLl\x82\x43\x8BG\x81I\x81I=\x83\x46I\x81G0\x81G0\x82R" '(member)) // (#lambda "\x82#I\xA9\x46Ip\x97\x46\x81I\x81Ia=\x82\x46PR\x81I\x81Id\x81P\x81PLl\x82r\x81I\x81I=\x82\x46PR0\x81PDR0\x81PDR" '(member)) s=new_string("\x82#I\xA9\x46Ip\x97\x46\x81I\x81Ia=\x82\x46PR\x81I\x81Id\x81P\x81PLl\x82r\x81I\x81I=\x82\x46PR0\x81PDR0\x81PDR",51); if(!s) return(1); c=INCREF(&nilobj); o=new_word("member",6); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("member",6); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (reverse/append straight newtail) (#append/reversed newtail straight)) // (#define 'reverse/append (byte-compile '(straight newtail) '(#append/reversed newtail straight))) // (#lambda "\x82#I\x82II\x8B\x46Ia\x82Ic\x81PdI\xF5TD\x82R" '#f) // (#lambda "\x82#I\x82II\x8B\x46Ia\x82Ic\x81PdI\xF5TD\x81PDR" '#f) s=new_string("\x82#I\x82II\x8B\x46Ia\x82Ic\x81PdI\xF5TD\x81PDR",24); if(!s) return(1); c=INCREF(&nilobj); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("reverse/append",14); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (write-newline file) (write-char file 10)) // (#define 'write-newline (byte-compile '(file) '(write-char file 10))) // (#lambda "\x81#I\x8AiLl\x82\x43\x81R" '(write-char)) // (#lambda "\x81#I\x8AiX\x81PLl\x82r" '(write-char)) s=new_string("\x81#I\x8AiX\x81PLl\x82r",12); if(!s) return(1); c=INCREF(&nilobj); o=new_word("write-char",10); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("write-newline",13); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (write-object file obj) (ifelse (eq? obj #t) (write-string file "#t") (write-string file (->string obj)))) // (#define 'write-object (byte-compile '(file obj) '(#ifelse (eq? obj #t) '(write-string file "#t") '(write-string file (->string obj))))) // (#lambda "\x82#I0!=\x8A\x46\x81IL\x81Ll\x82\x43\x8EG\x81I\x81I\x82Ll\x81\x43\x81Ll\x82\x43\x82R" '("#t" write-string ->string)) // (#lambda "\x82#I0!=\x8C\x46\x81IL\x81P\x81P\x81Ll\x82r\x81I\x81I\x82Ll\x81\x43\x81P\x81P\x81Ll\x82r" '("#t" write-string ->string)) s=new_string("\x82#I0!=\x8C\x46\x81IL\x81P\x81P\x81Ll\x82r\x81I\x81I\x82Ll\x81\x43\x81P\x81P\x81Ll\x82r",38); if(!s) return(1); c=INCREF(&nilobj); o=new_word("->string",8); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("write-string",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_string("#t",2); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("write-object",12); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (#dprint o) (while o (write-object #standard-out (car o)) (set o (cdr o)) (if o (write-char #standard-out 32))) (write-newline #standard-out) #f) // (#define '#dprint (byte-compile '(o) '(#prog2of2 (#loop '(#ifelse o '(#prog2of2 (write-object #standard-out (car o)) '(#prog2of2 (#set 'o (cdr o)) '(#ifelse o '(write-char #standard-out 32) '#f))) '(#exit-loop #f))) '(#prog2of2 (write-newline #standard-out) '#f)))) // (#lambda "\x81#I\xA2\x46Ll\x81Ia\x81Ll\x82\x43\x44IdI\x81PDI\x8B\x46Ll\xA0i\x82Ll\x82\x43\x81G0\x83G0\x83GD\xD5GDLl\x83Ll\x81\x43\x44\x30\x81R" '(#standard-out write-object write-char write-newline)) // (#lambda "\x81#I\x9D\x46Ll\x81Ia\x81Ll\x82\x43\x44\x64I\x8C\x46Ll\xA0i\x82Ll\x82\x43\x44\xE2G\xE0GLl\x83Ll\x81\x43\x81\x44\x30R" '(#standard-out write-object write-char write-newline)) s=new_string("\x81#I\x9D\x46Ll\x81Ia\x81Ll\x82\x43\x44\x64I\x8C\x46Ll\xA0i\x82Ll\x82\x43\x44\xE2G\xE0GLl\x83Ll\x81\x43\x81\x44\x30R",45); if(!s) return(1); c=INCREF(&nilobj); o=new_word("write-newline",13); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("write-char",10); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("write-object",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("#standard-out",13); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("#dprint",7); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (macro-define (dprint o) (list '#dprint (cons 'list (cdr o)))) // (#macro-define 'dprint (byte-compile '(o) '(cons '#dprint (cons (cons 'list (cdr o)) #f)))) // (#lambda "\x81#L\x81L\x82Idc0cc\x81R" '(#dprint list)) // (#lambda "\x81#L\x81L\x82Idc0ccPR" '(#dprint list)) s=new_string("\x81#L\x81L\x82Idc0ccPR",14); if(!s) return(1); c=INCREF(&nilobj); o=new_word("list",4); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("#dprint",7); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("dprint",6); if(!s) return(1); c=cons(s,o); if(!c) return(1); s=new_word("#macro-expansions",17); if(!s) return(1); INCREF(s); o=lookup(s); if(!o) return(1); o=cons(c,o); if(!o) return(1); o=set(s,o); if(!o) return(1); DECREF(o); // (define unquote-identifier '(unquote . identifier)) // (#define 'unquote-identifier '(unquote . identifier)) // (unquote . identifier) o=new_word("unquote",7); if(!o) return(1); c=new_word("identifier",10); if(!c) return(1); o=cons(o,c); if(!o) return(1); s=new_word("unquote-identifier",18); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define #character-macros #f) // (#define '#character-macros #f) // #f o=INCREF(&nilobj); s=new_word("#character-macros",17); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (define-character-macro char macro) (set #character-macros (cons (cons char macro) #character-macros)) char) // (#define 'define-character-macro (byte-compile '(char macro) '(#prog2of2 (#set '#character-macros (cons (cons char macro) #character-macros)) 'char))) // (#lambda "\x82#\x81I\x81IcLlcLSD\x81I\x82R" '(#character-macros)) // (#lambda "\x82#\x81I\x81IcLlcLS\x81\x44R" '(#character-macros)) s=new_string("\x82#\x81I\x81IcLlcLS\x81\x44R",15); if(!s) return(1); c=INCREF(&nilobj); o=new_word("#character-macros",17); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("define-character-macro",22); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (get-using-= hash item) (while hash (if (= (car (car hash)) item) (exit-loop (cdr (car hash)))) (set hash (cdr hash)))) // (#define 'get-using-= (byte-compile '(hash item) '(#loop '(#ifelse hash '(#prog2of2 (#ifelse (= (car (car hash)) item) '(#exit-loop (cdr (car hash))) '#f) '(#set 'hash (cdr hash))) '(#exit-loop #f))))) // (#lambda "\x82#\x81I\x9C\x46\x81Iaa\x81I\x82?\x88\x46\x81Iad\x92G\x81G0D\x81IdI\x82P\x83G0\x83GD\xDAG\x82R" '#f) // (#lambda "\x82#\x81I\x99\x46\x81Iaa\x81I\x82?\x88\x46\x81Iad\x81PDR\x81Id\x81P\xE3G0\x81PDR" '#f) s=new_string("\x82#\x81I\x99\x46\x81Iaa\x81I\x82?\x88\x46\x81Iad\x81PDR\x81Id\x81P\xE3G0\x81PDR",36); if(!s) return(1); c=INCREF(&nilobj); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("get-using-=",11); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (expand-string oldstring) (let ((i 0) (newstring (new-string (+ 512 (string-length oldstring))))) (while (< i (string-length oldstring)) (put-char newstring i (get-char oldstring i))) newstring)) // (#define 'expand-string (byte-compile '(oldstring) '(#let 'i 0 '(#let 'newstring (new-string (+ 512 (string-length oldstring))) '(#prog2of2 (#loop '(#ifelse (< i (string-length oldstring)) '(put-char newstring i (get-char oldstring i)) '(#exit-loop #f))) 'newstring))))) // (#lambda "\x81#i\x84\x80i\x82ILl\x81\x43+\x81Ll\x81\x43\x81I\x83ILl\x81\x43\x81?\x93\x46I\x82I\x84I\x84I\x82Ll\x82\x43\x83Ll\x83\x43\x83G0\x83GD\xDBGDIPP\x81R" '(string-length new-string get-char put-char)) // (#lambda "\x81#i\x84\x80i\x82ILl\x81\x43+\x81Ll\x81\x43\x81I\x83ILl\x81\x43\x81?\x94\x46I\x82I\x84I\x84I\x82Ll\x82\x43\x83Ll\x83\x43\x44\xE0GPPR" '(string-length new-string get-char put-char)) s=new_string("\x81#i\x84\x80i\x82ILl\x81\x43+\x81Ll\x81\x43\x81I\x83ILl\x81\x43\x81?\x94\x46I\x82I\x84I\x84I\x82Ll\x82\x43\x83Ll\x83\x43\x44\xE0GPPR",53); if(!s) return(1); c=INCREF(&nilobj); o=new_word("put-char",8); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("get-char",8); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("new-string",10); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("string-length",13); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("expand-string",13); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (is-space c) (or (= c 32) (and (< 8 c) (< c 14)))) // (#define 'is-space (byte-compile '(c) '(#or (= c 32) '(#and (< 8 c) '(< c 14))))) // (#lambda "\x81#I\xA0i\x82?I\x90TD\x88i\x81I\x81?I\x86\x46\x44I\x8Ei\x81?\x81R" '#f) // (#lambda "\x81#I\xA0i\x82?I\x90TD\x88i\x81I\x81?I\x86\x46\x44I\x8Ei\x81?PR" '#f) s=new_string("\x81#I\xA0i\x82?I\x90TD\x88i\x81I\x81?I\x86\x46\x44I\x8Ei\x81?PR",28); if(!s) return(1); c=INCREF(&nilobj); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("is-space",8); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (is-ascii c) (and (< 31 c) (< c 127))) // (#define 'is-ascii (byte-compile '(c) '(#and (< 31 c) '(< c 127)))) // (#lambda "\x81#\x9Fi\x81I\x81?I\x87\x46\x44I\x80\xFFi\x81?\x81R" '#f) // (#lambda "\x81#\x9Fi\x81I\x81?I\x87\x46\x44I\x80\xFFi\x81?PR" '#f) s=new_string("\x81#\x9Fi\x81I\x81?I\x87\x46\x44I\x80\xFFi\x81?PR",20); if(!s) return(1); c=INCREF(&nilobj); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("is-ascii",8); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (hexchar? c) (ifelse (and (<= 48 c) (<= c 57)) (- c 48) (ifelse (and (<= 65 c) (<= c 70)) (- c 55) (ifelse (and (<= 97 c) (<= c 102)) (- c 87) #f)))) // (#define 'hexchar? (byte-compile '(c) '(#ifelse (#and (<= 48 c) '(<= c 57)) '(- c 48) '(#ifelse (#and (<= 65 c) '(<= c 70)) '(- c 55) '(#ifelse (#and (<= 97 c) '(<= c 102)) '(- c 87) '#f))))) // (#lambda "\x81#\xB0i\x81I\x83?I\x86\x46\x44I\xB9i\x83?\x86\x46I\xB0i-\xB4G\x80\xC1i\x81I\x83?I\x87\x46\x44I\x80\xC6i\x83?\x86\x46I\xB7i-\x9BG\x80\xE1i\x81I\x83?I\x87\x46\x44I\x80\xE6i\x83?\x87\x46I\x80\xD7i-\x81G0\x81R" '#f) // (#lambda "\x81#\xB0i\x81I\x83?I\x86\x46\x44I\xB9i\x83?\x84\x46\xB0i-R\x80\xC1i\x81I\x83?I\x87\x46\x44I\x80\xC6i\x83?\x84\x46\xB7i-R\x80\xE1i\x81I\x83?I\x87\x46\x44I\x80\xE6i\x83?\x85\x46\x80\xD7i-RD0R" '#f) s=new_string("\x81#\xB0i\x81I\x83?I\x86\x46\x44I\xB9i\x83?\x84\x46\xB0i-R\x80\xC1i\x81I\x83?I\x87\x46\x44I\x80\xC6i\x83?\x84\x46\xB7i-R\x80\xE1i\x81I\x83?I\x87\x46\x44I\x80\xE6i\x83?\x85\x46\x80\xD7i-RD0R",73); if(!s) return(1); c=INCREF(&nilobj); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("hexchar?",8); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (skip-whitespace stream) (loop (let ((c (peek-char stream))) (if (= 59 c) (while (and (<> c 10) (<> c 13)) (set c (read-char stream))) (next-loop)) (unless (is-space c) (exit-loop c)) (read-char stream)))) // (#define 'skip-whitespace (byte-compile '(stream) '(#loop '(#let 'c (peek-char stream) '(#prog2of2 (#ifelse (= 59 c) '(#prog2of2 (#loop '(#ifelse (#and (<> c 10) '(<> c 13)) '(#set 'c (read-char stream)) '(#exit-loop #f))) '(#next-loop)) '#f) '(#prog2of2 (#ifelse (is-space c) '#f '(#exit-loop c)) '(read-char stream))))))) // (#lambda "\x81#ILl\x81\x43\xBBi\x81I\x82?\xA8\x46I\x8Ai\x85?I\x86\x46\x44I\x8Di\x85?\x8C\x46\x81I\x81Ll\x81\x43I\x81P\x83G0\x83GD\xDEGDD\xCDG\x81G0DI\x82Ll\x81\x43\x83\x46\x30\x84GIP\x8DGD\x81I\x81Ll\x81\x43PD\xFF\xADG\x81R" '(peek-char read-char is-space)) // (#lambda "\x81#ILl\x81\x43\xBBi\x81I\x82?\x9D\x46I\x8Ai\x85?I\x86\x46\x44I\x8Di\x85?\x8A\x46\x81I\x81Ll\x81\x43P\xE6GD\xD6GI\x82Ll\x81\x43\x82TPR\x81I\x81Ll\x81\x43PD\xC1G" '(peek-char read-char is-space)) s=new_string("\x81#ILl\x81\x43\xBBi\x81I\x82?\x9D\x46I\x8Ai\x85?I\x86\x46\x44I\x8Di\x85?\x8A\x46\x81I\x81Ll\x81\x43P\xE6GD\xD6GI\x82Ll\x81\x43\x82TPR\x81I\x81Ll\x81\x43PD\xC1G",65); if(!s) return(1); c=INCREF(&nilobj); o=new_word("is-space",8); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("read-char",9); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("peek-char",9); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("skip-whitespace",15); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (macro-singlequote stream) (catch 'end-of-file (quote (read-object stream)) (throw 'reader-error stream))) // (#define 'macro-singlequote (byte-compile '(stream) '(#catch 'end-of-file '(quote (read-object stream)) '(throw 'reader-error stream)))) // (#lambda "\x81#\x89{ILl\x81\x43'}\x8DG\x81L1=\x83T21:I\x82L:\x81R" '(read-object end-of-file reader-error)) // (#lambda "\x81#\x89{ILl\x81\x43'}PR\x81L1=\x83T21:I\x82L:" '(read-object end-of-file reader-error)) s=new_string("\x81#\x89{ILl\x81\x43'}PR\x81L1=\x83T21:I\x82L:",26); if(!s) return(1); c=INCREF(&nilobj); o=new_word("reader-error",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("end-of-file",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("read-object",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("macro-singlequote",17); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define-character-macro 39 macro-singlequote) // (define-character-macro 39 macro-singlequote) o=new_object(&integer_objtype); if(!o) return(1); o->value.i=39; s=new_word("macro-singlequote",17); if(!s) return(1); s=lookup(s); if(!s) return(1); c=cons(o,s); if(!c) return(1); s=new_word("#character-macros",17); if(!s) return(1); INCREF(s); o=lookup(s); if(!o) return(1); o=cons(c,o); if(!o) return(1); o=set(s,o); if(!o) return(1); DECREF(o); // (define close-parenthesis '(close . parenthesis)) // (#define 'close-parenthesis '(close . parenthesis)) // (close . parenthesis) o=new_word("close",5); if(!o) return(1); c=new_word("parenthesis",11); if(!c) return(1); o=cons(o,c); if(!o) return(1); s=new_word("close-parenthesis",17); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (submacro-dot stream) (catch 'end-of-file (let ((o (read-object stream)) (c (skip-whitespace stream))) (unless (= 41 c) (throw 'reader-error stream)) (read-char stream) o) (throw 'reader-error stream))) // (#define 'submacro-dot (byte-compile '(stream) '(#catch 'end-of-file '(#let 'o (read-object stream) '(#let 'c (skip-whitespace stream) '(#prog2of2 (#ifelse (= 41 c) '#f '(throw 'reader-error stream)) '(#prog2of2 (read-char stream) 'o)))) '(throw 'reader-error stream)))) // (#lambda "\x81#\xAC{ILl\x81\x43\x81I\x81Ll\x81\x43\xA9i\x81I\x82?\x83\x46\x30\x85G\x82I\x82L:D\x82I\x83Ll\x81\x43\x44\x81IPP}\x8DG\x84L1=\x83T21:I\x82L:\x81R" '(read-object skip-whitespace reader-error read-char end-of-file)) // (#lambda "\x81#\xA8{ILl\x81\x43\x81I\x81Ll\x81\x43\xA9i\x81I\x82?\x85T\x82I\x82L:\x82I\x83Ll\x81\x43\x44\x81IPP}PR\x84L1=\x83T21:I\x82L:" '(read-object skip-whitespace reader-error read-char end-of-file)) s=new_string("\x81#\xA8{ILl\x81\x43\x81I\x81Ll\x81\x43\xA9i\x81I\x82?\x85T\x82I\x82L:\x82I\x83Ll\x81\x43\x44\x81IPP}PR\x84L1=\x83T21:I\x82L:",57); if(!s) return(1); c=INCREF(&nilobj); o=new_word("end-of-file",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("read-char",9); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("reader-error",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("skip-whitespace",15); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("read-object",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("submacro-dot",12); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (macro-openparen stream) (let ((reverse-list #f) (new-list #f)) (catch 'end-of-file (loop (let ((o (read-object stream))) (ifelse (eq? o close-parenthesis) (exit-loop) (ifelse (eq? o '.) (ifelse reverse-list (progn (set new-list (submacro-dot stream)) (exit-loop)) (throw 'reader-error stream)) (set reverse-list (cons o reverse-list)))))) (throw 'reader-error stream)) (reverse/append reverse-list new-list))) // (#define 'macro-openparen (byte-compile '(stream) '(#let 'reverse-list #f '(#let 'new-list #f '(#prog2of2 (#catch 'end-of-file '(#loop '(#let 'o (read-object stream) '(#ifelse (eq? o close-parenthesis) '(#exit-loop #f) '(#ifelse (eq? o '.) '(#ifelse reverse-list '(#prog2of2 (#set 'new-list (submacro-dot stream)) '(#exit-loop #f)) '(throw 'reader-error stream)) '(#set 'reverse-list (cons o reverse-list)))))) '(throw 'reader-error stream)) '(reverse/append reverse-list new-list)))))) // (#lambda "\x81#00\x80\xC3{\x82ILl\x81\x43I\x81Ll=\x86\x46\x30P\xAFG\xA9GI\x82L=\x9C\x46\x82I\x91\x46\x83I\x83Ll\x81\x43I\x82PD0P\x94G\x85G\x83I\x84L:\x87GI\x83IcI\x83PPD\xC0G}\x8EG\x85L1=\x83T21:\x82I\x84L:D\x81I\x81I\x86Ll\x82\x43PP\x81R" '(read-object close-parenthesis . submacro-dot reader-error end-of-file reverse/append)) // (#lambda "\x81#00\xBC{\x82ILl\x81\x43I\x81Ll=\x84\x46\x44\x30\xA7GI\x82L=\x96\x46\x82I\x8D\x46\x83I\x83Ll\x81\x43\x81PD0\x90G\x83I\x84L:I\x83IcI\x83PPD\xC8G}D\x8EG\x85L1=\x83T21:\x82I\x84L:\x81I\x81I\x86Ll\x82\x43PPPR" '(read-object close-parenthesis . submacro-dot reader-error end-of-file reverse/append)) s=new_string("\x81#00\xBC{\x82ILl\x81\x43I\x81Ll=\x84\x46\x44\x30\xA7GI\x82L=\x96\x46\x82I\x8D\x46\x83I\x83Ll\x81\x43\x81PD0\x90G\x83I\x84L:I\x83IcI\x83PPD\xC8G}D\x8EG\x85L1=\x83T21:\x82I\x84L:\x81I\x81I\x86Ll\x82\x43PPPR",93); if(!s) return(1); c=INCREF(&nilobj); o=new_word("reverse/append",14); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("end-of-file",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("reader-error",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("submacro-dot",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word(".",1); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("close-parenthesis",17); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("read-object",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("macro-openparen",15); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define-character-macro 40 macro-openparen) // (define-character-macro 40 macro-openparen) o=new_object(&integer_objtype); if(!o) return(1); o->value.i=40; s=new_word("macro-openparen",15); if(!s) return(1); s=lookup(s); if(!s) return(1); c=cons(o,s); if(!c) return(1); s=new_word("#character-macros",17); if(!s) return(1); INCREF(s); o=lookup(s); if(!o) return(1); o=cons(c,o); if(!o) return(1); o=set(s,o); if(!o) return(1); DECREF(o); // (define (macro-closeparen stream) close-parenthesis) // (#define 'macro-closeparen (byte-compile '(stream) 'close-parenthesis)) // (#lambda "\x81#Ll\x81R" '(close-parenthesis)) // (#lambda "\x81#LlPR" '(close-parenthesis)) s=new_string("\x81#LlPR",6); if(!s) return(1); c=INCREF(&nilobj); o=new_word("close-parenthesis",17); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("macro-closeparen",16); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define-character-macro 41 macro-closeparen) // (define-character-macro 41 macro-closeparen) o=new_object(&integer_objtype); if(!o) return(1); o->value.i=41; s=new_word("macro-closeparen",16); if(!s) return(1); s=lookup(s); if(!s) return(1); c=cons(o,s); if(!c) return(1); s=new_word("#character-macros",17); if(!s) return(1); INCREF(s); o=lookup(s); if(!o) return(1); o=cons(c,o); if(!o) return(1); o=set(s,o); if(!o) return(1); DECREF(o); // (define (macro-comma stream) (catch 'end-of-file (cons unquote-identifier (read-object stream)) (throw 'reader-error stream))) // (#define 'macro-comma (byte-compile '(stream) '(#catch 'end-of-file '(cons unquote-identifier (read-object stream)) '(throw 'reader-error stream)))) // (#lambda "\x81#\x8D{Ll\x81I\x81Ll\x81\x43\x63}\x8DG\x82L1=\x83T21:I\x83L:\x81R" '(unquote-identifier read-object end-of-file reader-error)) // (#lambda "\x81#\x8D{Ll\x81I\x81Ll\x81\x43\x63}PR\x82L1=\x83T21:I\x83L:" '(unquote-identifier read-object end-of-file reader-error)) s=new_string("\x81#\x8D{Ll\x81I\x81Ll\x81\x43\x63}PR\x82L1=\x83T21:I\x83L:",30); if(!s) return(1); c=INCREF(&nilobj); o=new_word("reader-error",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("end-of-file",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("read-object",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("unquote-identifier",18); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("macro-comma",11); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define-character-macro 44 macro-comma) // (define-character-macro 44 macro-comma) o=new_object(&integer_objtype); if(!o) return(1); o->value.i=44; s=new_word("macro-comma",11); if(!s) return(1); s=lookup(s); if(!s) return(1); c=cons(o,s); if(!c) return(1); s=new_word("#character-macros",17); if(!s) return(1); INCREF(s); o=lookup(s); if(!o) return(1); o=cons(c,o); if(!o) return(1); o=set(s,o); if(!o) return(1); DECREF(o); // (define (macro-semicolon stream) (let ((c 0)) (while (and (<> c 10) (<> c 13)) (set c (read-char stream)))) (read-object stream)) // (#define 'macro-semicolon (byte-compile '(stream) '(#prog2of2 (#let 'c 0 '(#loop '(#ifelse (#and (<> c 10) '(<> c 13)) '(#set 'c (read-char stream)) '(#exit-loop #f)))) '(read-object stream)))) // (#lambda "\x81#iI\x8Ai\x85?I\x86\x46\x44I\x8Di\x85?\x8B\x46\x81ILl\x81\x43I\x81P\x83G0\x83GD\xDFGPDI\x81Ll\x81\x43\x81R" '(read-char read-object)) // (#lambda "\x81#iI\x8Ai\x85?I\x86\x46\x44I\x8Di\x85?\x89\x46\x81ILl\x81\x43P\xE7GD\x81Ll\x81r" '(read-char read-object)) s=new_string("\x81#iI\x8Ai\x85?I\x86\x46\x44I\x8Di\x85?\x89\x46\x81ILl\x81\x43P\xE7GD\x81Ll\x81r",34); if(!s) return(1); c=INCREF(&nilobj); o=new_word("read-object",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("read-char",9); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("macro-semicolon",15); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define-character-macro 59 macro-semicolon) // (define-character-macro 59 macro-semicolon) o=new_object(&integer_objtype); if(!o) return(1); o->value.i=59; s=new_word("macro-semicolon",15); if(!s) return(1); s=lookup(s); if(!s) return(1); c=cons(o,s); if(!c) return(1); s=new_word("#character-macros",17); if(!s) return(1); INCREF(s); o=lookup(s); if(!o) return(1); o=cons(c,o); if(!o) return(1); o=set(s,o); if(!o) return(1); DECREF(o); // (define (quasiquote obj) (ifelse obj (ifelse (pair? obj) (ifelse (eq? unquote-identifier (car obj)) (cdr obj) (ifelse (member unquote-identifier obj) (list 'cons (quasiquote (car obj)) (quasiquote (cdr obj))) (cons 'list (map-safe a (quasiquote a) obj)))) (quote obj)) obj)) // (#define 'quasiquote (byte-compile '(obj) '(#ifelse obj '(#ifelse (pair? obj) '(#ifelse (eq? unquote-identifier (car obj)) '(cdr obj) '(#ifelse (member unquote-identifier obj) '(cons 'cons (cons (quasiquote (car obj)) (cons (quasiquote (cdr obj)) #f))) '(cons 'list (#map-safe 'a '(quasiquote a) obj)))) '(quote obj)) 'obj))) // (#lambda "\x81#I\x80\xF5\x46Ip\x80\xEC\x46Ll\x81Ia=\x85\x46Id\x80\xDDGLl\x81I\x81Ll\x82\x43\x98\x46\x82L\x81Ia\x83Ll\x81\x43\x82Id\x83Ll\x81\x43\x30\x63\x63\x63\xBAG\x84L\x81II\xB2\x46\x30\x81IaI\x83Ll\x81\x43PXc\x81Id\x81P\x81Ip\xEAT\x81I\x8B\x46\x81II\x83Ll\x81\x43P\x81PIa\x82Ic\x81PdI\xF5TDc\x82GI'\x81GI\x81R" '(unquote-identifier member cons quasiquote list)) // (#lambda "\x81#I\x80\xF2\x46Ip\x80\xE9\x46Ll\x81Ia=\x82\x46\x64RLl\x81I\x81Ll\x82\x43\x98\x46\x82L\x81Ia\x83Ll\x81\x43\x82Id\x83Ll\x81\x43\x30\x63\x63\x63PR\x84L\x81II\xB2\x46\x30\x81IaI\x83Ll\x81\x43PXc\x81Id\x81P\x81Ip\xEAT\x81I\x8B\x46\x81II\x83Ll\x81\x43P\x81PIa\x82Ic\x81PdI\xF5TDcPRI'PRR" '(unquote-identifier member cons quasiquote list)) s=new_string("\x81#I\x80\xF2\x46Ip\x80\xE9\x46Ll\x81Ia=\x82\x46\x64RLl\x81I\x81Ll\x82\x43\x98\x46\x82L\x81Ia\x83Ll\x81\x43\x82Id\x83Ll\x81\x43\x30\x63\x63\x63PR\x84L\x81II\xB2\x46\x30\x81IaI\x83Ll\x81\x43PXc\x81Id\x81P\x81Ip\xEAT\x81I\x8B\x46\x81II\x83Ll\x81\x43P\x81PIa\x82Ic\x81PdI\xF5TDcPRI'PRR",121); if(!s) return(1); c=INCREF(&nilobj); o=new_word("list",4); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("quasiquote",10); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("cons",4); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("member",6); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("unquote-identifier",18); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("quasiquote",10); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (macro-backtick stream) (quasiquote (catch 'end-of-file (read-object stream) (throw 'reader-error stream)))) // (#define 'macro-backtick (byte-compile '(stream) '(quasiquote (#catch 'end-of-file '(read-object stream) '(throw 'reader-error stream))))) // (#lambda "\x81#\x88{ILl\x81\x43}\x8DG\x81L1=\x83T21:I\x82L:\x83Ll\x81\x43\x81R" '(read-object end-of-file reader-error quasiquote)) // (#lambda "\x81#\x88{ILl\x81\x43}\x8DG\x81L1=\x83T21:I\x82L:P\x83Ll\x81r" '(read-object end-of-file reader-error quasiquote)) s=new_string("\x81#\x88{ILl\x81\x43}\x8DG\x81L1=\x83T21:I\x82L:P\x83Ll\x81r",31); if(!s) return(1); c=INCREF(&nilobj); o=new_word("quasiquote",10); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("reader-error",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("end-of-file",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("read-object",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("macro-backtick",14); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define-character-macro 96 macro-backtick) // (define-character-macro 96 macro-backtick) o=new_object(&integer_objtype); if(!o) return(1); o->value.i=96; s=new_word("macro-backtick",14); if(!s) return(1); s=lookup(s); if(!s) return(1); c=cons(o,s); if(!c) return(1); s=new_word("#character-macros",17); if(!s) return(1); INCREF(s); o=lookup(s); if(!o) return(1); o=cons(c,o); if(!o) return(1); o=set(s,o); if(!o) return(1); DECREF(o); // (define (subsubmacro-doublequote-backslash-x stream) (let ((c (hexchar? (catch 'end-of-file (peek-char stream) (throw 'reader-error stream))))) (unless c (throw 'reader-error stream)) (read-char stream) (catch 'end-of-file (let ((c2 (hexchar? (peek-char stream)))) (if c2 (read-char stream) (set c (+ (* c 16) c2)))) #f) c)) // (#define 'subsubmacro-doublequote-backslash-x (byte-compile '(stream) '(#let 'c (hexchar? (#catch 'end-of-file '(peek-char stream) '(throw 'reader-error stream))) '(#prog2of2 (#ifelse c '#f '(throw 'reader-error stream)) '(#prog2of2 (read-char stream) '(#prog2of2 (#catch 'end-of-file '(#let 'c2 (hexchar? (peek-char stream)) '(#ifelse c2 '(#prog2of2 (read-char stream) '(#set 'c (+ (* c 16) c2))) '#f)) '#f) 'c)))))) // (#lambda "\x81#\x88{ILl\x81\x43}\x8DG\x81L1=\x83T21:I\x82L:\x83Ll\x81\x43I\x83\x46\x30\x85G\x81I\x82L:D\x81I\x84Ll\x81\x43\x44\xA8{\x81ILl\x81\x43\x83Ll\x81\x43I\x95\x46\x82I\x84Ll\x81\x43\x44\x81I\x90i*\x81I+I\x82P\x81G0P}\x8AG\x81L1=\x83T21:0DIP\x81R" '(peek-char end-of-file reader-error hexchar? read-char)) // (#lambda "\x81#\x88{ILl\x81\x43}\x8DG\x81L1=\x83T21:I\x82L:\x83Ll\x81\x43I\x85T\x81I\x82L:\x81I\x84Ll\x81\x43\x44\xA9{\x81ILl\x81\x43\x83Ll\x81\x43I\x95\x46\x82I\x84Ll\x81\x43\x44\x81I\x90i*\x81I+I\x82P\x81G0P}DPR\x81L1=\x83T21:PR" '(peek-char end-of-file reader-error hexchar? read-char)) s=new_string("\x81#\x88{ILl\x81\x43}\x8DG\x81L1=\x83T21:I\x82L:\x83Ll\x81\x43I\x85T\x81I\x82L:\x81I\x84Ll\x81\x43\x44\xA9{\x81ILl\x81\x43\x83Ll\x81\x43I\x95\x46\x82I\x84Ll\x81\x43\x44\x81I\x90i*\x81I+I\x82P\x81G0P}DPR\x81L1=\x83T21:PR",100); if(!s) return(1); c=INCREF(&nilobj); o=new_word("read-char",9); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("hexchar?",8); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("reader-error",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("end-of-file",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("peek-char",9); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("subsubmacro-doublequote-backslash-x",35); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (submacro-doublequote-backslash stream) (let ((c (catch 'end-of-file (read-char stream) (throw 'reader-error stream)))) (ifelse (= 120 c) (subsubmacro-doublequote-backslash-x stream) c))) // (#define 'submacro-doublequote-backslash (byte-compile '(stream) '(#let 'c (#catch 'end-of-file '(read-char stream) '(throw 'reader-error stream)) '(#ifelse (= 120 c) '(subsubmacro-doublequote-backslash-x stream) 'c)))) // (#lambda "\x81#\x88{ILl\x81\x43}\x8DG\x81L1=\x83T21:I\x82L:\x80\xF8i\x81I\x82?\x89\x46\x81I\x83Ll\x81\x43\x81GIP\x81R" '(read-char end-of-file reader-error subsubmacro-doublequote-backslash-x)) // (#lambda "\x81#\x88{ILl\x81\x43}\x8DG\x81L1=\x83T21:I\x82L:\x80\xF8i\x81I\x82?\x89\x46\x81I\x83Ll\x81\x43\x81GIPPR" '(read-char end-of-file reader-error subsubmacro-doublequote-backslash-x)) s=new_string("\x81#\x88{ILl\x81\x43}\x8DG\x81L1=\x83T21:I\x82L:\x80\xF8i\x81I\x82?\x89\x46\x81I\x83Ll\x81\x43\x81GIPPR",47); if(!s) return(1); c=INCREF(&nilobj); o=new_word("subsubmacro-doublequote-backslash-x",35); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("reader-error",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("end-of-file",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("read-char",9); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("submacro-doublequote-backslash",30); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (macro-doublequote stream) (let ((c #f) (i 0) (string (new-string 512))) (loop (if (= i (string-length string)) (set string (expand-string string))) (set c (catch 'end-of-file (read-char stream) (throw 'reader-error stream))) (if (= c 34) (exit-loop)) (if (= c 92) (set c (submacro-doublequote-backslash stream))) (put-char string i c) (set i (+ i 1))) (substring string 0 i))) // (#define 'macro-doublequote (byte-compile '(stream) '(#let 'c #f '(#let 'i 0 '(#let 'string (new-string 512) '(#prog2of2 (#loop '(#prog2of2 (#ifelse (= i (string-length string)) '(#set 'string (expand-string string)) '#f) '(#prog2of2 (#set 'c (#catch 'end-of-file '(read-char stream) '(throw 'reader-error stream))) '(#prog2of2 (#ifelse (= c 34) '(#exit-loop #f) '#f) '(#prog2of2 (#ifelse (= c 92) '(#set 'c (submacro-doublequote-backslash stream)) '#f) '(#prog2of2 (put-char string i c) '(#set 'i (+ i 1)))))))) '(substring string 0 i))))))) // (#lambda "\x81#0i\x84\x80iLl\x81\x43\x81I\x81I\x81Ll\x81\x43\x82?\x8B\x46I\x82Ll\x81\x43I\x81P\x81G0D\x8A{\x83I\x83Ll\x81\x43}\x8EG\x84L1=\x83T21:\x83I\x85L:I\x83PD\x82I\xA2i\x82?\x85\x46\x30\xB2G\x81G0D\x82I\x80\xDCi\x82?\x8C\x46\x83I\x86Ll\x81\x43I\x83P\x81G0DI\x82I\x84I\x87Ll\x83\x43\x44\x81I\x81i+I\x82PD\xFF\x8BGDIi\x83I\x88Ll\x83\x43PPP\x81R" '(new-string string-length expand-string read-char end-of-file reader-error submacro-doublequote-backslash put-char substring)) // (#lambda "\x81#0i\x84\x80iLl\x81\x43\x81I\x81I\x81Ll\x81\x43\x82?\x87\x46I\x82Ll\x81\x43P\x8A{\x83I\x83Ll\x81\x43}\x8EG\x84L1=\x83T21:\x83I\x85L:\x82P\x82I\xA2i\x82?\xA7T\x82I\x80\xDCi\x82?\x89\x46\x83I\x86Ll\x81\x43\x82PI\x82I\x84I\x87Ll\x83\x43\x44\x81I\x81i+\x81P\xFF\xA1GIi\x83I\x88Ll\x83\x43PPPPR" '(new-string string-length expand-string read-char end-of-file reader-error submacro-doublequote-backslash put-char substring)) s=new_string("\x81#0i\x84\x80iLl\x81\x43\x81I\x81I\x81Ll\x81\x43\x82?\x87\x46I\x82Ll\x81\x43P\x8A{\x83I\x83Ll\x81\x43}\x8EG\x84L1=\x83T21:\x83I\x85L:\x82P\x82I\xA2i\x82?\xA7T\x82I\x80\xDCi\x82?\x89\x46\x83I\x86Ll\x81\x43\x82PI\x82I\x84I\x87Ll\x83\x43\x44\x81I\x81i+\x81P\xFF\xA1GIi\x83I\x88Ll\x83\x43PPPPR",120); if(!s) return(1); c=INCREF(&nilobj); o=new_word("substring",9); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("put-char",8); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("submacro-doublequote-backslash",30); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("reader-error",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("end-of-file",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("read-char",9); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("expand-string",13); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("string-length",13); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("new-string",10); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("macro-doublequote",17); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define-character-macro 34 macro-doublequote) // (define-character-macro 34 macro-doublequote) o=new_object(&integer_objtype); if(!o) return(1); o->value.i=34; s=new_word("macro-doublequote",17); if(!s) return(1); s=lookup(s); if(!s) return(1); c=cons(o,s); if(!c) return(1); s=new_word("#character-macros",17); if(!s) return(1); INCREF(s); o=lookup(s); if(!o) return(1); o=cons(c,o); if(!o) return(1); o=set(s,o); if(!o) return(1); DECREF(o); // (define (read-token stream c) (let ((buffer (new-string 512)) (i 0)) (loop (if (= i (string-length buffer)) (set buffer (expand-string buffer))) (put-char buffer i c) (set i (+ i 1)) (catch 'end-of-file (set c (peek-char stream)) (exit-loop)) (if (is-space c) (exit-loop)) (unless (is-ascii c) (exit-loop)) (if (get-using-= #character-macros c) (exit-loop)) (set c (read-char stream))) (set buffer (substring buffer 0 i)) (ifelse (string-eqv? buffer "#f") #f (catch 'type-error (string->integer buffer) (catch 'type-error (string->float buffer) (string->symbol buffer)))))) // (#define 'read-token (byte-compile '(stream c) '(#let 'buffer (new-string 512) '(#let 'i 0 '(#prog2of2 (#loop '(#prog2of2 (#ifelse (= i (string-length buffer)) '(#set 'buffer (expand-string buffer)) '#f) '(#prog2of2 (put-char buffer i c) '(#prog2of2 (#set 'i (+ i 1)) '(#prog2of2 (#catch 'end-of-file '(#set 'c (peek-char stream)) '(#exit-loop #f)) '(#prog2of2 (#ifelse (is-space c) '(#exit-loop #f) '#f) '(#prog2of2 (#ifelse (is-ascii c) '#f '(#exit-loop #f)) '(#prog2of2 (#ifelse (get-using-= #character-macros c) '(#exit-loop #f) '#f) '(#set 'c (read-char stream)))))))))) '(#prog2of2 (#set 'buffer (substring buffer 0 i)) '(#ifelse (string-eqv? buffer "#f") '#f '(#catch 'type-error '(string->integer buffer) '(#catch 'type-error '(string->float buffer) '(string->symbol buffer)))))))))) // (#lambda "\x82#\x84\x80iLl\x81\x43iI\x82I\x81Ll\x81\x43\x82?\x8C\x46\x81I\x82Ll\x81\x43I\x82P\x81G0D\x81I\x81I\x84I\x83Ll\x83\x43\x44I\x81i+I\x81PD\x8D{\x83I\x84Ll\x81\x43I\x83P}\x8DG\x85L1=\x83T21:0\x80\xC2GD\x82I\x86Ll\x81\x43\x85\x46\x30\xB5G\x81G0D\x82I\x87Ll\x81\x43\x83\x46\x30\x83G0\xA2GD\x88Ll\x83I\x89Ll\x82\x43\x85\x46\x30\x92G\x81G0D\x83I\x8ALl\x81\x43I\x83PD\xFE\xF4GD\x81Ii\x82I\x8BLl\x83\x43I\x82PD\x81I\x8CL\x8DLl\x82\x43\x83\x46\x30\xB1G\x8A{\x81I\x8ELl\x81\x43}\xA5G\x8FL1=\x83T21:\x8A{\x81I\x90Ll\x81\x43}\x90G\x8FL1=\x83T21:\x81I\x91Ll\x81\x43PP\x82R" '(new-string string-length expand-string put-char peek-char end-of-file is-space is-ascii #character-macros get-using-= read-char substring "#f" string-eqv? string->integer type-error string->float string->symbol)) // (#lambda "\x82#\x84\x80iLl\x81\x43iI\x82I\x81Ll\x81\x43\x82?\x89\x46\x81I\x82Ll\x81\x43\x81P\x81I\x81I\x84I\x83Ll\x83\x43\x44\x81i+\x8E{\x83I\x84Ll\x81\x43I\x83P}D\x8BG\x85L1=\x83T21:\xAAG\x82I\x86Ll\x81\x43\xA1T\x82I\x87Ll\x81\x43\x98\x46\x88Ll\x83I\x89Ll\x82\x43\x8CT\x83I\x8ALl\x81\x43\x82P\xFF\x97G\x81Ii\x82I\x8BLl\x83\x43\x81P\x81I\x8CL\x8DLl\x82\x43\x83\x46\x30\xB1G\x8A{\x81I\x8ELl\x81\x43}\xA5G\x8FL1=\x83T21:\x8A{\x81I\x90Ll\x81\x43}\x90G\x8FL1=\x83T21:\x81I\x91Ll\x81\x43PP\x81PDR" '(new-string string-length expand-string put-char peek-char end-of-file is-space is-ascii #character-macros get-using-= read-char substring "#f" string-eqv? string->integer type-error string->float string->symbol)) s=new_string("\x82#\x84\x80iLl\x81\x43iI\x82I\x81Ll\x81\x43\x82?\x89\x46\x81I\x82Ll\x81\x43\x81P\x81I\x81I\x84I\x83Ll\x83\x43\x44\x81i+\x8E{\x83I\x84Ll\x81\x43I\x83P}D\x8BG\x85L1=\x83T21:\xAAG\x82I\x86Ll\x81\x43\xA1T\x82I\x87Ll\x81\x43\x98\x46\x88Ll\x83I\x89Ll\x82\x43\x8CT\x83I\x8ALl\x81\x43\x82P\xFF\x97G\x81Ii\x82I\x8BLl\x83\x43\x81P\x81I\x8CL\x8DLl\x82\x43\x83\x46\x30\xB1G\x8A{\x81I\x8ELl\x81\x43}\xA5G\x8FL1=\x83T21:\x8A{\x81I\x90Ll\x81\x43}\x90G\x8FL1=\x83T21:\x81I\x91Ll\x81\x43PP\x81PDR",196); if(!s) return(1); c=INCREF(&nilobj); o=new_word("string->symbol",14); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("string->float",13); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("type-error",10); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("string->integer",15); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("string-eqv?",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_string("#f",2); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("substring",9); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("read-char",9); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("get-using-=",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("#character-macros",17); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("is-ascii",8); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("is-space",8); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("end-of-file",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("peek-char",9); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("put-char",8); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("expand-string",13); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("string-length",13); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("new-string",10); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("read-token",10); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (read-object stream) (let ((c (skip-whitespace stream)) (macro #f)) (unless (is-ascii c) (throw 'reader-error stream)) (read-char stream) (set macro (get-using-= #character-macros c)) (ifelse macro (macro stream) (read-token stream c)))) // (#define 'read-object (byte-compile '(stream) '(#let 'c (skip-whitespace stream) '(#let 'macro #f '(#prog2of2 (#ifelse (is-ascii c) '#f '(throw 'reader-error stream)) '(#prog2of2 (read-char stream) '(#prog2of2 (#set 'macro (get-using-= #character-macros c)) '(#ifelse macro '(macro stream) '(read-token stream c))))))))) // (#lambda "\x81#ILl\x81\x43\x30\x81I\x81Ll\x81\x43\x83\x46\x30\x85G\x82I\x82L:D\x82I\x83Ll\x81\x43\x44\x84Ll\x82I\x85Ll\x82\x43I\x81PDI\x88\x46\x82I\x81I\x81\x43\x89G\x82I\x82I\x86Ll\x82\x43PP\x81R" '(skip-whitespace is-ascii reader-error read-char #character-macros get-using-= read-token)) // (#lambda "\x81#ILl\x81\x43\x30\x81I\x81Ll\x81\x43\x85T\x82I\x82L:\x82I\x83Ll\x81\x43\x44\x84Ll\x82I\x85Ll\x82\x43PI\x88\x46\x82I\x81I\x81\x43\x89G\x82I\x82I\x86Ll\x82\x43PPPR" '(skip-whitespace is-ascii reader-error read-char #character-macros get-using-= read-token)) s=new_string("\x81#ILl\x81\x43\x30\x81I\x81Ll\x81\x43\x85T\x82I\x82L:\x82I\x83Ll\x81\x43\x44\x84Ll\x82I\x85Ll\x82\x43PI\x88\x46\x82I\x81I\x81\x43\x89G\x82I\x82I\x86Ll\x82\x43PPPR",65); if(!s) return(1); c=INCREF(&nilobj); o=new_word("read-token",10); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("get-using-=",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("#character-macros",17); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("read-char",9); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("reader-error",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("is-ascii",8); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("skip-whitespace",15); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("read-object",11); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (cars arg) (map o (car o) arg)) // (#define 'cars (byte-compile '(arg) '(#map 'o '(car o) arg))) // (#lambda "\x81#II\x9E\x46\x30\x81IaIaPXc\x81Id\x81P\x81I\xEFTIa\x82Ic\x81PdI\xF5TD\x81R" '#f) // (#lambda "\x81#II\x9C\x46\x30\x81IaaXc\x81Id\x81P\x81I\xF1TIa\x82Ic\x81PdI\xF5TDPR" '#f) s=new_string("\x81#II\x9C\x46\x30\x81IaaXc\x81Id\x81P\x81I\xF1TIa\x82Ic\x81PdI\xF5TDPR",36); if(!s) return(1); c=INCREF(&nilobj); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("cars",4); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (cdrs arg) (map o (cdr o) arg)) // (#define 'cdrs (byte-compile '(arg) '(#map 'o '(cdr o) arg))) // (#lambda "\x81#II\x9E\x46\x30\x81IaIdPXc\x81Id\x81P\x81I\xEFTIa\x82Ic\x81PdI\xF5TD\x81R" '#f) // (#lambda "\x81#II\x9C\x46\x30\x81IadXc\x81Id\x81P\x81I\xF1TIa\x82Ic\x81PdI\xF5TDPR" '#f) s=new_string("\x81#II\x9C\x46\x30\x81IadXc\x81Id\x81P\x81I\xF1TIa\x82Ic\x81PdI\xF5TDPR",36); if(!s) return(1); c=INCREF(&nilobj); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("cdrs",4); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (cadrs arg) (map o (cadr o) arg)) // (#define 'cadrs (byte-compile '(arg) '(#map 'o '(car (cdr o)) arg))) // (#lambda "\x81#II\x9F\x46\x30\x81IaIdaPXc\x81Id\x81P\x81I\xEETIa\x82Ic\x81PdI\xF5TD\x81R" '#f) // (#lambda "\x81#II\x9F\x46\x30\x81IaIdaPXc\x81Id\x81P\x81I\xEETIa\x82Ic\x81PdI\xF5TDPR" '#f) s=new_string("\x81#II\x9F\x46\x30\x81IaIdaPXc\x81Id\x81P\x81I\xEETIa\x82Ic\x81PdI\xF5TDPR",39); if(!s) return(1); c=INCREF(&nilobj); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("cadrs",5); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (load-file filename) (let ((file (open-file filename "r")) (objs #f)) (loop (set objs (cons (catch 'end-of-file (read-object file) (exit-loop #f)) objs))) (if objs (set objs (cons 'progn (reverse objs)))) (set objs (macro-expand objs)) (set objs (byte-compile #f objs)) (objs) #f)) // (#define 'load-file (byte-compile '(filename) '(#let 'file (open-file filename "r") '(#let 'objs #f '(#prog2of2 (#loop '(#set 'objs (cons (#catch 'end-of-file '(read-object file) '(#exit-loop #f)) objs))) '(#prog2of2 (#ifelse objs '(#set 'objs (cons 'progn (#append/reversed #f objs))) '#f) '(#prog2of2 (#set 'objs (macro-expand objs)) '(#prog2of2 (#set 'objs (byte-compile #f objs)) '(#prog2of2 (objs) '#f))))))))) // (#lambda "\x81#IL\x81Ll\x82\x43\x30\x8A{\x81I\x82Ll\x81\x43}\x8CG\x83L1=\x83T21:0\x89G\x81IcI\x81PD\xDFGDI\x9A\x46\x84L0\x82II\x8B\x46Ia\x82Ic\x81PdI\xF5TDcI\x81P\x81G0DI\x85Ll\x81\x43I\x81PD0\x81I\x86Ll\x82\x43I\x81PDICD0PP\x81R" '("r" open-file read-object end-of-file progn macro-expand byte-compile)) // (#lambda "\x81#IL\x81Ll\x82\x43\x30\x8A{\x81I\x82Ll\x81\x43}\x8BG\x83L1=\x83T21:\x86G\x81IcP\xE3GI\x96\x46\x84L0\x82II\x8B\x46Ia\x82Ic\x81PdI\xF5TDcPI\x85Ll\x81\x43P0\x81I\x86Ll\x82\x43PIC\x83\x44\x30R" '("r" open-file read-object end-of-file progn macro-expand byte-compile)) s=new_string("\x81#IL\x81Ll\x82\x43\x30\x8A{\x81I\x82Ll\x81\x43}\x8BG\x83L1=\x83T21:\x86G\x81IcP\xE3GI\x96\x46\x84L0\x82II\x8B\x46Ia\x82Ic\x81PdI\xF5TDcPI\x85Ll\x81\x43P0\x81I\x86Ll\x82\x43PIC\x83\x44\x30R",86); if(!s) return(1); c=INCREF(&nilobj); o=new_word("byte-compile",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("macro-expand",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("progn",5); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("end-of-file",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("read-object",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("open-file",9); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_string("r",1); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("load-file",9); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (string-eqv? a b) (let ((c (string-length a))) (ifelse (= c (string-length b)) (loop (if (= c 0) (exit-loop #t)) (set c (- c 1)) (if (<> (get-char a c) (get-char b c)) (exit-loop #f))) #f))) // (#define 'string-eqv? (byte-compile '(a b) '(#let 'c (string-length a) '(#ifelse (= c (string-length b)) '(#loop '(#prog2of2 (#ifelse (= c 0) '(#exit-loop #t) '#f) '(#prog2of2 (#set 'c (- c 1)) '(#ifelse (<> (get-char a c) (get-char b c)) '(#exit-loop #f) '#f)))) '#f)))) // (#lambda "\x82#\x81ILl\x81\x43I\x82ILl\x81\x43\x82?\xB7\x46Ii\x82?\x86\x46\x30!\xABG\x81G0DI\x81i-I\x81PD\x82I\x81I\x81Ll\x82\x43\x82I\x82I\x81Ll\x82\x43\x85?\x85\x46\x30\x86G\x81G0D\xCBG\x81G0P\x82R" '(string-length get-char)) // (#lambda "\x82#\x81ILl\x81\x43I\x82ILl\x81\x43\x82?\xA8\x46Ii\x82?\x84\x46\x30!\x9FG\x81i-\x82I\x81I\x81Ll\x82\x43\x82I\x82I\x81Ll\x82\x43\x85?\x83\x46\x30\x83G\xD8G0P\x81PDR" '(string-length get-char)) s=new_string("\x82#\x81ILl\x81\x43I\x82ILl\x81\x43\x82?\xA8\x46Ii\x82?\x84\x46\x30!\x9FG\x81i-\x82I\x81I\x81Ll\x82\x43\x82I\x82I\x81Ll\x82\x43\x85?\x83\x46\x30\x83G\xD8G0P\x81PDR",65); if(!s) return(1); c=INCREF(&nilobj); o=new_word("get-char",8); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("string-length",13); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("string-eqv?",11); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (eqv? a b) (let ((ot-a (object-type a))) (ifelse (eq? a b) #t (ifelse (neq? ot-a (object-type b)) #f (ifelse (or (eq? ot-a 'integer) (eq? ot-a 'bigint) (eq? ot-a 'float)) (= a b) (ifelse (eq? ot-a 'quote) (eqv? (unquote a) (unquote b)) (ifelse (eq? ot-a 'string) (string-eqv? a b) (ifelse (eq? ot-a 'cons) (and (eqv? (car a) (car b)) (eqv? (cdr a) (cdr b))) #f)))))))) // (#define 'eqv? (byte-compile '(a b) '(#let 'ot-a (object-type a) '(#ifelse (eq? a b) '#t '(#ifelse (not (eq? ot-a (object-type b))) '#f '(#ifelse (#or (#or (eq? ot-a 'integer) '(eq? ot-a 'bigint)) '(eq? ot-a 'float)) '(= a b) '(#ifelse (eq? ot-a 'quote) '(eqv? (unquote a) (unquote b)) '(#ifelse (eq? ot-a 'string) '(string-eqv? a b) '(#ifelse (eq? ot-a 'cons) '(#and (eqv? (car a) (car b)) '(eqv? (cdr a) (cdr b))) '#f))))))))) // (#lambda "\x82#\x81IO\x82I\x82I=\x85\x46\x30!\x80\xF1GI\x82IO=!\x84\x46\x30\x80\xE5GIL=I\x85TDI\x81L=I\x85TDI\x82L=\x89\x46\x82I\x82I\x82?\x80\xC7GI\x83L=\x8D\x46\x82I,\x82I,\x84Ll\x82\x43\xB4GI\x85L=\x8B\x46\x82I\x82I\x86Ll\x82\x43\xA3GI\x87L=\x9C\x46\x82Ia\x82Ia\x84Ll\x82\x43I\x8C\x46\x44\x82Id\x82Id\x84Ll\x82\x43\x81G0P\x82R" '(integer bigint float quote eqv? string string-eqv? cons)) // (#lambda "\x82#\x81IO\x82I\x82I=\x85\x46\x30!\x80\xF1GI\x82IO=!\x84\x46\x30\x80\xE5GIL=I\x85TDI\x81L=I\x85TDI\x82L=\x89\x46\x82I\x82I\x82?\x80\xC7GI\x83L=\x8D\x46\x82I,\x82I,\x84Ll\x82\x43\xB4GI\x85L=\x8B\x46\x82I\x82I\x86Ll\x82\x43\xA3GI\x87L=\x9C\x46\x82Ia\x82Ia\x84Ll\x82\x43I\x8C\x46\x44\x82Id\x82Id\x84Ll\x82\x43\x81G0P\x81PDR" '(integer bigint float quote eqv? string string-eqv? cons)) s=new_string("\x82#\x81IO\x82I\x82I=\x85\x46\x30!\x80\xF1GI\x82IO=!\x84\x46\x30\x80\xE5GIL=I\x85TDI\x81L=I\x85TDI\x82L=\x89\x46\x82I\x82I\x82?\x80\xC7GI\x83L=\x8D\x46\x82I,\x82I,\x84Ll\x82\x43\xB4GI\x85L=\x8B\x46\x82I\x82I\x86Ll\x82\x43\xA3GI\x87L=\x9C\x46\x82Ia\x82Ia\x84Ll\x82\x43I\x8C\x46\x44\x82Id\x82Id\x84Ll\x82\x43\x81G0P\x81PDR",135); if(!s) return(1); c=INCREF(&nilobj); o=new_word("cons",4); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("string-eqv?",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("string",6); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("eqv?",4); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("quote",5); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("float",5); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("bigint",6); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("integer",7); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("eqv?",4); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (concatenate-strings list) (let ((l list) (i 0)) (while l (set i (+ i (string-length (car l)))) (set l (cdr l))) (let ((s (new-string i))) (set i 0) (while list (let ((j 0)) (while (< j (string-length (car list))) (put-char s i (get-char (car list) j)) (set i (+ i 1)) (set j (+ j 1)))) (set list (cdr list))) s))) // (#define 'concatenate-strings (byte-compile '(list) '(#let 'l list '(#let 'i 0 '(#prog2of2 (#loop '(#ifelse l '(#prog2of2 (#set 'i (+ i (string-length (car l)))) '(#set 'l (cdr l))) '(#exit-loop #f))) '(#let 's (new-string i) '(#prog2of2 (#set 'i 0) '(#prog2of2 (#loop '(#ifelse list '(#prog2of2 (#let 'j 0 '(#loop '(#ifelse (< j (string-length (car list))) '(#prog2of2 (put-char s i (get-char (car list) j)) '(#prog2of2 (#set 'i (+ i 1)) '(#set 'j (+ j 1)))) '(#exit-loop #f)))) '(#set 'list (cdr list))) '(#exit-loop #f))) 's)))))))) // (#lambda "\x81#Ii\x81I\x95\x46I\x82IaLl\x81\x43+I\x81PD\x81IdI\x82P\x83G0\x83GD\xE1GDI\x81Ll\x81\x43iI\x82PD\x83I\x80\xC3\x46iI\x85IaLl\x81\x43\x81?\xA6\x46\x81I\x83I\x86Ia\x83I\x82Ll\x82\x43\x83Ll\x83\x43\x44\x82I\x81i+I\x83PDI\x81i+I\x81P\x83G0\x83GD\xC8GPD\x83IdI\x84P\x83G0\x84GD\xFF\xB1GDIPPP\x81R" '(string-length new-string get-char put-char)) // (#lambda "\x81#Ii\x81I\x91\x46I\x82IaLl\x81\x43+P\x81Id\x81P\xEBGI\x81Ll\x81\x43i\x81P\x83I\xB5\x46iI\x85IaLl\x81\x43\x81?\xA0\x46\x81I\x83I\x86Ia\x83I\x82Ll\x82\x43\x83Ll\x83\x43\x44\x82I\x81i+\x82P\x81i+\xD4GD\x83Id\x83P\xC7GPPPR" '(string-length new-string get-char put-char)) s=new_string("\x81#Ii\x81I\x91\x46I\x82IaLl\x81\x43+P\x81Id\x81P\xEBGI\x81Ll\x81\x43i\x81P\x83I\xB5\x46iI\x85IaLl\x81\x43\x81?\xA0\x46\x81I\x83I\x86Ia\x83I\x82Ll\x82\x43\x83Ll\x83\x43\x44\x82I\x81i+\x82P\x81i+\xD4GD\x83Id\x83P\xC7GPPPR",95); if(!s) return(1); c=INCREF(&nilobj); o=new_word("put-char",8); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("get-char",8); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("new-string",10); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("string-length",13); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("concatenate-strings",19); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (macro-define (string-concatenate o) (list 'concatenate-strings (cons 'list (cdr o)))) // (#macro-define 'string-concatenate (byte-compile '(o) '(cons 'concatenate-strings (cons (cons 'list (cdr o)) #f)))) // (#lambda "\x81#L\x81L\x82Idc0cc\x81R" '(concatenate-strings list)) // (#lambda "\x81#L\x81L\x82Idc0ccPR" '(concatenate-strings list)) s=new_string("\x81#L\x81L\x82Idc0ccPR",14); if(!s) return(1); c=INCREF(&nilobj); o=new_word("list",4); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("concatenate-strings",19); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("string-concatenate",18); if(!s) return(1); c=cons(s,o); if(!c) return(1); s=new_word("#macro-expansions",17); if(!s) return(1); INCREF(s); o=lookup(s); if(!o) return(1); o=cons(c,o); if(!o) return(1); o=set(s,o); if(!o) return(1); DECREF(o); // (define (string-gt? a b) (let ((i 0) (a-len (string-length a)) (b-len (string-length b)) (a-char #f) (b-char #f)) (loop (if (and (= i a-len) (= i b-len)) (exit-loop #f)) (if (= i a-len) (exit-loop #f)) (if (= i b-len) (exit-loop i)) (set a-char (get-char a i)) (set b-char (get-char b i)) (if (< a-char b-char) (exit-loop #f)) (if (> a-char b-char) (exit-loop i)) (set i (+ i 1))))) // (#define 'string-gt? (byte-compile '(a b) '(#let 'i 0 '(#let 'a-len (string-length a) '(#let 'b-len (string-length b) '(#let 'a-char #f '(#let 'b-char #f '(#loop '(#prog2of2 (#ifelse (#and (= i a-len) '(= i b-len)) '(#exit-loop #f) '#f) '(#prog2of2 (#ifelse (= i a-len) '(#exit-loop #f) '#f) '(#prog2of2 (#ifelse (= i b-len) '(#exit-loop i) '#f) '(#prog2of2 (#set 'a-char (get-char a i)) '(#prog2of2 (#set 'b-char (get-char b i)) '(#prog2of2 (#ifelse (< a-char b-char) '(#exit-loop #f) '#f) '(#prog2of2 (#ifelse (> a-char b-char) '(#exit-loop i) '#f) '(#set 'i (+ i 1))))))))))))))))) // (#lambda "\x82#i\x82ILl\x81\x43\x82ILl\x81\x43\x30\x30\x84I\x84I\x82?I\x87\x46\x44\x84I\x83I\x82?\x86\x46\x30\x80\xEAG\x81G0D\x84I\x84I\x82?\x86\x46\x30\x80\xDAG\x81G0D\x84I\x83I\x82?\x87\x46\x84I\x80\xC9G\x81G0D\x86I\x85I\x81Ll\x82\x43I\x82PD\x85I\x85I\x81Ll\x82\x43I\x81PD\x81I\x81I\x81?\x85\x46\x30\xA0G\x81G0D\x81I\x81I\x84?\x86\x46\x84I\x90G\x81G0D\x84I\x81i+I\x85PD\xFF\x80GPPPPP\x82R" '(string-length get-char)) // (#lambda "\x82#i\x82ILl\x81\x43\x82ILl\x81\x43\x30\x30\x84I\x84I\x82?I\x87\x46\x44\x84I\x83I\x82?\x84\x46\x30\x80\xCEG\x84I\x84I\x82?\x84\x46\x30\x80\xC2G\x84I\x83I\x82?\x84\x46\x84I\xB6G\x86I\x85I\x81Ll\x82\x43\x81P\x85I\x85I\x81Ll\x82\x43P\x81I\x81I\x81?\x83\x46\x30\x96G\x81I\x81I\x84?\x84\x46\x84I\x8AG\x84I\x81i+\x84P\xFF\x9CGPPPPP\x81PDR" '(string-length get-char)) s=new_string("\x82#i\x82ILl\x81\x43\x82ILl\x81\x43\x30\x30\x84I\x84I\x82?I\x87\x46\x44\x84I\x83I\x82?\x84\x46\x30\x80\xCEG\x84I\x84I\x82?\x84\x46\x30\x80\xC2G\x84I\x83I\x82?\x84\x46\x84I\xB6G\x86I\x85I\x81Ll\x82\x43\x81P\x85I\x85I\x81Ll\x82\x43P\x81I\x81I\x81?\x83\x46\x30\x96G\x81I\x81I\x84?\x84\x46\x84I\x8AG\x84I\x81i+\x84P\xFF\x9CGPPPPP\x81PDR",126); if(!s) return(1); c=INCREF(&nilobj); o=new_word("get-char",8); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("string-length",13); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("string-gt?",10); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (sort lst) (if (and lst (cdr lst)) (let ((prev #f)) (while (neq? prev lst) (set prev lst) (if (string-gt? (->string (car lst)) (->string (cadr lst))) (set lst (cons (cadr lst) (cons (car lst) (cddr lst))))) (let ((new (sort (cdr lst)))) (if (neq? new (cdr lst)) (set lst (cons (car lst) new))))))) lst) // (#define 'sort (byte-compile '(lst) '(#prog2of2 (#ifelse (#and lst '(cdr lst)) '(#let 'prev #f '(#loop '(#ifelse (not (eq? prev lst)) '(#prog2of2 (#set 'prev lst) '(#prog2of2 (#ifelse (string-gt? (->string (car lst)) (->string (car (cdr lst)))) '(#set 'lst (cons (car (cdr lst)) (cons (car lst) (cdr (cdr lst))))) '#f) '(#let 'new (sort (cdr lst)) '(#ifelse (not (eq? new (cdr lst))) '(#set 'lst (cons (car lst) new)) '#f)))) '(#exit-loop #f)))) '#f) 'lst))) // (#lambda "\x81#II\x83\x46\x44Id\x80\xE2\x46\x30I\x82I=!\x80\xCF\x46\x81II\x81PD\x81IaLl\x81\x43\x82IdaLl\x81\x43\x81Ll\x82\x43\x92\x46\x81Ida\x82Ia\x83IddccI\x82P\x81G0D\x81Id\x82Ll\x81\x43I\x83Id=!\x8B\x46\x82Ia\x81IcI\x83P\x81G0P\x83G0\x84GD\xFF\xA2GP\x81G0DI\x81R" '(->string string-gt? sort)) // (#lambda "\x81#II\x83\x46\x44Id\x80\xD3\x46\x30I\x82I=!\x80\xC9\x46\x81IP\x81IaLl\x81\x43\x82IdaLl\x81\x43\x81Ll\x82\x43\x8F\x46\x81Ida\x82Ia\x83Iddcc\x81P\x81Id\x82Ll\x81\x43I\x83Id=!\x8B\x46\x82Ia\x81IcI\x83P\x81G0PD\xFF\xAFGDR" '(->string string-gt? sort)) s=new_string("\x81#II\x83\x46\x44Id\x80\xD3\x46\x30I\x82I=!\x80\xC9\x46\x81IP\x81IaLl\x81\x43\x82IdaLl\x81\x43\x81Ll\x82\x43\x8F\x46\x81Ida\x82Ia\x83Iddcc\x81P\x81Id\x82Ll\x81\x43I\x83Id=!\x8B\x46\x82Ia\x81IcI\x83P\x81G0PD\xFF\xAFGDR",96); if(!s) return(1); c=INCREF(&nilobj); o=new_word("sort",4); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("string-gt?",10); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("->string",8); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("sort",4); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (list-length a) (let ((len 0)) (while a (set len (+ len 1)) (set a (cdr a))) len)) // (#define 'list-length (byte-compile '(a) '(#let 'len 0 '(#prog2of2 (#loop '(#ifelse a '(#prog2of2 (#set 'len (+ len 1)) '(#set 'a (cdr a))) '(#exit-loop #f))) 'len)))) // (#lambda "\x81#i\x81I\x90\x46I\x81i+I\x81PD\x81IdI\x82P\x83G0\x83GD\xE6GDIP\x81R" '#f) // (#lambda "\x81#i\x81I\x8A\x46\x81i+\x81Id\x81P\xF2GPR" '#f) s=new_string("\x81#i\x81I\x8A\x46\x81i+\x81Id\x81P\xF2GPR",19); if(!s) return(1); c=INCREF(&nilobj); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("list-length",11); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (nth-item list n) (while (< 0 n) (set list (cdr list)) (set n (- n 1))) (car list)) // (#define 'nth-item (byte-compile '(list n) '(#prog2of2 (#loop '(#ifelse (< 0 n) '(#prog2of2 (#set 'list (cdr list)) '(#set 'n (- n 1))) '(#exit-loop #f))) '(car list)))) // (#lambda "\x82#i\x81I\x81?\x90\x46\x81IdI\x82PDI\x81i-I\x81P\x83G0\x83GD\xE3GD\x81Ia\x82R" '#f) // (#lambda "\x82#i\x81I\x81?\x8A\x46\x81Id\x81P\x81i-\xEFG\x81Ia\x81PDR" '#f) s=new_string("\x82#i\x81I\x81?\x8A\x46\x81Id\x81P\x81i-\xEFG\x81Ia\x81PDR",26); if(!s) return(1); c=INCREF(&nilobj); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("nth-item",8); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (list-index list item) (let ((i 0)) (while list (if (eq? item (car list)) (exit-loop i)) (set i (+ i 1)) (set list (cdr list))))) // (#define 'list-index (byte-compile '(list item) '(#let 'i 0 '(#loop '(#ifelse list '(#prog2of2 (#ifelse (eq? item (car list)) '(#exit-loop i) '#f) '(#prog2of2 (#set 'i (+ i 1)) '(#set 'list (cdr list)))) '(#exit-loop #f)))))) // (#lambda "\x82#i\x82I\x9F\x46\x81I\x83Ia=\x85\x46I\x9AG\x81G0DI\x81i+I\x81PD\x82IdI\x83P\x83G0\x83GD\xD7GP\x82R" '#f) // (#lambda "\x82#i\x82I\x95\x46\x81I\x83Ia=\x83\x46I\x8BG\x81i+\x82Id\x82P\xE7G0P\x81PDR" '#f) s=new_string("\x82#i\x82I\x95\x46\x81I\x83Ia=\x83\x46I\x8BG\x81i+\x82Id\x82P\xE7G0P\x81PDR",34); if(!s) return(1); c=INCREF(&nilobj); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("list-index",10); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (list-rindex list item) (let ((i 0) (pos #f)) (while list (if (eq? item (car list)) (set pos i)) (set i (+ i 1)) (set list (cdr list))) pos)) // (#define 'list-rindex (byte-compile '(list item) '(#let 'i 0 '(#let 'pos #f '(#prog2of2 (#loop '(#ifelse list '(#prog2of2 (#ifelse (eq? item (car list)) '(#set 'pos i) '#f) '(#prog2of2 (#set 'i (+ i 1)) '(#set 'list (cdr list)))) '(#exit-loop #f))) 'pos))))) // (#lambda "\x82#i0\x83I\xA2\x46\x82I\x84Ia=\x87\x46\x81II\x81P\x81G0D\x81I\x81i+I\x82PD\x83IdI\x84P\x83G0\x83GD\xD4GDIPP\x82R" '#f) // (#lambda "\x82#i0\x83I\x99\x46\x82I\x84Ia=\x83\x46\x81IP\x81I\x81i+\x81P\x83Id\x83P\xE3GP\x81PDR" '#f) s=new_string("\x82#i0\x83I\x99\x46\x82I\x84Ia=\x83\x46\x81IP\x81I\x81i+\x81P\x83Id\x83P\xE3GP\x81PDR",38); if(!s) return(1); c=INCREF(&nilobj); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("list-rindex",11); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (reverse-get-with-eqv? hash item) (while hash (if (eqv? (cdr (car hash)) item) (exit-loop (car (car hash)))) (set hash (cdr hash)))) // (#define 'reverse-get-with-eqv? (byte-compile '(hash item) '(#loop '(#ifelse hash '(#prog2of2 (#ifelse (eqv? (cdr (car hash)) item) '(#exit-loop (car (car hash))) '#f) '(#set 'hash (cdr hash))) '(#exit-loop #f))))) // (#lambda "\x82#\x81I\x9E\x46\x81Iad\x81ILl\x82\x43\x88\x46\x81Iaa\x92G\x81G0D\x81IdI\x82P\x83G0\x83GD\xD8G\x82R" '(eqv?)) // (#lambda "\x82#\x81I\x9B\x46\x81Iad\x81ILl\x82\x43\x88\x46\x81Iaa\x81PDR\x81Id\x81P\xE1G0\x81PDR" '(eqv?)) s=new_string("\x82#\x81I\x9B\x46\x81Iad\x81ILl\x82\x43\x88\x46\x81Iaa\x81PDR\x81Id\x81P\xE1G0\x81PDR",38); if(!s) return(1); c=INCREF(&nilobj); o=new_word("eqv?",4); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("reverse-get-with-eqv?",21); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (switch-handle-map var cases) (let ((result #f)) (while cases (set result (cons (list 'eq? var (car cases)) result)) (set cases (cdr cases))) (reverse result))) // (#define 'switch-handle-map (byte-compile '(var cases) '(#let 'result #f '(#prog2of2 (#loop '(#ifelse cases '(#prog2of2 (#set 'result (cons (cons 'eq? (cons var (cons (car cases) #f))) result)) '(#set 'cases (cdr cases))) '(#exit-loop #f))) '(#append/reversed #f result))))) // (#lambda "\x82#0\x81I\x99\x46L\x83I\x83Ia0ccc\x81IcI\x81PD\x81IdI\x82P\x83G0\x83GD\xDDGD0\x81II\x8B\x46Ia\x82Ic\x81PdI\xF5TDP\x82R" '(eq?)) // (#lambda "\x82#0\x81I\x95\x46L\x83I\x83Ia0ccc\x81IcP\x81Id\x81P\xE7G0\x81II\x8B\x46Ia\x82Ic\x81PdI\xF5TDP\x81PDR" '(eq?)) s=new_string("\x82#0\x81I\x95\x46L\x83I\x83Ia0ccc\x81IcP\x81Id\x81P\xE7G0\x81II\x8B\x46Ia\x82Ic\x81PdI\xF5TDP\x81PDR",51); if(!s) return(1); c=INCREF(&nilobj); o=new_word("eq?",3); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("switch-handle-map",17); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (switch-handle var cases) (ifelse cases (ifelse (eq? 'else (caar cases)) (cons 'progn (cdar cases)) (ifelse (caar cases) (list 'ifelse (cons 'or (switch-handle-map var (caar cases))) (cons 'progn (cdar cases)) (switch-handle var (cdr cases))) (switch-handle var (cdr cases)))) #f)) // (#define 'switch-handle (byte-compile '(var cases) '(#ifelse cases '(#ifelse (eq? 'else (car (car cases))) '(cons 'progn (cdr (car cases))) '(#ifelse (car (car cases)) '(cons 'ifelse (cons (cons 'or (switch-handle-map var (car (car cases)))) (cons (cons 'progn (cdr (car cases))) (cons (switch-handle var (cdr cases)) #f)))) '(switch-handle var (cdr cases)))) '#f))) // (#lambda "\x82#I\x80\xCA\x46L\x81Iaa=\x89\x46\x81L\x81Iadc\xB7GIaa\xA8\x46\x82L\x83L\x83I\x83Iaa\x84Ll\x82\x43\x63\x81L\x83Iadc\x84I\x84Id\x85Ll\x82\x43\x30\x63\x63\x63\x63\x8AG\x81I\x81Id\x85Ll\x82\x43\x81G0\x82R" '(else progn ifelse or switch-handle-map switch-handle)) // (#lambda "\x82#I\x80\xD0\x46L\x81Iaa=\x8B\x46\x81L\x81Iadc\x81PDRIaa\xAA\x46\x82L\x83L\x83I\x83Iaa\x84Ll\x82\x43\x63\x81L\x83Iadc\x84I\x84Id\x85Ll\x82\x43\x30\x63\x63\x63\x63\x81PDR\x81I\x81Id\x81P\x81P\x85Ll\x82r0\x81PDR" '(else progn ifelse or switch-handle-map switch-handle)) s=new_string("\x82#I\x80\xD0\x46L\x81Iaa=\x8B\x46\x81L\x81Iadc\x81PDRIaa\xAA\x46\x82L\x83L\x83I\x83Iaa\x84Ll\x82\x43\x63\x81L\x83Iadc\x84I\x84Id\x85Ll\x82\x43\x30\x63\x63\x63\x63\x81PDR\x81I\x81Id\x81P\x81P\x85Ll\x82r0\x81PDR",91); if(!s) return(1); c=INCREF(&nilobj); o=new_word("switch-handle",13); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("switch-handle-map",17); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("or",2); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("ifelse",6); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("progn",5); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("else",4); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("switch-handle",13); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (macro-define (switch o) (let ((var (unique-word))) (list 'progn (list 'let (list (list var (cadr o))) (switch-handle var (cddr o)))))) // (#macro-define 'switch (byte-compile '(o) '(#let 'var (unique-word) '(cons 'progn (cons (cons 'let (cons (cons (cons var (cons (car (cdr o)) #f)) #f) (cons (switch-handle var (cdr (cdr o))) #f))) #f))))) // (#lambda "\x81#LlC\x81L\x82L\x82I\x84Ida0cc0c\x83I\x85Idd\x83Ll\x82\x43\x30\x63\x63\x63\x30\x63\x63P\x81R" '(unique-word progn let switch-handle)) // (#lambda "\x81#LlC\x81L\x82L\x82I\x84Ida0cc0c\x83I\x85Idd\x83Ll\x82\x43\x30\x63\x63\x63\x30\x63\x63PPR" '(unique-word progn let switch-handle)) s=new_string("\x81#LlC\x81L\x82L\x82I\x84Ida0cc0c\x83I\x85Idd\x83Ll\x82\x43\x30\x63\x63\x63\x30\x63\x63PPR",41); if(!s) return(1); c=INCREF(&nilobj); o=new_word("switch-handle",13); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("let",3); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("progn",5); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("unique-word",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("switch",6); if(!s) return(1); c=cons(s,o); if(!c) return(1); s=new_word("#macro-expansions",17); if(!s) return(1); INCREF(s); o=lookup(s); if(!o) return(1); o=cons(c,o); if(!o) return(1); o=set(s,o); if(!o) return(1); DECREF(o); // (define (show-error error errorvalue) (write-newline #standard-error) (write-string #standard-error "EXCEPTION: ") (write-object #standard-error error) (write-newline #standard-error) (write-string #standard-error "EXCEPTION-VALUE: ") (write-object #standard-error errorvalue) (write-newline #standard-error)) // (#define 'show-error (byte-compile '(error errorvalue) '(#prog2of2 (write-newline #standard-error) '(#prog2of2 (write-string #standard-error "EXCEPTION: ") '(#prog2of2 (write-object #standard-error error) '(#prog2of2 (write-newline #standard-error) '(#prog2of2 (write-string #standard-error "EXCEPTION-VALUE: ") '(#prog2of2 (write-object #standard-error errorvalue) '(write-newline #standard-error))))))))) // (#lambda "\x82#Ll\x81Ll\x81\x43\x44Ll\x82L\x83Ll\x82\x43\x44Ll\x82I\x84Ll\x82\x43\x44Ll\x81Ll\x81\x43\x44Ll\x85L\x83Ll\x82\x43\x44Ll\x81I\x84Ll\x82\x43\x44Ll\x81Ll\x81\x43\x82R" '(#standard-error write-newline "EXCEPTION: " write-string write-object "EXCEPTION-VALUE: ")) // (#lambda "\x82#Ll\x81Ll\x81\x43\x44Ll\x82L\x83Ll\x82\x43\x44Ll\x82I\x84Ll\x82\x43\x44Ll\x81Ll\x81\x43\x44Ll\x85L\x83Ll\x82\x43\x44Ll\x81I\x84Ll\x82\x43\x44Ll\x81PD\x81Ll\x81r" '(#standard-error write-newline "EXCEPTION: " write-string write-object "EXCEPTION-VALUE: ")) s=new_string("\x82#Ll\x81Ll\x81\x43\x44Ll\x82L\x83Ll\x82\x43\x44Ll\x82I\x84Ll\x82\x43\x44Ll\x81Ll\x81\x43\x44Ll\x85L\x83Ll\x82\x43\x44Ll\x81I\x84Ll\x82\x43\x44Ll\x81PD\x81Ll\x81r",68); if(!s) return(1); c=INCREF(&nilobj); o=new_string("EXCEPTION-VALUE: ",17); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("write-object",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("write-string",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_string("EXCEPTION: ",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("write-newline",13); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("#standard-error",15); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("show-error",10); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (read-eval-print in out prompt) (let ((o #f)) (loop (if prompt (write-string out prompt)) (set o (catch 'end-of-file (catch 'reader-error (read-object in) (progn (show-error #exception #exceptionvalue) (ifelse prompt (next-loop) (exit-loop #t)))) (progn (if prompt (write-newline out)) (exit-loop)))) (set o (catch #f ((byte-compile #f (macro-expand o))) (progn (show-error #exception #exceptionvalue) (ifelse prompt (next-loop) (exit-loop #t))))) (if (and prompt o) (write-object out o) (write-newline out))))) // (#define 'read-eval-print (byte-compile '(in out prompt) '(#let 'o #f '(#loop '(#prog2of2 (#ifelse prompt '(write-string out prompt) '#f) '(#prog2of2 (#set 'o (#catch 'end-of-file '(#catch 'reader-error '(read-object in) '(#prog2of2 (show-error #exception #exceptionvalue) '(#ifelse prompt '(#next-loop) '(#exit-loop #t)))) '(#prog2of2 (#ifelse prompt '(write-newline out) '#f) '(#exit-loop #f)))) '(#prog2of2 (#set 'o (#catch #f '((byte-compile #f (macro-expand o))) '(#prog2of2 (show-error #exception #exceptionvalue) '(#ifelse prompt '(#next-loop) '(#exit-loop #t))))) '(#ifelse (#and prompt 'o) '(#prog2of2 (write-object out o) '(write-newline out)) '#f)))))))) // (#lambda "\x83#0\x81I\x8A\x46\x82I\x82ILl\x82\x43\x81G0D\xAF{\x8A{\x83I\x81Ll\x81\x43}\xA0G\x82L1=\x83T21:12\x83Ll\x82\x43\x44\x81I\x85\x46}\xCAG\x86G0!}\x80\xF0G}\x9CG\x84L1=\x83T21:\x81I\x89\x46\x82I\x85Ll\x81\x43\x81G0D0\x80\xD1GI\x81PD\x91{0\x81I\x86Ll\x81\x43\x87Ll\x82\x43\x43}\x95G12\x83Ll\x82\x43\x44\x81I\x85\x46\xFE\xFDG\x84G0!\xA5GI\x81PD\x81II\x82\x46\x44I\x93\x46\x82I\x81I\x88Ll\x82\x43\x44\x82I\x85Ll\x81\x43\x81G0D\xFE\xD2GP\x83R" '(write-string read-object reader-error show-error end-of-file write-newline macro-expand byte-compile write-object)) // (#lambda "\x83#0\x81I\x89\x46\x82I\x82ILl\x82\x43\x44\xAD{\x8A{\x83I\x81Ll\x81\x43}\x9EG\x82L1=\x83T21:12\x83Ll\x82\x43\x44\x81I\x83\x46}\xCDG0!}\x80\xE3G}\x99G\x84L1=\x83T21:\x81I\x88\x46\x82I\x85Ll\x81\x43\x44\x30\x80\xC7GP\x91{0\x81I\x86Ll\x81\x43\x87Ll\x82\x43\x43}\x91G12\x83Ll\x82\x43\x44\x81I\xFF\x8AT0!\xA2GP\x81II\x82\x46\x44I\x95\x46\x82I\x81I\x88Ll\x82\x43\x44\x82I\x85Ll\x81\x43\x44\xFE\xE7G\xFE\xE4GP\x82P\x81\x44R" '(write-string read-object reader-error show-error end-of-file write-newline macro-expand byte-compile write-object)) s=new_string("\x83#0\x81I\x89\x46\x82I\x82ILl\x82\x43\x44\xAD{\x8A{\x83I\x81Ll\x81\x43}\x9EG\x82L1=\x83T21:12\x83Ll\x82\x43\x44\x81I\x83\x46}\xCDG0!}\x80\xE3G}\x99G\x84L1=\x83T21:\x81I\x88\x46\x82I\x85Ll\x81\x43\x44\x30\x80\xC7GP\x91{0\x81I\x86Ll\x81\x43\x87Ll\x82\x43\x43}\x91G12\x83Ll\x82\x43\x44\x81I\xFF\x8AT0!\xA2GP\x81II\x82\x46\x44I\x95\x46\x82I\x81I\x88Ll\x82\x43\x44\x82I\x85Ll\x81\x43\x44\xFE\xE7G\xFE\xE4GP\x82P\x81\x44R",165); if(!s) return(1); c=INCREF(&nilobj); o=new_word("write-object",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("byte-compile",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("macro-expand",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("write-newline",13); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("end-of-file",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("show-error",10); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("reader-error",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("read-object",11); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("write-string",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("read-eval-print",15); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o); // (define (#init) (define #t (not #f)) (if (and #argv (eqv? "-l" (car #argv))) (set #argv (cdr #argv)) (while #argv (let ((file (car #argv))) (set #argv (cdr #argv)) (load-file file)))) (ifelse #argv (let ((file (car #argv))) (set #argv (cdr #argv)) (load-file file)) (read-eval-print #standard-in #standard-out (ifelse (isatty #standard-in) "mikelisp> " #f)))) // (#define '#init (byte-compile '#f '(#prog2of2 (#define '#t (not #f)) '(#prog2of2 (#ifelse (#and #argv '(eqv? "-l" (car #argv))) '(#prog2of2 (#set '#argv (cdr #argv)) '(#loop '(#ifelse #argv '(#let 'file (car #argv) '(#prog2of2 (#set '#argv (cdr #argv)) '(load-file file))) '(#exit-loop #f)))) '#f) '(#ifelse #argv '(#let 'file (car #argv) '(#prog2of2 (#set '#argv (cdr #argv)) '(load-file file))) '(read-eval-print #standard-in #standard-out (#ifelse (isatty #standard-in) '"mikelisp> " '#f))))))) // (#lambda "#0!LAD\x81LlI\x8C\x46\x44\x82L\x81Lla\x83Ll\x82\x43\xAA\x46\x81Lld\x81LSD\x81Ll\x95\x46\x81Lla\x81Lld\x81LSDI\x84Ll\x81\x43P\x83G0\x83GD\xE0G\x81G0D\x81Ll\x95\x46\x81Lla\x81Lld\x81LSDI\x84Ll\x81\x43P\x9AG\x85Ll\x86Ll\x85Ll\x87Ll\x81\x43\x84\x46\x88L\x81G0\x89Ll\x83\x43R" '(#t #argv "-l" eqv? load-file #standard-in #standard-out isatty "mikelisp> " read-eval-print)) // (#lambda "#0!LAD\x81LlI\x8C\x46\x44\x82L\x81Lla\x83Ll\x82\x43\xA3\x46\x81Lld\x81LSD\x81Ll\x96\x46\x81Lla\x81Lld\x81LSDI\x84Ll\x81\x43PD\xE5G\x81Ll\x94\x46\x81Lla\x81Lld\x81LSDI\x84Ll\x81\x43PR\x85Ll\x86Ll\x85Ll\x87Ll\x81\x43\x84\x46\x88L\x81G0\x89Ll\x83r" '(#t #argv "-l" eqv? load-file #standard-in #standard-out isatty "mikelisp> " read-eval-print)) s=new_string("#0!LAD\x81LlI\x8C\x46\x44\x82L\x81Lla\x83Ll\x82\x43\xA3\x46\x81Lld\x81LSD\x81Ll\x96\x46\x81Lla\x81Lld\x81LSDI\x84Ll\x81\x43PD\xE5G\x81Ll\x94\x46\x81Lla\x81Lld\x81LSDI\x84Ll\x81\x43PR\x85Ll\x86Ll\x85Ll\x87Ll\x81\x43\x84\x46\x88L\x81G0\x89Ll\x83r",112); if(!s) return(1); c=INCREF(&nilobj); o=new_word("read-eval-print",15); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_string("mikelisp> ",10); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("isatty",6); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("#standard-out",13); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("#standard-in",12); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("load-file",9); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("eqv?",4); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_string("-l",2); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("#argv",5); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_word("#t",2); if(!o) return(1); c=cons(o,c); if(!c) return(1); o=new_object(&bytefunc_objtype); if(!o) return(1); o->value.bytefunc.code=s; o->value.bytefunc.objs=c; s=new_word("#init",5); if(!s) return(1); o=define(s,o); if(!o) return(1); DECREF(o);