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

precompile library system

This commit is contained in:
Yuichi Nishiwaki 2017-04-04 00:02:00 +09:00
parent bba2abffde
commit b9cfbe8276
8 changed files with 1175 additions and 1630 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -78,7 +78,7 @@ src/init_contrib.c:
# $(CC) -shared $(CFLAGS) -o $@ $(LIBPICRIN_OBJS) $(LDFLAGS) # $(CC) -shared $(CFLAGS) -o $@ $(LIBPICRIN_OBJS) $(LDFLAGS)
lib/ext/boot.c: piclib/boot.scm piclib/library.scm lib/ext/boot.c: piclib/boot.scm piclib/library.scm
bin/picrin-bootstrap tools/mkboot.scm > lib/ext/boot.c cat piclib/boot.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 $(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

BIN
bin/picrin-bootstrap
View File

Binary file not shown.

878
lib/ext/boot.c
View File

@ -2,409 +2,489 @@
#include "picrin/extra.h" #include "picrin/extra.h"
static const char boot_rom[][80] = { static const char boot_rom[][80] = {
"(core#begin (core#define transformer (core#lambda (.f.172) (core#lambda (.form.1", "(core#begin (core#define transformer (core#lambda (.f.2252) (core#lambda (.form.",
"73 .env.174) ((core#lambda (.ephemeron1.175 .ephemeron2.176) ((core#lambda (.wra", "2253 .env.2254) ((core#lambda (.ephemeron1.2255 .ephemeron2.2256) ((core#lambda ",
"p.177 .unwrap.178 .walk.179) (core#begin (core#set! .wrap.177 (core#lambda (.var", "(.wrap.2257 .unwrap.2258 .walk.2259) (core#begin (core#set! .wrap.2257 (core#lam",
"1.180) ((core#lambda (.var2.181) (core#if .var2.181 (cdr .var2.181) ((core#lambd", "bda (.var1.2260) ((core#lambda (.var2.2261) (core#if .var2.2261 (cdr .var2.2261)",
"a (.var2.182) (core#begin (.ephemeron1.175 .var1.180 .var2.182) (core#begin (.ep", " ((core#lambda (.var2.2262) (core#begin (.ephemeron1.2255 .var1.2260 .var2.2262)",
"hemeron2.176 .var2.182 .var1.180) .var2.182))) (make-identifier .var1.180 .env.1", " (core#begin (.ephemeron2.2256 .var2.2262 .var1.2260) .var2.2262))) (make-identi",
"74)))) (.ephemeron1.175 .var1.180)))) (core#begin (core#set! .unwrap.178 (core#l", "fier .var1.2260 .env.2254)))) (.ephemeron1.2255 .var1.2260)))) (core#begin (core",
"ambda (.var2.183) ((core#lambda (.var1.184) (core#if .var1.184 (cdr .var1.184) .", "#set! .unwrap.2258 (core#lambda (.var2.2263) ((core#lambda (.var1.2264) (core#if",
"var2.183)) (.ephemeron2.176 .var2.183)))) (core#begin (core#set! .walk.179 (core", " .var1.2264 (cdr .var1.2264) .var2.2263)) (.ephemeron2.2256 .var2.2263)))) (core",
"#lambda (.f.185 .form.186) (core#if (identifier? .form.186) (.f.185 .form.186) (", "#begin (core#set! .walk.2259 (core#lambda (.f.2265 .form.2266) (core#if (identif",
"core#if (pair? .form.186) (cons (.walk.179 .f.185 (car .form.186)) (.walk.179 .f", "ier? .form.2266) (.f.2265 .form.2266) (core#if (pair? .form.2266) (cons (.walk.2",
".185 (cdr .form.186))) (core#if (vector? .form.186) (list->vector (.walk.179 .f.", "259 .f.2265 (car .form.2266)) (.walk.2259 .f.2265 (cdr .form.2266))) (core#if (v",
"185 (vector->list .form.186))) .form.186))))) ((core#lambda (.form.187) (.walk.1", "ector? .form.2266) (list->vector (.walk.2259 .f.2265 (vector->list .form.2266)))",
"79 .unwrap.178 (apply .f.172 (.walk.179 .wrap.177 .form.187)))) (cdr .form.173))", " .form.2266))))) ((core#lambda (.form.2267) (.walk.2259 .unwrap.2258 (apply .f.2",
")))) #f #f #f)) (make-ephemeron-table) (make-ephemeron-table))))) ((core#lambda ", "252 (.walk.2259 .wrap.2257 .form.2267)))) (cdr .form.2253)))))) #undefined #unde",
"() (core#begin (core#define .define-transformer.188 (core#lambda (.name.208 .tra", "fined #undefined)) (make-ephemeron-table) (make-ephemeron-table))))) ((core#lamb",
"nsformer.209) (add-macro! .name.208 .transformer.209))) (core#begin (core#define", "da () (core#begin (core#define .define-transformer.2268 (core#lambda (.name.2288",
" .the.189 (core#lambda (.var.210) (make-identifier .var.210 default-environment)", " .transformer.2289) (add-macro! .name.2288 .transformer.2289))) (core#begin (cor",
")) (core#begin (core#define .the-core-define.190 (.the.189 (core#quote core#defi", "e#define .the.2269 (core#lambda (.var.2290) (make-identifier .var.2290 default-e",
"ne))) (core#begin (core#define .the-core-lambda.191 (.the.189 (core#quote core#l", "nvironment))) (core#begin (core#define .the-core-define.2270 (.the.2269 (core#qu",
"ambda))) (core#begin (core#define .the-core-begin.192 (.the.189 (core#quote core", "ote core#define))) (core#begin (core#define .the-core-lambda.2271 (.the.2269 (co",
"#begin))) (core#begin (core#define .the-core-quote.193 (.the.189 (core#quote cor", "re#quote core#lambda))) (core#begin (core#define .the-core-begin.2272 (.the.2269",
"e#quote))) (core#begin (core#define .the-core-set!.194 (.the.189 (core#quote cor", " (core#quote core#begin))) (core#begin (core#define .the-core-quote.2273 (.the.2",
"e#set!))) (core#begin (core#define .the-core-if.195 (.the.189 (core#quote core#i", "269 (core#quote core#quote))) (core#begin (core#define .the-core-set!.2274 (.the",
"f))) (core#begin (core#define .the-core-define-macro.196 (.the.189 (core#quote c", ".2269 (core#quote core#set!))) (core#begin (core#define .the-core-if.2275 (.the.",
"ore#define-macro))) (core#begin (core#define .the-define.197 (.the.189 (core#quo", "2269 (core#quote core#if))) (core#begin (core#define .the-core-define-macro.2276",
"te define))) (core#begin (core#define .the-lambda.198 (.the.189 (core#quote lamb", " (.the.2269 (core#quote core#define-macro))) (core#begin (core#define .the-defin",
"da))) (core#begin (core#define .the-begin.199 (.the.189 (core#quote begin))) (co", "e.2277 (.the.2269 (core#quote define))) (core#begin (core#define .the-lambda.227",
"re#begin (core#define .the-quote.200 (.the.189 (core#quote quote))) (core#begin ", "8 (.the.2269 (core#quote lambda))) (core#begin (core#define .the-begin.2279 (.th",
"(core#define .the-set!.201 (.the.189 (core#quote set!))) (core#begin (core#defin", "e.2269 (core#quote begin))) (core#begin (core#define .the-quote.2280 (.the.2269 ",
"e .the-if.202 (.the.189 (core#quote if))) (core#begin (core#define .the-define-m", "(core#quote quote))) (core#begin (core#define .the-set!.2281 (.the.2269 (core#qu",
"acro.203 (.the.189 (core#quote define-macro))) (core#begin (.define-transformer.", "ote set!))) (core#begin (core#define .the-if.2282 (.the.2269 (core#quote if))) (",
"188 (core#quote quote) (core#lambda (.form.211 .env.212) (core#if (= (length .fo", "core#begin (core#define .the-define-macro.2283 (.the.2269 (core#quote define-mac",
"rm.211) 2) (cons .the-core-quote.193 (cons (cadr .form.211) (core#quote ()))) (e", "ro))) (core#begin (.define-transformer.2268 (core#quote quote) (core#lambda (.fo",
"rror \"malformed quote\" .form.211)))) (core#begin (.define-transformer.188 (core#", "rm.2291 .env.2292) (core#if (= (length .form.2291) 2) (cons .the-core-quote.2273",
"quote if) (core#lambda (.form.213 .env.214) ((core#lambda (.len.215) (core#if (=", " (cons (cadr .form.2291) (core#quote ()))) (error \"malformed quote\" .form.2291))",
" .len.215 3) (append .form.213 (cons (core#quote #undefined) (core#quote ()))) (", ")) (core#begin (.define-transformer.2268 (core#quote if) (core#lambda (.form.229",
"core#if (= .len.215 4) (cons .the-core-if.195 (cdr .form.213)) (error \"malformed", "3 .env.2294) ((core#lambda (.len.2295) (core#if (= .len.2295 3) (append .form.22",
" if\" .form.213)))) (length .form.213)))) (core#begin (.define-transformer.188 (c", "93 (cons (core#quote #undefined) (core#quote ()))) (core#if (= .len.2295 4) (con",
"ore#quote begin) (core#lambda (.form.216 .env.217) ((core#lambda (.len.218) (cor", "s .the-core-if.2275 (cdr .form.2293)) (error \"malformed if\" .form.2293)))) (leng",
"e#if (= .len.218 1) #undefined (core#if (= .len.218 2) (cadr .form.216) (core#if", "th .form.2293)))) (core#begin (.define-transformer.2268 (core#quote begin) (core",
" (= .len.218 3) (cons .the-core-begin.192 (cdr .form.216)) (cons .the-core-begin", "#lambda (.form.2296 .env.2297) ((core#lambda (.len.2298) (core#if (= .len.2298 1",
".192 (cons (cadr .form.216) (cons (cons .the-begin.199 (cddr .form.216)) (core#q", ") #undefined (core#if (= .len.2298 2) (cadr .form.2296) (core#if (= .len.2298 3)",
"uote ())))))))) (length .form.216)))) (core#begin (.define-transformer.188 (core", " (cons .the-core-begin.2272 (cdr .form.2296)) (cons .the-core-begin.2272 (cons (",
"#quote set!) (core#lambda (.form.219 .env.220) (core#if (core#if (= (length .for", "cadr .form.2296) (cons (cons .the-begin.2279 (cddr .form.2296)) (core#quote ()))",
"m.219) 3) (identifier? (cadr .form.219)) #f) (cons .the-core-set!.194 (cdr .form", ")))))) (length .form.2296)))) (core#begin (.define-transformer.2268 (core#quote ",
".219)) (error \"malformed set!\" .form.219)))) (core#begin (core#define .check-for", "set!) (core#lambda (.form.2299 .env.2300) (core#if (core#if (= (length .form.229",
"mal.204 (core#lambda (.formal.221) ((core#lambda (.it.222) (core#if .it.222 .it.", "9) 3) (identifier? (cadr .form.2299)) #f) (cons .the-core-set!.2274 (cdr .form.2",
"222 ((core#lambda (.it.223) (core#if .it.223 .it.223 ((core#lambda (.it.224) (co", "299)) (error \"malformed set!\" .form.2299)))) (core#begin (core#define .check-for",
"re#if .it.224 .it.224 #f)) (core#if (pair? .formal.221) (core#if (identifier? (c", "mal.2284 (core#lambda (.formal.2301) ((core#lambda (.it.2302) (core#if .it.2302 ",
"ar .formal.221)) (.check-formal.204 (cdr .formal.221)) #f) #f)))) (identifier? .", ".it.2302 ((core#lambda (.it.2303) (core#if .it.2303 .it.2303 ((core#lambda (.it.",
"formal.221)))) (null? .formal.221)))) (core#begin (.define-transformer.188 (core", "2304) (core#if .it.2304 .it.2304 #f)) (core#if (pair? .formal.2301) (core#if (id",
"#quote lambda) (core#lambda (.form.225 .env.226) (core#if (= (length .form.225) ", "entifier? (car .formal.2301)) (.check-formal.2284 (cdr .formal.2301)) #f) #f))))",
"1) (error \"malformed lambda\" .form.225) (core#if (.check-formal.204 (cadr .form.", " (identifier? .formal.2301)))) (null? .formal.2301)))) (core#begin (.define-tran",
"225)) (cons .the-core-lambda.191 (cons (cadr .form.225) (cons (cons .the-begin.1", "sformer.2268 (core#quote lambda) (core#lambda (.form.2305 .env.2306) (core#if (=",
"99 (cddr .form.225)) (core#quote ())))) (error \"malformed lambda\" .form.225)))))", " (length .form.2305) 1) (error \"malformed lambda\" .form.2305) (core#if (.check-f",
" (core#begin (.define-transformer.188 (core#quote define) (core#lambda (.form.22", "ormal.2284 (cadr .form.2305)) (cons .the-core-lambda.2271 (cons (cadr .form.2305",
"7 .env.228) ((core#lambda (.len.229) (core#if (= .len.229 1) (error \"malformed d", ") (cons (cons .the-begin.2279 (cddr .form.2305)) (core#quote ())))) (error \"malf",
"efine\" .form.227) ((core#lambda (.formal.230) (core#if (identifier? .formal.230)", "ormed lambda\" .form.2305))))) (core#begin (.define-transformer.2268 (core#quote ",
" (core#if (= .len.229 3) (cons .the-core-define.190 (cdr .form.227)) (error \"mal", "define) (core#lambda (.form.2307 .env.2308) ((core#lambda (.len.2309) (core#if (",
"formed define\" .form.227)) (core#if (pair? .formal.230) (cons .the-define.197 (c", "= .len.2309 1) (error \"malformed define\" .form.2307) ((core#lambda (.formal.2310",
"ons (car .formal.230) (cons (cons .the-lambda.198 (cons (cdr .formal.230) (cddr ", ") (core#if (identifier? .formal.2310) (core#if (= .len.2309 3) (cons .the-core-d",
".form.227))) (core#quote ())))) (error \"define: binding to non-varaible object\" ", "efine.2270 (cdr .form.2307)) (error \"malformed define\" .form.2307)) (core#if (pa",
".form.227)))) (cadr .form.227)))) (length .form.227)))) (core#begin (.define-tra", "ir? .formal.2310) (cons .the-define.2277 (cons (car .formal.2310) (cons (cons .t",
"nsformer.188 (core#quote define-macro) (core#lambda (.form.231 .env.232) (core#i", "he-lambda.2278 (cons (cdr .formal.2310) (cddr .form.2307))) (core#quote ())))) (",
"f (= (length .form.231) 3) (core#if (identifier? (cadr .form.231)) (cons .the-co", "error \"define: binding to non-varaible object\" .form.2307)))) (cadr .form.2307))",
"re-define-macro.196 (cdr .form.231)) (error \"define-macro: binding to non-variab", ")) (length .form.2307)))) (core#begin (.define-transformer.2268 (core#quote defi",
"le object\" .form.231)) (error \"malformed define-macro\" .form.231)))) (core#begin", "ne-macro) (core#lambda (.form.2311 .env.2312) (core#if (= (length .form.2311) 3)",
" (.define-transformer.188 (core#quote syntax-error) (core#lambda (.form.233 ._.2", " (core#if (identifier? (cadr .form.2311)) (cons .the-core-define-macro.2276 (cdr",
"34) (apply error (cdr .form.233)))) (core#begin #undefined (core#begin (.define-", " .form.2311)) (error \"define-macro: binding to non-variable object\" .form.2311))",
"transformer.188 (core#quote else) (core#lambda ._.235 (error \"invalid use of aux", " (error \"malformed define-macro\" .form.2311)))) (core#begin (.define-transformer",
"iliary syntax\" (core#quote else)))) (core#begin (.define-transformer.188 (core#q", ".2268 (core#quote syntax-error) (core#lambda (.form.2313 ._.2314) (apply error (",
"uote =>) (core#lambda ._.236 (error \"invalid use of auxiliary syntax\" (core#quot", "cdr .form.2313)))) (core#begin #undefined (core#begin (.define-transformer.2268 ",
"e =>)))) (core#begin (.define-transformer.188 (core#quote unquote) (core#lambda ", "(core#quote else) (core#lambda ._.2315 (error \"invalid use of auxiliary syntax\" ",
"._.237 (error \"invalid use of auxiliary syntax\" (core#quote unquote)))) (core#be", "(core#quote else)))) (core#begin (.define-transformer.2268 (core#quote =>) (core",
"gin (.define-transformer.188 (core#quote unquote-splicing) (core#lambda ._.238 (", "#lambda ._.2316 (error \"invalid use of auxiliary syntax\" (core#quote =>)))) (cor",
"error \"invalid use of auxiliary syntax\" (core#quote unquote-splicing)))) (core#b", "e#begin (.define-transformer.2268 (core#quote unquote) (core#lambda ._.2317 (err",
"egin (.define-transformer.188 (core#quote syntax-unquote) (core#lambda ._.239 (e", "or \"invalid use of auxiliary syntax\" (core#quote unquote)))) (core#begin (.defin",
"rror \"invalid use of auxiliary syntax\" (core#quote syntax-unquote)))) (core#begi", "e-transformer.2268 (core#quote unquote-splicing) (core#lambda ._.2318 (error \"in",
"n (.define-transformer.188 (core#quote syntax-unquote-splicing) (core#lambda ._.", "valid use of auxiliary syntax\" (core#quote unquote-splicing)))) (core#begin (.de",
"240 (error \"invalid use of auxiliary syntax\" (core#quote syntax-unquote-splicing", "fine-transformer.2268 (core#quote syntax-unquote) (core#lambda ._.2319 (error \"i",
")))) (core#begin (.define-transformer.188 (core#quote let) (core#lambda (.form.2", "nvalid use of auxiliary syntax\" (core#quote syntax-unquote)))) (core#begin (.def",
"41 .env.242) (core#if (identifier? (cadr .form.241)) ((core#lambda (.name.243 .f", "ine-transformer.2268 (core#quote syntax-unquote-splicing) (core#lambda ._.2320 (",
"ormal.244 .body.245) (cons (cons .the-lambda.198 (cons (core#quote ()) (cons (co", "error \"invalid use of auxiliary syntax\" (core#quote syntax-unquote-splicing)))) ",
"ns .the-define.197 (cons (cons .name.243 (map car .formal.244)) .body.245)) (con", "(core#begin (.define-transformer.2268 (core#quote let) (core#lambda (.form.2321 ",
"s (cons .name.243 (map cadr .formal.244)) (core#quote ()))))) (core#quote ()))) ", ".env.2322) (core#if (identifier? (cadr .form.2321)) ((core#lambda (.name.2323 .f",
"(car (cdr .form.241)) (car (cdr (cdr .form.241))) (cdr (cdr (cdr .form.241)))) (", "ormal.2324 .body.2325) (cons (cons .the-lambda.2278 (cons (core#quote ()) (cons ",
"(core#lambda (.formal.246 .body.247) (cons (cons .the-lambda.198 (cons (map car ", "(cons .the-define.2277 (cons (cons .name.2323 (map car .formal.2324)) .body.2325",
".formal.246) .body.247)) (map cadr .formal.246))) (car (cdr .form.241)) (cdr (cd", ")) (cons (cons .name.2323 (map cadr .formal.2324)) (core#quote ()))))) (core#quo",
"r .form.241)))))) (core#begin (.define-transformer.188 (core#quote and) (core#la", "te ()))) (car (cdr .form.2321)) (car (cdr (cdr .form.2321))) (cdr (cdr (cdr .for",
"mbda (.form.248 .env.249) (core#if (null? (cdr .form.248)) #t (core#if (null? (c", "m.2321)))) ((core#lambda (.formal.2326 .body.2327) (cons (cons .the-lambda.2278 ",
"ddr .form.248)) (cadr .form.248) (cons .the-if.202 (cons (cadr .form.248) (cons ", "(cons (map car .formal.2326) .body.2327)) (map cadr .formal.2326))) (car (cdr .f",
"(cons (.the.189 (core#quote and)) (cddr .form.248)) (cons (core#quote #f) (core#", "orm.2321)) (cdr (cdr .form.2321)))))) (core#begin (.define-transformer.2268 (cor",
"quote ()))))))))) (core#begin (.define-transformer.188 (core#quote or) (core#lam", "e#quote and) (core#lambda (.form.2328 .env.2329) (core#if (null? (cdr .form.2328",
"bda (.form.250 .env.251) (core#if (null? (cdr .form.250)) #f ((core#lambda (.tmp", ")) #t (core#if (null? (cddr .form.2328)) (cadr .form.2328) (cons .the-if.2282 (c",
".252) (cons (.the.189 (core#quote let)) (cons (cons (cons .tmp.252 (cons (cadr .", "ons (cadr .form.2328) (cons (cons (.the.2269 (core#quote and)) (cddr .form.2328)",
"form.250) (core#quote ()))) (core#quote ())) (cons (cons .the-if.202 (cons .tmp.", ") (cons (core#quote #f) (core#quote ()))))))))) (core#begin (.define-transformer",
"252 (cons .tmp.252 (cons (cons (.the.189 (core#quote or)) (cddr .form.250)) (cor", ".2268 (core#quote or) (core#lambda (.form.2330 .env.2331) (core#if (null? (cdr .",
"e#quote ()))))) (core#quote ()))))) (make-identifier (core#quote it) .env.251)))", "form.2330)) #f ((core#lambda (.tmp.2332) (cons (.the.2269 (core#quote let)) (con",
")) (core#begin (.define-transformer.188 (core#quote cond) (core#lambda (.form.25", "s (cons (cons .tmp.2332 (cons (cadr .form.2330) (core#quote ()))) (core#quote ()",
"3 .env.254) ((core#lambda (.clauses.255) (core#if (null? .clauses.255) #undefine", ")) (cons (cons .the-if.2282 (cons .tmp.2332 (cons .tmp.2332 (cons (cons (.the.22",
"d ((core#lambda (.clause.256) (core#if (core#if (identifier? (car .clause.256)) ", "69 (core#quote or)) (cddr .form.2330)) (core#quote ()))))) (core#quote ()))))) (",
"(identifier=? (.the.189 (core#quote else)) (make-identifier (car .clause.256) .e", "make-identifier (core#quote it) .env.2331))))) (core#begin (.define-transformer.",
"nv.254)) #f) (cons .the-begin.199 (cdr .clause.256)) (core#if (null? (cdr .claus", "2268 (core#quote cond) (core#lambda (.form.2333 .env.2334) ((core#lambda (.claus",
"e.256)) (cons (.the.189 (core#quote or)) (cons (car .clause.256) (cons (cons (.t", "es.2335) (core#if (null? .clauses.2335) #undefined ((core#lambda (.clause.2336) ",
"he.189 (core#quote cond)) (cdr .clauses.255)) (core#quote ())))) (core#if (core#", "(core#if (core#if (identifier? (car .clause.2336)) (identifier=? (.the.2269 (cor",
"if (identifier? (cadr .clause.256)) (identifier=? (.the.189 (core#quote =>)) (ma", "e#quote else)) (make-identifier (car .clause.2336) .env.2334)) #f) (cons .the-be",
"ke-identifier (cadr .clause.256) .env.254)) #f) ((core#lambda (.tmp.257) (cons (", "gin.2279 (cdr .clause.2336)) (core#if (null? (cdr .clause.2336)) (cons (.the.226",
".the.189 (core#quote let)) (cons (cons (cons .tmp.257 (cons (car .clause.256) (c", "9 (core#quote or)) (cons (car .clause.2336) (cons (cons (.the.2269 (core#quote c",
"ore#quote ()))) (core#quote ())) (cons (cons .the-if.202 (cons .tmp.257 (cons (c", "ond)) (cdr .clauses.2335)) (core#quote ())))) (core#if (core#if (identifier? (ca",
"ons (cadr (cdr .clause.256)) (cons .tmp.257 (core#quote ()))) (cons (cons (.the.", "dr .clause.2336)) (identifier=? (.the.2269 (core#quote =>)) (make-identifier (ca",
"189 (core#quote cond)) (cddr .form.253)) (core#quote ()))))) (core#quote ())))))", "dr .clause.2336) .env.2334)) #f) ((core#lambda (.tmp.2337) (cons (.the.2269 (cor",
" (make-identifier (core#quote tmp) .env.254)) (cons .the-if.202 (cons (car .clau", "e#quote let)) (cons (cons (cons .tmp.2337 (cons (car .clause.2336) (core#quote (",
"se.256) (cons (cons .the-begin.199 (cdr .clause.256)) (cons (cons (.the.189 (cor", ")))) (core#quote ())) (cons (cons .the-if.2282 (cons .tmp.2337 (cons (cons (cadr",
"e#quote cond)) (cdr .clauses.255)) (core#quote ()))))))))) (car .clauses.255))))", " (cdr .clause.2336)) (cons .tmp.2337 (core#quote ()))) (cons (cons (.the.2269 (c",
" (cdr .form.253)))) (core#begin (.define-transformer.188 (core#quote quasiquote)", "ore#quote cond)) (cddr .form.2333)) (core#quote ()))))) (core#quote ()))))) (mak",
" (core#lambda (.form.258 .env.259) (core#begin (core#define .quasiquote?.260 (co", "e-identifier (core#quote tmp) .env.2334)) (cons .the-if.2282 (cons (car .clause.",
"re#lambda (.form.264) (core#if (pair? .form.264) (core#if (identifier? (car .for", "2336) (cons (cons .the-begin.2279 (cdr .clause.2336)) (cons (cons (.the.2269 (co",
"m.264)) (identifier=? (.the.189 (core#quote quasiquote)) (make-identifier (car .", "re#quote cond)) (cdr .clauses.2335)) (core#quote ()))))))))) (car .clauses.2335)",
"form.264) .env.259)) #f) #f))) (core#begin (core#define .unquote?.261 (core#lamb", "))) (cdr .form.2333)))) (core#begin (.define-transformer.2268 (core#quote quasiq",
"da (.form.265) (core#if (pair? .form.265) (core#if (identifier? (car .form.265))", "uote) (core#lambda (.form.2338 .env.2339) (core#begin (core#define .quasiquote?.",
" (identifier=? (.the.189 (core#quote unquote)) (make-identifier (car .form.265) ", "2340 (core#lambda (.form.2344) (core#if (pair? .form.2344) (core#if (identifier?",
".env.259)) #f) #f))) (core#begin (core#define .unquote-splicing?.262 (core#lambd", " (car .form.2344)) (identifier=? (.the.2269 (core#quote quasiquote)) (make-ident",
"a (.form.266) (core#if (pair? .form.266) (core#if (pair? (car .form.266)) (core#", "ifier (car .form.2344) .env.2339)) #f) #f))) (core#begin (core#define .unquote?.",
"if (identifier? (caar .form.266)) (identifier=? (.the.189 (core#quote unquote-sp", "2341 (core#lambda (.form.2345) (core#if (pair? .form.2345) (core#if (identifier?",
"licing)) (make-identifier (caar .form.266) .env.259)) #f) #f) #f))) (core#begin ", " (car .form.2345)) (identifier=? (.the.2269 (core#quote unquote)) (make-identifi",
"(core#define .qq.263 (core#lambda (.depth.267 .expr.268) (core#if (.unquote?.261", "er (car .form.2345) .env.2339)) #f) #f))) (core#begin (core#define .unquote-spli",
" .expr.268) (core#if (= .depth.267 1) (cadr .expr.268) (list (.the.189 (core#quo", "cing?.2342 (core#lambda (.form.2346) (core#if (pair? .form.2346) (core#if (pair?",
"te list)) (list (.the.189 (core#quote quote)) (.the.189 (core#quote unquote))) (", " (car .form.2346)) (core#if (identifier? (caar .form.2346)) (identifier=? (.the.",
".qq.263 (- .depth.267 1) (car (cdr .expr.268))))) (core#if (.unquote-splicing?.2", "2269 (core#quote unquote-splicing)) (make-identifier (caar .form.2346) .env.2339",
"62 .expr.268) (core#if (= .depth.267 1) (list (.the.189 (core#quote append)) (ca", ")) #f) #f) #f))) (core#begin (core#define .qq.2343 (core#lambda (.depth.2347 .ex",
"r (cdr (car .expr.268))) (.qq.263 .depth.267 (cdr .expr.268))) (list (.the.189 (", "pr.2348) (core#if (.unquote?.2341 .expr.2348) (core#if (= .depth.2347 1) (cadr .",
"core#quote cons)) (list (.the.189 (core#quote list)) (list (.the.189 (core#quote", "expr.2348) (list (.the.2269 (core#quote list)) (list (.the.2269 (core#quote quot",
" quote)) (.the.189 (core#quote unquote-splicing))) (.qq.263 (- .depth.267 1) (ca", "e)) (.the.2269 (core#quote unquote))) (.qq.2343 (- .depth.2347 1) (car (cdr .exp",
"r (cdr (car .expr.268))))) (.qq.263 .depth.267 (cdr .expr.268)))) (core#if (.qua", "r.2348))))) (core#if (.unquote-splicing?.2342 .expr.2348) (core#if (= .depth.234",
"siquote?.260 .expr.268) (list (.the.189 (core#quote list)) (list (.the.189 (core", "7 1) (list (.the.2269 (core#quote append)) (car (cdr (car .expr.2348))) (.qq.234",
"#quote quote)) (.the.189 (core#quote quasiquote))) (.qq.263 (+ .depth.267 1) (ca", "3 .depth.2347 (cdr .expr.2348))) (list (.the.2269 (core#quote cons)) (list (.the",
"r (cdr .expr.268)))) (core#if (pair? .expr.268) (list (.the.189 (core#quote cons", ".2269 (core#quote list)) (list (.the.2269 (core#quote quote)) (.the.2269 (core#q",
")) (.qq.263 .depth.267 (car .expr.268)) (.qq.263 .depth.267 (cdr .expr.268))) (c", "uote unquote-splicing))) (.qq.2343 (- .depth.2347 1) (car (cdr (car .expr.2348))",
"ore#if (vector? .expr.268) (list (.the.189 (core#quote list->vector)) (.qq.263 .", "))) (.qq.2343 .depth.2347 (cdr .expr.2348)))) (core#if (.quasiquote?.2340 .expr.",
"depth.267 (vector->list .expr.268))) (list (.the.189 (core#quote quote)) .expr.2", "2348) (list (.the.2269 (core#quote list)) (list (.the.2269 (core#quote quote)) (",
"68)))))))) ((core#lambda (.x.269) (.qq.263 1 .x.269)) (cadr .form.258)))))))) (c", ".the.2269 (core#quote quasiquote))) (.qq.2343 (+ .depth.2347 1) (car (cdr .expr.",
"ore#begin (.define-transformer.188 (core#quote let*) (core#lambda (.form.270 .en", "2348)))) (core#if (pair? .expr.2348) (list (.the.2269 (core#quote cons)) (.qq.23",
"v.271) ((core#lambda (.bindings.272 .body.273) (core#if (null? .bindings.272) (c", "43 .depth.2347 (car .expr.2348)) (.qq.2343 .depth.2347 (cdr .expr.2348))) (core#",
"ons (.the.189 (core#quote let)) (cons (core#quote ()) .body.273)) (cons (.the.18", "if (vector? .expr.2348) (list (.the.2269 (core#quote list->vector)) (.qq.2343 .d",
"9 (core#quote let)) (cons (cons (cons (car (car .bindings.272)) (cdr (car .bindi", "epth.2347 (vector->list .expr.2348))) (list (.the.2269 (core#quote quote)) .expr",
"ngs.272))) (core#quote ())) (cons (cons (.the.189 (core#quote let*)) (cons (cdr ", ".2348)))))))) ((core#lambda (.x.2349) (.qq.2343 1 .x.2349)) (cadr .form.2338))))",
".bindings.272) .body.273)) (core#quote ())))))) (car (cdr .form.270)) (cdr (cdr ", ")))) (core#begin (.define-transformer.2268 (core#quote let*) (core#lambda (.form",
".form.270))))) (core#begin (.define-transformer.188 (core#quote letrec) (core#la", ".2350 .env.2351) ((core#lambda (.bindings.2352 .body.2353) (core#if (null? .bind",
"mbda (.form.274 .env.275) (cons (.the.189 (core#quote letrec*)) (cdr .form.274))", "ings.2352) (cons (.the.2269 (core#quote let)) (cons (core#quote ()) .body.2353))",
")) (core#begin (.define-transformer.188 (core#quote letrec*) (core#lambda (.form", " (cons (.the.2269 (core#quote let)) (cons (cons (cons (car (car .bindings.2352))",
".276 .env.277) ((core#lambda (.bindings.278 .body.279) ((core#lambda (.variables", " (cdr (car .bindings.2352))) (core#quote ())) (cons (cons (.the.2269 (core#quote",
".280 .initials.281) (cons (.the.189 (core#quote let)) (cons .variables.280 (appe", " let*)) (cons (cdr .bindings.2352) .body.2353)) (core#quote ())))))) (car (cdr .",
"nd .initials.281 (append .body.279 (core#quote ())))))) (map (core#lambda (.v.28", "form.2350)) (cdr (cdr .form.2350))))) (core#begin (.define-transformer.2268 (cor",
"2) (cons .v.282 (cons (core#quote #undefined) (core#quote ())))) (map car .bindi", "e#quote letrec) (core#lambda (.form.2354 .env.2355) (cons (.the.2269 (core#quote",
"ngs.278)) (map (core#lambda (.v.283) (cons (.the.189 (core#quote set!)) (append ", " letrec*)) (cdr .form.2354)))) (core#begin (.define-transformer.2268 (core#quote",
".v.283 (core#quote ())))) .bindings.278))) (car (cdr .form.276)) (cdr (cdr .form", " letrec*) (core#lambda (.form.2356 .env.2357) ((core#lambda (.bindings.2358 .bod",
".276))))) (core#begin (.define-transformer.188 (core#quote let-values) (core#lam", "y.2359) ((core#lambda (.variables.2360 .initials.2361) (cons (.the.2269 (core#qu",
"bda (.form.284 .env.285) (cons (.the.189 (core#quote let*-values)) (append (cdr ", "ote let)) (cons .variables.2360 (append .initials.2361 (append .body.2359 (core#",
".form.284) (core#quote ()))))) (core#begin (.define-transformer.188 (core#quote ", "quote ())))))) (map (core#lambda (.v.2362) (cons .v.2362 (cons (core#quote #unde",
"let*-values) (core#lambda (.form.286 .env.287) ((core#lambda (.formal.288 .body.", "fined) (core#quote ())))) (map car .bindings.2358)) (map (core#lambda (.v.2363) ",
"289) (core#if (null? .formal.288) (cons (.the.189 (core#quote let)) (cons (core#", "(cons (.the.2269 (core#quote set!)) (append .v.2363 (core#quote ())))) .bindings",
"quote ()) (append .body.289 (core#quote ())))) (cons (.the.189 (core#quote call-", ".2358))) (car (cdr .form.2356)) (cdr (cdr .form.2356))))) (core#begin (.define-t",
"with-values)) (cons (cons .the-lambda.198 (cons (core#quote ()) (append (cdr (ca", "ransformer.2268 (core#quote let-values) (core#lambda (.form.2364 .env.2365) (con",
"r .formal.288)) (core#quote ())))) (cons (cons (.the.189 (core#quote lambda)) (c", "s (.the.2269 (core#quote let*-values)) (append (cdr .form.2364) (core#quote ()))",
"ons (append (car (car .formal.288)) (core#quote ())) (cons (cons (.the.189 (core", "))) (core#begin (.define-transformer.2268 (core#quote let*-values) (core#lambda ",
"#quote let*-values)) (cons (append (cdr .formal.288) (core#quote ())) (append .b", "(.form.2366 .env.2367) ((core#lambda (.formal.2368 .body.2369) (core#if (null? .",
"ody.289 (core#quote ())))) (core#quote ())))) (core#quote ())))))) (car (cdr .fo", "formal.2368) (cons (.the.2269 (core#quote let)) (cons (core#quote ()) (append .b",
"rm.286)) (cdr (cdr .form.286))))) (core#begin (.define-transformer.188 (core#quo", "ody.2369 (core#quote ())))) (cons (.the.2269 (core#quote call-with-values)) (con",
"te define-values) (core#lambda (.form.290 .env.291) ((core#lambda (.formal.292 .", "s (cons .the-lambda.2278 (cons (core#quote ()) (append (cdr (car .formal.2368)) ",
"body.293) ((core#lambda (.arguments.294) (cons .the-begin.199 (append ((core#lam", "(core#quote ())))) (cons (cons (.the.2269 (core#quote lambda)) (cons (append (ca",
"bda () (core#begin (core#define .loop.295 (core#lambda (.formal.296) (core#if (p", "r (car .formal.2368)) (core#quote ())) (cons (cons (.the.2269 (core#quote let*-v",
"air? .formal.296) (cons (cons .the-define.197 (cons (car .formal.296) (cons (cor", "alues)) (cons (append (cdr .formal.2368) (core#quote ())) (append .body.2369 (co",
"e#quote #undefined) (core#quote ())))) (append (.loop.295 (cdr .formal.296)) (co", "re#quote ())))) (core#quote ())))) (core#quote ())))))) (car (cdr .form.2366)) (",
"re#quote ()))) (core#if (identifier? .formal.296) (cons (cons .the-define.197 (c", "cdr (cdr .form.2366))))) (core#begin (.define-transformer.2268 (core#quote defin",
"ons .formal.296 (cons (core#quote #undefined) (core#quote ())))) (core#quote ())", "e-values) (core#lambda (.form.2370 .env.2371) ((core#lambda (.formal.2372 .body.",
") (core#quote ()))))) (.loop.295 .formal.292)))) (cons (cons (.the.189 (core#quo", "2373) ((core#lambda (.arguments.2374) (cons .the-begin.2279 (append ((core#lambd",
"te call-with-values)) (cons (cons .the-lambda.198 (cons (core#quote ()) (append ", "a () (core#begin (core#define .loop.2375 (core#lambda (.formal.2376) (core#if (p",
".body.293 (core#quote ())))) (cons (cons .the-lambda.198 (cons .arguments.294 (a", "air? .formal.2376) (cons (cons .the-define.2277 (cons (car .formal.2376) (cons (",
"ppend ((core#lambda () (core#begin (core#define .loop.297 (core#lambda (.formal.", "core#quote #undefined) (core#quote ())))) (append (.loop.2375 (cdr .formal.2376)",
"298 .args.299) (core#if (pair? .formal.298) (cons (cons .the-set!.201 (cons (car", ") (core#quote ()))) (core#if (identifier? .formal.2376) (cons (cons .the-define.",
" .formal.298) (cons (cons (.the.189 (core#quote car)) (cons .args.299 (core#quot", "2277 (cons .formal.2376 (cons (core#quote #undefined) (core#quote ())))) (core#q",
"e ()))) (core#quote ())))) (append (.loop.297 (cdr .formal.298) (cons (.the.189 ", "uote ())) (core#quote ()))))) (.loop.2375 .formal.2372)))) (cons (cons (.the.226",
"(core#quote cdr)) (cons .args.299 (core#quote ())))) (core#quote ()))) (core#if ", "9 (core#quote call-with-values)) (cons (cons .the-lambda.2278 (cons (core#quote ",
"(identifier? .formal.298) (cons (cons .the-set!.201 (cons .formal.298 (cons .arg", "()) (append .body.2373 (core#quote ())))) (cons (cons .the-lambda.2278 (cons .ar",
"s.299 (core#quote ())))) (core#quote ())) (core#quote ()))))) (.loop.297 .formal", "guments.2374 (append ((core#lambda () (core#begin (core#define .loop.2377 (core#",
".292 .arguments.294)))) (core#quote ())))) (core#quote ())))) (core#quote ()))))", "lambda (.formal.2378 .args.2379) (core#if (pair? .formal.2378) (cons (cons .the-",
") (make-identifier (core#quote arguments) .env.291))) (car (cdr .form.290)) (cdr", "set!.2281 (cons (car .formal.2378) (cons (cons (.the.2269 (core#quote car)) (con",
" (cdr .form.290))))) (core#begin (.define-transformer.188 (core#quote do) (core#", "s .args.2379 (core#quote ()))) (core#quote ())))) (append (.loop.2377 (cdr .form",
"lambda (.form.300 .env.301) ((core#lambda (.bindings.302 .test.303 .cleanup.304 ", "al.2378) (cons (.the.2269 (core#quote cdr)) (cons .args.2379 (core#quote ())))) ",
".body.305) ((core#lambda (.loop.306) (cons (.the.189 (core#quote let)) (cons .lo", "(core#quote ()))) (core#if (identifier? .formal.2378) (cons (cons .the-set!.2281",
"op.306 (cons (map (core#lambda (.x.307) (cons (car .x.307) (cons (cadr .x.307) (", " (cons .formal.2378 (cons .args.2379 (core#quote ())))) (core#quote ())) (core#q",
"core#quote ())))) .bindings.302) (cons (cons .the-if.202 (cons .test.303 (cons (", "uote ()))))) (.loop.2377 .formal.2372 .arguments.2374)))) (core#quote ())))) (co",
"cons .the-begin.199 .cleanup.304) (cons (cons .the-begin.199 (append .body.305 (", "re#quote ())))) (core#quote ()))))) (make-identifier (core#quote arguments) .env",
"cons (cons .loop.306 (map (core#lambda (.x.308) (core#if (null? (cdr (cdr .x.308", ".2371))) (car (cdr .form.2370)) (cdr (cdr .form.2370))))) (core#begin (.define-t",
"))) (car .x.308) (car (cdr (cdr .x.308))))) .bindings.302)) (core#quote ())))) (", "ransformer.2268 (core#quote do) (core#lambda (.form.2380 .env.2381) ((core#lambd",
"core#quote ()))))) (core#quote ())))))) (make-identifier (core#quote loop) .env.", "a (.bindings.2382 .test.2383 .cleanup.2384 .body.2385) ((core#lambda (.loop.2386",
"301))) (car (cdr .form.300)) (car (car (cdr (cdr .form.300)))) (cdr (car (cdr (c", ") (cons (.the.2269 (core#quote let)) (cons .loop.2386 (cons (map (core#lambda (.",
"dr .form.300)))) (cdr (cdr (cdr .form.300)))))) (core#begin (.define-transformer", "x.2387) (cons (car .x.2387) (cons (cadr .x.2387) (core#quote ())))) .bindings.23",
".188 (core#quote when) (core#lambda (.form.309 .env.310) ((core#lambda (.test.31", "82) (cons (cons .the-if.2282 (cons .test.2383 (cons (cons .the-begin.2279 .clean",
"1 .body.312) (cons .the-if.202 (cons .test.311 (cons (cons .the-begin.199 (appen", "up.2384) (cons (cons .the-begin.2279 (append .body.2385 (cons (cons .loop.2386 (",
"d .body.312 (core#quote ()))) (cons (core#quote #undefined) (core#quote ()))))))", "map (core#lambda (.x.2388) (core#if (null? (cdr (cdr .x.2388))) (car .x.2388) (c",
" (car (cdr .form.309)) (cdr (cdr .form.309))))) (core#begin (.define-transformer", "ar (cdr (cdr .x.2388))))) .bindings.2382)) (core#quote ())))) (core#quote ()))))",
".188 (core#quote unless) (core#lambda (.form.313 .env.314) ((core#lambda (.test.", ") (core#quote ())))))) (make-identifier (core#quote loop) .env.2381))) (car (cdr",
"315 .body.316) (cons .the-if.202 (cons .test.315 (cons (core#quote #undefined) (", " .form.2380)) (car (car (cdr (cdr .form.2380)))) (cdr (car (cdr (cdr .form.2380)",
"cons (cons .the-begin.199 (append .body.316 (core#quote ()))) (core#quote ()))))", "))) (cdr (cdr (cdr .form.2380)))))) (core#begin (.define-transformer.2268 (core#",
")) (car (cdr .form.313)) (cdr (cdr .form.313))))) (core#begin (.define-transform", "quote when) (core#lambda (.form.2389 .env.2390) ((core#lambda (.test.2391 .body.",
"er.188 (core#quote case) (core#lambda (.form.317 .env.318) ((core#lambda (.key.3", "2392) (cons .the-if.2282 (cons .test.2391 (cons (cons .the-begin.2279 (append .b",
"19 .clauses.320) ((core#lambda (.the-key.321) (cons (.the.189 (core#quote let)) ", "ody.2392 (core#quote ()))) (cons (core#quote #undefined) (core#quote ())))))) (c",
"(cons (cons (cons .the-key.321 (cons .key.319 (core#quote ()))) (core#quote ()))", "ar (cdr .form.2389)) (cdr (cdr .form.2389))))) (core#begin (.define-transformer.",
" (cons ((core#lambda () (core#begin (core#define .loop.322 (core#lambda (.clause", "2268 (core#quote unless) (core#lambda (.form.2393 .env.2394) ((core#lambda (.tes",
"s.323) (core#if (null? .clauses.323) #undefined ((core#lambda (.clause.324) (con", "t.2395 .body.2396) (cons .the-if.2282 (cons .test.2395 (cons (core#quote #undefi",
"s .the-if.202 (cons (core#if (core#if (identifier? (car .clause.324)) (identifie", "ned) (cons (cons .the-begin.2279 (append .body.2396 (core#quote ()))) (core#quot",
"r=? (.the.189 (core#quote else)) (make-identifier (car .clause.324) .env.318)) #", "e ())))))) (car (cdr .form.2393)) (cdr (cdr .form.2393))))) (core#begin (.define",
"f) #t (cons (.the.189 (core#quote or)) (append (map (core#lambda (.x.325) (cons ", "-transformer.2268 (core#quote case) (core#lambda (.form.2397 .env.2398) ((core#l",
"(.the.189 (core#quote eqv?)) (cons .the-key.321 (cons (cons .the-quote.200 (cons", "ambda (.key.2399 .clauses.2400) ((core#lambda (.the-key.2401) (cons (.the.2269 (",
" .x.325 (core#quote ()))) (core#quote ()))))) (car .clause.324)) (core#quote ())", "core#quote let)) (cons (cons (cons .the-key.2401 (cons .key.2399 (core#quote ())",
"))) (cons (core#if (core#if (identifier? (cadr .clause.324)) (identifier=? (.the", ")) (core#quote ())) (cons ((core#lambda () (core#begin (core#define .loop.2402 (",
".189 (core#quote =>)) (make-identifier (cadr .clause.324) .env.318)) #f) (cons (", "core#lambda (.clauses.2403) (core#if (null? .clauses.2403) #undefined ((core#lam",
"car (cdr (cdr .clause.324))) (cons .the-key.321 (core#quote ()))) (cons .the-beg", "bda (.clause.2404) (cons .the-if.2282 (cons (core#if (core#if (identifier? (car ",
"in.199 (append (cdr .clause.324) (core#quote ())))) (cons (.loop.322 (cdr .claus", ".clause.2404)) (identifier=? (.the.2269 (core#quote else)) (make-identifier (car",
"es.323)) (core#quote ())))))) (car .clauses.323))))) (.loop.322 .clauses.320))))", " .clause.2404) .env.2398)) #f) #t (cons (.the.2269 (core#quote or)) (append (map",
" (core#quote ()))))) (make-identifier (core#quote key) .env.318))) (car (cdr .fo", " (core#lambda (.x.2405) (cons (.the.2269 (core#quote eqv?)) (cons .the-key.2401 ",
"rm.317)) (cdr (cdr .form.317))))) (core#begin (.define-transformer.188 (core#quo", "(cons (cons .the-quote.2280 (cons .x.2405 (core#quote ()))) (core#quote ()))))) ",
"te parameterize) (core#lambda (.form.326 .env.327) ((core#lambda (.formal.328 .b", "(car .clause.2404)) (core#quote ())))) (cons (core#if (core#if (identifier? (cad",
"ody.329) (cons (.the.189 (core#quote with-dynamic-environment)) (cons (cons (.th", "r .clause.2404)) (identifier=? (.the.2269 (core#quote =>)) (make-identifier (cad",
"e.189 (core#quote list)) (append (map (core#lambda (.x.330) (cons (.the.189 (cor", "r .clause.2404) .env.2398)) #f) (cons (car (cdr (cdr .clause.2404))) (cons .the-",
"e#quote cons)) (cons (car .x.330) (cons (cadr .x.330) (core#quote ()))))) .forma", "key.2401 (core#quote ()))) (cons .the-begin.2279 (append (cdr .clause.2404) (cor",
"l.328) (core#quote ()))) (cons (cons .the-lambda.198 (cons (core#quote ()) (appe", "e#quote ())))) (cons (.loop.2402 (cdr .clauses.2403)) (core#quote ())))))) (car ",
"nd .body.329 (core#quote ())))) (core#quote ()))))) (car (cdr .form.326)) (cdr (", ".clauses.2403))))) (.loop.2402 .clauses.2400)))) (core#quote ()))))) (make-ident",
"cdr .form.326))))) (core#begin (.define-transformer.188 (core#quote syntax-quote", "ifier (core#quote key) .env.2398))) (car (cdr .form.2397)) (cdr (cdr .form.2397)",
") (core#lambda (.form.331 .env.332) ((core#lambda (.renames.333) ((core#lambda (", ")))) (core#begin (.define-transformer.2268 (core#quote parameterize) (core#lambd",
".rename.334 .walk.335) (core#begin (core#set! .rename.334 (core#lambda (.var.336", "a (.form.2406 .env.2407) ((core#lambda (.formal.2408 .body.2409) (cons (.the.226",
") ((core#lambda (.x.337) (core#if .x.337 (cadr .x.337) (core#begin (core#set! .r", "9 (core#quote with-dynamic-environment)) (cons (cons (.the.2269 (core#quote list",
"enames.333 (cons (cons .var.336 (cons (make-identifier .var.336 .env.332) (cons ", ")) (append (map (core#lambda (.x.2410) (cons (.the.2269 (core#quote cons)) (cons",
"(cons (.the.189 (core#quote make-identifier)) (cons (cons (core#quote quote) (co", " (car .x.2410) (cons (cadr .x.2410) (core#quote ()))))) .formal.2408) (core#quot",
"ns .var.336 (core#quote ()))) (cons (cons (core#quote quote) (cons .env.332 (cor", "e ()))) (cons (cons .the-lambda.2278 (cons (core#quote ()) (append .body.2409 (c",
"e#quote ()))) (core#quote ())))) (core#quote ())))) .renames.333)) (.rename.334 ", "ore#quote ())))) (core#quote ()))))) (car (cdr .form.2406)) (cdr (cdr .form.2406",
".var.336)))) (assq .var.336 .renames.333)))) (core#begin (core#set! .walk.335 (c", "))))) (core#begin (.define-transformer.2268 (core#quote syntax-quote) (core#lamb",
"ore#lambda (.f.338 .form.339) (core#if (identifier? .form.339) (.f.338 .form.339", "da (.form.2411 .env.2412) ((core#lambda (.renames.2413) ((core#lambda (.rename.2",
") (core#if (pair? .form.339) (cons (.the.189 (core#quote cons)) (cons (cons (cor", "414 .walk.2415) (core#begin (core#set! .rename.2414 (core#lambda (.var.2416) ((c",
"e#quote walk) (cons (core#quote f) (cons (cons (core#quote car) (cons (core#quot", "ore#lambda (.x.2417) (core#if .x.2417 (cadr .x.2417) (core#begin (core#set! .ren",
"e form) (core#quote ()))) (core#quote ())))) (cons (cons (core#quote walk) (cons", "ames.2413 (cons (cons .var.2416 (cons (make-identifier .var.2416 .env.2412) (con",
" (core#quote f) (cons (cons (core#quote cdr) (cons (core#quote form) (core#quote", "s (cons (.the.2269 (core#quote make-identifier)) (cons (cons (core#quote quote) ",
" ()))) (core#quote ())))) (core#quote ())))) (core#if (vector? .form.339) (cons ", "(cons .var.2416 (core#quote ()))) (cons (cons (core#quote quote) (cons .env.2412",
"(.the.189 (core#quote list->vector)) (cons (cons (core#quote walk) (cons (core#q", " (core#quote ()))) (core#quote ())))) (core#quote ())))) .renames.2413)) (.renam",
"uote f) (cons (cons (core#quote vector->list) (cons (core#quote form) (core#quot", "e.2414 .var.2416)))) (assq .var.2416 .renames.2413)))) (core#begin (core#set! .w",
"e ()))) (core#quote ())))) (core#quote ()))) (cons (.the.189 (core#quote quote))", "alk.2415 (core#lambda (.f.2418 .form.2419) (core#if (identifier? .form.2419) (.f",
" (cons .form.339 (core#quote ())))))))) ((core#lambda (.form.340) (cons (.the.18", ".2418 .form.2419) (core#if (pair? .form.2419) (cons (.the.2269 (core#quote cons)",
"9 (core#quote let)) (cons (map cdr .renames.333) (cons .form.340 (core#quote ())", ") (cons (cons (core#quote walk) (cons (core#quote f) (cons (cons (core#quote car",
")))) (.walk.335 .rename.334 (cadr .form.331)))))) #f #f)) (core#quote ())))) (co", ") (cons (core#quote form) (core#quote ()))) (core#quote ())))) (cons (cons (core",
"re#begin (.define-transformer.188 (core#quote syntax-quasiquote) (core#lambda (.", "#quote walk) (cons (core#quote f) (cons (cons (core#quote cdr) (cons (core#quote",
"form.341 .env.342) ((core#lambda (.renames.343) ((core#lambda (.rename.344) (cor", " form) (core#quote ()))) (core#quote ())))) (core#quote ())))) (core#if (vector?",
"e#begin (core#set! .rename.344 (core#lambda (.var.349) ((core#lambda (.x.350) (c", " .form.2419) (cons (.the.2269 (core#quote list->vector)) (cons (cons (core#quote",
"ore#if .x.350 (cadr .x.350) (core#begin (core#set! .renames.343 (cons (cons .var", " walk) (cons (core#quote f) (cons (cons (core#quote vector->list) (cons (core#qu",
".349 (cons (make-identifier .var.349 .env.342) (cons (cons (.the.189 (core#quote", "ote form) (core#quote ()))) (core#quote ())))) (core#quote ()))) (cons (.the.226",
" make-identifier)) (cons (cons (core#quote quote) (cons .var.349 (core#quote ())", "9 (core#quote quote)) (cons .form.2419 (core#quote ())))))))) ((core#lambda (.fo",
")) (cons (cons (core#quote quote) (cons .env.342 (core#quote ()))) (core#quote (", "rm.2420) (cons (.the.2269 (core#quote let)) (cons (map cdr .renames.2413) (cons ",
"))))) (core#quote ())))) .renames.343)) (.rename.344 .var.349)))) (assq .var.349", ".form.2420 (core#quote ()))))) (.walk.2415 .rename.2414 (cadr .form.2411)))))) #",
" .renames.343)))) (core#begin (core#define .syntax-quasiquote?.345 (core#lambda ", "undefined #undefined)) (core#quote ())))) (core#begin (.define-transformer.2268 ",
"(.form.351) (core#if (pair? .form.351) (core#if (identifier? (car .form.351)) (i", "(core#quote syntax-quasiquote) (core#lambda (.form.2421 .env.2422) ((core#lambda",
"dentifier=? (.the.189 (core#quote syntax-quasiquote)) (make-identifier (car .for", " (.renames.2423) ((core#lambda (.rename.2424) (core#begin (core#set! .rename.242",
"m.351) .env.342)) #f) #f))) (core#begin (core#define .syntax-unquote?.346 (core#", "4 (core#lambda (.var.2429) ((core#lambda (.x.2430) (core#if .x.2430 (cadr .x.243",
"lambda (.form.352) (core#if (pair? .form.352) (core#if (identifier? (car .form.3", "0) (core#begin (core#set! .renames.2423 (cons (cons .var.2429 (cons (make-identi",
"52)) (identifier=? (.the.189 (core#quote syntax-unquote)) (make-identifier (car ", "fier .var.2429 .env.2422) (cons (cons (.the.2269 (core#quote make-identifier)) (",
".form.352) .env.342)) #f) #f))) (core#begin (core#define .syntax-unquote-splicin", "cons (cons (core#quote quote) (cons .var.2429 (core#quote ()))) (cons (cons (cor",
"g?.347 (core#lambda (.form.353) (core#if (pair? .form.353) (core#if (pair? (car ", "e#quote quote) (cons .env.2422 (core#quote ()))) (core#quote ())))) (core#quote ",
".form.353)) (core#if (identifier? (caar .form.353)) (identifier=? (.the.189 (cor", "())))) .renames.2423)) (.rename.2424 .var.2429)))) (assq .var.2429 .renames.2423",
"e#quote syntax-unquote-splicing)) (make-identifier (caar .form.353) .env.342)) #", ")))) (core#begin (core#define .syntax-quasiquote?.2425 (core#lambda (.form.2431)",
"f) #f) #f))) (core#begin (core#define .qq.348 (core#lambda (.depth.354 .expr.355", " (core#if (pair? .form.2431) (core#if (identifier? (car .form.2431)) (identifier",
") (core#if (.syntax-unquote?.346 .expr.355) (core#if (= .depth.354 1) (car (cdr ", "=? (.the.2269 (core#quote syntax-quasiquote)) (make-identifier (car .form.2431) ",
".expr.355)) (list (.the.189 (core#quote list)) (list (.the.189 (core#quote quote", ".env.2422)) #f) #f))) (core#begin (core#define .syntax-unquote?.2426 (core#lambd",
")) (.the.189 (core#quote syntax-unquote))) (.qq.348 (- .depth.354 1) (car (cdr .", "a (.form.2432) (core#if (pair? .form.2432) (core#if (identifier? (car .form.2432",
"expr.355))))) (core#if (.syntax-unquote-splicing?.347 .expr.355) (core#if (= .de", ")) (identifier=? (.the.2269 (core#quote syntax-unquote)) (make-identifier (car .",
"pth.354 1) (list (.the.189 (core#quote append)) (car (cdr (car .expr.355))) (.qq", "form.2432) .env.2422)) #f) #f))) (core#begin (core#define .syntax-unquote-splici",
".348 .depth.354 (cdr .expr.355))) (list (.the.189 (core#quote cons)) (list (.the", "ng?.2427 (core#lambda (.form.2433) (core#if (pair? .form.2433) (core#if (pair? (",
".189 (core#quote list)) (list (.the.189 (core#quote quote)) (.the.189 (core#quot", "car .form.2433)) (core#if (identifier? (caar .form.2433)) (identifier=? (.the.22",
"e syntax-unquote-splicing))) (.qq.348 (- .depth.354 1) (car (cdr (car .expr.355)", "69 (core#quote syntax-unquote-splicing)) (make-identifier (caar .form.2433) .env",
")))) (.qq.348 .depth.354 (cdr .expr.355)))) (core#if (.syntax-quasiquote?.345 .e", ".2422)) #f) #f) #f))) (core#begin (core#define .qq.2428 (core#lambda (.depth.243",
"xpr.355) (list (.the.189 (core#quote list)) (list (.the.189 (core#quote quote)) ", "4 .expr.2435) (core#if (.syntax-unquote?.2426 .expr.2435) (core#if (= .depth.243",
"(.the.189 (core#quote quasiquote))) (.qq.348 (+ .depth.354 1) (car (cdr .expr.35", "4 1) (car (cdr .expr.2435)) (list (.the.2269 (core#quote list)) (list (.the.2269",
"5)))) (core#if (pair? .expr.355) (list (.the.189 (core#quote cons)) (.qq.348 .de", " (core#quote quote)) (.the.2269 (core#quote syntax-unquote))) (.qq.2428 (- .dept",
"pth.354 (car .expr.355)) (.qq.348 .depth.354 (cdr .expr.355))) (core#if (vector?", "h.2434 1) (car (cdr .expr.2435))))) (core#if (.syntax-unquote-splicing?.2427 .ex",
" .expr.355) (list (.the.189 (core#quote list->vector)) (.qq.348 .depth.354 (vect", "pr.2435) (core#if (= .depth.2434 1) (list (.the.2269 (core#quote append)) (car (",
"or->list .expr.355))) (core#if (identifier? .expr.355) (.rename.344 .expr.355) (", "cdr (car .expr.2435))) (.qq.2428 .depth.2434 (cdr .expr.2435))) (list (.the.2269",
"list (.the.189 (core#quote quote)) .expr.355))))))))) ((core#lambda (.body.356) ", " (core#quote cons)) (list (.the.2269 (core#quote list)) (list (.the.2269 (core#q",
"(cons (.the.189 (core#quote let)) (cons (map cdr .renames.343) (cons .body.356 (", "uote quote)) (.the.2269 (core#quote syntax-unquote-splicing))) (.qq.2428 (- .dep",
"core#quote ()))))) (.qq.348 1 (cadr .form.341))))))))) #f)) (core#quote ())))) (", "th.2434 1) (car (cdr (car .expr.2435))))) (.qq.2428 .depth.2434 (cdr .expr.2435)",
"core#begin (.define-transformer.188 (core#quote define-syntax) (core#lambda (.fo", "))) (core#if (.syntax-quasiquote?.2425 .expr.2435) (list (.the.2269 (core#quote ",
"rm.357 .env.358) ((core#lambda (.formal.359 .body.360) (core#if (pair? .formal.3", "list)) (list (.the.2269 (core#quote quote)) (.the.2269 (core#quote quasiquote)))",
"59) (cons (.the.189 (core#quote define-syntax)) (cons (car .formal.359) (cons (c", " (.qq.2428 (+ .depth.2434 1) (car (cdr .expr.2435)))) (core#if (pair? .expr.2435",
"ons .the-lambda.198 (cons (cdr .formal.359) (append .body.360 (core#quote ()))))", ") (list (.the.2269 (core#quote cons)) (.qq.2428 .depth.2434 (car .expr.2435)) (.",
" (core#quote ())))) (cons .the-define-macro.203 (cons .formal.359 (cons (cons (.", "qq.2428 .depth.2434 (cdr .expr.2435))) (core#if (vector? .expr.2435) (list (.the",
"the.189 (core#quote transformer)) (cons (cons .the-begin.199 (append .body.360 (", ".2269 (core#quote list->vector)) (.qq.2428 .depth.2434 (vector->list .expr.2435)",
"core#quote ()))) (core#quote ()))) (core#quote ())))))) (car (cdr .form.357)) (c", ")) (core#if (identifier? .expr.2435) (.rename.2424 .expr.2435) (list (.the.2269 ",
"dr (cdr .form.357))))) (core#begin (.define-transformer.188 (core#quote letrec-s", "(core#quote quote)) .expr.2435))))))))) ((core#lambda (.body.2436) (cons (.the.2",
"yntax) (core#lambda (.form.361 .env.362) ((core#lambda (.formal.363 .body.364) (", "269 (core#quote let)) (cons (map cdr .renames.2423) (cons .body.2436 (core#quote",
"cons (core#quote let) (cons (core#quote ()) (append (map (core#lambda (.x.365) (", " ()))))) (.qq.2428 1 (cadr .form.2421))))))))) #undefined)) (core#quote ())))) (",
"cons (.the.189 (core#quote define-syntax)) (cons (car .x.365) (cons (cadr .x.365", "core#begin (.define-transformer.2268 (core#quote define-syntax) (core#lambda (.f",
") (core#quote ()))))) .formal.363) (append .body.364 (core#quote ())))))) (car (", "orm.2437 .env.2438) ((core#lambda (.formal.2439 .body.2440) (core#if (pair? .for",
"cdr .form.361)) (cdr (cdr .form.361))))) (.define-transformer.188 (core#quote le", "mal.2439) (cons (.the.2269 (core#quote define-syntax)) (cons (car .formal.2439) ",
"t-syntax) (core#lambda (.form.366 .env.367) (cons (.the.189 (core#quote letrec-s", "(cons (cons .the-lambda.2278 (cons (cdr .formal.2439) (append .body.2440 (core#q",
"yntax)) (append (cdr .form.366) (core#quote ()))))))))))))))))))))))))))))))))))", "uote ())))) (core#quote ())))) (cons .the-define-macro.2283 (cons .formal.2439 (",
")))))))))))))))))))))))))) ", "cons (cons (.the.2269 (core#quote transformer)) (cons (cons .the-begin.2279 (app",
"end .body.2440 (core#quote ()))) (core#quote ()))) (core#quote ())))))) (car (cd",
"r .form.2437)) (cdr (cdr .form.2437))))) (core#begin (.define-transformer.2268 (",
"core#quote letrec-syntax) (core#lambda (.form.2441 .env.2442) ((core#lambda (.fo",
"rmal.2443 .body.2444) (cons (core#quote let) (cons (core#quote ()) (append (map ",
"(core#lambda (.x.2445) (cons (.the.2269 (core#quote define-syntax)) (cons (car .",
"x.2445) (cons (cadr .x.2445) (core#quote ()))))) .formal.2443) (append .body.244",
"4 (core#quote ())))))) (car (cdr .form.2441)) (cdr (cdr .form.2441))))) (.define",
"-transformer.2268 (core#quote let-syntax) (core#lambda (.form.2446 .env.2447) (c",
"ons (.the.2269 (core#quote letrec-syntax)) (append (cdr .form.2446) (core#quote ",
"()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))",
}; };
#if PIC_USE_LIBRARY #if PIC_USE_LIBRARY
static const char boot_library_rom[][80] = { static const char boot_library_rom[][80] = {
"(define (mangle name) (when (null? name) (error \"library name should be a list o", "(core#begin (core#define mangle (core#lambda (.name.2448) (core#begin (core#if (",
"f at least one symbols\" name)) (define (->string n) (cond ((symbol? n) (let ((st", "null? .name.2448) (error \"library name should be a list of at least one symbols\"",
"r (symbol->string n))) (string-for-each (lambda (c) (when (or (char=? c #\\.) (ch", " .name.2448) #undefined) (core#begin (core#define .->string.2449 (core#lambda (.",
"ar=? c #\\:)) (error \"elements of library name may not contain '.' or ':'\" n))) s", "n.2451) (core#if (symbol? .n.2451) ((core#lambda (.str.2452) (core#begin (string",
"tr) str)) ((and (number? n) (exact? n) (<= 0 n)) (number->string n)) (else (erro", "-for-each (core#lambda (.c.2453) (core#if ((core#lambda (.it.2454) (core#if .it.",
"r \"symbol or non-negative integer is required\" n)))) (define (join strs delim) (", "2454 .it.2454 ((core#lambda (.it.2455) (core#if .it.2455 .it.2455 #f)) (char=? .",
"let loop ((res (car strs)) (strs (cdr strs))) (if (null? strs) res (loop (string", "c.2453 #\\:)))) (char=? .c.2453 #\\.)) (error \"elements of library name may not co",
"-append res delim (car strs)) (cdr strs))))) (if (symbol? name) name (string->sy", "ntain '.' or ':'\" .n.2451) #undefined)) .str.2452) .str.2452)) (symbol->string .",
"mbol (join (map ->string name) \".\")))) (define current-library (make-parameter '", "n.2451)) (core#if (core#if (number? .n.2451) (core#if (exact? .n.2451) (<= 0 .n.",
"(picrin base) mangle)) (define *libraries* (make-dictionary)) (define (find-libr", "2451) #f) #f) (number->string .n.2451) (error \"symbol or non-negative integer is",
"ary name) (dictionary-has? *libraries* (mangle name))) (define (make-library nam", " required\" .n.2451))))) (core#begin (core#define .join.2450 (core#lambda (.strs.",
"e) (let ((name (mangle name))) (let ((env (make-environment (string->symbol (str", "2456 .delim.2457) ((core#lambda () (core#begin (core#define .loop.2458 (core#lam",
"ing-append (symbol->string name) \":\")))) (exports (make-dictionary))) (set-ident", "bda (.res.2459 .strs.2460) (core#if (null? .strs.2460) .res.2459 (.loop.2458 (st",
"ifier! 'define-library 'define-library env) (set-identifier! 'import 'import env", "ring-append .res.2459 .delim.2457 (car .strs.2460)) (cdr .strs.2460))))) (.loop.",
") (set-identifier! 'export 'export env) (set-identifier! 'cond-expand 'cond-expa", "2458 (car .strs.2456) (cdr .strs.2456))))))) (core#if (symbol? .name.2448) .name",
"nd env) (dictionary-set! *libraries* name `(,env unquote exports))))) (define (l", ".2448 (string->symbol (.join.2450 (map .->string.2449 .name.2448) \".\")))))))) (c",
"ibrary-environment name) (car (dictionary-ref *libraries* (mangle name)))) (defi", "ore#begin (core#define current-library (make-parameter (core#quote (picrin base)",
"ne (library-exports name) (cdr (dictionary-ref *libraries* (mangle name)))) (def", ") mangle)) (core#begin (core#define *libraries* (make-dictionary)) (core#begin (",
"ine (library-import name sym alias) (let ((uid (dictionary-ref (library-exports ", "core#define find-library (core#lambda (.name.2461) (dictionary-has? *libraries* ",
"name) sym))) (let ((env (library-environment (current-library)))) (set-identifie", "(mangle .name.2461)))) (core#begin (core#define make-library (core#lambda (.name",
"r! alias uid env)))) (define (library-export sym alias) (let ((env (library-envi", ".2462) ((core#lambda (.name.2463) ((core#lambda (.env.2464 .exports.2465) (core#",
"ronment (current-library))) (exports (library-exports (current-library)))) (dict", "begin (set-identifier! (core#quote define-library) (core#quote define-library) .",
"ionary-set! exports alias (find-identifier sym env)))) (define-macro define-libr", "env.2464) (core#begin (set-identifier! (core#quote import) (core#quote import) .",
"ary (lambda (form _) (let ((name (cadr form)) (body (cddr form))) (or (find-libr", "env.2464) (core#begin (set-identifier! (core#quote export) (core#quote export) .",
"ary name) (make-library name)) (parameterize ((current-library name)) (for-each ", "env.2464) (core#begin (set-identifier! (core#quote cond-expand) (core#quote cond",
"(lambda (expr) (eval expr name)) body))))) (define-macro cond-expand (lambda (fo", "-expand) .env.2464) (dictionary-set! *libraries* .name.2463 (cons .env.2464 .exp",
"rm _) (letrec ((test (lambda (form) (or (eq? form 'else) (and (symbol? form) (me", "orts.2465))))))) (make-environment (string->symbol (string-append (symbol->strin",
"mq form (features))) (and (pair? form) (case (car form) ((library) (find-library", "g .name.2463) \":\"))) (make-dictionary))) (mangle .name.2462)))) (core#begin (cor",
" (cadr form))) ((not) (not (test (cadr form)))) ((and) (let loop ((form (cdr for", "e#define library-environment (core#lambda (.name.2466) (car (dictionary-ref *lib",
"m))) (or (null? form) (and (test (car form)) (loop (cdr form)))))) ((or) (let lo", "raries* (mangle .name.2466))))) (core#begin (core#define library-exports (core#l",
"op ((form (cdr form))) (and (pair? form) (or (test (car form)) (loop (cdr form))", "ambda (.name.2467) (cdr (dictionary-ref *libraries* (mangle .name.2467))))) (cor",
")))) (else #f))))))) (let loop ((clauses (cdr form))) (if (null? clauses) #undef", "e#begin (core#define library-import (core#lambda (.name.2468 .sym.2469 .alias.24",
"ined (if (test (caar clauses)) `(,(make-identifier 'begin default-environment) ,", "70) ((core#lambda (.uid.2471) ((core#lambda (.env.2472) (set-identifier! .alias.",
"@(cdar clauses)) (loop (cdr clauses)))))))) (define-macro import (lambda (form _", "2470 .uid.2471 .env.2472)) (library-environment (current-library)))) (dictionary",
") (let ((caddr (lambda (x) (car (cdr (cdr x))))) (prefix (lambda (prefix symbol)", "-ref (library-exports .name.2468) .sym.2469)))) (core#begin (core#define library",
" (string->symbol (string-append (symbol->string prefix) (symbol->string symbol))", "-export (core#lambda (.sym.2473 .alias.2474) ((core#lambda (.env.2475 .exports.2",
"))) (getlib (lambda (name) (if (find-library name) name (error \"library not foun", "476) (dictionary-set! .exports.2476 .alias.2474 (find-identifier .sym.2473 .env.",
"d\" name))))) (letrec ((extract (lambda (spec) (case (car spec) ((only rename pre", "2475))) (library-environment (current-library)) (library-exports (current-librar",
"fix except) (extract (cadr spec))) (else (getlib spec))))) (collect (lambda (spe", "y))))) (core#begin ((core#lambda (.define-transformer.2477) (core#begin (.define",
"c) (case (car spec) ((only) (let ((alist (collect (cadr spec)))) (map (lambda (v", "-transformer.2477 (core#quote define-library) (core#lambda (.form.2478 ._.2479) ",
"ar) (assq var alist)) (cddr spec)))) ((rename) (let ((alist (collect (cadr spec)", "((core#lambda (.name.2480 .body.2481) (core#begin ((core#lambda (.it.2482) (core",
")) (renames (map (lambda (x) `(,(car x) unquote (cadr x))) (cddr spec)))) (map (", "#if .it.2482 .it.2482 ((core#lambda (.it.2483) (core#if .it.2483 .it.2483 #f)) (",
"lambda (s) (or (assq (car s) renames) s)) alist))) ((prefix) (let ((alist (colle", "make-library .name.2480)))) (find-library .name.2480)) (with-dynamic-environment",
"ct (cadr spec)))) (map (lambda (s) (cons (prefix (caddr spec) (car s)) (cdr s)))", " (list (cons current-library .name.2480)) (core#lambda () (for-each (core#lambda",
" alist))) ((except) (let ((alist (collect (cadr spec)))) (let loop ((alist alist", " (.expr.2484) (eval .expr.2484 .name.2480)) .body.2481))))) (cadr .form.2478) (c",
")) (if (null? alist) '() (if (memq (caar alist) (cddr spec)) (loop (cdr alist)) ", "ddr .form.2478)))) (core#begin (.define-transformer.2477 (core#quote cond-expand",
"(cons (car alist) (loop (cdr alist)))))))) (else (dictionary-map (lambda (x) (co", ") (core#lambda (.form.2485 ._.2486) ((core#lambda (.test.2487) (core#begin (core",
"ns x x)) (library-exports (getlib spec)))))))) (letrec ((import (lambda (spec) (", "#set! .test.2487 (core#lambda (.form.2488) ((core#lambda (.it.2489) (core#if .it",
"let ((lib (extract spec)) (alist (collect spec))) (for-each (lambda (slot) (libr", ".2489 .it.2489 ((core#lambda (.it.2490) (core#if .it.2490 .it.2490 ((core#lambda",
"ary-import lib (cdr slot) (car slot))) alist))))) (for-each import (cdr form))))", " (.it.2491) (core#if .it.2491 .it.2491 #f)) (core#if (pair? .form.2488) ((core#l",
"))) (define-macro export (lambda (form _) (letrec ((collect (lambda (spec) (cond", "ambda (.key.2492) (core#if ((core#lambda (.it.2493) (core#if .it.2493 .it.2493 #",
" ((symbol? spec) `(,spec unquote spec)) ((and (list? spec) (= (length spec) 3) (", "f)) (eqv? .key.2492 (core#quote library))) (find-library (cadr .form.2488)) (cor",
"eq? (car spec) 'rename)) `(,(list-ref spec 1) unquote (list-ref spec 2))) (else ", "e#if ((core#lambda (.it.2494) (core#if .it.2494 .it.2494 #f)) (eqv? .key.2492 (c",
"(error \"malformed export\"))))) (export (lambda (spec) (let ((slot (collect spec)", "ore#quote not))) (not (.test.2487 (cadr .form.2488))) (core#if ((core#lambda (.i",
")) (library-export (car slot) (cdr slot)))))) (for-each export (cdr form))))) (l", "t.2495) (core#if .it.2495 .it.2495 #f)) (eqv? .key.2492 (core#quote and))) ((cor",
"et () (make-library '(picrin base)) (set-car! (dictionary-ref *libraries* (mangl", "e#lambda () (core#begin (core#define .loop.2496 (core#lambda (.form.2497) ((core",
"e '(picrin base))) default-environment) (let ((export-keywords (lambda (keywords", "#lambda (.it.2498) (core#if .it.2498 .it.2498 ((core#lambda (.it.2499) (core#if ",
") (let ((env (library-environment '(picrin base))) (exports (library-exports '(p", ".it.2499 .it.2499 #f)) (core#if (.test.2487 (car .form.2497)) (.loop.2496 (cdr .",
"icrin base)))) (for-each (lambda (keyword) (dictionary-set! exports keyword keyw", "form.2497)) #f)))) (null? .form.2497)))) (.loop.2496 (cdr .form.2488))))) (core#",
"ord)) keywords))))) (export-keywords '(define lambda quote set! if begin define-", "if ((core#lambda (.it.2500) (core#if .it.2500 .it.2500 #f)) (eqv? .key.2492 (cor",
"macro let let* letrec letrec* let-values let*-values define-values quasiquote un", "e#quote or))) ((core#lambda () (core#begin (core#define .loop.2501 (core#lambda ",
"quote unquote-splicing and or cond case else => do when unless parameterize defi", "(.form.2502) (core#if (pair? .form.2502) ((core#lambda (.it.2503) (core#if .it.2",
"ne-syntax syntax-quote syntax-unquote syntax-quasiquote syntax-unquote-splicing ", "503 .it.2503 ((core#lambda (.it.2504) (core#if .it.2504 .it.2504 #f)) (.loop.250",
"let-syntax letrec-syntax syntax-error)) (export-keywords '(features eq? eqv? equ", "1 (cdr .form.2502))))) (.test.2487 (car .form.2502))) #f))) (.loop.2501 (cdr .fo",
"al? not boolean? boolean=? pair? cons car cdr null? set-car! set-cdr! caar cadr ", "rm.2488))))) (core#if #t #f #undefined)))))) (car .form.2488)) #f)))) (core#if (",
"cdar cddr list? make-list list length append reverse list-tail list-ref list-set", "symbol? .form.2488) (memq .form.2488 (features)) #f)))) (eq? .form.2488 (core#qu",
"! list-copy map for-each memq memv member assq assv assoc current-input-port cur", "ote else))))) ((core#lambda () (core#begin (core#define .loop.2505 (core#lambda ",
"rent-output-port current-error-port port? input-port? output-port? port-open? cl", "(.clauses.2506) (core#if (null? .clauses.2506) #undefined (core#if (.test.2487 (",
"ose-port eof-object? eof-object read-u8 peek-u8 read-bytevector! write-u8 write-", "caar .clauses.2506)) (cons (make-identifier (core#quote begin) default-environme",
"bytevector flush-output-port open-input-bytevector open-output-bytevector get-ou", "nt) (append (cdar .clauses.2506) (core#quote ()))) (.loop.2505 (cdr .clauses.250",
"tput-bytevector number? exact? inexact? inexact exact = < > <= >= + - * / number", "6)))))) (.loop.2505 (cdr .form.2485))))))) #undefined))) (core#begin (.define-tr",
"->string string->number procedure? apply symbol? symbol=? symbol->string string-", "ansformer.2477 (core#quote import) (core#lambda (.form.2507 ._.2508) ((core#lamb",
">symbol make-identifier identifier? identifier=? identifier-base identifier-envi", "da (.caddr.2509 .prefix.2510 .getlib.2511) ((core#lambda (.extract.2512 .collect",
"ronment vector? vector make-vector vector-length vector-ref vector-set! vector-c", ".2513) (core#begin (core#set! .extract.2512 (core#lambda (.spec.2514) ((core#lam",
"opy! vector-copy vector-append vector-fill! vector-map vector-for-each list->vec", "bda (.key.2515) (core#if ((core#lambda (.it.2516) (core#if .it.2516 .it.2516 ((c",
"tor vector->list string->vector vector->string bytevector? bytevector make-bytev", "ore#lambda (.it.2517) (core#if .it.2517 .it.2517 ((core#lambda (.it.2518) (core#",
"ector bytevector-length bytevector-u8-ref bytevector-u8-set! bytevector-copy! by", "if .it.2518 .it.2518 ((core#lambda (.it.2519) (core#if .it.2519 .it.2519 #f)) (e",
"tevector-copy bytevector-append bytevector->list list->bytevector call-with-curr", "qv? .key.2515 (core#quote except))))) (eqv? .key.2515 (core#quote prefix))))) (e",
"ent-continuation call/cc values call-with-values char? char->integer integer->ch", "qv? .key.2515 (core#quote rename))))) (eqv? .key.2515 (core#quote only))) (.extr",
"ar char=? char<? char>? char<=? char>=? current-exception-handlers with-exceptio", "act.2512 (cadr .spec.2514)) (core#if #t (.getlib.2511 .spec.2514) #undefined))) ",
"n-handler raise raise-continuable error error-object? error-object-message error", "(car .spec.2514)))) (core#begin (core#set! .collect.2513 (core#lambda (.spec.252",
"-object-irritants error-object-type string? string make-string string-length str", "0) ((core#lambda (.key.2521) (core#if ((core#lambda (.it.2522) (core#if .it.2522",
"ing-ref string-set! string-copy string-copy! string-fill! string-append string-m", " .it.2522 #f)) (eqv? .key.2521 (core#quote only))) ((core#lambda (.alist.2523) (",
"ap string-for-each list->string string->list string=? string<? string>? string<=", "map (core#lambda (.var.2524) (assq .var.2524 .alist.2523)) (cddr .spec.2520))) (",
"? string>=? make-parameter with-dynamic-environment read make-dictionary diction", ".collect.2513 (cadr .spec.2520))) (core#if ((core#lambda (.it.2525) (core#if .it",
"ary? dictionary dictionary-has? dictionary-ref dictionary-set! dictionary-delete", ".2525 .it.2525 #f)) (eqv? .key.2521 (core#quote rename))) ((core#lambda (.alist.",
"! dictionary-size dictionary-map dictionary-for-each dictionary->alist alist->di", "2526 .renames.2527) (map (core#lambda (.s.2528) ((core#lambda (.it.2529) (core#i",
"ctionary dictionary->plist plist->dictionary make-record record? record-type rec", "f .it.2529 .it.2529 ((core#lambda (.it.2530) (core#if .it.2530 .it.2530 #f)) .s.",
"ord-datum default-environment make-environment find-identifier set-identifier! e", "2528))) (assq (car .s.2528) .renames.2527))) .alist.2526)) (.collect.2513 (cadr ",
"val compile add-macro! make-ephemeron-table write write-simple write-shared disp", ".spec.2520)) (map (core#lambda (.x.2531) (cons (car .x.2531) (cadr .x.2531))) (c",
"lay)) (export-keywords '(find-library make-library current-library))) (set! eval", "ddr .spec.2520))) (core#if ((core#lambda (.it.2532) (core#if .it.2532 .it.2532 #",
" (let ((e eval)) (lambda (expr . lib) (let ((lib (if (null? lib) (current-librar", "f)) (eqv? .key.2521 (core#quote prefix))) ((core#lambda (.alist.2533) (map (core",
"y) (car lib)))) (e expr (library-environment lib)))))) (make-library '(picrin us", "#lambda (.s.2534) (cons (.prefix.2510 (.caddr.2509 .spec.2520) (car .s.2534)) (c",
"er)) (current-library '(picrin user))) ", "dr .s.2534))) .alist.2533)) (.collect.2513 (cadr .spec.2520))) (core#if ((core#l",
"ambda (.it.2535) (core#if .it.2535 .it.2535 #f)) (eqv? .key.2521 (core#quote exc",
"ept))) ((core#lambda (.alist.2536) ((core#lambda () (core#begin (core#define .lo",
"op.2537 (core#lambda (.alist.2538) (core#if (null? .alist.2538) (core#quote ()) ",
"(core#if (memq (caar .alist.2538) (cddr .spec.2520)) (.loop.2537 (cdr .alist.253",
"8)) (cons (car .alist.2538) (.loop.2537 (cdr .alist.2538))))))) (.loop.2537 .ali",
"st.2536))))) (.collect.2513 (cadr .spec.2520))) (core#if #t (dictionary-map (cor",
"e#lambda (.x.2539) (cons .x.2539 .x.2539)) (library-exports (.getlib.2511 .spec.",
"2520))) #undefined)))))) (car .spec.2520)))) ((core#lambda (.import.2540) (core#",
"begin (core#set! .import.2540 (core#lambda (.spec.2541) ((core#lambda (.lib.2542",
" .alist.2543) (for-each (core#lambda (.slot.2544) (library-import .lib.2542 (cdr",
" .slot.2544) (car .slot.2544))) .alist.2543)) (.extract.2512 .spec.2541) (.colle",
"ct.2513 .spec.2541)))) (for-each .import.2540 (cdr .form.2507)))) #undefined))))",
" #undefined #undefined)) (core#lambda (.x.2545) (car (cdr (cdr .x.2545)))) (core",
"#lambda (.prefix.2546 .symbol.2547) (string->symbol (string-append (symbol->stri",
"ng .prefix.2546) (symbol->string .symbol.2547)))) (core#lambda (.name.2548) (cor",
"e#if (find-library .name.2548) .name.2548 (error \"library not found\" .name.2548)",
"))))) (.define-transformer.2477 (core#quote export) (core#lambda (.form.2549 ._.",
"2550) ((core#lambda (.collect.2551 .export.2552) (core#begin (core#set! .collect",
".2551 (core#lambda (.spec.2553) (core#if (symbol? .spec.2553) (cons .spec.2553 .",
"spec.2553) (core#if (core#if (list? .spec.2553) (core#if (= (length .spec.2553) ",
"3) (eq? (car .spec.2553) (core#quote rename)) #f) #f) (cons (list-ref .spec.2553",
" 1) (list-ref .spec.2553 2)) (error \"malformed export\"))))) (core#begin (core#se",
"t! .export.2552 (core#lambda (.spec.2554) ((core#lambda (.slot.2555) (library-ex",
"port (car .slot.2555) (cdr .slot.2555))) (.collect.2551 .spec.2554)))) (for-each",
" .export.2552 (cdr .form.2549))))) #undefined #undefined))))))) (core#lambda (.n",
"ame.2556 .macro.2557) (add-macro! .name.2556 .macro.2557))) ((core#lambda () (co",
"re#begin (make-library (core#quote (picrin base))) (core#begin (set-car! (dictio",
"nary-ref *libraries* (mangle (core#quote (picrin base)))) default-environment) (",
"core#begin ((core#lambda (.export-keywords.2558) (core#begin (.export-keywords.2",
"558 (core#quote (define lambda quote set! if begin define-macro let let* letrec ",
"letrec* let-values let*-values define-values quasiquote unquote unquote-splicing",
" and or cond case else => do when unless parameterize define-syntax syntax-quote",
" syntax-unquote syntax-quasiquote syntax-unquote-splicing let-syntax letrec-synt",
"ax syntax-error))) (core#begin (.export-keywords.2558 (core#quote (features eq? ",
"eqv? equal? not boolean? boolean=? pair? cons car cdr null? set-car! set-cdr! ca",
"ar cadr cdar cddr list? make-list list length append reverse list-tail list-ref ",
"list-set! list-copy map for-each memq memv member assq assv assoc current-input-",
"port current-output-port current-error-port port? input-port? output-port? port-",
"open? close-port eof-object? eof-object read-u8 peek-u8 read-bytevector! write-u",
"8 write-bytevector flush-output-port open-input-bytevector open-output-bytevecto",
"r get-output-bytevector number? exact? inexact? inexact exact = < > <= >= + - * ",
"/ number->string string->number procedure? apply symbol? symbol=? symbol->string",
" string->symbol make-identifier identifier? identifier=? identifier-base identif",
"ier-environment vector? vector make-vector vector-length vector-ref vector-set! ",
"vector-copy! vector-copy vector-append vector-fill! vector-map vector-for-each l",
"ist->vector vector->list string->vector vector->string bytevector? bytevector ma",
"ke-bytevector bytevector-length bytevector-u8-ref bytevector-u8-set! bytevector-",
"copy! bytevector-copy bytevector-append bytevector->list list->bytevector call-w",
"ith-current-continuation call/cc values call-with-values char? char->integer int",
"eger->char char=? char<? char>? char<=? char>=? current-exception-handlers with-",
"exception-handler raise raise-continuable error error-object? error-object-messa",
"ge error-object-irritants error-object-type string? string make-string string-le",
"ngth string-ref string-set! string-copy string-copy! string-fill! string-append ",
"string-map string-for-each list->string string->list string=? string<? string>? ",
"string<=? string>=? make-parameter with-dynamic-environment read make-dictionary",
" dictionary? dictionary dictionary-has? dictionary-ref dictionary-set! dictionar",
"y-delete! dictionary-size dictionary-map dictionary-for-each dictionary->alist a",
"list->dictionary dictionary->plist plist->dictionary make-record record? record-",
"type record-datum default-environment make-environment find-identifier set-ident",
"ifier! eval compile add-macro! make-ephemeron-table write write-simple write-sha",
"red display))) (.export-keywords.2558 (core#quote (find-library make-library cur",
"rent-library)))))) (core#lambda (.keywords.2559) ((core#lambda (.env.2560 .expor",
"ts.2561) (for-each (core#lambda (.keyword.2562) (dictionary-set! .exports.2561 .",
"keyword.2562 .keyword.2562)) .keywords.2559)) (library-environment (core#quote (",
"picrin base))) (library-exports (core#quote (picrin base)))))) (core#begin (core",
"#set! eval ((core#lambda (.e.2563) (core#lambda (.expr.2564 . .lib.2565) ((core#",
"lambda (.lib.2566) (.e.2563 .expr.2564 (library-environment .lib.2566))) (core#i",
"f (null? .lib.2565) (current-library) (car .lib.2565))))) eval)) (core#begin (ma",
"ke-library (core#quote (picrin user))) (current-library (core#quote (picrin user",
"))))))))))))))))))))",
}; };
#endif #endif
@ -414,6 +494,6 @@ pic_boot(pic_state *pic)
{ {
pic_call(pic, pic_compile(pic, pic_read_cstr(pic, &boot_rom[0][0])), 0); pic_call(pic, pic_compile(pic, pic_read_cstr(pic, &boot_rom[0][0])), 0);
#if PIC_USE_LIBRARY #if PIC_USE_LIBRARY
pic_load_cstr(pic, &boot_library_rom[0][0]); pic_call(pic, pic_compile(pic, pic_read_cstr(pic, &boot_library_rom[0][0])), 0);
#endif #endif
} }

906
piclib/boot.scm
View File

@ -1,457 +1,232 @@
(core#define-macro call-with-current-environment (begin
(core#lambda (form env) ;; FIXME
(list (cadr form) env))) (define (transformer f)
(lambda (form env)
(let ((ephemeron1 (make-ephemeron-table))
(ephemeron2 (make-ephemeron-table)))
(letrec
((wrap (lambda (var1)
(let ((var2 (ephemeron1 var1)))
(if var2
(cdr var2)
(let ((var2 (make-identifier var1 env)))
(ephemeron1 var1 var2)
(ephemeron2 var2 var1)
var2)))))
(unwrap (lambda (var2)
(let ((var1 (ephemeron2 var2)))
(if var1
(cdr var1)
var2))))
(walk (lambda (f form)
(cond
((identifier? form)
(f form))
((pair? form)
(cons (walk f (car form)) (walk f (cdr form))))
((vector? form)
(list->vector (walk f (vector->list form))))
(else
form)))))
(let ((form (cdr form)))
(walk unwrap (apply f (walk wrap form))))))))
(let ()
(define (define-transformer name transformer)
(add-macro! name transformer))
(core#define here (define (the var) ; synonym for #'var
(call-with-current-environment (make-identifier var default-environment))
(core#lambda (env)
env)))
(core#define the ; synonym for #'var (define the-core-define (the 'core#define))
(core#lambda (var) (define the-core-lambda (the 'core#lambda))
(make-identifier var here))) (define the-core-begin (the 'core#begin))
(define the-core-quote (the 'core#quote))
(define the-core-set! (the 'core#set!))
(define the-core-if (the 'core#if))
(define the-core-define-macro (the 'core#define-macro))
(define the-define (the 'define))
(define the-lambda (the 'lambda))
(define the-begin (the 'begin))
(define the-quote (the 'quote))
(define the-set! (the 'set!))
(define the-if (the 'if))
(define 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))))
(core#define the-builtin-define (the (core#quote core#define))) (define-transformer 'syntax-error
(core#define the-builtin-lambda (the (core#quote core#lambda))) (lambda (form _)
(core#define the-builtin-begin (the (core#quote core#begin))) (apply error (cdr form))))
(core#define the-builtin-quote (the (core#quote core#quote)))
(core#define the-builtin-set! (the (core#quote core#set!)))
(core#define the-builtin-if (the (core#quote core#if)))
(core#define the-builtin-define-macro (the (core#quote core#define-macro)))
(core#define the-define (the (core#quote define))) (define-macro define-auxiliary-syntax
(core#define the-lambda (the (core#quote lambda))) (lambda (form _)
(core#define the-begin (the (core#quote begin))) `(define-transformer ',(cadr form)
(core#define the-quote (the (core#quote quote))) (lambda _
(core#define the-set! (the (core#quote set!))) (error "invalid use of auxiliary syntax" ',(cadr form))))))
(core#define the-if (the (core#quote if)))
(core#define the-define-macro (the (core#quote define-macro)))
(core#define-macro quote (define-auxiliary-syntax else)
(core#lambda (form env) (define-auxiliary-syntax =>)
(core#if (= (length form) 2) (define-auxiliary-syntax unquote)
(list the-builtin-quote (cadr form)) (define-auxiliary-syntax unquote-splicing)
(error "illegal quote form" form)))) (define-auxiliary-syntax syntax-unquote)
(define-auxiliary-syntax syntax-unquote-splicing)
(core#define-macro if (define-transformer 'let
(core#lambda (form env) (lambda (form env)
((core#lambda (len)
(core#if (= len 4)
(cons the-builtin-if (cdr form))
(core#if (= len 3)
(list the-builtin-if (list-ref form 1) (list-ref form 2) #undefined)
(error "illegal if form" form))))
(length form))))
(core#define-macro begin
(core#lambda (form env)
((core#lambda (len)
(if (= len 1)
#undefined
(if (= len 2)
(cadr form)
(if (= len 3)
(cons the-builtin-begin (cdr form))
(list the-builtin-begin
(cadr form)
(cons the-begin (cddr form)))))))
(length form))))
(core#define-macro set!
(core#lambda (form env)
(if (= (length form) 3)
(if (identifier? (cadr form)) (if (identifier? (cadr form))
(cons the-builtin-set! (cdr form)) (let ((name (car (cdr form)))
(error "illegal set! form" form)) (formal (car (cdr (cdr form))))
(error "illegal set! form" 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))))))
(core#define check-formal (define-transformer 'and
(core#lambda (formal) (lambda (form env)
(if (null? formal) (if (null? (cdr form))
#t
(if (identifier? formal)
#t #t
(if (pair? formal) (if (null? (cddr form))
(if (identifier? (car formal)) (cadr form)
(check-formal (cdr formal)) `(,the-if ,(cadr form) (,(the 'and) . ,(cddr form)) #f)))))
#f)
#f)))))
(core#define-macro lambda (define-transformer 'or
(core#lambda (form env) (lambda (form env)
(if (= (length form) 1) (if (null? (cdr form))
(error "illegal lambda form" form) #f
(if (check-formal (cadr form)) (let ((tmp (make-identifier 'it env))) ; should we use #f as the env for tmp?
(list the-builtin-lambda (cadr form) (cons the-begin (cddr form))) `(,(the 'let) ((,tmp ,(cadr form)))
(error "illegal lambda form" form))))) (,the-if ,tmp ,tmp (,(the 'or) . ,(cddr form))))))))
(core#define-macro define (define-transformer 'cond
(lambda (form env) (lambda (form env)
((lambda (len) (let ((clauses (cdr form)))
(if (= len 1) (if (null? clauses)
(error "illegal define form" form) #undefined
(if (identifier? (cadr form)) (let ((clause (car clauses)))
(if (= len 3) (if (and (identifier? (car clause))
(cons the-builtin-define (cdr form)) (identifier=? (the 'else) (make-identifier (car clause) env)))
(error "illegal define form" form)) `(,the-begin . ,(cdr clause))
(if (pair? (cadr form)) (if (null? (cdr clause))
(list the-define `(,(the 'or) ,(car clause) (,(the 'cond) . ,(cdr clauses)))
(car (cadr form)) (if (and (identifier? (cadr clause))
(cons the-lambda (cons (cdr (cadr form)) (cddr form)))) (identifier=? (the '=>) (make-identifier (cadr clause) env)))
(error "define: binding to non-varaible object" form))))) (let ((tmp (make-identifier 'tmp env)))
(length form)))) `(,(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)))))))))))
(core#define-macro define-macro (define-transformer 'quasiquote
(lambda (form env) (lambda (form env)
(if (= (length form) 3)
(if (identifier? (cadr form))
(cons the-builtin-define-macro (cdr form))
(error "define-macro: binding to non-variable object" form))
(error "illegal define-macro form" form))))
(define (quasiquote? form)
(define-macro syntax-error
(lambda (form _)
(apply error (cdr form))))
(define-macro define-auxiliary-syntax
(lambda (form _)
(define message
(string-append
"invalid use of auxiliary syntax: '" (symbol->string (cadr form)) "'"))
(list
the-define-macro
(cadr form)
(list the-lambda '_
(list (the 'error) message)))))
(define-auxiliary-syntax else)
(define-auxiliary-syntax =>)
(define-auxiliary-syntax unquote)
(define-auxiliary-syntax unquote-splicing)
(define-auxiliary-syntax syntax-unquote)
(define-auxiliary-syntax syntax-unquote-splicing)
(define-macro let
(lambda (form env)
(if (identifier? (cadr form))
(list
(list the-lambda '()
(list the-define (cadr form)
(cons the-lambda
(cons (map car (car (cddr form)))
(cdr (cddr form)))))
(cons (cadr form) (map cadr (car (cddr form))))))
(cons
(cons
the-lambda
(cons (map car (cadr form))
(cddr form)))
(map cadr (cadr form))))))
(define-macro and
(lambda (form env)
(if (null? (cdr form))
#t
(if (null? (cddr form))
(cadr form)
(list the-if
(cadr form)
(cons (the 'and) (cddr form))
#f)))))
(define-macro or
(lambda (form env)
(if (null? (cdr form))
#f
(let ((tmp (make-identifier 'it env)))
(list (the 'let)
(list (list tmp (cadr form)))
(list the-if
tmp
tmp
(cons (the 'or) (cddr form))))))))
(define-macro 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)))
(cons the-begin (cdr clause))
(if (null? (cdr clause))
(let ((tmp (make-identifier 'tmp here)))
(list (the 'let) (list (list tmp (car clause)))
(list the-if tmp tmp (cons (the 'cond) (cdr clauses)))))
(if (and (identifier? (cadr clause))
(identifier=? (the '=>) (make-identifier (cadr clause) env)))
(let ((tmp (make-identifier 'tmp here)))
(list (the 'let) (list (list tmp (car clause)))
(list the-if tmp
(list (car (cddr clause)) tmp)
(cons (the 'cond) (cdr clauses)))))
(list the-if (car clause)
(cons the-begin (cdr clause))
(cons (the 'cond) (cdr clauses)))))))))))
(define-macro 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)
(car (cdr 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-macro 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-macro letrec
(lambda (form env)
`(,(the 'letrec*) ,@(cdr form))))
(define-macro letrec*
(lambda (form env)
(let ((bindings (car (cdr form)))
(body (cdr (cdr form))))
(let ((variables (map (lambda (v) `(,v #f)) (map car bindings)))
(initials (map (lambda (v) `(,(the 'set!) ,@v)) bindings)))
`(,(the 'let) (,@variables)
,@initials
,@body)))))
(define-macro let-values
(lambda (form env)
`(,(the 'let*-values) ,@(cdr form))))
(define-macro let*-values
(lambda (form env)
(let ((formal (car (cdr form)))
(body (cdr (cdr form))))
(if (null? formal)
`(,(the 'let) () ,@body)
`(,(the 'call-with-values) (,the-lambda () ,@(cdr (car formal)))
(,(the 'lambda) (,@(car (car formal)))
(,(the 'let*-values) (,@(cdr formal))
,@body)))))))
(define-macro define-values
(lambda (form env)
(let ((formal (car (cdr form)))
(body (cdr (cdr form))))
(let ((arguments (make-identifier 'arguments here)))
`(,the-begin
,@(let loop ((formal formal))
(if (pair? formal)
`((,the-define ,(car formal) #undefined) ,@(loop (cdr formal)))
(if (identifier? formal)
`((,the-define ,formal #undefined))
'())))
(,(the 'call-with-values) (,the-lambda () ,@body)
(,the-lambda
,arguments
,@(let loop ((formal formal) (args arguments))
(if (pair? formal)
`((,the-set! ,(car formal) (,(the 'car) ,args)) ,@(loop (cdr formal) `(,(the 'cdr) ,args)))
(if (identifier? formal)
`((,the-set! ,formal ,args))
'()))))))))))
(define-macro 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 here)))
`(,(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-macro when
(lambda (form env)
(let ((test (car (cdr form)))
(body (cdr (cdr form))))
`(,the-if ,test
(,the-begin ,@body)
#undefined))))
(define-macro unless
(lambda (form env)
(let ((test (car (cdr form)))
(body (cdr (cdr form))))
`(,the-if ,test
#undefined
(,the-begin ,@body)))))
(define-macro case
(lambda (form env)
(let ((key (car (cdr form)))
(clauses (cdr (cdr form))))
(let ((the-key (make-identifier 'key here)))
`(,(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-macro 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-macro syntax-quote
(lambda (form env)
(let ((renames '()))
(letrec
((rename (lambda (var)
(let ((x (assq var renames)))
(if x
(cadr x)
(begin
(set! renames `((,var ,(make-identifier var env) (,(the 'make-identifier) ',var ',env)) . ,renames))
(rename var))))))
(walk (lambda (f form)
(cond
((identifier? form)
(f form))
((pair? form)
`(,(the 'cons) (walk f (car form)) (walk f (cdr form))))
((vector? form)
`(,(the 'list->vector) (walk f (vector->list form))))
(else
`(,(the 'quote) ,form))))))
(let ((form (walk rename (cadr form))))
`(,(the 'let)
,(map cdr renames)
,form))))))
(define-macro syntax-quasiquote
(lambda (form env)
(let ((renames '()))
(letrec
((rename (lambda (var)
(let ((x (assq var renames)))
(if x
(cadr x)
(begin
(set! renames `((,var ,(make-identifier var env) (,(the 'make-identifier) ',var ',env)) . ,renames))
(rename var)))))))
(define (syntax-quasiquote? form)
(and (pair? form) (and (pair? form)
(identifier? (car form)) (identifier? (car form))
(identifier=? (the 'syntax-quasiquote) (make-identifier (car form) env)))) (identifier=? (the 'quasiquote) (make-identifier (car form) env))))
(define (syntax-unquote? form) (define (unquote? form)
(and (pair? form) (and (pair? form)
(identifier? (car form)) (identifier? (car form))
(identifier=? (the 'syntax-unquote) (make-identifier (car form) env)))) (identifier=? (the 'unquote) (make-identifier (car form) env))))
(define (syntax-unquote-splicing? form) (define (unquote-splicing? form)
(and (pair? form) (and (pair? form)
(pair? (car form)) (pair? (car form))
(identifier? (caar form)) (identifier? (caar form))
(identifier=? (the 'syntax-unquote-splicing) (make-identifier (caar form) env)))) (identifier=? (the 'unquote-splicing) (make-identifier (caar form) env))))
(define (qq depth expr) (define (qq depth expr)
(cond (cond
;; syntax-unquote ;; unquote
((syntax-unquote? expr) ((unquote? expr)
(if (= depth 1) (if (= depth 1)
(car (cdr expr)) (cadr expr)
(list (the 'list) (list (the 'list)
(list (the 'quote) (the 'syntax-unquote)) (list (the 'quote) (the 'unquote))
(qq (- depth 1) (car (cdr expr)))))) (qq (- depth 1) (car (cdr expr))))))
;; syntax-unquote-splicing ;; unquote-splicing
((syntax-unquote-splicing? expr) ((unquote-splicing? expr)
(if (= depth 1) (if (= depth 1)
(list (the 'append) (list (the 'append)
(car (cdr (car expr))) (car (cdr (car expr)))
(qq depth (cdr expr))) (qq depth (cdr expr)))
(list (the 'cons) (list (the 'cons)
(list (the 'list) (list (the 'list)
(list (the 'quote) (the 'syntax-unquote-splicing)) (list (the 'quote) (the 'unquote-splicing))
(qq (- depth 1) (car (cdr (car expr))))) (qq (- depth 1) (car (cdr (car expr)))))
(qq depth (cdr expr))))) (qq depth (cdr expr)))))
;; syntax-quasiquote ;; quasiquote
((syntax-quasiquote? expr) ((quasiquote? expr)
(list (the 'list) (list (the 'list)
(list (the 'quote) (the 'quasiquote)) (list (the 'quote) (the 'quasiquote))
(qq (+ depth 1) (car (cdr expr))))) (qq (+ depth 1) (car (cdr expr)))))
@ -463,67 +238,252 @@
;; vector ;; vector
((vector? expr) ((vector? expr)
(list (the 'list->vector) (qq depth (vector->list expr)))) (list (the 'list->vector) (qq depth (vector->list expr))))
;; identifier
((identifier? expr)
(rename expr))
;; simple datum ;; simple datum
(else (else
(list (the 'quote) expr)))) (list (the 'quote) expr))))
(let ((body (qq 1 (cadr form)))) (let ((x (cadr form)))
`(,(the 'let) (qq 1 x))))
,(map cdr renames)
,body))))))
(define (transformer f) (define-transformer 'let*
(lambda (form env) (lambda (form env)
(let ((ephemeron1 (make-ephemeron-table)) (let ((bindings (car (cdr form)))
(ephemeron2 (make-ephemeron-table))) (body (cdr (cdr form))))
(letrec (if (null? bindings)
((wrap (lambda (var1) `(,(the 'let) () . ,body)
(let ((var2 (ephemeron1 var1))) `(,(the 'let) ((,(car (car bindings)) . ,(cdr (car bindings))))
(if var2 (,(the 'let*) ,(cdr bindings) . ,body))))))
(cdr var2)
(let ((var2 (make-identifier var1 env)))
(ephemeron1 var1 var2)
(ephemeron2 var2 var1)
var2)))))
(unwrap (lambda (var2)
(let ((var1 (ephemeron2 var2)))
(if var1
(cdr var1)
var2))))
(walk (lambda (f form)
(cond
((identifier? form)
(f form))
((pair? form)
(cons (walk f (car form)) (walk f (cdr form))))
((vector? form)
(list->vector (walk f (vector->list form))))
(else
form)))))
(let ((form (cdr form)))
(walk unwrap (apply f (walk wrap form))))))))
(define-macro define-syntax (define-transformer 'letrec
(lambda (form env) (lambda (form env)
(let ((formal (car (cdr form))) `(,(the 'letrec*) . ,(cdr form))))
(body (cdr (cdr form))))
(if (pair? formal)
`(,(the 'define-syntax) ,(car formal) (,the-lambda ,(cdr formal) ,@body))
`(,the-define-macro ,formal (,(the 'transformer) (,the-begin ,@body)))))))
(define-macro letrec-syntax (define-transformer 'letrec*
(lambda (form env) (lambda (form env)
(let ((formal (car (cdr form))) (let ((bindings (car (cdr form)))
(body (cdr (cdr form)))) (body (cdr (cdr form))))
`(let () (let ((variables (map (lambda (v) `(,v #undefined)) (map car bindings)))
,@(map (lambda (x) (initials (map (lambda (v) `(,(the 'set!) ,@v)) bindings)))
`(,(the 'define-syntax) ,(car x) ,(cadr x))) `(,(the 'let) ,variables
formal) ,@initials
,@body)))) ,@body)))))
(define-macro let-syntax (define-transformer 'let-values
(lambda (form env) (lambda (form env)
`(,(the 'letrec-syntax) ,@(cdr form)))) `(,(the 'let*-values) ,@(cdr form))))
(define-transformer 'let*-values
(lambda (form env)
(let ((formal (car (cdr form)))
(body (cdr (cdr form))))
(if (null? formal)
`(,(the 'let) () ,@body)
`(,(the 'call-with-values) (,the-lambda () ,@(cdr (car formal)))
(,(the 'lambda) (,@(car (car formal)))
(,(the 'let*-values) (,@(cdr formal))
,@body)))))))
(define-transformer 'define-values
(lambda (form env)
(let ((formal (car (cdr form)))
(body (cdr (cdr form))))
(let ((arguments (make-identifier 'arguments env)))
`(,the-begin
,@(let loop ((formal formal))
(if (pair? formal)
`((,the-define ,(car formal) #undefined) ,@(loop (cdr formal)))
(if (identifier? formal)
`((,the-define ,formal #undefined))
'())))
(,(the 'call-with-values) (,the-lambda () ,@body)
(,the-lambda
,arguments
,@(let loop ((formal formal) (args arguments))
(if (pair? formal)
`((,the-set! ,(car formal) (,(the 'car) ,args)) ,@(loop (cdr formal) `(,(the 'cdr) ,args)))
(if (identifier? formal)
`((,the-set! ,formal ,args))
'()))))))))))
(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 'syntax-quote
(lambda (form env)
(let ((renames '()))
(letrec
((rename (lambda (var)
(let ((x (assq var renames)))
(if x
(cadr x)
(begin
(set! renames `((,var ,(make-identifier var env) (,(the 'make-identifier) ',var ',env)) . ,renames))
(rename var))))))
(walk (lambda (f form)
(cond
((identifier? form)
(f form))
((pair? form)
`(,(the 'cons) (walk f (car form)) (walk f (cdr form))))
((vector? form)
`(,(the 'list->vector) (walk f (vector->list form))))
(else
`(,(the 'quote) ,form))))))
(let ((form (walk rename (cadr form))))
`(,(the 'let)
,(map cdr renames)
,form))))))
(define-transformer 'syntax-quasiquote
(lambda (form env)
(let ((renames '()))
(letrec
((rename (lambda (var)
(let ((x (assq var renames)))
(if x
(cadr x)
(begin
(set! renames `((,var ,(make-identifier var env) (,(the 'make-identifier) ',var ',env)) . ,renames))
(rename var)))))))
(define (syntax-quasiquote? form)
(and (pair? form)
(identifier? (car form))
(identifier=? (the 'syntax-quasiquote) (make-identifier (car form) env))))
(define (syntax-unquote? form)
(and (pair? form)
(identifier? (car form))
(identifier=? (the 'syntax-unquote) (make-identifier (car form) env))))
(define (syntax-unquote-splicing? form)
(and (pair? form)
(pair? (car form))
(identifier? (caar form))
(identifier=? (the 'syntax-unquote-splicing) (make-identifier (caar form) env))))
(define (qq depth expr)
(cond
;; syntax-unquote
((syntax-unquote? expr)
(if (= depth 1)
(car (cdr expr))
(list (the 'list)
(list (the 'quote) (the 'syntax-unquote))
(qq (- depth 1) (car (cdr expr))))))
;; syntax-unquote-splicing
((syntax-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 'syntax-unquote-splicing))
(qq (- depth 1) (car (cdr (car expr)))))
(qq depth (cdr expr)))))
;; syntax-quasiquote
((syntax-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))))
;; identifier
((identifier? expr)
(rename expr))
;; simple datum
(else
(list (the 'quote) expr))))
(let ((body (qq 1 (cadr form))))
`(,(the 'let)
,(map cdr renames)
,body))))))
(define-transformer 'define-syntax
(lambda (form env)
(let ((formal (car (cdr form)))
(body (cdr (cdr form))))
(if (pair? formal)
`(,(the 'define-syntax) ,(car formal) (,the-lambda ,(cdr formal) ,@body))
`(,the-define-macro ,formal (,(the 'transformer) (,the-begin ,@body)))))))
(define-transformer 'letrec-syntax
(lambda (form env)
(let ((formal (car (cdr form)))
(body (cdr (cdr form))))
`(let ()
,@(map (lambda (x)
`(,(the 'define-syntax) ,(car x) ,(cadr x)))
formal)
,@body))))
(define-transformer 'let-syntax
(lambda (form env)
`(,(the 'letrec-syntax) ,@(cdr form))))))

489
piclib/boot2.scm
View File

@ -1,489 +0,0 @@
(begin
;; FIXME
(define (transformer f)
(lambda (form env)
(let ((ephemeron1 (make-ephemeron-table))
(ephemeron2 (make-ephemeron-table)))
(letrec
((wrap (lambda (var1)
(let ((var2 (ephemeron1 var1)))
(if var2
(cdr var2)
(let ((var2 (make-identifier var1 env)))
(ephemeron1 var1 var2)
(ephemeron2 var2 var1)
var2)))))
(unwrap (lambda (var2)
(let ((var1 (ephemeron2 var2)))
(if var1
(cdr var1)
var2))))
(walk (lambda (f form)
(cond
((identifier? form)
(f form))
((pair? form)
(cons (walk f (car form)) (walk f (cdr form))))
((vector? form)
(list->vector (walk f (vector->list form))))
(else
form)))))
(let ((form (cdr form)))
(walk unwrap (apply f (walk wrap form))))))))
(let ()
(define (define-transformer name transformer)
(add-macro! name transformer))
(define (the var) ; synonym for #'var
(make-identifier var default-environment))
(define the-core-define (the 'core#define))
(define the-core-lambda (the 'core#lambda))
(define the-core-begin (the 'core#begin))
(define the-core-quote (the 'core#quote))
(define the-core-set! (the 'core#set!))
(define the-core-if (the 'core#if))
(define the-core-define-macro (the 'core#define-macro))
(define the-define (the 'define))
(define the-lambda (the 'lambda))
(define the-begin (the 'begin))
(define the-quote (the 'quote))
(define the-set! (the 'set!))
(define the-if (the 'if))
(define 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-transformer 'syntax-error
(lambda (form _)
(apply error (cdr 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-auxiliary-syntax syntax-unquote)
(define-auxiliary-syntax 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 ((formal (car (cdr form)))
(body (cdr (cdr form))))
(if (null? formal)
`(,(the 'let) () ,@body)
`(,(the 'call-with-values) (,the-lambda () ,@(cdr (car formal)))
(,(the 'lambda) (,@(car (car formal)))
(,(the 'let*-values) (,@(cdr formal))
,@body)))))))
(define-transformer 'define-values
(lambda (form env)
(let ((formal (car (cdr form)))
(body (cdr (cdr form))))
(let ((arguments (make-identifier 'arguments env)))
`(,the-begin
,@(let loop ((formal formal))
(if (pair? formal)
`((,the-define ,(car formal) #undefined) ,@(loop (cdr formal)))
(if (identifier? formal)
`((,the-define ,formal #undefined))
'())))
(,(the 'call-with-values) (,the-lambda () ,@body)
(,the-lambda
,arguments
,@(let loop ((formal formal) (args arguments))
(if (pair? formal)
`((,the-set! ,(car formal) (,(the 'car) ,args)) ,@(loop (cdr formal) `(,(the 'cdr) ,args)))
(if (identifier? formal)
`((,the-set! ,formal ,args))
'()))))))))))
(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 'syntax-quote
(lambda (form env)
(let ((renames '()))
(letrec
((rename (lambda (var)
(let ((x (assq var renames)))
(if x
(cadr x)
(begin
(set! renames `((,var ,(make-identifier var env) (,(the 'make-identifier) ',var ',env)) . ,renames))
(rename var))))))
(walk (lambda (f form)
(cond
((identifier? form)
(f form))
((pair? form)
`(,(the 'cons) (walk f (car form)) (walk f (cdr form))))
((vector? form)
`(,(the 'list->vector) (walk f (vector->list form))))
(else
`(,(the 'quote) ,form))))))
(let ((form (walk rename (cadr form))))
`(,(the 'let)
,(map cdr renames)
,form))))))
(define-transformer 'syntax-quasiquote
(lambda (form env)
(let ((renames '()))
(letrec
((rename (lambda (var)
(let ((x (assq var renames)))
(if x
(cadr x)
(begin
(set! renames `((,var ,(make-identifier var env) (,(the 'make-identifier) ',var ',env)) . ,renames))
(rename var)))))))
(define (syntax-quasiquote? form)
(and (pair? form)
(identifier? (car form))
(identifier=? (the 'syntax-quasiquote) (make-identifier (car form) env))))
(define (syntax-unquote? form)
(and (pair? form)
(identifier? (car form))
(identifier=? (the 'syntax-unquote) (make-identifier (car form) env))))
(define (syntax-unquote-splicing? form)
(and (pair? form)
(pair? (car form))
(identifier? (caar form))
(identifier=? (the 'syntax-unquote-splicing) (make-identifier (caar form) env))))
(define (qq depth expr)
(cond
;; syntax-unquote
((syntax-unquote? expr)
(if (= depth 1)
(car (cdr expr))
(list (the 'list)
(list (the 'quote) (the 'syntax-unquote))
(qq (- depth 1) (car (cdr expr))))))
;; syntax-unquote-splicing
((syntax-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 'syntax-unquote-splicing))
(qq (- depth 1) (car (cdr (car expr)))))
(qq depth (cdr expr)))))
;; syntax-quasiquote
((syntax-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))))
;; identifier
((identifier? expr)
(rename expr))
;; simple datum
(else
(list (the 'quote) expr))))
(let ((body (qq 1 (cadr form))))
`(,(the 'let)
,(map cdr renames)
,body))))))
(define-transformer 'define-syntax
(lambda (form env)
(let ((formal (car (cdr form)))
(body (cdr (cdr form))))
(if (pair? formal)
`(,(the 'define-syntax) ,(car formal) (,the-lambda ,(cdr formal) ,@body))
`(,the-define-macro ,formal (,(the 'transformer) (,the-begin ,@body)))))))
(define-transformer 'letrec-syntax
(lambda (form env)
(let ((formal (car (cdr form)))
(body (cdr (cdr form))))
`(let ()
,@(map (lambda (x)
`(,(the 'define-syntax) ,(car x) ,(cadr x)))
formal)
,@body))))
(define-transformer 'let-syntax
(lambda (form env)
`(,(the 'letrec-syntax) ,@(cdr form))))))

502
piclib/library.scm
View File

@ -1,271 +1,275 @@
;;; There are two ways to name a library: (foo bar) or foo.bar (begin
;;; The former is normalized to the latter. ;; There are two ways to name a library: (foo bar) or foo.bar
;; The former is normalized to the latter.
(define (mangle name) (define (mangle name)
(when (null? name) (when (null? name)
(error "library name should be a list of at least one symbols" name)) (error "library name should be a list of at least one symbols" name))
(define (->string n) (define (->string n)
(cond (cond
((symbol? n) ((symbol? n)
(let ((str (symbol->string n))) (let ((str (symbol->string n)))
(string-for-each (string-for-each
(lambda (c) (lambda (c)
(when (or (char=? c #\.) (char=? c #\:)) (when (or (char=? c #\.) (char=? c #\:))
(error "elements of library name may not contain '.' or ':'" n))) (error "elements of library name may not contain '.' or ':'" n)))
str) str)
str)) str))
((and (number? n) (exact? n) (<= 0 n)) ((and (number? n) (exact? n) (<= 0 n))
(number->string n)) (number->string n))
(else (else
(error "symbol or non-negative integer is required" n)))) (error "symbol or non-negative integer is required" n))))
(define (join strs delim) (define (join strs delim)
(let loop ((res (car strs)) (strs (cdr strs))) (let loop ((res (car strs)) (strs (cdr strs)))
(if (null? strs) (if (null? strs)
res res
(loop (string-append res delim (car strs)) (cdr strs))))) (loop (string-append res delim (car strs)) (cdr strs)))))
(if (symbol? name) (if (symbol? name)
name ; TODO: check symbol names name ; TODO: check symbol names
(string->symbol (join (map ->string name) ".")))) (string->symbol (join (map ->string name) "."))))
(define current-library (define current-library
(make-parameter '(picrin base) mangle)) (make-parameter '(picrin base) mangle))
(define *libraries* (define *libraries*
(make-dictionary)) (make-dictionary))
(define (find-library name) (define (find-library name)
(dictionary-has? *libraries* (mangle name))) (dictionary-has? *libraries* (mangle name)))
(define (make-library name) (define (make-library name)
(let ((name (mangle name))) (let ((name (mangle name)))
(let ((env (make-environment (let ((env (make-environment
(string->symbol (string-append (symbol->string name) ":")))) (string->symbol (string-append (symbol->string name) ":"))))
(exports (make-dictionary))) (exports (make-dictionary)))
;; set up initial environment ;; set up initial environment
(set-identifier! 'define-library 'define-library env) (set-identifier! 'define-library 'define-library env)
(set-identifier! 'import 'import env) (set-identifier! 'import 'import env)
(set-identifier! 'export 'export env) (set-identifier! 'export 'export env)
(set-identifier! 'cond-expand 'cond-expand env) (set-identifier! 'cond-expand 'cond-expand env)
(dictionary-set! *libraries* name `(,env . ,exports))))) (dictionary-set! *libraries* name `(,env . ,exports)))))
(define (library-environment name) (define (library-environment name)
(car (dictionary-ref *libraries* (mangle name)))) (car (dictionary-ref *libraries* (mangle name))))
(define (library-exports name) (define (library-exports name)
(cdr (dictionary-ref *libraries* (mangle name)))) (cdr (dictionary-ref *libraries* (mangle name))))
(define (library-import name sym alias) (define (library-import name sym alias)
(let ((uid (dictionary-ref (library-exports name) sym))) (let ((uid (dictionary-ref (library-exports name) sym)))
(let ((env (library-environment (current-library)))) (let ((env (library-environment (current-library))))
(set-identifier! alias uid env)))) (set-identifier! alias uid env))))
(define (library-export sym alias) (define (library-export sym alias)
(let ((env (library-environment (current-library))) (let ((env (library-environment (current-library)))
(exports (library-exports (current-library)))) (exports (library-exports (current-library))))
(dictionary-set! exports alias (find-identifier sym env)))) (dictionary-set! exports alias (find-identifier sym env))))
;;; R7RS library syntax ;; R7RS library syntax
(define-macro define-library (let ((define-transformer
(lambda (form _) (lambda (name macro)
(let ((name (cadr form)) (add-macro! name macro))))
(body (cddr form)))
(or (find-library name) (make-library name))
(parameterize ((current-library name))
(for-each
(lambda (expr)
(eval expr name)) ; TODO parse library declarations
body)))))
(define-macro cond-expand (define-transformer 'define-library
(lambda (form _) (lambda (form _)
(letrec (let ((name (cadr form))
((test (lambda (form) (body (cddr form)))
(or (or (find-library name) (make-library name))
(eq? form 'else) (parameterize ((current-library name))
(and (symbol? form) (for-each
(memq form (features))) (lambda (expr)
(and (pair? form) (eval expr name)) ; TODO parse library declarations
(case (car form) body)))))
((library) (find-library (cadr form)))
((not) (not (test (cadr form))))
((and) (let loop ((form (cdr form)))
(or (null? form)
(and (test (car form)) (loop (cdr form))))))
((or) (let loop ((form (cdr form)))
(and (pair? form)
(or (test (car form)) (loop (cdr form))))))
(else #f)))))))
(let loop ((clauses (cdr form)))
(if (null? clauses)
#undefined
(if (test (caar clauses))
`(,(make-identifier 'begin default-environment) ,@(cdar clauses))
(loop (cdr clauses))))))))
(define-macro import (define-transformer 'cond-expand
(lambda (form _) (lambda (form _)
(let ((caddr
(lambda (x) (car (cdr (cdr x)))))
(prefix
(lambda (prefix symbol)
(string->symbol
(string-append
(symbol->string prefix)
(symbol->string symbol)))))
(getlib
(lambda (name)
(if (find-library name)
name
(error "library not found" name)))))
(letrec
((extract
(lambda (spec)
(case (car spec)
((only rename prefix except)
(extract (cadr spec)))
(else
(getlib spec)))))
(collect
(lambda (spec)
(case (car spec)
((only)
(let ((alist (collect (cadr spec))))
(map (lambda (var) (assq var alist)) (cddr spec))))
((rename)
(let ((alist (collect (cadr spec)))
(renames (map (lambda (x) `(,(car x) . ,(cadr x))) (cddr spec))))
(map (lambda (s) (or (assq (car s) renames) s)) alist)))
((prefix)
(let ((alist (collect (cadr spec))))
(map (lambda (s) (cons (prefix (caddr spec) (car s)) (cdr s))) alist)))
((except)
(let ((alist (collect (cadr spec))))
(let loop ((alist alist))
(if (null? alist)
'()
(if (memq (caar alist) (cddr spec))
(loop (cdr alist))
(cons (car alist) (loop (cdr alist))))))))
(else
(dictionary-map (lambda (x) (cons x x))
(library-exports (getlib spec))))))))
(letrec (letrec
((import ((test (lambda (form)
(or
(eq? form 'else)
(and (symbol? form)
(memq form (features)))
(and (pair? form)
(case (car form)
((library) (find-library (cadr form)))
((not) (not (test (cadr form))))
((and) (let loop ((form (cdr form)))
(or (null? form)
(and (test (car form)) (loop (cdr form))))))
((or) (let loop ((form (cdr form)))
(and (pair? form)
(or (test (car form)) (loop (cdr form))))))
(else #f)))))))
(let loop ((clauses (cdr form)))
(if (null? clauses)
#undefined
(if (test (caar clauses))
`(,(make-identifier 'begin default-environment) ,@(cdar clauses))
(loop (cdr clauses))))))))
(define-transformer 'import
(lambda (form _)
(let ((caddr
(lambda (x) (car (cdr (cdr x)))))
(prefix
(lambda (prefix symbol)
(string->symbol
(string-append
(symbol->string prefix)
(symbol->string symbol)))))
(getlib
(lambda (name)
(if (find-library name)
name
(error "library not found" name)))))
(letrec
((extract
(lambda (spec)
(case (car spec)
((only rename prefix except)
(extract (cadr spec)))
(else
(getlib spec)))))
(collect
(lambda (spec)
(case (car spec)
((only)
(let ((alist (collect (cadr spec))))
(map (lambda (var) (assq var alist)) (cddr spec))))
((rename)
(let ((alist (collect (cadr spec)))
(renames (map (lambda (x) `(,(car x) . ,(cadr x))) (cddr spec))))
(map (lambda (s) (or (assq (car s) renames) s)) alist)))
((prefix)
(let ((alist (collect (cadr spec))))
(map (lambda (s) (cons (prefix (caddr spec) (car s)) (cdr s))) alist)))
((except)
(let ((alist (collect (cadr spec))))
(let loop ((alist alist))
(if (null? alist)
'()
(if (memq (caar alist) (cddr spec))
(loop (cdr alist))
(cons (car alist) (loop (cdr alist))))))))
(else
(dictionary-map (lambda (x) (cons x x))
(library-exports (getlib spec))))))))
(letrec
((import
(lambda (spec)
(let ((lib (extract spec))
(alist (collect spec)))
(for-each
(lambda (slot)
(library-import lib (cdr slot) (car slot)))
alist)))))
(for-each import (cdr form)))))))
(define-transformer 'export
(lambda (form _)
(letrec
((collect
(lambda (spec)
(cond
((symbol? spec)
`(,spec . ,spec))
((and (list? spec) (= (length spec) 3) (eq? (car spec) 'rename))
`(,(list-ref spec 1) . ,(list-ref spec 2)))
(else
(error "malformed export")))))
(export
(lambda (spec) (lambda (spec)
(let ((lib (extract spec)) (let ((slot (collect spec)))
(alist (collect spec))) (library-export (car slot) (cdr slot))))))
(for-each (for-each export (cdr form))))))
(lambda (slot)
(library-import lib (cdr slot) (car slot)))
alist)))))
(for-each import (cdr form)))))))
(define-macro export
(lambda (form _)
(letrec
((collect
(lambda (spec)
(cond
((symbol? spec)
`(,spec . ,spec))
((and (list? spec) (= (length spec) 3) (eq? (car spec) 'rename))
`(,(list-ref spec 1) . ,(list-ref spec 2)))
(else
(error "malformed export")))))
(export
(lambda (spec)
(let ((slot (collect spec)))
(library-export (car slot) (cdr slot))))))
(for-each export (cdr form)))))
;;; bootstrap... ;; bootstrap...
(let () (let ()
(make-library '(picrin base)) (make-library '(picrin base))
(set-car! (dictionary-ref *libraries* (mangle '(picrin base))) default-environment) (set-car! (dictionary-ref *libraries* (mangle '(picrin base))) default-environment)
(let ((export-keywords (let ((export-keywords
(lambda (keywords) (lambda (keywords)
(let ((env (library-environment '(picrin base))) (let ((env (library-environment '(picrin base)))
(exports (library-exports '(picrin base)))) (exports (library-exports '(picrin base))))
(for-each (for-each
(lambda (keyword) (lambda (keyword)
(dictionary-set! exports keyword keyword)) (dictionary-set! exports keyword keyword))
keywords))))) keywords)))))
(export-keywords (export-keywords
'(define lambda quote set! if begin define-macro '(define lambda quote set! if begin define-macro
let let* letrec letrec* let let* letrec letrec*
let-values let*-values define-values let-values let*-values define-values
quasiquote unquote unquote-splicing quasiquote unquote unquote-splicing
and or and or
cond case else => cond case else =>
do when unless do when unless
parameterize parameterize
define-syntax define-syntax
syntax-quote syntax-unquote syntax-quote syntax-unquote
syntax-quasiquote syntax-unquote-splicing syntax-quasiquote syntax-unquote-splicing
let-syntax letrec-syntax let-syntax letrec-syntax
syntax-error)) syntax-error))
(export-keywords (export-keywords
'(features '(features
eq? eqv? equal? not boolean? boolean=? eq? eqv? equal? not boolean? boolean=?
pair? cons car cdr null? set-car! set-cdr! pair? cons car cdr null? set-car! set-cdr!
caar cadr cdar cddr caar cadr cdar cddr
list? make-list list length append reverse list? make-list list length append reverse
list-tail list-ref list-set! list-copy list-tail list-ref list-set! list-copy
map for-each memq memv member assq assv assoc map for-each memq memv member assq assv assoc
current-input-port current-output-port current-error-port current-input-port current-output-port current-error-port
port? input-port? output-port? port-open? close-port port? input-port? output-port? port-open? close-port
eof-object? eof-object eof-object? eof-object
read-u8 peek-u8 read-bytevector! read-u8 peek-u8 read-bytevector!
write-u8 write-bytevector flush-output-port write-u8 write-bytevector flush-output-port
open-input-bytevector open-output-bytevector get-output-bytevector open-input-bytevector open-output-bytevector get-output-bytevector
number? exact? inexact? inexact exact number? exact? inexact? inexact exact
= < > <= >= + - * / = < > <= >= + - * /
number->string string->number number->string string->number
procedure? apply procedure? apply
symbol? symbol=? symbol->string string->symbol symbol? symbol=? symbol->string string->symbol
make-identifier identifier? identifier=? identifier-base identifier-environment make-identifier identifier? identifier=? identifier-base identifier-environment
vector? vector make-vector vector-length vector-ref vector-set! vector? vector make-vector vector-length vector-ref vector-set!
vector-copy! vector-copy vector-append vector-fill! vector-map vector-for-each vector-copy! vector-copy vector-append vector-fill! vector-map vector-for-each
list->vector vector->list string->vector vector->string list->vector vector->list string->vector vector->string
bytevector? bytevector make-bytevector bytevector? bytevector make-bytevector
bytevector-length bytevector-u8-ref bytevector-u8-set! bytevector-length bytevector-u8-ref bytevector-u8-set!
bytevector-copy! bytevector-copy bytevector-append bytevector-copy! bytevector-copy bytevector-append
bytevector->list list->bytevector bytevector->list list->bytevector
call-with-current-continuation call/cc values call-with-values call-with-current-continuation call/cc values call-with-values
char? char->integer integer->char char=? char<? char>? char<=? char>=? char? char->integer integer->char char=? char<? char>? char<=? char>=?
current-exception-handlers with-exception-handler current-exception-handlers with-exception-handler
raise raise-continuable error raise raise-continuable error
error-object? error-object-message error-object-irritants error-object? error-object-message error-object-irritants
error-object-type error-object-type
string? string make-string string-length string-ref string-set! string? string make-string string-length string-ref string-set!
string-copy string-copy! string-fill! string-append string-copy string-copy! string-fill! string-append
string-map string-for-each list->string string->list string-map string-for-each list->string string->list
string=? string<? string>? string<=? string>=? string=? string<? string>? string<=? string>=?
make-parameter with-dynamic-environment make-parameter with-dynamic-environment
read read
make-dictionary dictionary? dictionary dictionary-has? make-dictionary dictionary? dictionary dictionary-has?
dictionary-ref dictionary-set! dictionary-delete! dictionary-size dictionary-ref dictionary-set! dictionary-delete! dictionary-size
dictionary-map dictionary-for-each dictionary-map dictionary-for-each
dictionary->alist alist->dictionary dictionary->plist plist->dictionary dictionary->alist alist->dictionary dictionary->plist plist->dictionary
make-record record? record-type record-datum make-record record? record-type record-datum
default-environment make-environment find-identifier set-identifier! default-environment make-environment find-identifier set-identifier!
eval compile add-macro! eval compile add-macro!
make-ephemeron-table make-ephemeron-table
write write-simple write-shared display)) write write-simple write-shared display))
(export-keywords (export-keywords
'(find-library make-library current-library))) '(find-library make-library current-library)))
(set! eval (set! eval
(let ((e eval)) (let ((e eval))
(lambda (expr . lib) (lambda (expr . lib)
(let ((lib (if (null? lib) (current-library) (car lib)))) (let ((lib (if (null? lib) (current-library) (car lib))))
(e expr (library-environment lib)))))) (e expr (library-environment lib))))))
(make-library '(picrin user)) (make-library '(picrin user))
(current-library '(picrin user))) (current-library '(picrin user))))

3
src/tiny-main.c
View File

@ -14,6 +14,9 @@ main()
pic = pic_open(pic_default_allocf, NULL); pic = pic_open(pic_default_allocf, NULL);
pic_printf(pic, "~s\n", pic_funcall(pic, "compile", 1, pic_read(pic, pic_stdin(pic))));
return 0;
pic_try { pic_try {
while (1) { while (1) {
size_t ai = pic_enter(pic); size_t ai = pic_enter(pic);

25
tools/mkboot.scm
View File

@ -1,9 +1,9 @@
(import (scheme base) (import (scheme base)
(scheme read) (scheme read)
(scheme write) (scheme write)
(scheme file)) (only (picrin base) compile))
(define (generate-rom filename) (define (generate-rom)
(define (with-output-to-string thunk) (define (with-output-to-string thunk)
(let ((port (open-output-string))) (let ((port (open-output-string)))
@ -13,23 +13,10 @@
(close-port port) (close-port port)
s)))) s))))
(define exprs
(with-input-from-file filename
(lambda ()
(let loop ((acc '()))
(let ((e (read)))
(if (eof-object? e)
(reverse acc)
(loop (cons e acc))))))))
(define text (define text
(with-output-to-string (with-output-to-string
(lambda () (lambda ()
(for-each (write (compile (read))))))
(lambda (e)
(write e)
(write-string " "))
exprs))))
(define (escape-string s) (define (escape-string s)
(with-output-to-string (with-output-to-string
@ -65,12 +52,12 @@
"#include \"picrin/extra.h\"" "#include \"picrin/extra.h\""
"" ""
"static const char boot_rom[][80] = {" "static const char boot_rom[][80] = {"
,(generate-rom "piclib/boot3.scm") ,(generate-rom)
"};" "};"
"" ""
"#if PIC_USE_LIBRARY" "#if PIC_USE_LIBRARY"
"static const char boot_library_rom[][80] = {" "static const char boot_library_rom[][80] = {"
,(generate-rom "piclib/library.scm") ,(generate-rom)
"};" "};"
"#endif" "#endif"
"" ""
@ -79,7 +66,7 @@
"{" "{"
" pic_call(pic, pic_compile(pic, pic_read_cstr(pic, &boot_rom[0][0])), 0);" " pic_call(pic, pic_compile(pic, pic_read_cstr(pic, &boot_rom[0][0])), 0);"
"#if PIC_USE_LIBRARY" "#if PIC_USE_LIBRARY"
" pic_load_cstr(pic, &boot_library_rom[0][0]);" " pic_call(pic, pic_compile(pic, pic_read_cstr(pic, &boot_library_rom[0][0])), 0);"
"#endif" "#endif"
"}")) "}"))