From c1a7f6d2d8455c8159641c20d90cb99b66617bf5 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Tue, 4 Apr 2017 19:00:37 +0900 Subject: [PATCH] integrate boot.scm and compile.scm --- Makefile | 6 +- lib/ext/boot.c | 817 +++++++++++++++++++------------------ lib/include/picconf.h | 1 + lib/include/picrin/setup.h | 4 + piclib/boot.scm | 362 ---------------- piclib/compile.scm | 366 +++++++++++++++++ tools/mkboot.scm | 11 +- 7 files changed, 789 insertions(+), 778 deletions(-) delete mode 100644 piclib/boot.scm diff --git a/Makefile b/Makefile index 29895f54..1bc84673 100644 --- a/Makefile +++ b/Makefile @@ -76,8 +76,8 @@ src/init_contrib.c: # libpicrin.so: $(LIBPICRIN_OBJS) # $(CC) -shared $(CFLAGS) -o $@ $(LIBPICRIN_OBJS) $(LDFLAGS) -lib/ext/boot.c: piclib/boot.scm piclib/compile.scm piclib/library.scm - cat piclib/boot.scm piclib/compile.scm piclib/library.scm | bin/picrin-bootstrap tools/mkboot.scm > lib/ext/boot.c +lib/ext/boot.c: piclib/compile.scm piclib/library.scm + cat piclib/compile.scm piclib/library.scm | bin/picrin-bootstrap tools/mkboot.scm > lib/ext/boot.c $(LIBPICRIN_OBJS) $(PICRIN_OBJS) $(CONTRIB_OBJS): lib/include/picrin.h lib/include/picrin/*.h lib/khash.h lib/object.h lib/state.h lib/vm.h @@ -97,7 +97,7 @@ test: test-contribs test-nostdlib test-issue test-contribs: picrin $(CONTRIB_TESTS) test-nostdlib: lib/ext/boot.c - $(CC) -I./lib -I./lib/include -D'PIC_USE_LIBC=0' -D'PIC_USE_STDIO=0' -D'PIC_USE_WRITE=0' -D'PIC_USE_LIBRARY=0' -ffreestanding -nostdlib -Os -fPIC -shared -std=c89 -pedantic -Wall -Wextra -Werror -o libpicrin-tiny.so $(LIBPICRIN_SRCS) etc/libc_polyfill.c -fno-stack-protector + $(CC) -I./lib -I./lib/include -D'PIC_USE_LIBC=0' -D'PIC_USE_STDIO=0' -D'PIC_USE_WRITE=0' -D'PIC_USE_LIBRARY=0' -D'PIC_USE_EVAL=0' -ffreestanding -nostdlib -Os -fPIC -shared -std=c89 -pedantic -Wall -Wextra -Werror -o libpicrin-tiny.so $(LIBPICRIN_SRCS) etc/libc_polyfill.c -fno-stack-protector strip libpicrin-tiny.so ls -lh libpicrin-tiny.so rm -f libpicrin-tiny.so diff --git a/lib/ext/boot.c b/lib/ext/boot.c index cd0d1626..2b052e60 100644 --- a/lib/ext/boot.c +++ b/lib/ext/boot.c @@ -1,257 +1,7 @@ #include "picrin.h" #include "picrin/extra.h" -static const char boot_rom[][80] = { -"((core#lambda (.define-transformer.2149 .the.2150) ((core#lambda (.the-core-defi", -"ne.2151 .the-core-lambda.2152 .the-core-begin.2153 .the-core-quote.2154 .the-cor", -"e-set!.2155 .the-core-if.2156 .the-core-define-macro.2157 .the-define.2158 .the-", -"lambda.2159 .the-begin.2160 .the-quote.2161 .the-set!.2162 .the-if.2163 .the-def", -"ine-macro.2164) (core#begin (.define-transformer.2149 (core#quote quote) (core#l", -"ambda (.form.2169 .env.2170) (core#if (= (length .form.2169) 2) (cons .the-core-", -"quote.2154 (cons (cadr .form.2169) (core#quote ()))) (error \"malformed quote\" .f", -"orm.2169)))) (core#begin (.define-transformer.2149 (core#quote if) (core#lambda ", -"(.form.2171 .env.2172) ((core#lambda (.len.2173) (core#if (= .len.2173 3) (appen", -"d .form.2171 (cons (core#quote #undefined) (core#quote ()))) (core#if (= .len.21", -"73 4) (cons .the-core-if.2156 (cdr .form.2171)) (error \"malformed if\" .form.2171", -")))) (length .form.2171)))) (core#begin (.define-transformer.2149 (core#quote be", -"gin) (core#lambda (.form.2174 .env.2175) ((core#lambda (.len.2176) (core#if (= .", -"len.2176 1) #undefined (core#if (= .len.2176 2) (cadr .form.2174) (core#if (= .l", -"en.2176 3) (cons .the-core-begin.2153 (cdr .form.2174)) (cons .the-core-begin.21", -"53 (cons (cadr .form.2174) (cons (cons .the-begin.2160 (cddr .form.2174)) (core#", -"quote ())))))))) (length .form.2174)))) (core#begin (.define-transformer.2149 (c", -"ore#quote set!) (core#lambda (.form.2177 .env.2178) (core#if (core#if (= (length", -" .form.2177) 3) (identifier? (cadr .form.2177)) #f) (cons .the-core-set!.2155 (c", -"dr .form.2177)) (error \"malformed set!\" .form.2177)))) (core#begin (core#define ", -".check-formal.2165 (core#lambda (.formal.2179) ((core#lambda (.it.2180) (core#if", -" .it.2180 .it.2180 ((core#lambda (.it.2181) (core#if .it.2181 .it.2181 ((core#la", -"mbda (.it.2182) (core#if .it.2182 .it.2182 #f)) (core#if (pair? .formal.2179) (c", -"ore#if (identifier? (car .formal.2179)) (.check-formal.2165 (cdr .formal.2179)) ", -"#f) #f)))) (identifier? .formal.2179)))) (null? .formal.2179)))) (core#begin (.d", -"efine-transformer.2149 (core#quote lambda) (core#lambda (.form.2183 .env.2184) (", -"core#if (= (length .form.2183) 1) (error \"malformed lambda\" .form.2183) (core#if", -" (.check-formal.2165 (cadr .form.2183)) (cons .the-core-lambda.2152 (cons (cadr ", -".form.2183) (cons (cons .the-begin.2160 (cddr .form.2183)) (core#quote ())))) (e", -"rror \"malformed lambda\" .form.2183))))) (core#begin (.define-transformer.2149 (c", -"ore#quote define) (core#lambda (.form.2185 .env.2186) ((core#lambda (.len.2187) ", -"(core#if (= .len.2187 1) (error \"malformed define\" .form.2185) ((core#lambda (.f", -"ormal.2188) (core#if (identifier? .formal.2188) (core#if (= .len.2187 3) (cons .", -"the-core-define.2151 (cdr .form.2185)) (error \"malformed define\" .form.2185)) (c", -"ore#if (pair? .formal.2188) (cons .the-define.2158 (cons (car .formal.2188) (con", -"s (cons .the-lambda.2159 (cons (cdr .formal.2188) (cddr .form.2185))) (core#quot", -"e ())))) (error \"define: binding to non-varaible object\" .form.2185)))) (cadr .f", -"orm.2185)))) (length .form.2185)))) (core#begin (.define-transformer.2149 (core#", -"quote define-macro) (core#lambda (.form.2189 .env.2190) (core#if (= (length .for", -"m.2189) 3) (core#if (identifier? (cadr .form.2189)) (cons .the-core-define-macro", -".2157 (cdr .form.2189)) (error \"define-macro: binding to non-variable object\" .f", -"orm.2189)) (error \"malformed define-macro\" .form.2189)))) (core#begin #undefined", -" (core#begin (.define-transformer.2149 (core#quote else) (core#lambda ._.2191 (e", -"rror \"invalid use of auxiliary syntax\" (core#quote else)))) (core#begin (.define", -"-transformer.2149 (core#quote =>) (core#lambda ._.2192 (error \"invalid use of au", -"xiliary syntax\" (core#quote =>)))) (core#begin (.define-transformer.2149 (core#q", -"uote unquote) (core#lambda ._.2193 (error \"invalid use of auxiliary syntax\" (cor", -"e#quote unquote)))) (core#begin (.define-transformer.2149 (core#quote unquote-sp", -"licing) (core#lambda ._.2194 (error \"invalid use of auxiliary syntax\" (core#quot", -"e unquote-splicing)))) (core#begin (.define-transformer.2149 (core#quote let) (c", -"ore#lambda (.form.2195 .env.2196) (core#if (identifier? (cadr .form.2195)) ((cor", -"e#lambda (.name.2197 .formal.2198 .body.2199) (cons (cons .the-lambda.2159 (cons", -" (core#quote ()) (cons (cons .the-define.2158 (cons (cons .name.2197 (map car .f", -"ormal.2198)) .body.2199)) (cons (cons .name.2197 (map cadr .formal.2198)) (core#", -"quote ()))))) (core#quote ()))) (car (cdr .form.2195)) (car (cdr (cdr .form.2195", -"))) (cdr (cdr (cdr .form.2195)))) ((core#lambda (.formal.2200 .body.2201) (cons ", -"(cons .the-lambda.2159 (cons (map car .formal.2200) .body.2201)) (map cadr .form", -"al.2200))) (car (cdr .form.2195)) (cdr (cdr .form.2195)))))) (core#begin (.defin", -"e-transformer.2149 (core#quote and) (core#lambda (.form.2202 .env.2203) (core#if", -" (null? (cdr .form.2202)) #t (core#if (null? (cddr .form.2202)) (cadr .form.2202", -") (cons .the-if.2163 (cons (cadr .form.2202) (cons (cons (.the.2150 (core#quote ", -"and)) (cddr .form.2202)) (cons (core#quote #f) (core#quote ()))))))))) (core#beg", -"in (.define-transformer.2149 (core#quote or) (core#lambda (.form.2204 .env.2205)", -" (core#if (null? (cdr .form.2204)) #f ((core#lambda (.tmp.2206) (cons (.the.2150", -" (core#quote let)) (cons (cons (cons .tmp.2206 (cons (cadr .form.2204) (core#quo", -"te ()))) (core#quote ())) (cons (cons .the-if.2163 (cons .tmp.2206 (cons .tmp.22", -"06 (cons (cons (.the.2150 (core#quote or)) (cddr .form.2204)) (core#quote ()))))", -") (core#quote ()))))) (make-identifier (core#quote it) .env.2205))))) (core#begi", -"n (.define-transformer.2149 (core#quote cond) (core#lambda (.form.2207 .env.2208", -") ((core#lambda (.clauses.2209) (core#if (null? .clauses.2209) #undefined ((core", -"#lambda (.clause.2210) (core#if (core#if (identifier? (car .clause.2210)) (ident", -"ifier=? (.the.2150 (core#quote else)) (make-identifier (car .clause.2210) .env.2", -"208)) #f) (cons .the-begin.2160 (cdr .clause.2210)) (core#if (null? (cdr .clause", -".2210)) (cons (.the.2150 (core#quote or)) (cons (car .clause.2210) (cons (cons (", -".the.2150 (core#quote cond)) (cdr .clauses.2209)) (core#quote ())))) (core#if (c", -"ore#if (identifier? (cadr .clause.2210)) (identifier=? (.the.2150 (core#quote =>", -")) (make-identifier (cadr .clause.2210) .env.2208)) #f) ((core#lambda (.tmp.2211", -") (cons (.the.2150 (core#quote let)) (cons (cons (cons .tmp.2211 (cons (car .cla", -"use.2210) (core#quote ()))) (core#quote ())) (cons (cons .the-if.2163 (cons .tmp", -".2211 (cons (cons (cadr (cdr .clause.2210)) (cons .tmp.2211 (core#quote ()))) (c", -"ons (cons (.the.2150 (core#quote cond)) (cddr .form.2207)) (core#quote ()))))) (", -"core#quote ()))))) (make-identifier (core#quote tmp) .env.2208)) (cons .the-if.2", -"163 (cons (car .clause.2210) (cons (cons .the-begin.2160 (cdr .clause.2210)) (co", -"ns (cons (.the.2150 (core#quote cond)) (cdr .clauses.2209)) (core#quote ()))))))", -"))) (car .clauses.2209)))) (cdr .form.2207)))) (core#begin (.define-transformer.", -"2149 (core#quote quasiquote) (core#lambda (.form.2212 .env.2213) (core#begin (co", -"re#define .quasiquote?.2214 (core#lambda (.form.2218) (core#if (pair? .form.2218", -") (core#if (identifier? (car .form.2218)) (identifier=? (.the.2150 (core#quote q", -"uasiquote)) (make-identifier (car .form.2218) .env.2213)) #f) #f))) (core#begin ", -"(core#define .unquote?.2215 (core#lambda (.form.2219) (core#if (pair? .form.2219", -") (core#if (identifier? (car .form.2219)) (identifier=? (.the.2150 (core#quote u", -"nquote)) (make-identifier (car .form.2219) .env.2213)) #f) #f))) (core#begin (co", -"re#define .unquote-splicing?.2216 (core#lambda (.form.2220) (core#if (pair? .for", -"m.2220) (core#if (pair? (car .form.2220)) (core#if (identifier? (caar .form.2220", -")) (identifier=? (.the.2150 (core#quote unquote-splicing)) (make-identifier (caa", -"r .form.2220) .env.2213)) #f) #f) #f))) (core#begin (core#define .qq.2217 (core#", -"lambda (.depth.2221 .expr.2222) (core#if (.unquote?.2215 .expr.2222) (core#if (=", -" .depth.2221 1) (cadr .expr.2222) (list (.the.2150 (core#quote list)) (list (.th", -"e.2150 (core#quote quote)) (.the.2150 (core#quote unquote))) (.qq.2217 (- .depth", -".2221 1) (car (cdr .expr.2222))))) (core#if (.unquote-splicing?.2216 .expr.2222)", -" (core#if (= .depth.2221 1) (list (.the.2150 (core#quote append)) (car (cdr (car", -" .expr.2222))) (.qq.2217 .depth.2221 (cdr .expr.2222))) (list (.the.2150 (core#q", -"uote cons)) (list (.the.2150 (core#quote list)) (list (.the.2150 (core#quote quo", -"te)) (.the.2150 (core#quote unquote-splicing))) (.qq.2217 (- .depth.2221 1) (car", -" (cdr (car .expr.2222))))) (.qq.2217 .depth.2221 (cdr .expr.2222)))) (core#if (.", -"quasiquote?.2214 .expr.2222) (list (.the.2150 (core#quote list)) (list (.the.215", -"0 (core#quote quote)) (.the.2150 (core#quote quasiquote))) (.qq.2217 (+ .depth.2", -"221 1) (car (cdr .expr.2222)))) (core#if (pair? .expr.2222) (list (.the.2150 (co", -"re#quote cons)) (.qq.2217 .depth.2221 (car .expr.2222)) (.qq.2217 .depth.2221 (c", -"dr .expr.2222))) (core#if (vector? .expr.2222) (list (.the.2150 (core#quote list", -"->vector)) (.qq.2217 .depth.2221 (vector->list .expr.2222))) (list (.the.2150 (c", -"ore#quote quote)) .expr.2222)))))))) ((core#lambda (.x.2223) (.qq.2217 1 .x.2223", -")) (cadr .form.2212)))))))) (core#begin (.define-transformer.2149 (core#quote le", -"t*) (core#lambda (.form.2224 .env.2225) ((core#lambda (.bindings.2226 .body.2227", -") (core#if (null? .bindings.2226) (cons (.the.2150 (core#quote let)) (cons (core", -"#quote ()) .body.2227)) (cons (.the.2150 (core#quote let)) (cons (cons (cons (ca", -"r (car .bindings.2226)) (cdr (car .bindings.2226))) (core#quote ())) (cons (cons", -" (.the.2150 (core#quote let*)) (cons (cdr .bindings.2226) .body.2227)) (core#quo", -"te ())))))) (car (cdr .form.2224)) (cdr (cdr .form.2224))))) (core#begin (.defin", -"e-transformer.2149 (core#quote letrec) (core#lambda (.form.2228 .env.2229) (cons", -" (.the.2150 (core#quote letrec*)) (cdr .form.2228)))) (core#begin (.define-trans", -"former.2149 (core#quote letrec*) (core#lambda (.form.2230 .env.2231) ((core#lamb", -"da (.bindings.2232 .body.2233) ((core#lambda (.variables.2234 .initials.2235) (c", -"ons (.the.2150 (core#quote let)) (cons .variables.2234 (append .initials.2235 (a", -"ppend .body.2233 (core#quote ())))))) (map (core#lambda (.v.2236) (cons .v.2236 ", -"(cons (core#quote #undefined) (core#quote ())))) (map car .bindings.2232)) (map ", -"(core#lambda (.v.2237) (cons (.the.2150 (core#quote set!)) (append .v.2237 (core", -"#quote ())))) .bindings.2232))) (car (cdr .form.2230)) (cdr (cdr .form.2230)))))", -" (core#begin (.define-transformer.2149 (core#quote let-values) (core#lambda (.fo", -"rm.2238 .env.2239) (cons (.the.2150 (core#quote let*-values)) (append (cdr .form", -".2238) (core#quote ()))))) (core#begin (.define-transformer.2149 (core#quote let", -"*-values) (core#lambda (.form.2240 .env.2241) ((core#lambda (.formals.2242 .body", -".2243) (core#if (null? .formals.2242) (cons (.the.2150 (core#quote let)) (cons (", -"core#quote ()) (append .body.2243 (core#quote ())))) ((core#lambda (.formal.2244", -") (cons (.the.2150 (core#quote call-with-values)) (cons (cons .the-lambda.2159 (", -"cons (core#quote ()) (cdr .formal.2244))) (cons (cons (.the.2150 (core#quote lam", -"bda)) (cons (car .formal.2244) (cons (cons (.the.2150 (core#quote let*-values)) ", -"(cons (cdr .formals.2242) .body.2243)) (core#quote ())))) (core#quote ()))))) (c", -"ar .formals.2242)))) (cadr .form.2240) (cddr .form.2240)))) (core#begin (.define", -"-transformer.2149 (core#quote define-values) (core#lambda (.form.2245 .env.2246)", -" ((core#lambda (.formal.2247 .body.2248) ((core#lambda (.tmps.2249) (cons .the-b", -"egin.2160 (append ((core#lambda () (core#begin (core#define .loop.2250 (core#lam", -"bda (.formal.2251) (core#if (identifier? .formal.2251) (cons (cons .the-define.2", -"158 (cons .formal.2251 (cons (core#quote #undefined) (core#quote ())))) (core#qu", -"ote ())) (core#if (pair? .formal.2251) (cons (cons .the-define.2158 (cons (car .", -"formal.2251) (cons (core#quote #undefined) (core#quote ())))) (.loop.2250 (cdr .", -"formal.2251))) (core#quote ()))))) (.loop.2250 .formal.2247)))) (cons (cons (.th", -"e.2150 (core#quote call-with-values)) (cons (cons .the-lambda.2159 (cons (core#q", -"uote ()) .body.2248)) (cons (cons .the-lambda.2159 (cons .tmps.2249 ((core#lambd", -"a () (core#begin (core#define .loop.2252 (core#lambda (.formal.2253 .tmps.2254) ", -"(core#if (identifier? .formal.2253) (cons (cons .the-set!.2162 (cons .formal.225", -"3 (cons .tmps.2254 (core#quote ())))) (core#quote ())) (core#if (pair? .formal.2", -"253) (cons (cons .the-set!.2162 (cons (car .formal.2253) (cons (car .tmps.2254) ", -"(core#quote ())))) (.loop.2252 (cdr .formal.2253) (cdr .tmps.2254))) (core#quote", -" ()))))) (.loop.2252 .formal.2247 .tmps.2249)))))) (core#quote ())))) (core#quot", -"e ()))))) ((core#lambda () (core#begin (core#define .loop.2255 (core#lambda (.fo", -"rmal.2256) (core#if (identifier? .formal.2256) (make-identifier .formal.2256 .en", -"v.2246) (core#if (pair? .formal.2256) (cons (make-identifier (car .formal.2256) ", -".env.2246) (.loop.2255 (cdr .formal.2256))) (core#quote ()))))) (.loop.2255 .for", -"mal.2247)))))) (cadr .form.2245) (cddr .form.2245)))) (core#begin (.define-trans", -"former.2149 (core#quote do) (core#lambda (.form.2257 .env.2258) ((core#lambda (.", -"bindings.2259 .test.2260 .cleanup.2261 .body.2262) ((core#lambda (.loop.2263) (c", -"ons (.the.2150 (core#quote let)) (cons .loop.2263 (cons (map (core#lambda (.x.22", -"64) (cons (car .x.2264) (cons (cadr .x.2264) (core#quote ())))) .bindings.2259) ", -"(cons (cons .the-if.2163 (cons .test.2260 (cons (cons .the-begin.2160 .cleanup.2", -"261) (cons (cons .the-begin.2160 (append .body.2262 (cons (cons .loop.2263 (map ", -"(core#lambda (.x.2265) (core#if (null? (cdr (cdr .x.2265))) (car .x.2265) (car (", -"cdr (cdr .x.2265))))) .bindings.2259)) (core#quote ())))) (core#quote ()))))) (c", -"ore#quote ())))))) (make-identifier (core#quote loop) .env.2258))) (car (cdr .fo", -"rm.2257)) (car (car (cdr (cdr .form.2257)))) (cdr (car (cdr (cdr .form.2257)))) ", -"(cdr (cdr (cdr .form.2257)))))) (core#begin (.define-transformer.2149 (core#quot", -"e when) (core#lambda (.form.2266 .env.2267) ((core#lambda (.test.2268 .body.2269", -") (cons .the-if.2163 (cons .test.2268 (cons (cons .the-begin.2160 (append .body.", -"2269 (core#quote ()))) (cons (core#quote #undefined) (core#quote ())))))) (car (", -"cdr .form.2266)) (cdr (cdr .form.2266))))) (core#begin (.define-transformer.2149", -" (core#quote unless) (core#lambda (.form.2270 .env.2271) ((core#lambda (.test.22", -"72 .body.2273) (cons .the-if.2163 (cons .test.2272 (cons (core#quote #undefined)", -" (cons (cons .the-begin.2160 (append .body.2273 (core#quote ()))) (core#quote ()", -")))))) (car (cdr .form.2270)) (cdr (cdr .form.2270))))) (core#begin (.define-tra", -"nsformer.2149 (core#quote case) (core#lambda (.form.2274 .env.2275) ((core#lambd", -"a (.key.2276 .clauses.2277) ((core#lambda (.the-key.2278) (cons (.the.2150 (core", -"#quote let)) (cons (cons (cons .the-key.2278 (cons .key.2276 (core#quote ()))) (", -"core#quote ())) (cons ((core#lambda () (core#begin (core#define .loop.2279 (core", -"#lambda (.clauses.2280) (core#if (null? .clauses.2280) #undefined ((core#lambda ", -"(.clause.2281) (cons .the-if.2163 (cons (core#if (core#if (identifier? (car .cla", -"use.2281)) (identifier=? (.the.2150 (core#quote else)) (make-identifier (car .cl", -"ause.2281) .env.2275)) #f) #t (cons (.the.2150 (core#quote or)) (append (map (co", -"re#lambda (.x.2282) (cons (.the.2150 (core#quote eqv?)) (cons .the-key.2278 (con", -"s (cons .the-quote.2161 (cons .x.2282 (core#quote ()))) (core#quote ()))))) (car", -" .clause.2281)) (core#quote ())))) (cons (core#if (core#if (identifier? (cadr .c", -"lause.2281)) (identifier=? (.the.2150 (core#quote =>)) (make-identifier (cadr .c", -"lause.2281) .env.2275)) #f) (cons (car (cdr (cdr .clause.2281))) (cons .the-key.", -"2278 (core#quote ()))) (cons .the-begin.2160 (append (cdr .clause.2281) (core#qu", -"ote ())))) (cons (.loop.2279 (cdr .clauses.2280)) (core#quote ())))))) (car .cla", -"uses.2280))))) (.loop.2279 .clauses.2277)))) (core#quote ()))))) (make-identifie", -"r (core#quote key) .env.2275))) (car (cdr .form.2274)) (cdr (cdr .form.2274)))))", -" (core#begin (.define-transformer.2149 (core#quote parameterize) (core#lambda (.", -"form.2283 .env.2284) ((core#lambda (.formal.2285 .body.2286) (cons (.the.2150 (c", -"ore#quote with-dynamic-environment)) (cons (cons (.the.2150 (core#quote list)) (", -"append (map (core#lambda (.x.2287) (cons (.the.2150 (core#quote cons)) (cons (ca", -"r .x.2287) (cons (cadr .x.2287) (core#quote ()))))) .formal.2285) (core#quote ()", -"))) (cons (cons .the-lambda.2159 (cons (core#quote ()) (append .body.2286 (core#", -"quote ())))) (core#quote ()))))) (car (cdr .form.2283)) (cdr (cdr .form.2283))))", -") (.define-transformer.2149 (core#quote define-record-type) (core#lambda (.form.", -"2288 .env.2289) ((core#lambda (.type.2290 .ctor.2291 .pred.2292 .fields.2293) (c", -"ons .the-begin.2160 (cons (cons .the-define.2158 (cons .ctor.2291 (cons (cons (.", -"the.2150 (core#quote make-record)) (cons (cons (core#quote quote) (cons .type.22", -"90 (core#quote ()))) (cons (cons (.the.2150 (core#quote vector)) (map (core#lamb", -"da (.field.2294) (core#if (memq (car .field.2294) (cdr .ctor.2291)) (car .field.", -"2294) #undefined)) .fields.2293)) (core#quote ())))) (core#quote ())))) (cons (c", -"ons .the-define.2158 (cons .pred.2292 (cons (cons (.the.2150 (core#quote lambda)", -") (cons (cons (core#quote obj) (core#quote ())) (cons (cons (.the.2150 (core#quo", -"te and)) (cons (cons (.the.2150 (core#quote record?)) (cons (core#quote obj) (co", -"re#quote ()))) (cons (cons (.the.2150 (core#quote eq?)) (cons (cons (.the.2150 (", -"core#quote record-type)) (cons (core#quote obj) (core#quote ()))) (cons (cons (c", -"ore#quote quote) (cons .type.2290 (core#quote ()))) (core#quote ())))) (core#quo", -"te ())))) (core#quote ())))) (core#quote ())))) ((core#lambda () (core#begin (co", -"re#define .loop.2295 (core#lambda (.fields.2296 .pos.2297 .acc.2298) (core#if (n", -"ull? .fields.2296) .acc.2298 ((core#lambda (.field.2299) ((core#lambda (.defs.23", -"00) (.loop.2295 (cdr .fields.2296) (+ .pos.2297 1) (append .defs.2300 .acc.2298)", -")) (cons (cons .the-define.2158 (cons (cons (cadr .field.2299) (cons (core#quote", -" obj) (core#quote ()))) (cons (cons .the-if.2163 (cons (cons .pred.2292 (cons (c", -"ore#quote obj) (core#quote ()))) (cons (cons (.the.2150 (core#quote vector-ref))", -" (cons (cons (.the.2150 (core#quote record-datum)) (cons (core#quote obj) (core#", -"quote ()))) (cons .pos.2297 (core#quote ())))) (cons (cons (.the.2150 (core#quot", -"e error)) (cons (core#quote \"record type mismatch\") (cons (core#quote obj) (cons", -" (cons (core#quote quote) (cons .type.2290 (core#quote ()))) (core#quote ())))))", -" (core#quote ()))))) (core#quote ())))) (core#if (null? (cddr .field.2299)) (cor", -"e#quote ()) (cons (cons .the-define.2158 (cons (cons (car (cddr .field.2299)) (c", -"ons (core#quote obj) (cons (core#quote value) (core#quote ())))) (cons (cons .th", -"e-if.2163 (cons (cons .pred.2292 (cons (core#quote obj) (core#quote ()))) (cons ", -"(cons (.the.2150 (core#quote vector-set!)) (cons (cons (.the.2150 (core#quote re", -"cord-datum)) (cons (core#quote obj) (core#quote ()))) (cons .pos.2297 (cons (cor", -"e#quote value) (core#quote ()))))) (cons (cons (.the.2150 (core#quote error)) (c", -"ons (core#quote \"record type mismatch\") (cons (core#quote obj) (cons (cons (core", -"#quote quote) (cons .type.2290 (core#quote ()))) (core#quote ()))))) (core#quote", -" ()))))) (core#quote ())))) (core#quote ())))))) (car .fields.2296))))) (.loop.2", -"295 .fields.2293 0 (core#quote ()))))))))) (car (cdr .form.2288)) (car (cdr (cdr", -" .form.2288))) (car (cdr (cdr (cdr .form.2288)))) (cdr (cdr (cdr (cdr .form.2288", -"))))))))))))))))))))))))))))))))))))) (.the.2150 (core#quote core#define)) (.the", -".2150 (core#quote core#lambda)) (.the.2150 (core#quote core#begin)) (.the.2150 (", -"core#quote core#quote)) (.the.2150 (core#quote core#set!)) (.the.2150 (core#quot", -"e core#if)) (.the.2150 (core#quote core#define-macro)) (.the.2150 (core#quote de", -"fine)) (.the.2150 (core#quote lambda)) (.the.2150 (core#quote begin)) (.the.2150", -" (core#quote quote)) (.the.2150 (core#quote set!)) (.the.2150 (core#quote if)) (", -".the.2150 (core#quote define-macro)))) (core#lambda (.name.2301 .transformer.230", -"2) (dictionary-set! (macro-objects) .name.2301 .transformer.2302)) (core#lambda ", -"(.var.2303) (make-identifier .var.2303 default-environment)))", -}; - +#if PIC_USE_EVAL static const char boot_compile_rom[][80] = { "(core#begin (core#define make-identifier #undefined) (core#begin (core#define id", "entifier? #undefined) (core#begin (core#define identifier=? #undefined) (core#be", @@ -263,162 +13,414 @@ static const char boot_compile_rom[][80] = { "-identifier! #undefined) (core#begin (core#define macro-objects #undefined) (cor", "e#begin (core#define compile #undefined) (core#begin (core#define eval #undefine", "d) (call-with-values (core#lambda () ((core#lambda () (core#begin (core#begin (c", -"ore#define .make-identifier.2304 (core#lambda (.name.2330 .env.2331) (make-recor", -"d (core#quote identifier) (vector .name.2330 .env.2331)))) (core#begin (core#def", -"ine .%identifier?.2305 (core#lambda (.obj.2332) (core#if (record? .obj.2332) (eq", -"? (record-type .obj.2332) (core#quote identifier)) #f))) (core#begin (core#defin", -"e .identifier-environment.2306 (core#lambda (.obj.2333) (core#if (.%identifier?.", -"2305 .obj.2333) (vector-ref (record-datum .obj.2333) 1) (error \"record type mism", -"atch\" .obj.2333 (core#quote identifier))))) (core#define .identifier-name.2307 (", -"core#lambda (.obj.2334) (core#if (.%identifier?.2305 .obj.2334) (vector-ref (rec", -"ord-datum .obj.2334) 0) (error \"record type mismatch\" .obj.2334 (core#quote iden", -"tifier)))))))) (core#begin (core#define .identifier?.2308 (core#lambda (.obj.233", -"5) ((core#lambda (.it.2336) (core#if .it.2336 .it.2336 ((core#lambda (.it.2337) ", -"(core#if .it.2337 .it.2337 #f)) (.%identifier?.2305 .obj.2335)))) (symbol? .obj.", -"2335)))) (core#begin (core#define .identifier=?.2309 (core#lambda (.id1.2338 .id", -"2.2339) (core#if (core#if (symbol? .id1.2338) (symbol? .id2.2339) #f) (eq? .id1.", -"2338 .id2.2339) (core#if (core#if (.%identifier?.2305 .id1.2338) (.%identifier?.", -"2305 .id2.2339) #f) (eq? (.find-identifier.2316 (.identifier-name.2307 .id1.2338", -") (.identifier-environment.2306 .id1.2338)) (.find-identifier.2316 (.identifier-", -"name.2307 .id2.2339) (.identifier-environment.2306 .id2.2339))) #f)))) (core#beg", -"in (core#set! equal? ((core#lambda (.e?.2340) (core#lambda (.x.2341 .y.2342) (co", -"re#if (.%identifier?.2305 .x.2341) (.identifier=?.2309 .x.2341 .y.2342) (.e?.234", -"0 .x.2341 .y.2342)))) equal?)) (core#begin (core#begin (core#define .%make-envir", -"onment.2310 (core#lambda (.parent.2343 .prefix.2344 .binding.2345) (make-record ", -"(core#quote environment) (vector .parent.2343 .prefix.2344 .binding.2345)))) (co", -"re#begin (core#define .environment?.2311 (core#lambda (.obj.2346) (core#if (reco", -"rd? .obj.2346) (eq? (record-type .obj.2346) (core#quote environment)) #f))) (cor", -"e#begin (core#define .environment-binding.2312 (core#lambda (.obj.2347) (core#if", -" (.environment?.2311 .obj.2347) (vector-ref (record-datum .obj.2347) 2) (error \"", -"record type mismatch\" .obj.2347 (core#quote environment))))) (core#begin (core#d", -"efine .environment-prefix.2313 (core#lambda (.obj.2348) (core#if (.environment?.", -"2311 .obj.2348) (vector-ref (record-datum .obj.2348) 1) (error \"record type mism", -"atch\" .obj.2348 (core#quote environment))))) (core#define .environment-parent.23", -"14 (core#lambda (.obj.2349) (core#if (.environment?.2311 .obj.2349) (vector-ref ", -"(record-datum .obj.2349) 0) (error \"record type mismatch\" .obj.2349 (core#quote ", -"environment))))))))) (core#begin (core#define .search-scope.2315 (core#lambda (.", -"id.2350 .env.2351) ((.environment-binding.2312 .env.2351) .id.2350))) (core#begi", -"n (core#define .find-identifier.2316 (core#lambda (.id.2352 .env.2353) ((core#la", -"mbda (.it.2354) (core#if .it.2354 .it.2354 ((core#lambda (.it.2355) (core#if .it", -".2355 .it.2355 #f)) ((core#lambda (.parent.2356) (core#if .parent.2356 (.find-id", -"entifier.2316 .id.2352 .parent.2356) (core#if (symbol? .id.2352) (.add-identifie", -"r!.2317 .id.2352 .env.2353) (.find-identifier.2316 (.identifier-name.2307 .id.23", -"52) (.identifier-environment.2306 .id.2352))))) (.environment-parent.2314 .env.2", -"353))))) (.search-scope.2315 .id.2352 .env.2353)))) (core#begin (core#define .ad", -"d-identifier!.2317 ((core#lambda (.uniq.2357) (core#lambda (.id.2358 .env.2359) ", -"((core#lambda (.it.2360) (core#if .it.2360 .it.2360 ((core#lambda (.it.2361) (co", -"re#if .it.2361 .it.2361 #f)) (core#if (core#if (not (.environment-parent.2314 .e", -"nv.2359)) (symbol? .id.2358) #f) (string->symbol (string-append (.environment-pr", -"efix.2313 .env.2359) (symbol->string .id.2358))) ((core#lambda (.uid.2362) (core", -"#begin (.set-identifier!.2318 .id.2358 .uid.2362 .env.2359) .uid.2362)) (.uniq.2", -"357 .id.2358)))))) (.search-scope.2315 .id.2358 .env.2359)))) ((core#lambda (.n.", -"2363) (core#lambda (.id.2364) ((core#lambda (.m.2365) (core#begin (core#set! .n.", -"2363 (+ .n.2363 1)) (string->symbol (string-append \".\" (symbol->string ((core#la", -"mbda () (core#begin (core#define .loop.2366 (core#lambda (.id.2367) (core#if (sy", -"mbol? .id.2367) .id.2367 (.loop.2366 (.identifier-name.2307 .id.2367))))) (.loop", -".2366 .id.2364))))) \".\" (number->string .m.2365))))) .n.2363))) 0))) (core#begin", -" (core#define .set-identifier!.2318 (core#lambda (.id.2368 .uid.2369 .env.2370) ", -"((.environment-binding.2312 .env.2370) .id.2368 .uid.2369))) (core#begin (core#d", -"efine .make-environment.2319 (core#lambda (.prefix.2371) (.%make-environment.231", -"0 #f (symbol->string .prefix.2371) (make-ephemeron-table)))) (core#begin (core#d", -"efine .default-environment.2320 ((core#lambda (.env.2372) (core#begin (for-each ", -"(core#lambda (.x.2373) (.set-identifier!.2318 .x.2373 .x.2373 .env.2372)) (core#", +"ore#define .make-identifier.2149 (core#lambda (.name.2177 .env.2178) (make-recor", +"d (core#quote identifier) (vector .name.2177 .env.2178)))) (core#begin (core#def", +"ine .%identifier?.2150 (core#lambda (.obj.2179) (core#if (record? .obj.2179) (eq", +"? (record-type .obj.2179) (core#quote identifier)) #f))) (core#begin (core#defin", +"e .identifier-environment.2151 (core#lambda (.obj.2180) (core#if (.%identifier?.", +"2150 .obj.2180) (vector-ref (record-datum .obj.2180) 1) (error \"record type mism", +"atch\" .obj.2180 (core#quote identifier))))) (core#define .identifier-name.2152 (", +"core#lambda (.obj.2181) (core#if (.%identifier?.2150 .obj.2181) (vector-ref (rec", +"ord-datum .obj.2181) 0) (error \"record type mismatch\" .obj.2181 (core#quote iden", +"tifier)))))))) (core#begin (core#define .identifier?.2153 (core#lambda (.obj.218", +"2) ((core#lambda (.it.2183) (core#if .it.2183 .it.2183 ((core#lambda (.it.2184) ", +"(core#if .it.2184 .it.2184 #f)) (.%identifier?.2150 .obj.2182)))) (symbol? .obj.", +"2182)))) (core#begin (core#define .identifier=?.2154 (core#lambda (.id1.2185 .id", +"2.2186) (core#if (core#if (symbol? .id1.2185) (symbol? .id2.2186) #f) (eq? .id1.", +"2185 .id2.2186) (core#if (core#if (.%identifier?.2150 .id1.2185) (.%identifier?.", +"2150 .id2.2186) #f) (eq? (.find-identifier.2161 (.identifier-name.2152 .id1.2185", +") (.identifier-environment.2151 .id1.2185)) (.find-identifier.2161 (.identifier-", +"name.2152 .id2.2186) (.identifier-environment.2151 .id2.2186))) #f)))) (core#beg", +"in (core#set! equal? ((core#lambda (.e?.2187) (core#lambda (.x.2188 .y.2189) (co", +"re#if (.%identifier?.2150 .x.2188) (.identifier=?.2154 .x.2188 .y.2189) (.e?.218", +"7 .x.2188 .y.2189)))) equal?)) (core#begin (core#begin (core#define .%make-envir", +"onment.2155 (core#lambda (.parent.2190 .prefix.2191 .binding.2192) (make-record ", +"(core#quote environment) (vector .parent.2190 .prefix.2191 .binding.2192)))) (co", +"re#begin (core#define .environment?.2156 (core#lambda (.obj.2193) (core#if (reco", +"rd? .obj.2193) (eq? (record-type .obj.2193) (core#quote environment)) #f))) (cor", +"e#begin (core#define .environment-binding.2157 (core#lambda (.obj.2194) (core#if", +" (.environment?.2156 .obj.2194) (vector-ref (record-datum .obj.2194) 2) (error \"", +"record type mismatch\" .obj.2194 (core#quote environment))))) (core#begin (core#d", +"efine .environment-prefix.2158 (core#lambda (.obj.2195) (core#if (.environment?.", +"2156 .obj.2195) (vector-ref (record-datum .obj.2195) 1) (error \"record type mism", +"atch\" .obj.2195 (core#quote environment))))) (core#define .environment-parent.21", +"59 (core#lambda (.obj.2196) (core#if (.environment?.2156 .obj.2196) (vector-ref ", +"(record-datum .obj.2196) 0) (error \"record type mismatch\" .obj.2196 (core#quote ", +"environment))))))))) (core#begin (core#define .search-scope.2160 (core#lambda (.", +"id.2197 .env.2198) ((.environment-binding.2157 .env.2198) .id.2197))) (core#begi", +"n (core#define .find-identifier.2161 (core#lambda (.id.2199 .env.2200) ((core#la", +"mbda (.it.2201) (core#if .it.2201 .it.2201 ((core#lambda (.it.2202) (core#if .it", +".2202 .it.2202 #f)) ((core#lambda (.parent.2203) (core#if .parent.2203 (.find-id", +"entifier.2161 .id.2199 .parent.2203) (core#if (symbol? .id.2199) (.add-identifie", +"r!.2162 .id.2199 .env.2200) (.find-identifier.2161 (.identifier-name.2152 .id.21", +"99) (.identifier-environment.2151 .id.2199))))) (.environment-parent.2159 .env.2", +"200))))) (.search-scope.2160 .id.2199 .env.2200)))) (core#begin (core#define .ad", +"d-identifier!.2162 ((core#lambda (.uniq.2204) (core#lambda (.id.2205 .env.2206) ", +"((core#lambda (.it.2207) (core#if .it.2207 .it.2207 ((core#lambda (.it.2208) (co", +"re#if .it.2208 .it.2208 #f)) (core#if (core#if (not (.environment-parent.2159 .e", +"nv.2206)) (symbol? .id.2205) #f) (string->symbol (string-append (.environment-pr", +"efix.2158 .env.2206) (symbol->string .id.2205))) ((core#lambda (.uid.2209) (core", +"#begin (.set-identifier!.2163 .id.2205 .uid.2209 .env.2206) .uid.2209)) (.uniq.2", +"204 .id.2205)))))) (.search-scope.2160 .id.2205 .env.2206)))) ((core#lambda (.n.", +"2210) (core#lambda (.id.2211) ((core#lambda (.m.2212) (core#begin (core#set! .n.", +"2210 (+ .n.2210 1)) (string->symbol (string-append \".\" (symbol->string ((core#la", +"mbda () (core#begin (core#define .loop.2213 (core#lambda (.id.2214) (core#if (sy", +"mbol? .id.2214) .id.2214 (.loop.2213 (.identifier-name.2152 .id.2214))))) (.loop", +".2213 .id.2211))))) \".\" (number->string .m.2212))))) .n.2210))) 0))) (core#begin", +" (core#define .set-identifier!.2163 (core#lambda (.id.2215 .uid.2216 .env.2217) ", +"((.environment-binding.2157 .env.2217) .id.2215 .uid.2216))) (core#begin (core#d", +"efine .make-environment.2164 (core#lambda (.prefix.2218) (.%make-environment.215", +"5 #f (symbol->string .prefix.2218) (make-ephemeron-table)))) (core#begin (core#d", +"efine .default-environment.2165 ((core#lambda (.env.2219) (core#begin (for-each ", +"(core#lambda (.x.2220) (.set-identifier!.2163 .x.2220 .x.2220 .env.2219)) (core#", "quote (core#define core#set! core#quote core#lambda core#if core#begin core#defi", -"ne-macro))) .env.2372)) (.make-environment.2319 (string->symbol \"\")))) (core#beg", -"in (core#define .extend-environment.2321 (core#lambda (.parent.2374) (.%make-env", -"ironment.2310 .parent.2374 #f (make-ephemeron-table)))) (core#begin (core#define", -" .global-macro-table.2322 (make-dictionary)) (core#begin (core#define .find-macr", -"o.2323 (core#lambda (.uid.2375) (core#if (dictionary-has? .global-macro-table.23", -"22 .uid.2375) (dictionary-ref .global-macro-table.2322 .uid.2375) #f))) (core#be", -"gin (core#define .add-macro!.2324 (core#lambda (.uid.2376 .expander.2377) (dicti", -"onary-set! .global-macro-table.2322 .uid.2376 .expander.2377))) (core#begin (cor", -"e#define .shadow-macro!.2325 (core#lambda (.uid.2378) (core#if (dictionary-has? ", -".global-macro-table.2322 .uid.2378) (dictionary-delete! .global-macro-table.2322", -" .uid.2378) #undefined))) (core#begin (core#define .macro-objects.2326 (core#lam", -"bda () .global-macro-table.2322)) (core#begin (core#define .expand.2327 ((core#l", -"ambda (.task-queue.2379) (core#begin (core#define .queue.2380 (core#lambda (.tas", -"k.2393) ((core#lambda (.tmp.2394) (core#begin (.task-queue.2379 (cons (cons .tmp", -".2394 .task.2393) (.task-queue.2379))) .tmp.2394)) (cons #f #f)))) (core#begin (", -"core#define .run-all.2381 (core#lambda () (for-each (core#lambda (.x.2395) ((cor", -"e#lambda (.task.2396 .skelton.2397) ((core#lambda (.x.2398) (core#begin (set-car", -"! .skelton.2397 (car .x.2398)) (set-cdr! .skelton.2397 (cdr .x.2398)))) (.task.2", -"396))) (cdr .x.2395) (car .x.2395))) (reverse (.task-queue.2379))))) (core#begin", -" (core#define .caddr.2382 (core#lambda (.x.2399) (car (cddr .x.2399)))) (core#be", -"gin (core#define .map*.2383 (core#lambda (.proc.2400 .list*.2401) (core#if (null", -"? .list*.2401) .list*.2401 (core#if (pair? .list*.2401) (cons (.proc.2400 (car .", -"list*.2401)) (.map*.2383 .proc.2400 (cdr .list*.2401))) (.proc.2400 .list*.2401)", -")))) (core#begin (core#define .literal?.2384 (core#lambda (.x.2402) (not ((core#", -"lambda (.it.2403) (core#if .it.2403 .it.2403 ((core#lambda (.it.2404) (core#if .", -"it.2404 .it.2404 #f)) (pair? .x.2402)))) (.identifier?.2308 .x.2402))))) (core#b", -"egin (core#define .call?.2385 (core#lambda (.x.2405) (core#if (list? .x.2405) (c", -"ore#if (not (null? .x.2405)) (.identifier?.2308 (car .x.2405)) #f) #f))) (core#b", -"egin (core#define .expand-variable.2386 (core#lambda (.var.2406 .env.2407) ((cor", -"e#lambda (.x.2408) ((core#lambda (.m.2409) (core#if .m.2409 (.expand-node.2391 (", -".m.2409 .var.2406 .env.2407) .env.2407) .x.2408)) (.find-macro.2323 .x.2408))) (", -".find-identifier.2316 .var.2406 .env.2407)))) (core#begin (core#define .expand-q", -"uote.2387 (core#lambda (.obj.2410) (cons (core#quote core#quote) (cons .obj.2410", -" (core#quote ()))))) (core#begin (core#define .expand-define.2388 (core#lambda (", -".var.2411 .form.2412 .env.2413) ((core#lambda (.uid.2414) (core#begin (.shadow-m", -"acro!.2325 .uid.2414) (cons (core#quote core#define) (cons .uid.2414 (cons (.exp", -"and-node.2391 .form.2412 .env.2413) (core#quote ())))))) (.add-identifier!.2317 ", -".var.2411 .env.2413)))) (core#begin (core#define .expand-lambda.2389 (core#lambd", -"a (.args.2415 .body.2416 .env.2417) ((core#lambda (.env.2418) ((core#lambda (.ar", -"gs.2419) (with-dynamic-environment (list (cons .task-queue.2379 (core#quote ()))", -") (core#lambda () ((core#lambda (.body.2420) (core#begin (.run-all.2381) (cons (", -"core#quote core#lambda) (cons .args.2419 (cons .body.2420 (core#quote ())))))) (", -".expand-node.2391 .body.2416 .env.2418))))) (.map*.2383 (core#lambda (.var.2421)", -" (.add-identifier!.2317 .var.2421 .env.2418)) .args.2415))) (.extend-environment", -".2321 .env.2417)))) (core#begin (core#define .expand-define-macro.2390 (core#lam", -"bda (.var.2422 .transformer.2423 .env.2424) ((core#lambda (.uid.2425) ((core#lam", -"bda (.expander.2426) (core#begin (.add-macro!.2324 .uid.2425 .expander.2426) #un", -"defined)) (load (.expand.2392 .transformer.2423 .env.2424)))) (.add-identifier!.", -"2317 .var.2422 .env.2424)))) (core#begin (core#define .expand-node.2391 (core#la", -"mbda (.expr.2427 .env.2428) (core#if (.literal?.2384 .expr.2427) .expr.2427 (cor", -"e#if (.identifier?.2308 .expr.2427) (.expand-variable.2386 .expr.2427 .env.2428)", -" (core#if (.call?.2385 .expr.2427) ((core#lambda (.functor.2429) ((core#lambda (", -".key.2430) (core#if ((core#lambda (.it.2431) (core#if .it.2431 .it.2431 #f)) (eq", -"v? .key.2430 (core#quote core#quote))) (.expand-quote.2387 (cadr .expr.2427)) (c", -"ore#if ((core#lambda (.it.2432) (core#if .it.2432 .it.2432 #f)) (eqv? .key.2430 ", -"(core#quote core#define))) (.expand-define.2388 (cadr .expr.2427) (.caddr.2382 .", -"expr.2427) .env.2428) (core#if ((core#lambda (.it.2433) (core#if .it.2433 .it.24", -"33 #f)) (eqv? .key.2430 (core#quote core#lambda))) (.queue.2380 (core#lambda () ", -"(.expand-lambda.2389 (cadr .expr.2427) (.caddr.2382 .expr.2427) .env.2428))) (co", -"re#if ((core#lambda (.it.2434) (core#if .it.2434 .it.2434 #f)) (eqv? .key.2430 (", -"core#quote core#define-macro))) (.expand-define-macro.2390 (cadr .expr.2427) (.c", -"addr.2382 .expr.2427) .env.2428) (core#if #t ((core#lambda (.m.2435) (core#if .m", -".2435 (.expand-node.2391 (.m.2435 .expr.2427 .env.2428) .env.2428) (map (core#la", -"mbda (.x.2436) (.expand-node.2391 .x.2436 .env.2428)) .expr.2427))) (.find-macro", -".2323 .functor.2429)) #undefined)))))) .functor.2429)) (.find-identifier.2316 (c", -"ar .expr.2427) .env.2428)) (core#if (list? .expr.2427) (map (core#lambda (.x.243", -"7) (.expand-node.2391 .x.2437 .env.2428)) .expr.2427) (error \"invalid expression", -"\" .expr.2427))))))) (core#begin (core#define .expand.2392 (core#lambda (.expr.24", -"38 .env.2439) ((core#lambda (.x.2440) (core#begin (.run-all.2381) .x.2440)) (.ex", -"pand-node.2391 .expr.2438 .env.2439)))) .expand.2392)))))))))))))) (make-paramet", -"er (core#quote ())))) (core#begin (core#define .compile.2328 (core#lambda (.expr", -".2441 . .env.2442) (.expand.2327 .expr.2441 (core#if (null? .env.2442) .default-", -"environment.2320 (car .env.2442))))) (core#begin (core#define .eval.2329 (core#l", -"ambda (.expr.2443 . .env.2444) (load (.compile.2328 .expr.2443 (core#if (null? .", -"env.2444) .default-environment.2320 (car .env.2444)))))) (values .make-identifie", -"r.2304 .identifier?.2308 .identifier=?.2309 .identifier-name.2307 .identifier-en", -"vironment.2306 .make-environment.2319 .default-environment.2320 .environment?.23", -"11 .find-identifier.2316 .add-identifier!.2317 .set-identifier!.2318 .macro-obje", -"cts.2326 .compile.2328 .eval.2329)))))))))))))))))))))))) (core#lambda (.make-id", -"entifier.2445 .identifier?.2446 .identifier=?.2447 .identifier-name.2448 .identi", -"fier-environment.2449 .make-environment.2450 .default-environment.2451 .environm", -"ent?.2452 .find-identifier.2453 .add-identifier!.2454 .set-identifier!.2455 .mac", -"ro-objects.2456 .compile.2457 .eval.2458) (core#begin (core#set! make-identifier", -" .make-identifier.2445) (core#begin (core#set! identifier? .identifier?.2446) (c", -"ore#begin (core#set! identifier=? .identifier=?.2447) (core#begin (core#set! ide", -"ntifier-name .identifier-name.2448) (core#begin (core#set! identifier-environmen", -"t .identifier-environment.2449) (core#begin (core#set! make-environment .make-en", -"vironment.2450) (core#begin (core#set! default-environment .default-environment.", -"2451) (core#begin (core#set! environment? .environment?.2452) (core#begin (core#", -"set! find-identifier .find-identifier.2453) (core#begin (core#set! add-identifie", -"r! .add-identifier!.2454) (core#begin (core#set! set-identifier! .set-identifier", -"!.2455) (core#begin (core#set! macro-objects .macro-objects.2456) (core#begin (c", -"ore#set! compile .compile.2457) (core#set! eval .eval.2458))))))))))))))))))))))", -"))))))))", +"ne-macro))) .env.2219)) (.make-environment.2164 (string->symbol \"\")))) (core#beg", +"in (core#define .extend-environment.2166 (core#lambda (.parent.2221) (.%make-env", +"ironment.2155 .parent.2221 #f (make-ephemeron-table)))) (core#begin (core#define", +" .global-macro-table.2167 (make-dictionary)) (core#begin (core#define .find-macr", +"o.2168 (core#lambda (.uid.2222) (core#if (dictionary-has? .global-macro-table.21", +"67 .uid.2222) (dictionary-ref .global-macro-table.2167 .uid.2222) #f))) (core#be", +"gin (core#define .add-macro!.2169 (core#lambda (.uid.2223 .expander.2224) (dicti", +"onary-set! .global-macro-table.2167 .uid.2223 .expander.2224))) (core#begin (cor", +"e#define .shadow-macro!.2170 (core#lambda (.uid.2225) (core#if (dictionary-has? ", +".global-macro-table.2167 .uid.2225) (dictionary-delete! .global-macro-table.2167", +" .uid.2225) #undefined))) (core#begin (core#define .macro-objects.2171 (core#lam", +"bda () .global-macro-table.2167)) (core#begin (core#define .expand.2172 ((core#l", +"ambda (.task-queue.2226) (core#begin (core#define .queue.2227 (core#lambda (.tas", +"k.2240) ((core#lambda (.tmp.2241) (core#begin (.task-queue.2226 (cons (cons .tmp", +".2241 .task.2240) (.task-queue.2226))) .tmp.2241)) (cons #f #f)))) (core#begin (", +"core#define .run-all.2228 (core#lambda () (for-each (core#lambda (.x.2242) ((cor", +"e#lambda (.task.2243 .skelton.2244) ((core#lambda (.x.2245) (core#begin (set-car", +"! .skelton.2244 (car .x.2245)) (set-cdr! .skelton.2244 (cdr .x.2245)))) (.task.2", +"243))) (cdr .x.2242) (car .x.2242))) (reverse (.task-queue.2226))))) (core#begin", +" (core#define .caddr.2229 (core#lambda (.x.2246) (car (cddr .x.2246)))) (core#be", +"gin (core#define .map*.2230 (core#lambda (.proc.2247 .list*.2248) (core#if (null", +"? .list*.2248) .list*.2248 (core#if (pair? .list*.2248) (cons (.proc.2247 (car .", +"list*.2248)) (.map*.2230 .proc.2247 (cdr .list*.2248))) (.proc.2247 .list*.2248)", +")))) (core#begin (core#define .literal?.2231 (core#lambda (.x.2249) (not ((core#", +"lambda (.it.2250) (core#if .it.2250 .it.2250 ((core#lambda (.it.2251) (core#if .", +"it.2251 .it.2251 #f)) (pair? .x.2249)))) (.identifier?.2153 .x.2249))))) (core#b", +"egin (core#define .call?.2232 (core#lambda (.x.2252) (core#if (list? .x.2252) (c", +"ore#if (not (null? .x.2252)) (.identifier?.2153 (car .x.2252)) #f) #f))) (core#b", +"egin (core#define .expand-variable.2233 (core#lambda (.var.2253 .env.2254) ((cor", +"e#lambda (.x.2255) ((core#lambda (.m.2256) (core#if .m.2256 (.expand-node.2238 (", +".m.2256 .var.2253 .env.2254) .env.2254) .x.2255)) (.find-macro.2168 .x.2255))) (", +".find-identifier.2161 .var.2253 .env.2254)))) (core#begin (core#define .expand-q", +"uote.2234 (core#lambda (.obj.2257) (cons (core#quote core#quote) (cons .obj.2257", +" (core#quote ()))))) (core#begin (core#define .expand-define.2235 (core#lambda (", +".var.2258 .form.2259 .env.2260) ((core#lambda (.uid.2261) (core#begin (.shadow-m", +"acro!.2170 .uid.2261) (cons (core#quote core#define) (cons .uid.2261 (cons (.exp", +"and-node.2238 .form.2259 .env.2260) (core#quote ())))))) (.add-identifier!.2162 ", +".var.2258 .env.2260)))) (core#begin (core#define .expand-lambda.2236 (core#lambd", +"a (.args.2262 .body.2263 .env.2264) ((core#lambda (.env.2265) ((core#lambda (.ar", +"gs.2266) (with-dynamic-environment (list (cons .task-queue.2226 (core#quote ()))", +") (core#lambda () ((core#lambda (.body.2267) (core#begin (.run-all.2228) (cons (", +"core#quote core#lambda) (cons .args.2266 (cons .body.2267 (core#quote ())))))) (", +".expand-node.2238 .body.2263 .env.2265))))) (.map*.2230 (core#lambda (.var.2268)", +" (.add-identifier!.2162 .var.2268 .env.2265)) .args.2262))) (.extend-environment", +".2166 .env.2264)))) (core#begin (core#define .expand-define-macro.2237 (core#lam", +"bda (.var.2269 .transformer.2270 .env.2271) ((core#lambda (.uid.2272) ((core#lam", +"bda (.expander.2273) (core#begin (.add-macro!.2169 .uid.2272 .expander.2273) #un", +"defined)) (load (.expand.2239 .transformer.2270 .env.2271)))) (.add-identifier!.", +"2162 .var.2269 .env.2271)))) (core#begin (core#define .expand-node.2238 (core#la", +"mbda (.expr.2274 .env.2275) (core#if (.literal?.2231 .expr.2274) .expr.2274 (cor", +"e#if (.identifier?.2153 .expr.2274) (.expand-variable.2233 .expr.2274 .env.2275)", +" (core#if (.call?.2232 .expr.2274) ((core#lambda (.functor.2276) ((core#lambda (", +".key.2277) (core#if ((core#lambda (.it.2278) (core#if .it.2278 .it.2278 #f)) (eq", +"v? .key.2277 (core#quote core#quote))) (.expand-quote.2234 (cadr .expr.2274)) (c", +"ore#if ((core#lambda (.it.2279) (core#if .it.2279 .it.2279 #f)) (eqv? .key.2277 ", +"(core#quote core#define))) (.expand-define.2235 (cadr .expr.2274) (.caddr.2229 .", +"expr.2274) .env.2275) (core#if ((core#lambda (.it.2280) (core#if .it.2280 .it.22", +"80 #f)) (eqv? .key.2277 (core#quote core#lambda))) (.queue.2227 (core#lambda () ", +"(.expand-lambda.2236 (cadr .expr.2274) (.caddr.2229 .expr.2274) .env.2275))) (co", +"re#if ((core#lambda (.it.2281) (core#if .it.2281 .it.2281 #f)) (eqv? .key.2277 (", +"core#quote core#define-macro))) (.expand-define-macro.2237 (cadr .expr.2274) (.c", +"addr.2229 .expr.2274) .env.2275) (core#if #t ((core#lambda (.m.2282) (core#if .m", +".2282 (.expand-node.2238 (.m.2282 .expr.2274 .env.2275) .env.2275) (map (core#la", +"mbda (.x.2283) (.expand-node.2238 .x.2283 .env.2275)) .expr.2274))) (.find-macro", +".2168 .functor.2276)) #undefined)))))) .functor.2276)) (.find-identifier.2161 (c", +"ar .expr.2274) .env.2275)) (core#if (list? .expr.2274) (map (core#lambda (.x.228", +"4) (.expand-node.2238 .x.2284 .env.2275)) .expr.2274) (error \"invalid expression", +"\" .expr.2274))))))) (core#begin (core#define .expand.2239 (core#lambda (.expr.22", +"85 .env.2286) ((core#lambda (.x.2287) (core#begin (.run-all.2228) .x.2287)) (.ex", +"pand-node.2238 .expr.2285 .env.2286)))) .expand.2239)))))))))))))) (make-paramet", +"er (core#quote ())))) (core#begin (core#define .compile.2173 (core#lambda (.expr", +".2288 . .env.2289) (.expand.2172 .expr.2288 (core#if (null? .env.2289) .default-", +"environment.2165 (car .env.2289))))) (core#begin (core#define .eval.2174 (core#l", +"ambda (.expr.2290 . .env.2291) (load (.compile.2173 .expr.2290 (core#if (null? .", +"env.2291) .default-environment.2165 (car .env.2291)))))) (core#begin (core#defin", +"e .define-transformer.2175 (core#lambda (.name.2292 .transformer.2293) (dictiona", +"ry-set! .global-macro-table.2167 .name.2292 .transformer.2293))) (core#begin (co", +"re#define .the.2176 (core#lambda (.var.2294) (.make-identifier.2149 .var.2294 .d", +"efault-environment.2165))) (core#begin ((core#lambda (.the-core-define.2295 .the", +"-core-lambda.2296 .the-core-begin.2297 .the-core-quote.2298 .the-core-set!.2299 ", +".the-core-if.2300 .the-core-define-macro.2301 .the-define.2302 .the-lambda.2303 ", +".the-begin.2304 .the-quote.2305 .the-set!.2306 .the-if.2307 .the-define-macro.23", +"08) (core#begin (.define-transformer.2175 (core#quote quote) (core#lambda (.form", +".2313 .env.2314) (core#if (= (length .form.2313) 2) (cons .the-core-quote.2298 (", +"cons (cadr .form.2313) (core#quote ()))) (error \"malformed quote\" .form.2313))))", +" (core#begin (.define-transformer.2175 (core#quote if) (core#lambda (.form.2315 ", +".env.2316) ((core#lambda (.len.2317) (core#if (= .len.2317 3) (append .form.2315", +" (cons (core#quote #undefined) (core#quote ()))) (core#if (= .len.2317 4) (cons ", +".the-core-if.2300 (cdr .form.2315)) (error \"malformed if\" .form.2315)))) (length", +" .form.2315)))) (core#begin (.define-transformer.2175 (core#quote begin) (core#l", +"ambda (.form.2318 .env.2319) ((core#lambda (.len.2320) (core#if (= .len.2320 1) ", +"#undefined (core#if (= .len.2320 2) (cadr .form.2318) (core#if (= .len.2320 3) (", +"cons .the-core-begin.2297 (cdr .form.2318)) (cons .the-core-begin.2297 (cons (ca", +"dr .form.2318) (cons (cons .the-begin.2304 (cddr .form.2318)) (core#quote ()))))", +")))) (length .form.2318)))) (core#begin (.define-transformer.2175 (core#quote se", +"t!) (core#lambda (.form.2321 .env.2322) (core#if (core#if (= (length .form.2321)", +" 3) (.identifier?.2153 (cadr .form.2321)) #f) (cons .the-core-set!.2299 (cdr .fo", +"rm.2321)) (error \"malformed set!\" .form.2321)))) (core#begin (core#define .check", +"-formal.2309 (core#lambda (.formal.2323) ((core#lambda (.it.2324) (core#if .it.2", +"324 .it.2324 ((core#lambda (.it.2325) (core#if .it.2325 .it.2325 ((core#lambda (", +".it.2326) (core#if .it.2326 .it.2326 #f)) (core#if (pair? .formal.2323) (core#if", +" (.identifier?.2153 (car .formal.2323)) (.check-formal.2309 (cdr .formal.2323)) ", +"#f) #f)))) (.identifier?.2153 .formal.2323)))) (null? .formal.2323)))) (core#beg", +"in (.define-transformer.2175 (core#quote lambda) (core#lambda (.form.2327 .env.2", +"328) (core#if (= (length .form.2327) 1) (error \"malformed lambda\" .form.2327) (c", +"ore#if (.check-formal.2309 (cadr .form.2327)) (cons .the-core-lambda.2296 (cons ", +"(cadr .form.2327) (cons (cons .the-begin.2304 (cddr .form.2327)) (core#quote ())", +"))) (error \"malformed lambda\" .form.2327))))) (core#begin (.define-transformer.2", +"175 (core#quote define) (core#lambda (.form.2329 .env.2330) ((core#lambda (.len.", +"2331) (core#if (= .len.2331 1) (error \"malformed define\" .form.2329) ((core#lamb", +"da (.formal.2332) (core#if (.identifier?.2153 .formal.2332) (core#if (= .len.233", +"1 3) (cons .the-core-define.2295 (cdr .form.2329)) (error \"malformed define\" .fo", +"rm.2329)) (core#if (pair? .formal.2332) (cons .the-define.2302 (cons (car .forma", +"l.2332) (cons (cons .the-lambda.2303 (cons (cdr .formal.2332) (cddr .form.2329))", +") (core#quote ())))) (error \"define: binding to non-varaible object\" .form.2329)", +"))) (cadr .form.2329)))) (length .form.2329)))) (core#begin (.define-transformer", +".2175 (core#quote define-macro) (core#lambda (.form.2333 .env.2334) (core#if (= ", +"(length .form.2333) 3) (core#if (.identifier?.2153 (cadr .form.2333)) (cons .the", +"-core-define-macro.2301 (cdr .form.2333)) (error \"define-macro: binding to non-v", +"ariable object\" .form.2333)) (error \"malformed define-macro\" .form.2333)))) (cor", +"e#begin #undefined (core#begin (.define-transformer.2175 (core#quote else) (core", +"#lambda ._.2335 (error \"invalid use of auxiliary syntax\" (core#quote else)))) (c", +"ore#begin (.define-transformer.2175 (core#quote =>) (core#lambda ._.2336 (error ", +"\"invalid use of auxiliary syntax\" (core#quote =>)))) (core#begin (.define-transf", +"ormer.2175 (core#quote unquote) (core#lambda ._.2337 (error \"invalid use of auxi", +"liary syntax\" (core#quote unquote)))) (core#begin (.define-transformer.2175 (cor", +"e#quote unquote-splicing) (core#lambda ._.2338 (error \"invalid use of auxiliary ", +"syntax\" (core#quote unquote-splicing)))) (core#begin (.define-transformer.2175 (", +"core#quote let) (core#lambda (.form.2339 .env.2340) (core#if (.identifier?.2153 ", +"(cadr .form.2339)) ((core#lambda (.name.2341 .formal.2342 .body.2343) (cons (con", +"s .the-lambda.2303 (cons (core#quote ()) (cons (cons .the-define.2302 (cons (con", +"s .name.2341 (map car .formal.2342)) .body.2343)) (cons (cons .name.2341 (map ca", +"dr .formal.2342)) (core#quote ()))))) (core#quote ()))) (car (cdr .form.2339)) (", +"car (cdr (cdr .form.2339))) (cdr (cdr (cdr .form.2339)))) ((core#lambda (.formal", +".2344 .body.2345) (cons (cons .the-lambda.2303 (cons (map car .formal.2344) .bod", +"y.2345)) (map cadr .formal.2344))) (car (cdr .form.2339)) (cdr (cdr .form.2339))", +")))) (core#begin (.define-transformer.2175 (core#quote and) (core#lambda (.form.", +"2346 .env.2347) (core#if (null? (cdr .form.2346)) #t (core#if (null? (cddr .form", +".2346)) (cadr .form.2346) (cons .the-if.2307 (cons (cadr .form.2346) (cons (cons", +" (.the.2176 (core#quote and)) (cddr .form.2346)) (cons (core#quote #f) (core#quo", +"te ()))))))))) (core#begin (.define-transformer.2175 (core#quote or) (core#lambd", +"a (.form.2348 .env.2349) (core#if (null? (cdr .form.2348)) #f ((core#lambda (.tm", +"p.2350) (cons (.the.2176 (core#quote let)) (cons (cons (cons .tmp.2350 (cons (ca", +"dr .form.2348) (core#quote ()))) (core#quote ())) (cons (cons .the-if.2307 (cons", +" .tmp.2350 (cons .tmp.2350 (cons (cons (.the.2176 (core#quote or)) (cddr .form.2", +"348)) (core#quote ()))))) (core#quote ()))))) (.make-identifier.2149 (core#quote", +" it) .env.2349))))) (core#begin (.define-transformer.2175 (core#quote cond) (cor", +"e#lambda (.form.2351 .env.2352) ((core#lambda (.clauses.2353) (core#if (null? .c", +"lauses.2353) #undefined ((core#lambda (.clause.2354) (core#if (core#if (.identif", +"ier?.2153 (car .clause.2354)) (.identifier=?.2154 (.the.2176 (core#quote else)) ", +"(.make-identifier.2149 (car .clause.2354) .env.2352)) #f) (cons .the-begin.2304 ", +"(cdr .clause.2354)) (core#if (null? (cdr .clause.2354)) (cons (.the.2176 (core#q", +"uote or)) (cons (car .clause.2354) (cons (cons (.the.2176 (core#quote cond)) (cd", +"r .clauses.2353)) (core#quote ())))) (core#if (core#if (.identifier?.2153 (cadr ", +".clause.2354)) (.identifier=?.2154 (.the.2176 (core#quote =>)) (.make-identifier", +".2149 (cadr .clause.2354) .env.2352)) #f) ((core#lambda (.tmp.2355) (cons (.the.", +"2176 (core#quote let)) (cons (cons (cons .tmp.2355 (cons (car .clause.2354) (cor", +"e#quote ()))) (core#quote ())) (cons (cons .the-if.2307 (cons .tmp.2355 (cons (c", +"ons (cadr (cdr .clause.2354)) (cons .tmp.2355 (core#quote ()))) (cons (cons (.th", +"e.2176 (core#quote cond)) (cddr .form.2351)) (core#quote ()))))) (core#quote ())", +")))) (.make-identifier.2149 (core#quote tmp) .env.2352)) (cons .the-if.2307 (con", +"s (car .clause.2354) (cons (cons .the-begin.2304 (cdr .clause.2354)) (cons (cons", +" (.the.2176 (core#quote cond)) (cdr .clauses.2353)) (core#quote ()))))))))) (car", +" .clauses.2353)))) (cdr .form.2351)))) (core#begin (.define-transformer.2175 (co", +"re#quote quasiquote) (core#lambda (.form.2356 .env.2357) (core#begin (core#defin", +"e .quasiquote?.2358 (core#lambda (.form.2362) (core#if (pair? .form.2362) (core#", +"if (.identifier?.2153 (car .form.2362)) (.identifier=?.2154 (.the.2176 (core#quo", +"te quasiquote)) (.make-identifier.2149 (car .form.2362) .env.2357)) #f) #f))) (c", +"ore#begin (core#define .unquote?.2359 (core#lambda (.form.2363) (core#if (pair? ", +".form.2363) (core#if (.identifier?.2153 (car .form.2363)) (.identifier=?.2154 (.", +"the.2176 (core#quote unquote)) (.make-identifier.2149 (car .form.2363) .env.2357", +")) #f) #f))) (core#begin (core#define .unquote-splicing?.2360 (core#lambda (.for", +"m.2364) (core#if (pair? .form.2364) (core#if (pair? (car .form.2364)) (core#if (", +".identifier?.2153 (caar .form.2364)) (.identifier=?.2154 (.the.2176 (core#quote ", +"unquote-splicing)) (.make-identifier.2149 (caar .form.2364) .env.2357)) #f) #f) ", +"#f))) (core#begin (core#define .qq.2361 (core#lambda (.depth.2365 .expr.2366) (c", +"ore#if (.unquote?.2359 .expr.2366) (core#if (= .depth.2365 1) (cadr .expr.2366) ", +"(list (.the.2176 (core#quote list)) (list (.the.2176 (core#quote quote)) (.the.2", +"176 (core#quote unquote))) (.qq.2361 (- .depth.2365 1) (car (cdr .expr.2366)))))", +" (core#if (.unquote-splicing?.2360 .expr.2366) (core#if (= .depth.2365 1) (list ", +"(.the.2176 (core#quote append)) (car (cdr (car .expr.2366))) (.qq.2361 .depth.23", +"65 (cdr .expr.2366))) (list (.the.2176 (core#quote cons)) (list (.the.2176 (core", +"#quote list)) (list (.the.2176 (core#quote quote)) (.the.2176 (core#quote unquot", +"e-splicing))) (.qq.2361 (- .depth.2365 1) (car (cdr (car .expr.2366))))) (.qq.23", +"61 .depth.2365 (cdr .expr.2366)))) (core#if (.quasiquote?.2358 .expr.2366) (list", +" (.the.2176 (core#quote list)) (list (.the.2176 (core#quote quote)) (.the.2176 (", +"core#quote quasiquote))) (.qq.2361 (+ .depth.2365 1) (car (cdr .expr.2366)))) (c", +"ore#if (pair? .expr.2366) (list (.the.2176 (core#quote cons)) (.qq.2361 .depth.2", +"365 (car .expr.2366)) (.qq.2361 .depth.2365 (cdr .expr.2366))) (core#if (vector?", +" .expr.2366) (list (.the.2176 (core#quote list->vector)) (.qq.2361 .depth.2365 (", +"vector->list .expr.2366))) (list (.the.2176 (core#quote quote)) .expr.2366))))))", +")) ((core#lambda (.x.2367) (.qq.2361 1 .x.2367)) (cadr .form.2356)))))))) (core#", +"begin (.define-transformer.2175 (core#quote let*) (core#lambda (.form.2368 .env.", +"2369) ((core#lambda (.bindings.2370 .body.2371) (core#if (null? .bindings.2370) ", +"(cons (.the.2176 (core#quote let)) (cons (core#quote ()) .body.2371)) (cons (.th", +"e.2176 (core#quote let)) (cons (cons (cons (car (car .bindings.2370)) (cdr (car ", +".bindings.2370))) (core#quote ())) (cons (cons (.the.2176 (core#quote let*)) (co", +"ns (cdr .bindings.2370) .body.2371)) (core#quote ())))))) (car (cdr .form.2368))", +" (cdr (cdr .form.2368))))) (core#begin (.define-transformer.2175 (core#quote let", +"rec) (core#lambda (.form.2372 .env.2373) (cons (.the.2176 (core#quote letrec*)) ", +"(cdr .form.2372)))) (core#begin (.define-transformer.2175 (core#quote letrec*) (", +"core#lambda (.form.2374 .env.2375) ((core#lambda (.bindings.2376 .body.2377) ((c", +"ore#lambda (.variables.2378 .initials.2379) (cons (.the.2176 (core#quote let)) (", +"cons .variables.2378 (append .initials.2379 (append .body.2377 (core#quote ())))", +"))) (map (core#lambda (.v.2380) (cons .v.2380 (cons (core#quote #undefined) (cor", +"e#quote ())))) (map car .bindings.2376)) (map (core#lambda (.v.2381) (cons (.the", +".2176 (core#quote set!)) (append .v.2381 (core#quote ())))) .bindings.2376))) (c", +"ar (cdr .form.2374)) (cdr (cdr .form.2374))))) (core#begin (.define-transformer.", +"2175 (core#quote let-values) (core#lambda (.form.2382 .env.2383) (cons (.the.217", +"6 (core#quote let*-values)) (append (cdr .form.2382) (core#quote ()))))) (core#b", +"egin (.define-transformer.2175 (core#quote let*-values) (core#lambda (.form.2384", +" .env.2385) ((core#lambda (.formals.2386 .body.2387) (core#if (null? .formals.23", +"86) (cons (.the.2176 (core#quote let)) (cons (core#quote ()) (append .body.2387 ", +"(core#quote ())))) ((core#lambda (.formal.2388) (cons (.the.2176 (core#quote cal", +"l-with-values)) (cons (cons .the-lambda.2303 (cons (core#quote ()) (cdr .formal.", +"2388))) (cons (cons (.the.2176 (core#quote lambda)) (cons (car .formal.2388) (co", +"ns (cons (.the.2176 (core#quote let*-values)) (cons (cdr .formals.2386) .body.23", +"87)) (core#quote ())))) (core#quote ()))))) (car .formals.2386)))) (cadr .form.2", +"384) (cddr .form.2384)))) (core#begin (.define-transformer.2175 (core#quote defi", +"ne-values) (core#lambda (.form.2389 .env.2390) ((core#lambda (.formal.2391 .body", +".2392) ((core#lambda (.tmps.2393) (cons .the-begin.2304 (append ((core#lambda ()", +" (core#begin (core#define .loop.2394 (core#lambda (.formal.2395) (core#if (.iden", +"tifier?.2153 .formal.2395) (cons (cons .the-define.2302 (cons .formal.2395 (cons", +" (core#quote #undefined) (core#quote ())))) (core#quote ())) (core#if (pair? .fo", +"rmal.2395) (cons (cons .the-define.2302 (cons (car .formal.2395) (cons (core#quo", +"te #undefined) (core#quote ())))) (.loop.2394 (cdr .formal.2395))) (core#quote (", +")))))) (.loop.2394 .formal.2391)))) (cons (cons (.the.2176 (core#quote call-with", +"-values)) (cons (cons .the-lambda.2303 (cons (core#quote ()) .body.2392)) (cons ", +"(cons .the-lambda.2303 (cons .tmps.2393 ((core#lambda () (core#begin (core#defin", +"e .loop.2396 (core#lambda (.formal.2397 .tmps.2398) (core#if (.identifier?.2153 ", +".formal.2397) (cons (cons .the-set!.2306 (cons .formal.2397 (cons .tmps.2398 (co", +"re#quote ())))) (core#quote ())) (core#if (pair? .formal.2397) (cons (cons .the-", +"set!.2306 (cons (car .formal.2397) (cons (car .tmps.2398) (core#quote ())))) (.l", +"oop.2396 (cdr .formal.2397) (cdr .tmps.2398))) (core#quote ()))))) (.loop.2396 .", +"formal.2391 .tmps.2393)))))) (core#quote ())))) (core#quote ()))))) ((core#lambd", +"a () (core#begin (core#define .loop.2399 (core#lambda (.formal.2400) (core#if (.", +"identifier?.2153 .formal.2400) (.make-identifier.2149 .formal.2400 .env.2390) (c", +"ore#if (pair? .formal.2400) (cons (.make-identifier.2149 (car .formal.2400) .env", +".2390) (.loop.2399 (cdr .formal.2400))) (core#quote ()))))) (.loop.2399 .formal.", +"2391)))))) (cadr .form.2389) (cddr .form.2389)))) (core#begin (.define-transform", +"er.2175 (core#quote do) (core#lambda (.form.2401 .env.2402) ((core#lambda (.bind", +"ings.2403 .test.2404 .cleanup.2405 .body.2406) ((core#lambda (.loop.2407) (cons ", +"(.the.2176 (core#quote let)) (cons .loop.2407 (cons (map (core#lambda (.x.2408) ", +"(cons (car .x.2408) (cons (cadr .x.2408) (core#quote ())))) .bindings.2403) (con", +"s (cons .the-if.2307 (cons .test.2404 (cons (cons .the-begin.2304 .cleanup.2405)", +" (cons (cons .the-begin.2304 (append .body.2406 (cons (cons .loop.2407 (map (cor", +"e#lambda (.x.2409) (core#if (null? (cdr (cdr .x.2409))) (car .x.2409) (car (cdr ", +"(cdr .x.2409))))) .bindings.2403)) (core#quote ())))) (core#quote ()))))) (core#", +"quote ())))))) (.make-identifier.2149 (core#quote loop) .env.2402))) (car (cdr .", +"form.2401)) (car (car (cdr (cdr .form.2401)))) (cdr (car (cdr (cdr .form.2401)))", +") (cdr (cdr (cdr .form.2401)))))) (core#begin (.define-transformer.2175 (core#qu", +"ote when) (core#lambda (.form.2410 .env.2411) ((core#lambda (.test.2412 .body.24", +"13) (cons .the-if.2307 (cons .test.2412 (cons (cons .the-begin.2304 (append .bod", +"y.2413 (core#quote ()))) (cons (core#quote #undefined) (core#quote ())))))) (car", +" (cdr .form.2410)) (cdr (cdr .form.2410))))) (core#begin (.define-transformer.21", +"75 (core#quote unless) (core#lambda (.form.2414 .env.2415) ((core#lambda (.test.", +"2416 .body.2417) (cons .the-if.2307 (cons .test.2416 (cons (core#quote #undefine", +"d) (cons (cons .the-begin.2304 (append .body.2417 (core#quote ()))) (core#quote ", +"())))))) (car (cdr .form.2414)) (cdr (cdr .form.2414))))) (core#begin (.define-t", +"ransformer.2175 (core#quote case) (core#lambda (.form.2418 .env.2419) ((core#lam", +"bda (.key.2420 .clauses.2421) ((core#lambda (.the-key.2422) (cons (.the.2176 (co", +"re#quote let)) (cons (cons (cons .the-key.2422 (cons .key.2420 (core#quote ())))", +" (core#quote ())) (cons ((core#lambda () (core#begin (core#define .loop.2423 (co", +"re#lambda (.clauses.2424) (core#if (null? .clauses.2424) #undefined ((core#lambd", +"a (.clause.2425) (cons .the-if.2307 (cons (core#if (core#if (.identifier?.2153 (", +"car .clause.2425)) (.identifier=?.2154 (.the.2176 (core#quote else)) (.make-iden", +"tifier.2149 (car .clause.2425) .env.2419)) #f) #t (cons (.the.2176 (core#quote o", +"r)) (append (map (core#lambda (.x.2426) (cons (.the.2176 (core#quote eqv?)) (con", +"s .the-key.2422 (cons (cons .the-quote.2305 (cons .x.2426 (core#quote ()))) (cor", +"e#quote ()))))) (car .clause.2425)) (core#quote ())))) (cons (core#if (core#if (", +".identifier?.2153 (cadr .clause.2425)) (.identifier=?.2154 (.the.2176 (core#quot", +"e =>)) (.make-identifier.2149 (cadr .clause.2425) .env.2419)) #f) (cons (car (cd", +"r (cdr .clause.2425))) (cons .the-key.2422 (core#quote ()))) (cons .the-begin.23", +"04 (append (cdr .clause.2425) (core#quote ())))) (cons (.loop.2423 (cdr .clauses", +".2424)) (core#quote ())))))) (car .clauses.2424))))) (.loop.2423 .clauses.2421))", +")) (core#quote ()))))) (.make-identifier.2149 (core#quote key) .env.2419))) (car", +" (cdr .form.2418)) (cdr (cdr .form.2418))))) (core#begin (.define-transformer.21", +"75 (core#quote parameterize) (core#lambda (.form.2427 .env.2428) ((core#lambda (", +".formal.2429 .body.2430) (cons (.the.2176 (core#quote with-dynamic-environment))", +" (cons (cons (.the.2176 (core#quote list)) (append (map (core#lambda (.x.2431) (", +"cons (.the.2176 (core#quote cons)) (cons (car .x.2431) (cons (cadr .x.2431) (cor", +"e#quote ()))))) .formal.2429) (core#quote ()))) (cons (cons .the-lambda.2303 (co", +"ns (core#quote ()) (append .body.2430 (core#quote ())))) (core#quote ()))))) (ca", +"r (cdr .form.2427)) (cdr (cdr .form.2427))))) (.define-transformer.2175 (core#qu", +"ote define-record-type) (core#lambda (.form.2432 .env.2433) ((core#lambda (.type", +".2434 .ctor.2435 .pred.2436 .fields.2437) (cons .the-begin.2304 (cons (cons .the", +"-define.2302 (cons .ctor.2435 (cons (cons (.the.2176 (core#quote make-record)) (", +"cons (cons (core#quote quote) (cons .type.2434 (core#quote ()))) (cons (cons (.t", +"he.2176 (core#quote vector)) (map (core#lambda (.field.2438) (core#if (memq (car", +" .field.2438) (cdr .ctor.2435)) (car .field.2438) #undefined)) .fields.2437)) (c", +"ore#quote ())))) (core#quote ())))) (cons (cons .the-define.2302 (cons .pred.243", +"6 (cons (cons (.the.2176 (core#quote lambda)) (cons (cons (core#quote obj) (core", +"#quote ())) (cons (cons (.the.2176 (core#quote and)) (cons (cons (.the.2176 (cor", +"e#quote record?)) (cons (core#quote obj) (core#quote ()))) (cons (cons (.the.217", +"6 (core#quote eq?)) (cons (cons (.the.2176 (core#quote record-type)) (cons (core", +"#quote obj) (core#quote ()))) (cons (cons (core#quote quote) (cons .type.2434 (c", +"ore#quote ()))) (core#quote ())))) (core#quote ())))) (core#quote ())))) (core#q", +"uote ())))) ((core#lambda () (core#begin (core#define .loop.2439 (core#lambda (.", +"fields.2440 .pos.2441 .acc.2442) (core#if (null? .fields.2440) .acc.2442 ((core#", +"lambda (.field.2443) ((core#lambda (.defs.2444) (.loop.2439 (cdr .fields.2440) (", +"+ .pos.2441 1) (append .defs.2444 .acc.2442))) (cons (cons .the-define.2302 (con", +"s (cons (cadr .field.2443) (cons (core#quote obj) (core#quote ()))) (cons (cons ", +".the-if.2307 (cons (cons .pred.2436 (cons (core#quote obj) (core#quote ()))) (co", +"ns (cons (.the.2176 (core#quote vector-ref)) (cons (cons (.the.2176 (core#quote ", +"record-datum)) (cons (core#quote obj) (core#quote ()))) (cons .pos.2441 (core#qu", +"ote ())))) (cons (cons (.the.2176 (core#quote error)) (cons (core#quote \"record ", +"type mismatch\") (cons (core#quote obj) (cons (cons (core#quote quote) (cons .typ", +"e.2434 (core#quote ()))) (core#quote ()))))) (core#quote ()))))) (core#quote ())", +"))) (core#if (null? (cddr .field.2443)) (core#quote ()) (cons (cons .the-define.", +"2302 (cons (cons (car (cddr .field.2443)) (cons (core#quote obj) (cons (core#quo", +"te value) (core#quote ())))) (cons (cons .the-if.2307 (cons (cons .pred.2436 (co", +"ns (core#quote obj) (core#quote ()))) (cons (cons (.the.2176 (core#quote vector-", +"set!)) (cons (cons (.the.2176 (core#quote record-datum)) (cons (core#quote obj) ", +"(core#quote ()))) (cons .pos.2441 (cons (core#quote value) (core#quote ()))))) (", +"cons (cons (.the.2176 (core#quote error)) (cons (core#quote \"record type mismatc", +"h\") (cons (core#quote obj) (cons (cons (core#quote quote) (cons .type.2434 (core", +"#quote ()))) (core#quote ()))))) (core#quote ()))))) (core#quote ())))) (core#qu", +"ote ())))))) (car .fields.2440))))) (.loop.2439 .fields.2437 0 (core#quote ())))", +")))))) (car (cdr .form.2432)) (car (cdr (cdr .form.2432))) (car (cdr (cdr (cdr .", +"form.2432)))) (cdr (cdr (cdr (cdr .form.2432))))))))))))))))))))))))))))))))))))", +") (.the.2176 (core#quote core#define)) (.the.2176 (core#quote core#lambda)) (.th", +"e.2176 (core#quote core#begin)) (.the.2176 (core#quote core#quote)) (.the.2176 (", +"core#quote core#set!)) (.the.2176 (core#quote core#if)) (.the.2176 (core#quote c", +"ore#define-macro)) (.the.2176 (core#quote define)) (.the.2176 (core#quote lambda", +")) (.the.2176 (core#quote begin)) (.the.2176 (core#quote quote)) (.the.2176 (cor", +"e#quote set!)) (.the.2176 (core#quote if)) (.the.2176 (core#quote define-macro))", +") (values .make-identifier.2149 .identifier?.2153 .identifier=?.2154 .identifier", +"-name.2152 .identifier-environment.2151 .make-environment.2164 .default-environm", +"ent.2165 .environment?.2156 .find-identifier.2161 .add-identifier!.2162 .set-ide", +"ntifier!.2163 .macro-objects.2171 .compile.2173 .eval.2174))))))))))))))))))))))", +"))))) (core#lambda (.make-identifier.2445 .identifier?.2446 .identifier=?.2447 .", +"identifier-name.2448 .identifier-environment.2449 .make-environment.2450 .defaul", +"t-environment.2451 .environment?.2452 .find-identifier.2453 .add-identifier!.245", +"4 .set-identifier!.2455 .macro-objects.2456 .compile.2457 .eval.2458) (core#begi", +"n (core#set! make-identifier .make-identifier.2445) (core#begin (core#set! ident", +"ifier? .identifier?.2446) (core#begin (core#set! identifier=? .identifier=?.2447", +") (core#begin (core#set! identifier-name .identifier-name.2448) (core#begin (cor", +"e#set! identifier-environment .identifier-environment.2449) (core#begin (core#se", +"t! make-environment .make-environment.2450) (core#begin (core#set! default-envir", +"onment .default-environment.2451) (core#begin (core#set! environment? .environme", +"nt?.2452) (core#begin (core#set! find-identifier .find-identifier.2453) (core#be", +"gin (core#set! add-identifier! .add-identifier!.2454) (core#begin (core#set! set", +"-identifier! .set-identifier!.2455) (core#begin (core#set! macro-objects .macro-", +"objects.2456) (core#begin (core#set! compile .compile.2457) (core#set! eval .eva", +"l.2458))))))))))))))))))))))))))))))", }; +#endif #if PIC_USE_LIBRARY static const char boot_library_rom[][80] = { @@ -579,10 +581,11 @@ static const char boot_library_rom[][80] = { #endif void -pic_boot(pic_state *pic) +pic_boot(pic_state *PIC_UNUSED(pic)) { +#if PIC_USE_EVAL pic_load_native(pic, &boot_compile_rom[0][0]); - pic_load_native(pic, &boot_rom[0][0]); +#endif #if PIC_USE_LIBRARY pic_load_native(pic, &boot_library_rom[0][0]); #endif diff --git a/lib/include/picconf.h b/lib/include/picconf.h index 33e2d804..6fe9e034 100644 --- a/lib/include/picconf.h +++ b/lib/include/picconf.h @@ -10,6 +10,7 @@ /** enable specific features */ /* #define PIC_USE_WRITE 1 */ +/* #define PIC_USE_EVAL 1 */ /* #define PIC_USE_LIBRARY 1 */ /** essential external functions */ diff --git a/lib/include/picrin/setup.h b/lib/include/picrin/setup.h index c3c8f826..22b916eb 100644 --- a/lib/include/picrin/setup.h +++ b/lib/include/picrin/setup.h @@ -16,6 +16,10 @@ # define PIC_USE_WRITE 1 #endif +#ifndef PIC_USE_EVAL +# define PIC_USE_EVAL 1 +#endif + #ifndef PIC_USE_LIBRARY # define PIC_USE_LIBRARY 1 #endif diff --git a/piclib/boot.scm b/piclib/boot.scm deleted file mode 100644 index d97d03d1..00000000 --- a/piclib/boot.scm +++ /dev/null @@ -1,362 +0,0 @@ -(let ((define-transformer - (lambda (name transformer) - (dictionary-set! (macro-objects) name transformer))) - (the ; synonym for #'var - (lambda (var) - (make-identifier var default-environment)))) - ;; cache popular identifiers - (let ((the-core-define (the 'core#define)) - (the-core-lambda (the 'core#lambda)) - (the-core-begin (the 'core#begin)) - (the-core-quote (the 'core#quote)) - (the-core-set! (the 'core#set!)) - (the-core-if (the 'core#if)) - (the-core-define-macro (the 'core#define-macro)) - (the-define (the 'define)) - (the-lambda (the 'lambda)) - (the-begin (the 'begin)) - (the-quote (the 'quote)) - (the-set! (the 'set!)) - (the-if (the 'if)) - (the-define-macro (the 'define-macro))) - - (define-transformer 'quote - (lambda (form env) - (if (= (length form) 2) - `(,the-core-quote ,(cadr form)) - (error "malformed quote" form)))) - - (define-transformer 'if - (lambda (form env) - (let ((len (length form))) - (cond - ((= len 3) `(,@form #undefined)) - ((= len 4) `(,the-core-if . ,(cdr form))) - (else (error "malformed if" form)))))) - - (define-transformer 'begin - (lambda (form env) - (let ((len (length form))) - (cond - ((= len 1) #undefined) - ((= len 2) (cadr form)) - ((= len 3) `(,the-core-begin . ,(cdr form))) - (else `(,the-core-begin ,(cadr form) (,the-begin . ,(cddr form)))))))) - - (define-transformer 'set! - (lambda (form env) - (if (and (= (length form) 3) (identifier? (cadr form))) - `(,the-core-set! . ,(cdr form)) - (error "malformed set!" form)))) - - (define (check-formal formal) - (or (null? formal) - (identifier? formal) - (and (pair? formal) - (identifier? (car formal)) - (check-formal (cdr formal))))) - - (define-transformer 'lambda - (lambda (form env) - (if (= (length form) 1) - (error "malformed lambda" form) - (if (check-formal (cadr form)) - `(,the-core-lambda ,(cadr form) (,the-begin . ,(cddr form))) - (error "malformed lambda" form))))) - - (define-transformer 'define - (lambda (form env) - (let ((len (length form))) - (if (= len 1) - (error "malformed define" form) - (let ((formal (cadr form))) - (if (identifier? formal) - (if (= len 3) - `(,the-core-define . ,(cdr form)) - (error "malformed define" form)) - (if (pair? formal) - `(,the-define ,(car formal) (,the-lambda ,(cdr formal) . ,(cddr form))) - (error "define: binding to non-varaible object" form)))))))) - - (define-transformer 'define-macro - (lambda (form env) - (if (= (length form) 3) - (if (identifier? (cadr form)) - `(,the-core-define-macro . ,(cdr form)) - (error "define-macro: binding to non-variable object" form)) - (error "malformed define-macro" form)))) - - - (define-macro define-auxiliary-syntax - (lambda (form _) - `(define-transformer ',(cadr form) - (lambda _ - (error "invalid use of auxiliary syntax" ',(cadr form)))))) - - (define-auxiliary-syntax else) - (define-auxiliary-syntax =>) - (define-auxiliary-syntax unquote) - (define-auxiliary-syntax unquote-splicing) - - (define-transformer 'let - (lambda (form env) - (if (identifier? (cadr form)) - (let ((name (car (cdr form))) - (formal (car (cdr (cdr form)))) - (body (cdr (cdr (cdr form))))) - `((,the-lambda () - (,the-define (,name . ,(map car formal)) . ,body) - (,name . ,(map cadr formal))))) - (let ((formal (car (cdr form))) - (body (cdr (cdr form)))) - `((,the-lambda ,(map car formal) . ,body) . ,(map cadr formal)))))) - - (define-transformer 'and - (lambda (form env) - (if (null? (cdr form)) - #t - (if (null? (cddr form)) - (cadr form) - `(,the-if ,(cadr form) (,(the 'and) . ,(cddr form)) #f))))) - - (define-transformer 'or - (lambda (form env) - (if (null? (cdr form)) - #f - (let ((tmp (make-identifier 'it env))) ; should we use #f as the env for tmp? - `(,(the 'let) ((,tmp ,(cadr form))) - (,the-if ,tmp ,tmp (,(the 'or) . ,(cddr form)))))))) - - (define-transformer 'cond - (lambda (form env) - (let ((clauses (cdr form))) - (if (null? clauses) - #undefined - (let ((clause (car clauses))) - (if (and (identifier? (car clause)) - (identifier=? (the 'else) (make-identifier (car clause) env))) - `(,the-begin . ,(cdr clause)) - (if (null? (cdr clause)) - `(,(the 'or) ,(car clause) (,(the 'cond) . ,(cdr clauses))) - (if (and (identifier? (cadr clause)) - (identifier=? (the '=>) (make-identifier (cadr clause) env))) - (let ((tmp (make-identifier 'tmp env))) - `(,(the 'let) ((,tmp ,(car clause))) - (,the-if ,tmp (,(cadr (cdr clause)) ,tmp) (,(the 'cond) . ,(cddr form))))) - `(,the-if ,(car clause) - (,the-begin . ,(cdr clause)) - (,(the 'cond) . ,(cdr clauses))))))))))) - - (define-transformer 'quasiquote - (lambda (form env) - - (define (quasiquote? form) - (and (pair? form) - (identifier? (car form)) - (identifier=? (the 'quasiquote) (make-identifier (car form) env)))) - - (define (unquote? form) - (and (pair? form) - (identifier? (car form)) - (identifier=? (the 'unquote) (make-identifier (car form) env)))) - - (define (unquote-splicing? form) - (and (pair? form) - (pair? (car form)) - (identifier? (caar form)) - (identifier=? (the 'unquote-splicing) (make-identifier (caar form) env)))) - - (define (qq depth expr) - (cond - ;; unquote - ((unquote? expr) - (if (= depth 1) - (cadr expr) - (list (the 'list) - (list (the 'quote) (the 'unquote)) - (qq (- depth 1) (car (cdr expr)))))) - ;; unquote-splicing - ((unquote-splicing? expr) - (if (= depth 1) - (list (the 'append) - (car (cdr (car expr))) - (qq depth (cdr expr))) - (list (the 'cons) - (list (the 'list) - (list (the 'quote) (the 'unquote-splicing)) - (qq (- depth 1) (car (cdr (car expr))))) - (qq depth (cdr expr))))) - ;; quasiquote - ((quasiquote? expr) - (list (the 'list) - (list (the 'quote) (the 'quasiquote)) - (qq (+ depth 1) (car (cdr expr))))) - ;; list - ((pair? expr) - (list (the 'cons) - (qq depth (car expr)) - (qq depth (cdr expr)))) - ;; vector - ((vector? expr) - (list (the 'list->vector) (qq depth (vector->list expr)))) - ;; simple datum - (else - (list (the 'quote) expr)))) - - (let ((x (cadr form))) - (qq 1 x)))) - - (define-transformer 'let* - (lambda (form env) - (let ((bindings (car (cdr form))) - (body (cdr (cdr form)))) - (if (null? bindings) - `(,(the 'let) () . ,body) - `(,(the 'let) ((,(car (car bindings)) . ,(cdr (car bindings)))) - (,(the 'let*) ,(cdr bindings) . ,body)))))) - - (define-transformer 'letrec - (lambda (form env) - `(,(the 'letrec*) . ,(cdr form)))) - - (define-transformer 'letrec* - (lambda (form env) - (let ((bindings (car (cdr form))) - (body (cdr (cdr form)))) - (let ((variables (map (lambda (v) `(,v #undefined)) (map car bindings))) - (initials (map (lambda (v) `(,(the 'set!) ,@v)) bindings))) - `(,(the 'let) ,variables - ,@initials - ,@body))))) - - (define-transformer 'let-values - (lambda (form env) - `(,(the 'let*-values) ,@(cdr form)))) - - (define-transformer 'let*-values - (lambda (form env) - (let ((formals (cadr form)) - (body (cddr form))) - (if (null? formals) - `(,(the 'let) () ,@body) - (let ((formal (car formals))) - `(,(the 'call-with-values) (,the-lambda () . ,(cdr formal)) - (,(the 'lambda) ,(car formal) - (,(the 'let*-values) ,(cdr formals) . ,body)))))))) - - (define-transformer 'define-values - (lambda (form env) - (let ((formal (cadr form)) - (body (cddr form))) - (let ((tmps (let loop ((formal formal)) - (if (identifier? formal) - (make-identifier formal env) - (if (pair? formal) - (cons (make-identifier (car formal) env) (loop (cdr formal))) - '()))))) - `(,the-begin - ,@(let loop ((formal formal)) - (if (identifier? formal) - `((,the-define ,formal #undefined)) - (if (pair? formal) - (cons `(,the-define ,(car formal) #undefined) (loop (cdr formal))) - '()))) - (,(the 'call-with-values) (,the-lambda () . ,body) - (,the-lambda ,tmps . ,(let loop ((formal formal) (tmps tmps)) - (if (identifier? formal) - `((,the-set! ,formal ,tmps)) - (if (pair? formal) - (cons `(,the-set! ,(car formal) ,(car tmps)) - (loop (cdr formal) (cdr tmps))) - '())))))))))) - - (define-transformer 'do - (lambda (form env) - (let ((bindings (car (cdr form))) - (test (car (car (cdr (cdr form))))) - (cleanup (cdr (car (cdr (cdr form))))) - (body (cdr (cdr (cdr form))))) - (let ((loop (make-identifier 'loop env))) - `(,(the 'let) ,loop ,(map (lambda (x) `(,(car x) ,(cadr x))) bindings) - (,the-if ,test - (,the-begin . ,cleanup) - (,the-begin - ,@body - (,loop . ,(map (lambda (x) - (if (null? (cdr (cdr x))) - (car x) - (car (cdr (cdr x))))) - bindings))))))))) - - (define-transformer 'when - (lambda (form env) - (let ((test (car (cdr form))) - (body (cdr (cdr form)))) - `(,the-if ,test - (,the-begin ,@body) - #undefined)))) - - (define-transformer 'unless - (lambda (form env) - (let ((test (car (cdr form))) - (body (cdr (cdr form)))) - `(,the-if ,test - #undefined - (,the-begin ,@body))))) - - (define-transformer 'case - (lambda (form env) - (let ((key (car (cdr form))) - (clauses (cdr (cdr form)))) - (let ((the-key (make-identifier 'key env))) - `(,(the 'let) ((,the-key ,key)) - ,(let loop ((clauses clauses)) - (if (null? clauses) - #undefined - (let ((clause (car clauses))) - `(,the-if ,(if (and (identifier? (car clause)) - (identifier=? (the 'else) (make-identifier (car clause) env))) - #t - `(,(the 'or) ,@(map (lambda (x) `(,(the 'eqv?) ,the-key (,the-quote ,x))) (car clause)))) - ,(if (and (identifier? (cadr clause)) - (identifier=? (the '=>) (make-identifier (cadr clause) env))) - `(,(car (cdr (cdr clause))) ,the-key) - `(,the-begin ,@(cdr clause))) - ,(loop (cdr clauses))))))))))) - - (define-transformer 'parameterize - (lambda (form env) - (let ((formal (car (cdr form))) - (body (cdr (cdr form)))) - `(,(the 'with-dynamic-environment) - (,(the 'list) ,@(map (lambda (x) `(,(the 'cons) ,(car x) ,(cadr x))) formal)) - (,the-lambda () ,@body))))) - - (define-transformer 'define-record-type - (lambda (form env) - (let ((type (car (cdr form))) - (ctor (car (cdr (cdr form)))) - (pred (car (cdr (cdr (cdr form))))) - (fields (cdr (cdr (cdr (cdr form)))))) - `(,the-begin - (,the-define ,ctor - (,(the 'make-record) ',type - (,(the 'vector) . ,(map (lambda (field) (if (memq (car field) (cdr ctor)) (car field) #undefined)) fields)))) - (,the-define ,pred - (,(the 'lambda) (obj) - (,(the 'and) (,(the 'record?) obj) (,(the 'eq?) (,(the 'record-type) obj) ',type)))) - . ,(let loop ((fields fields) (pos 0) (acc '())) - (if (null? fields) - acc - (let ((field (car fields))) - (let ((defs `((,the-define (,(cadr field) obj) - (,the-if (,pred obj) - (,(the 'vector-ref) (,(the 'record-datum) obj) ,pos) - (,(the 'error) "record type mismatch" obj ',type))) - . ,(if (null? (cddr field)) - '() - `((,the-define (,(car (cddr field)) obj value) - (,the-if (,pred obj) - (,(the 'vector-set!) (,(the 'record-datum) obj) ,pos value) - (,(the 'error) "record type mismatch" obj ',type)))))))) - (loop (cdr fields) (+ pos 1) `(,@defs . ,acc)))))))))))) diff --git a/piclib/compile.scm b/piclib/compile.scm index 94a21afd..8ebe5d91 100644 --- a/piclib/compile.scm +++ b/piclib/compile.scm @@ -237,6 +237,372 @@ (define (eval expr . env) (load (compile expr (if (null? env) default-environment (car env))))) + ;; built-in macros + + (define (define-transformer name transformer) + (dictionary-set! global-macro-table name transformer)) + + (define (the var) + (make-identifier var default-environment)) + + (let + ;; cache popular identifiers + ((the-core-define (the 'core#define)) + (the-core-lambda (the 'core#lambda)) + (the-core-begin (the 'core#begin)) + (the-core-quote (the 'core#quote)) + (the-core-set! (the 'core#set!)) + (the-core-if (the 'core#if)) + (the-core-define-macro (the 'core#define-macro)) + (the-define (the 'define)) + (the-lambda (the 'lambda)) + (the-begin (the 'begin)) + (the-quote (the 'quote)) + (the-set! (the 'set!)) + (the-if (the 'if)) + (the-define-macro (the 'define-macro))) + + (define-transformer 'quote + (lambda (form env) + (if (= (length form) 2) + `(,the-core-quote ,(cadr form)) + (error "malformed quote" form)))) + + (define-transformer 'if + (lambda (form env) + (let ((len (length form))) + (cond + ((= len 3) `(,@form #undefined)) + ((= len 4) `(,the-core-if . ,(cdr form))) + (else (error "malformed if" form)))))) + + (define-transformer 'begin + (lambda (form env) + (let ((len (length form))) + (cond + ((= len 1) #undefined) + ((= len 2) (cadr form)) + ((= len 3) `(,the-core-begin . ,(cdr form))) + (else `(,the-core-begin ,(cadr form) (,the-begin . ,(cddr form)))))))) + + (define-transformer 'set! + (lambda (form env) + (if (and (= (length form) 3) (identifier? (cadr form))) + `(,the-core-set! . ,(cdr form)) + (error "malformed set!" form)))) + + (define (check-formal formal) + (or (null? formal) + (identifier? formal) + (and (pair? formal) + (identifier? (car formal)) + (check-formal (cdr formal))))) + + (define-transformer 'lambda + (lambda (form env) + (if (= (length form) 1) + (error "malformed lambda" form) + (if (check-formal (cadr form)) + `(,the-core-lambda ,(cadr form) (,the-begin . ,(cddr form))) + (error "malformed lambda" form))))) + + (define-transformer 'define + (lambda (form env) + (let ((len (length form))) + (if (= len 1) + (error "malformed define" form) + (let ((formal (cadr form))) + (if (identifier? formal) + (if (= len 3) + `(,the-core-define . ,(cdr form)) + (error "malformed define" form)) + (if (pair? formal) + `(,the-define ,(car formal) (,the-lambda ,(cdr formal) . ,(cddr form))) + (error "define: binding to non-varaible object" form)))))))) + + (define-transformer 'define-macro + (lambda (form env) + (if (= (length form) 3) + (if (identifier? (cadr form)) + `(,the-core-define-macro . ,(cdr form)) + (error "define-macro: binding to non-variable object" form)) + (error "malformed define-macro" form)))) + + + (define-macro define-auxiliary-syntax + (lambda (form _) + `(define-transformer ',(cadr form) + (lambda _ + (error "invalid use of auxiliary syntax" ',(cadr form)))))) + + (define-auxiliary-syntax else) + (define-auxiliary-syntax =>) + (define-auxiliary-syntax unquote) + (define-auxiliary-syntax unquote-splicing) + + (define-transformer 'let + (lambda (form env) + (if (identifier? (cadr form)) + (let ((name (car (cdr form))) + (formal (car (cdr (cdr form)))) + (body (cdr (cdr (cdr form))))) + `((,the-lambda () + (,the-define (,name . ,(map car formal)) . ,body) + (,name . ,(map cadr formal))))) + (let ((formal (car (cdr form))) + (body (cdr (cdr form)))) + `((,the-lambda ,(map car formal) . ,body) . ,(map cadr formal)))))) + + (define-transformer 'and + (lambda (form env) + (if (null? (cdr form)) + #t + (if (null? (cddr form)) + (cadr form) + `(,the-if ,(cadr form) (,(the 'and) . ,(cddr form)) #f))))) + + (define-transformer 'or + (lambda (form env) + (if (null? (cdr form)) + #f + (let ((tmp (make-identifier 'it env))) ; should we use #f as the env for tmp? + `(,(the 'let) ((,tmp ,(cadr form))) + (,the-if ,tmp ,tmp (,(the 'or) . ,(cddr form)))))))) + + (define-transformer 'cond + (lambda (form env) + (let ((clauses (cdr form))) + (if (null? clauses) + #undefined + (let ((clause (car clauses))) + (if (and (identifier? (car clause)) + (identifier=? (the 'else) (make-identifier (car clause) env))) + `(,the-begin . ,(cdr clause)) + (if (null? (cdr clause)) + `(,(the 'or) ,(car clause) (,(the 'cond) . ,(cdr clauses))) + (if (and (identifier? (cadr clause)) + (identifier=? (the '=>) (make-identifier (cadr clause) env))) + (let ((tmp (make-identifier 'tmp env))) + `(,(the 'let) ((,tmp ,(car clause))) + (,the-if ,tmp (,(cadr (cdr clause)) ,tmp) (,(the 'cond) . ,(cddr form))))) + `(,the-if ,(car clause) + (,the-begin . ,(cdr clause)) + (,(the 'cond) . ,(cdr clauses))))))))))) + + (define-transformer 'quasiquote + (lambda (form env) + + (define (quasiquote? form) + (and (pair? form) + (identifier? (car form)) + (identifier=? (the 'quasiquote) (make-identifier (car form) env)))) + + (define (unquote? form) + (and (pair? form) + (identifier? (car form)) + (identifier=? (the 'unquote) (make-identifier (car form) env)))) + + (define (unquote-splicing? form) + (and (pair? form) + (pair? (car form)) + (identifier? (caar form)) + (identifier=? (the 'unquote-splicing) (make-identifier (caar form) env)))) + + (define (qq depth expr) + (cond + ;; unquote + ((unquote? expr) + (if (= depth 1) + (cadr expr) + (list (the 'list) + (list (the 'quote) (the 'unquote)) + (qq (- depth 1) (car (cdr expr)))))) + ;; unquote-splicing + ((unquote-splicing? expr) + (if (= depth 1) + (list (the 'append) + (car (cdr (car expr))) + (qq depth (cdr expr))) + (list (the 'cons) + (list (the 'list) + (list (the 'quote) (the 'unquote-splicing)) + (qq (- depth 1) (car (cdr (car expr))))) + (qq depth (cdr expr))))) + ;; quasiquote + ((quasiquote? expr) + (list (the 'list) + (list (the 'quote) (the 'quasiquote)) + (qq (+ depth 1) (car (cdr expr))))) + ;; list + ((pair? expr) + (list (the 'cons) + (qq depth (car expr)) + (qq depth (cdr expr)))) + ;; vector + ((vector? expr) + (list (the 'list->vector) (qq depth (vector->list expr)))) + ;; simple datum + (else + (list (the 'quote) expr)))) + + (let ((x (cadr form))) + (qq 1 x)))) + + (define-transformer 'let* + (lambda (form env) + (let ((bindings (car (cdr form))) + (body (cdr (cdr form)))) + (if (null? bindings) + `(,(the 'let) () . ,body) + `(,(the 'let) ((,(car (car bindings)) . ,(cdr (car bindings)))) + (,(the 'let*) ,(cdr bindings) . ,body)))))) + + (define-transformer 'letrec + (lambda (form env) + `(,(the 'letrec*) . ,(cdr form)))) + + (define-transformer 'letrec* + (lambda (form env) + (let ((bindings (car (cdr form))) + (body (cdr (cdr form)))) + (let ((variables (map (lambda (v) `(,v #undefined)) (map car bindings))) + (initials (map (lambda (v) `(,(the 'set!) ,@v)) bindings))) + `(,(the 'let) ,variables + ,@initials + ,@body))))) + + (define-transformer 'let-values + (lambda (form env) + `(,(the 'let*-values) ,@(cdr form)))) + + (define-transformer 'let*-values + (lambda (form env) + (let ((formals (cadr form)) + (body (cddr form))) + (if (null? formals) + `(,(the 'let) () ,@body) + (let ((formal (car formals))) + `(,(the 'call-with-values) (,the-lambda () . ,(cdr formal)) + (,(the 'lambda) ,(car formal) + (,(the 'let*-values) ,(cdr formals) . ,body)))))))) + + (define-transformer 'define-values + (lambda (form env) + (let ((formal (cadr form)) + (body (cddr form))) + (let ((tmps (let loop ((formal formal)) + (if (identifier? formal) + (make-identifier formal env) + (if (pair? formal) + (cons (make-identifier (car formal) env) (loop (cdr formal))) + '()))))) + `(,the-begin + ,@(let loop ((formal formal)) + (if (identifier? formal) + `((,the-define ,formal #undefined)) + (if (pair? formal) + (cons `(,the-define ,(car formal) #undefined) (loop (cdr formal))) + '()))) + (,(the 'call-with-values) (,the-lambda () . ,body) + (,the-lambda ,tmps . ,(let loop ((formal formal) (tmps tmps)) + (if (identifier? formal) + `((,the-set! ,formal ,tmps)) + (if (pair? formal) + (cons `(,the-set! ,(car formal) ,(car tmps)) + (loop (cdr formal) (cdr tmps))) + '())))))))))) + + (define-transformer 'do + (lambda (form env) + (let ((bindings (car (cdr form))) + (test (car (car (cdr (cdr form))))) + (cleanup (cdr (car (cdr (cdr form))))) + (body (cdr (cdr (cdr form))))) + (let ((loop (make-identifier 'loop env))) + `(,(the 'let) ,loop ,(map (lambda (x) `(,(car x) ,(cadr x))) bindings) + (,the-if ,test + (,the-begin . ,cleanup) + (,the-begin + ,@body + (,loop . ,(map (lambda (x) + (if (null? (cdr (cdr x))) + (car x) + (car (cdr (cdr x))))) + bindings))))))))) + + (define-transformer 'when + (lambda (form env) + (let ((test (car (cdr form))) + (body (cdr (cdr form)))) + `(,the-if ,test + (,the-begin ,@body) + #undefined)))) + + (define-transformer 'unless + (lambda (form env) + (let ((test (car (cdr form))) + (body (cdr (cdr form)))) + `(,the-if ,test + #undefined + (,the-begin ,@body))))) + + (define-transformer 'case + (lambda (form env) + (let ((key (car (cdr form))) + (clauses (cdr (cdr form)))) + (let ((the-key (make-identifier 'key env))) + `(,(the 'let) ((,the-key ,key)) + ,(let loop ((clauses clauses)) + (if (null? clauses) + #undefined + (let ((clause (car clauses))) + `(,the-if ,(if (and (identifier? (car clause)) + (identifier=? (the 'else) (make-identifier (car clause) env))) + #t + `(,(the 'or) ,@(map (lambda (x) `(,(the 'eqv?) ,the-key (,the-quote ,x))) (car clause)))) + ,(if (and (identifier? (cadr clause)) + (identifier=? (the '=>) (make-identifier (cadr clause) env))) + `(,(car (cdr (cdr clause))) ,the-key) + `(,the-begin ,@(cdr clause))) + ,(loop (cdr clauses))))))))))) + + (define-transformer 'parameterize + (lambda (form env) + (let ((formal (car (cdr form))) + (body (cdr (cdr form)))) + `(,(the 'with-dynamic-environment) + (,(the 'list) ,@(map (lambda (x) `(,(the 'cons) ,(car x) ,(cadr x))) formal)) + (,the-lambda () ,@body))))) + + (define-transformer 'define-record-type + (lambda (form env) + (let ((type (car (cdr form))) + (ctor (car (cdr (cdr form)))) + (pred (car (cdr (cdr (cdr form))))) + (fields (cdr (cdr (cdr (cdr form)))))) + `(,the-begin + (,the-define ,ctor + (,(the 'make-record) ',type + (,(the 'vector) . ,(map (lambda (field) (if (memq (car field) (cdr ctor)) (car field) #undefined)) fields)))) + (,the-define ,pred + (,(the 'lambda) (obj) + (,(the 'and) (,(the 'record?) obj) (,(the 'eq?) (,(the 'record-type) obj) ',type)))) + . ,(let loop ((fields fields) (pos 0) (acc '())) + (if (null? fields) + acc + (let ((field (car fields))) + (let ((defs `((,the-define (,(cadr field) obj) + (,the-if (,pred obj) + (,(the 'vector-ref) (,(the 'record-datum) obj) ,pos) + (,(the 'error) "record type mismatch" obj ',type))) + . ,(if (null? (cddr field)) + '() + `((,the-define (,(car (cddr field)) obj value) + (,the-if (,pred obj) + (,(the 'vector-set!) (,(the 'record-datum) obj) ,pos value) + (,(the 'error) "record type mismatch" obj ',type)))))))) + (loop (cdr fields) (+ pos 1) `(,@defs . ,acc))))))))))) + (values make-identifier identifier? identifier=? diff --git a/tools/mkboot.scm b/tools/mkboot.scm index d7470d56..8192c31c 100644 --- a/tools/mkboot.scm +++ b/tools/mkboot.scm @@ -51,13 +51,11 @@ `("#include \"picrin.h\"\n" "#include \"picrin/extra.h\"\n" "\n" - "static const char boot_rom[][80] = {\n" - ,(generate-rom) - "};\n" - "\n" + "#if PIC_USE_EVAL\n" "static const char boot_compile_rom[][80] = {\n" ,(generate-rom) "};\n" + "#endif\n" "\n" "#if PIC_USE_LIBRARY\n" "static const char boot_library_rom[][80] = {\n" @@ -66,10 +64,11 @@ "#endif\n" "\n" "void\n" - "pic_boot(pic_state *pic)\n" + "pic_boot(pic_state *PIC_UNUSED(pic))\n" "{\n" + "#if PIC_USE_EVAL\n" " pic_load_native(pic, &boot_compile_rom[0][0]);\n" - " pic_load_native(pic, &boot_rom[0][0]);\n" + "#endif\n" "#if PIC_USE_LIBRARY\n" " pic_load_native(pic, &boot_library_rom[0][0]);\n" "#endif\n"