conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

integrate boot.scm and compile.scm

This commit is contained in:
Yuichi Nishiwaki 2017-04-04 19:00:37 +09:00
parent 463b73f11f
commit c1a7f6d2d8
7 changed files with 789 additions and 778 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Makefile
View File

@ -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

817
lib/ext/boot.c
View File

@ -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

1
lib/include/picconf.h
View File

@ -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 */

4
lib/include/picrin/setup.h
View File

@ -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

362
piclib/boot.scm
View File

@ -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))))))))))))

366
piclib/compile.scm
View File

@ -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=?

11
tools/mkboot.scm
View File

@ -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"