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

add macro-objects and global-objects

This commit is contained in:
Yuichi Nishiwaki 2017-04-04 03:55:23 +09:00
parent b9ec9c607b
commit 82939650a4
7 changed files with 920 additions and 956 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
bin/picrin-bootstrap
View File

Binary file not shown.

9
lib/dict.c
View File

@ -178,11 +178,15 @@ pic_dict_dictionary_map(pic_state *pic)
{ {
pic_value dict, proc, key, ret = pic_nil_value(pic); pic_value dict, proc, key, ret = pic_nil_value(pic);
int it = 0; int it = 0;
size_t ai;
pic_get_args(pic, "ld", &proc, &dict); pic_get_args(pic, "ld", &proc, &dict);
ai = pic_enter(pic);
while (pic_dict_next(pic, dict, &it, &key, NULL)) { while (pic_dict_next(pic, dict, &it, &key, NULL)) {
pic_push(pic, pic_call(pic, proc, 1, key), ret); pic_push(pic, pic_call(pic, proc, 1, key), ret);
pic_leave(pic, ai);
pic_protect(pic, ret);
} }
return pic_reverse(pic, ret); return pic_reverse(pic, ret);
} }
@ -191,12 +195,15 @@ static pic_value
pic_dict_dictionary_for_each(pic_state *pic) pic_dict_dictionary_for_each(pic_state *pic)
{ {
pic_value dict, proc, key; pic_value dict, proc, key;
int it; int it = 0;
size_t ai;
pic_get_args(pic, "ld", &proc, &dict); pic_get_args(pic, "ld", &proc, &dict);
ai = pic_enter(pic);
while (pic_dict_next(pic, dict, &it, &key, NULL)) { while (pic_dict_next(pic, dict, &it, &key, NULL)) {
pic_call(pic, proc, 1, key); pic_call(pic, proc, 1, key);
pic_leave(pic, ai);
} }
return pic_undef_value(pic); return pic_undef_value(pic);

742
lib/ext/boot.c
View File

@ -2,388 +2,374 @@
#include "picrin/extra.h" #include "picrin/extra.h"
static const char boot_rom[][80] = { static const char boot_rom[][80] = {
"((core#lambda () (core#begin (core#define .define-transformer.2228 (core#lambda ", "((core#lambda (.define-transformer.2228 .the.2229) ((core#lambda (.the-core-defi",
"(.name.2248 .transformer.2249) (add-macro! .name.2248 .transformer.2249))) (core", "ne.2230 .the-core-lambda.2231 .the-core-begin.2232 .the-core-quote.2233 .the-cor",
"#begin (core#define .the.2229 (core#lambda (.var.2250) (make-identifier .var.225", "e-set!.2234 .the-core-if.2235 .the-core-define-macro.2236 .the-define.2237 .the-",
"0 default-environment))) (core#begin (core#define .the-core-define.2230 (.the.22", "lambda.2238 .the-begin.2239 .the-quote.2240 .the-set!.2241 .the-if.2242 .the-def",
"29 (core#quote core#define))) (core#begin (core#define .the-core-lambda.2231 (.t", "ine-macro.2243) (core#begin (.define-transformer.2228 (core#quote quote) (core#l",
"he.2229 (core#quote core#lambda))) (core#begin (core#define .the-core-begin.2232", "ambda (.form.2248 .env.2249) (core#if (= (length .form.2248) 2) (cons .the-core-",
" (.the.2229 (core#quote core#begin))) (core#begin (core#define .the-core-quote.2", "quote.2233 (cons (cadr .form.2248) (core#quote ()))) (error \"malformed quote\" .f",
"233 (.the.2229 (core#quote core#quote))) (core#begin (core#define .the-core-set!", "orm.2248)))) (core#begin (.define-transformer.2228 (core#quote if) (core#lambda ",
".2234 (.the.2229 (core#quote core#set!))) (core#begin (core#define .the-core-if.", "(.form.2250 .env.2251) ((core#lambda (.len.2252) (core#if (= .len.2252 3) (appen",
"2235 (.the.2229 (core#quote core#if))) (core#begin (core#define .the-core-define", "d .form.2250 (cons (core#quote #undefined) (core#quote ()))) (core#if (= .len.22",
"-macro.2236 (.the.2229 (core#quote core#define-macro))) (core#begin (core#define", "52 4) (cons .the-core-if.2235 (cdr .form.2250)) (error \"malformed if\" .form.2250",
" .the-define.2237 (.the.2229 (core#quote define))) (core#begin (core#define .the", ")))) (length .form.2250)))) (core#begin (.define-transformer.2228 (core#quote be",
"-lambda.2238 (.the.2229 (core#quote lambda))) (core#begin (core#define .the-begi", "gin) (core#lambda (.form.2253 .env.2254) ((core#lambda (.len.2255) (core#if (= .",
"n.2239 (.the.2229 (core#quote begin))) (core#begin (core#define .the-quote.2240 ", "len.2255 1) #undefined (core#if (= .len.2255 2) (cadr .form.2253) (core#if (= .l",
"(.the.2229 (core#quote quote))) (core#begin (core#define .the-set!.2241 (.the.22", "en.2255 3) (cons .the-core-begin.2232 (cdr .form.2253)) (cons .the-core-begin.22",
"29 (core#quote set!))) (core#begin (core#define .the-if.2242 (.the.2229 (core#qu", "32 (cons (cadr .form.2253) (cons (cons .the-begin.2239 (cddr .form.2253)) (core#",
"ote if))) (core#begin (core#define .the-define-macro.2243 (.the.2229 (core#quote", "quote ())))))))) (length .form.2253)))) (core#begin (.define-transformer.2228 (c",
" define-macro))) (core#begin (.define-transformer.2228 (core#quote quote) (core#", "ore#quote set!) (core#lambda (.form.2256 .env.2257) (core#if (core#if (= (length",
"lambda (.form.2251 .env.2252) (core#if (= (length .form.2251) 2) (cons .the-core", " .form.2256) 3) (identifier? (cadr .form.2256)) #f) (cons .the-core-set!.2234 (c",
"-quote.2233 (cons (cadr .form.2251) (core#quote ()))) (error \"malformed quote\" .", "dr .form.2256)) (error \"malformed set!\" .form.2256)))) (core#begin (core#define ",
"form.2251)))) (core#begin (.define-transformer.2228 (core#quote if) (core#lambda", ".check-formal.2244 (core#lambda (.formal.2258) ((core#lambda (.it.2259) (core#if",
" (.form.2253 .env.2254) ((core#lambda (.len.2255) (core#if (= .len.2255 3) (appe", " .it.2259 .it.2259 ((core#lambda (.it.2260) (core#if .it.2260 .it.2260 ((core#la",
"nd .form.2253 (cons (core#quote #undefined) (core#quote ()))) (core#if (= .len.2", "mbda (.it.2261) (core#if .it.2261 .it.2261 #f)) (core#if (pair? .formal.2258) (c",
"255 4) (cons .the-core-if.2235 (cdr .form.2253)) (error \"malformed if\" .form.225", "ore#if (identifier? (car .formal.2258)) (.check-formal.2244 (cdr .formal.2258)) ",
"3)))) (length .form.2253)))) (core#begin (.define-transformer.2228 (core#quote b", "#f) #f)))) (identifier? .formal.2258)))) (null? .formal.2258)))) (core#begin (.d",
"egin) (core#lambda (.form.2256 .env.2257) ((core#lambda (.len.2258) (core#if (= ", "efine-transformer.2228 (core#quote lambda) (core#lambda (.form.2262 .env.2263) (",
".len.2258 1) #undefined (core#if (= .len.2258 2) (cadr .form.2256) (core#if (= .", "core#if (= (length .form.2262) 1) (error \"malformed lambda\" .form.2262) (core#if",
"len.2258 3) (cons .the-core-begin.2232 (cdr .form.2256)) (cons .the-core-begin.2", " (.check-formal.2244 (cadr .form.2262)) (cons .the-core-lambda.2231 (cons (cadr ",
"232 (cons (cadr .form.2256) (cons (cons .the-begin.2239 (cddr .form.2256)) (core", ".form.2262) (cons (cons .the-begin.2239 (cddr .form.2262)) (core#quote ())))) (e",
"#quote ())))))))) (length .form.2256)))) (core#begin (.define-transformer.2228 (", "rror \"malformed lambda\" .form.2262))))) (core#begin (.define-transformer.2228 (c",
"core#quote set!) (core#lambda (.form.2259 .env.2260) (core#if (core#if (= (lengt", "ore#quote define) (core#lambda (.form.2264 .env.2265) ((core#lambda (.len.2266) ",
"h .form.2259) 3) (identifier? (cadr .form.2259)) #f) (cons .the-core-set!.2234 (", "(core#if (= .len.2266 1) (error \"malformed define\" .form.2264) ((core#lambda (.f",
"cdr .form.2259)) (error \"malformed set!\" .form.2259)))) (core#begin (core#define", "ormal.2267) (core#if (identifier? .formal.2267) (core#if (= .len.2266 3) (cons .",
" .check-formal.2244 (core#lambda (.formal.2261) ((core#lambda (.it.2262) (core#i", "the-core-define.2230 (cdr .form.2264)) (error \"malformed define\" .form.2264)) (c",
"f .it.2262 .it.2262 ((core#lambda (.it.2263) (core#if .it.2263 .it.2263 ((core#l", "ore#if (pair? .formal.2267) (cons .the-define.2237 (cons (car .formal.2267) (con",
"ambda (.it.2264) (core#if .it.2264 .it.2264 #f)) (core#if (pair? .formal.2261) (", "s (cons .the-lambda.2238 (cons (cdr .formal.2267) (cddr .form.2264))) (core#quot",
"core#if (identifier? (car .formal.2261)) (.check-formal.2244 (cdr .formal.2261))", "e ())))) (error \"define: binding to non-varaible object\" .form.2264)))) (cadr .f",
" #f) #f)))) (identifier? .formal.2261)))) (null? .formal.2261)))) (core#begin (.", "orm.2264)))) (length .form.2264)))) (core#begin (.define-transformer.2228 (core#",
"define-transformer.2228 (core#quote lambda) (core#lambda (.form.2265 .env.2266) ", "quote define-macro) (core#lambda (.form.2268 .env.2269) (core#if (= (length .for",
"(core#if (= (length .form.2265) 1) (error \"malformed lambda\" .form.2265) (core#i", "m.2268) 3) (core#if (identifier? (cadr .form.2268)) (cons .the-core-define-macro",
"f (.check-formal.2244 (cadr .form.2265)) (cons .the-core-lambda.2231 (cons (cadr", ".2236 (cdr .form.2268)) (error \"define-macro: binding to non-variable object\" .f",
" .form.2265) (cons (cons .the-begin.2239 (cddr .form.2265)) (core#quote ())))) (", "orm.2268)) (error \"malformed define-macro\" .form.2268)))) (core#begin #undefined",
"error \"malformed lambda\" .form.2265))))) (core#begin (.define-transformer.2228 (", " (core#begin (.define-transformer.2228 (core#quote else) (core#lambda ._.2270 (e",
"core#quote define) (core#lambda (.form.2267 .env.2268) ((core#lambda (.len.2269)", "rror \"invalid use of auxiliary syntax\" (core#quote else)))) (core#begin (.define",
" (core#if (= .len.2269 1) (error \"malformed define\" .form.2267) ((core#lambda (.", "-transformer.2228 (core#quote =>) (core#lambda ._.2271 (error \"invalid use of au",
"formal.2270) (core#if (identifier? .formal.2270) (core#if (= .len.2269 3) (cons ", "xiliary syntax\" (core#quote =>)))) (core#begin (.define-transformer.2228 (core#q",
".the-core-define.2230 (cdr .form.2267)) (error \"malformed define\" .form.2267)) (", "uote unquote) (core#lambda ._.2272 (error \"invalid use of auxiliary syntax\" (cor",
"core#if (pair? .formal.2270) (cons .the-define.2237 (cons (car .formal.2270) (co", "e#quote unquote)))) (core#begin (.define-transformer.2228 (core#quote unquote-sp",
"ns (cons .the-lambda.2238 (cons (cdr .formal.2270) (cddr .form.2267))) (core#quo", "licing) (core#lambda ._.2273 (error \"invalid use of auxiliary syntax\" (core#quot",
"te ())))) (error \"define: binding to non-varaible object\" .form.2267)))) (cadr .", "e unquote-splicing)))) (core#begin (.define-transformer.2228 (core#quote let) (c",
"form.2267)))) (length .form.2267)))) (core#begin (.define-transformer.2228 (core", "ore#lambda (.form.2274 .env.2275) (core#if (identifier? (cadr .form.2274)) ((cor",
"#quote define-macro) (core#lambda (.form.2271 .env.2272) (core#if (= (length .fo", "e#lambda (.name.2276 .formal.2277 .body.2278) (cons (cons .the-lambda.2238 (cons",
"rm.2271) 3) (core#if (identifier? (cadr .form.2271)) (cons .the-core-define-macr", " (core#quote ()) (cons (cons .the-define.2237 (cons (cons .name.2276 (map car .f",
"o.2236 (cdr .form.2271)) (error \"define-macro: binding to non-variable object\" .", "ormal.2277)) .body.2278)) (cons (cons .name.2276 (map cadr .formal.2277)) (core#",
"form.2271)) (error \"malformed define-macro\" .form.2271)))) (core#begin #undefine", "quote ()))))) (core#quote ()))) (car (cdr .form.2274)) (car (cdr (cdr .form.2274",
"d (core#begin (.define-transformer.2228 (core#quote else) (core#lambda ._.2273 (", "))) (cdr (cdr (cdr .form.2274)))) ((core#lambda (.formal.2279 .body.2280) (cons ",
"error \"invalid use of auxiliary syntax\" (core#quote else)))) (core#begin (.defin", "(cons .the-lambda.2238 (cons (map car .formal.2279) .body.2280)) (map cadr .form",
"e-transformer.2228 (core#quote =>) (core#lambda ._.2274 (error \"invalid use of a", "al.2279))) (car (cdr .form.2274)) (cdr (cdr .form.2274)))))) (core#begin (.defin",
"uxiliary syntax\" (core#quote =>)))) (core#begin (.define-transformer.2228 (core#", "e-transformer.2228 (core#quote and) (core#lambda (.form.2281 .env.2282) (core#if",
"quote unquote) (core#lambda ._.2275 (error \"invalid use of auxiliary syntax\" (co", " (null? (cdr .form.2281)) #t (core#if (null? (cddr .form.2281)) (cadr .form.2281",
"re#quote unquote)))) (core#begin (.define-transformer.2228 (core#quote unquote-s", ") (cons .the-if.2242 (cons (cadr .form.2281) (cons (cons (.the.2229 (core#quote ",
"plicing) (core#lambda ._.2276 (error \"invalid use of auxiliary syntax\" (core#quo", "and)) (cddr .form.2281)) (cons (core#quote #f) (core#quote ()))))))))) (core#beg",
"te unquote-splicing)))) (core#begin (.define-transformer.2228 (core#quote let) (", "in (.define-transformer.2228 (core#quote or) (core#lambda (.form.2283 .env.2284)",
"core#lambda (.form.2277 .env.2278) (core#if (identifier? (cadr .form.2277)) ((co", " (core#if (null? (cdr .form.2283)) #f ((core#lambda (.tmp.2285) (cons (.the.2229",
"re#lambda (.name.2279 .formal.2280 .body.2281) (cons (cons .the-lambda.2238 (con", " (core#quote let)) (cons (cons (cons .tmp.2285 (cons (cadr .form.2283) (core#quo",
"s (core#quote ()) (cons (cons .the-define.2237 (cons (cons .name.2279 (map car .", "te ()))) (core#quote ())) (cons (cons .the-if.2242 (cons .tmp.2285 (cons .tmp.22",
"formal.2280)) .body.2281)) (cons (cons .name.2279 (map cadr .formal.2280)) (core", "85 (cons (cons (.the.2229 (core#quote or)) (cddr .form.2283)) (core#quote ()))))",
"#quote ()))))) (core#quote ()))) (car (cdr .form.2277)) (car (cdr (cdr .form.227", ") (core#quote ()))))) (make-identifier (core#quote it) .env.2284))))) (core#begi",
"7))) (cdr (cdr (cdr .form.2277)))) ((core#lambda (.formal.2282 .body.2283) (cons", "n (.define-transformer.2228 (core#quote cond) (core#lambda (.form.2286 .env.2287",
" (cons .the-lambda.2238 (cons (map car .formal.2282) .body.2283)) (map cadr .for", ") ((core#lambda (.clauses.2288) (core#if (null? .clauses.2288) #undefined ((core",
"mal.2282))) (car (cdr .form.2277)) (cdr (cdr .form.2277)))))) (core#begin (.defi", "#lambda (.clause.2289) (core#if (core#if (identifier? (car .clause.2289)) (ident",
"ne-transformer.2228 (core#quote and) (core#lambda (.form.2284 .env.2285) (core#i", "ifier=? (.the.2229 (core#quote else)) (make-identifier (car .clause.2289) .env.2",
"f (null? (cdr .form.2284)) #t (core#if (null? (cddr .form.2284)) (cadr .form.228", "287)) #f) (cons .the-begin.2239 (cdr .clause.2289)) (core#if (null? (cdr .clause",
"4) (cons .the-if.2242 (cons (cadr .form.2284) (cons (cons (.the.2229 (core#quote", ".2289)) (cons (.the.2229 (core#quote or)) (cons (car .clause.2289) (cons (cons (",
" and)) (cddr .form.2284)) (cons (core#quote #f) (core#quote ()))))))))) (core#be", ".the.2229 (core#quote cond)) (cdr .clauses.2288)) (core#quote ())))) (core#if (c",
"gin (.define-transformer.2228 (core#quote or) (core#lambda (.form.2286 .env.2287", "ore#if (identifier? (cadr .clause.2289)) (identifier=? (.the.2229 (core#quote =>",
") (core#if (null? (cdr .form.2286)) #f ((core#lambda (.tmp.2288) (cons (.the.222", ")) (make-identifier (cadr .clause.2289) .env.2287)) #f) ((core#lambda (.tmp.2290",
"9 (core#quote let)) (cons (cons (cons .tmp.2288 (cons (cadr .form.2286) (core#qu", ") (cons (.the.2229 (core#quote let)) (cons (cons (cons .tmp.2290 (cons (car .cla",
"ote ()))) (core#quote ())) (cons (cons .the-if.2242 (cons .tmp.2288 (cons .tmp.2", "use.2289) (core#quote ()))) (core#quote ())) (cons (cons .the-if.2242 (cons .tmp",
"288 (cons (cons (.the.2229 (core#quote or)) (cddr .form.2286)) (core#quote ())))", ".2290 (cons (cons (cadr (cdr .clause.2289)) (cons .tmp.2290 (core#quote ()))) (c",
")) (core#quote ()))))) (make-identifier (core#quote it) .env.2287))))) (core#beg", "ons (cons (.the.2229 (core#quote cond)) (cddr .form.2286)) (core#quote ()))))) (",
"in (.define-transformer.2228 (core#quote cond) (core#lambda (.form.2289 .env.229", "core#quote ()))))) (make-identifier (core#quote tmp) .env.2287)) (cons .the-if.2",
"0) ((core#lambda (.clauses.2291) (core#if (null? .clauses.2291) #undefined ((cor", "242 (cons (car .clause.2289) (cons (cons .the-begin.2239 (cdr .clause.2289)) (co",
"e#lambda (.clause.2292) (core#if (core#if (identifier? (car .clause.2292)) (iden", "ns (cons (.the.2229 (core#quote cond)) (cdr .clauses.2288)) (core#quote ()))))))",
"tifier=? (.the.2229 (core#quote else)) (make-identifier (car .clause.2292) .env.", "))) (car .clauses.2288)))) (cdr .form.2286)))) (core#begin (.define-transformer.",
"2290)) #f) (cons .the-begin.2239 (cdr .clause.2292)) (core#if (null? (cdr .claus", "2228 (core#quote quasiquote) (core#lambda (.form.2291 .env.2292) (core#begin (co",
"e.2292)) (cons (.the.2229 (core#quote or)) (cons (car .clause.2292) (cons (cons ", "re#define .quasiquote?.2293 (core#lambda (.form.2297) (core#if (pair? .form.2297",
"(.the.2229 (core#quote cond)) (cdr .clauses.2291)) (core#quote ())))) (core#if (", ") (core#if (identifier? (car .form.2297)) (identifier=? (.the.2229 (core#quote q",
"core#if (identifier? (cadr .clause.2292)) (identifier=? (.the.2229 (core#quote =", "uasiquote)) (make-identifier (car .form.2297) .env.2292)) #f) #f))) (core#begin ",
">)) (make-identifier (cadr .clause.2292) .env.2290)) #f) ((core#lambda (.tmp.229", "(core#define .unquote?.2294 (core#lambda (.form.2298) (core#if (pair? .form.2298",
"3) (cons (.the.2229 (core#quote let)) (cons (cons (cons .tmp.2293 (cons (car .cl", ") (core#if (identifier? (car .form.2298)) (identifier=? (.the.2229 (core#quote u",
"ause.2292) (core#quote ()))) (core#quote ())) (cons (cons .the-if.2242 (cons .tm", "nquote)) (make-identifier (car .form.2298) .env.2292)) #f) #f))) (core#begin (co",
"p.2293 (cons (cons (cadr (cdr .clause.2292)) (cons .tmp.2293 (core#quote ()))) (", "re#define .unquote-splicing?.2295 (core#lambda (.form.2299) (core#if (pair? .for",
"cons (cons (.the.2229 (core#quote cond)) (cddr .form.2289)) (core#quote ()))))) ", "m.2299) (core#if (pair? (car .form.2299)) (core#if (identifier? (caar .form.2299",
"(core#quote ()))))) (make-identifier (core#quote tmp) .env.2290)) (cons .the-if.", ")) (identifier=? (.the.2229 (core#quote unquote-splicing)) (make-identifier (caa",
"2242 (cons (car .clause.2292) (cons (cons .the-begin.2239 (cdr .clause.2292)) (c", "r .form.2299) .env.2292)) #f) #f) #f))) (core#begin (core#define .qq.2296 (core#",
"ons (cons (.the.2229 (core#quote cond)) (cdr .clauses.2291)) (core#quote ())))))", "lambda (.depth.2300 .expr.2301) (core#if (.unquote?.2294 .expr.2301) (core#if (=",
")))) (car .clauses.2291)))) (cdr .form.2289)))) (core#begin (.define-transformer", " .depth.2300 1) (cadr .expr.2301) (list (.the.2229 (core#quote list)) (list (.th",
".2228 (core#quote quasiquote) (core#lambda (.form.2294 .env.2295) (core#begin (c", "e.2229 (core#quote quote)) (.the.2229 (core#quote unquote))) (.qq.2296 (- .depth",
"ore#define .quasiquote?.2296 (core#lambda (.form.2300) (core#if (pair? .form.230", ".2300 1) (car (cdr .expr.2301))))) (core#if (.unquote-splicing?.2295 .expr.2301)",
"0) (core#if (identifier? (car .form.2300)) (identifier=? (.the.2229 (core#quote ", " (core#if (= .depth.2300 1) (list (.the.2229 (core#quote append)) (car (cdr (car",
"quasiquote)) (make-identifier (car .form.2300) .env.2295)) #f) #f))) (core#begin", " .expr.2301))) (.qq.2296 .depth.2300 (cdr .expr.2301))) (list (.the.2229 (core#q",
" (core#define .unquote?.2297 (core#lambda (.form.2301) (core#if (pair? .form.230", "uote cons)) (list (.the.2229 (core#quote list)) (list (.the.2229 (core#quote quo",
"1) (core#if (identifier? (car .form.2301)) (identifier=? (.the.2229 (core#quote ", "te)) (.the.2229 (core#quote unquote-splicing))) (.qq.2296 (- .depth.2300 1) (car",
"unquote)) (make-identifier (car .form.2301) .env.2295)) #f) #f))) (core#begin (c", " (cdr (car .expr.2301))))) (.qq.2296 .depth.2300 (cdr .expr.2301)))) (core#if (.",
"ore#define .unquote-splicing?.2298 (core#lambda (.form.2302) (core#if (pair? .fo", "quasiquote?.2293 .expr.2301) (list (.the.2229 (core#quote list)) (list (.the.222",
"rm.2302) (core#if (pair? (car .form.2302)) (core#if (identifier? (caar .form.230", "9 (core#quote quote)) (.the.2229 (core#quote quasiquote))) (.qq.2296 (+ .depth.2",
"2)) (identifier=? (.the.2229 (core#quote unquote-splicing)) (make-identifier (ca", "300 1) (car (cdr .expr.2301)))) (core#if (pair? .expr.2301) (list (.the.2229 (co",
"ar .form.2302) .env.2295)) #f) #f) #f))) (core#begin (core#define .qq.2299 (core", "re#quote cons)) (.qq.2296 .depth.2300 (car .expr.2301)) (.qq.2296 .depth.2300 (c",
"#lambda (.depth.2303 .expr.2304) (core#if (.unquote?.2297 .expr.2304) (core#if (", "dr .expr.2301))) (core#if (vector? .expr.2301) (list (.the.2229 (core#quote list",
"= .depth.2303 1) (cadr .expr.2304) (list (.the.2229 (core#quote list)) (list (.t", "->vector)) (.qq.2296 .depth.2300 (vector->list .expr.2301))) (list (.the.2229 (c",
"he.2229 (core#quote quote)) (.the.2229 (core#quote unquote))) (.qq.2299 (- .dept", "ore#quote quote)) .expr.2301)))))))) ((core#lambda (.x.2302) (.qq.2296 1 .x.2302",
"h.2303 1) (car (cdr .expr.2304))))) (core#if (.unquote-splicing?.2298 .expr.2304", ")) (cadr .form.2291)))))))) (core#begin (.define-transformer.2228 (core#quote le",
") (core#if (= .depth.2303 1) (list (.the.2229 (core#quote append)) (car (cdr (ca", "t*) (core#lambda (.form.2303 .env.2304) ((core#lambda (.bindings.2305 .body.2306",
"r .expr.2304))) (.qq.2299 .depth.2303 (cdr .expr.2304))) (list (.the.2229 (core#", ") (core#if (null? .bindings.2305) (cons (.the.2229 (core#quote let)) (cons (core",
"quote cons)) (list (.the.2229 (core#quote list)) (list (.the.2229 (core#quote qu", "#quote ()) .body.2306)) (cons (.the.2229 (core#quote let)) (cons (cons (cons (ca",
"ote)) (.the.2229 (core#quote unquote-splicing))) (.qq.2299 (- .depth.2303 1) (ca", "r (car .bindings.2305)) (cdr (car .bindings.2305))) (core#quote ())) (cons (cons",
"r (cdr (car .expr.2304))))) (.qq.2299 .depth.2303 (cdr .expr.2304)))) (core#if (", " (.the.2229 (core#quote let*)) (cons (cdr .bindings.2305) .body.2306)) (core#quo",
".quasiquote?.2296 .expr.2304) (list (.the.2229 (core#quote list)) (list (.the.22", "te ())))))) (car (cdr .form.2303)) (cdr (cdr .form.2303))))) (core#begin (.defin",
"29 (core#quote quote)) (.the.2229 (core#quote quasiquote))) (.qq.2299 (+ .depth.", "e-transformer.2228 (core#quote letrec) (core#lambda (.form.2307 .env.2308) (cons",
"2303 1) (car (cdr .expr.2304)))) (core#if (pair? .expr.2304) (list (.the.2229 (c", " (.the.2229 (core#quote letrec*)) (cdr .form.2307)))) (core#begin (.define-trans",
"ore#quote cons)) (.qq.2299 .depth.2303 (car .expr.2304)) (.qq.2299 .depth.2303 (", "former.2228 (core#quote letrec*) (core#lambda (.form.2309 .env.2310) ((core#lamb",
"cdr .expr.2304))) (core#if (vector? .expr.2304) (list (.the.2229 (core#quote lis", "da (.bindings.2311 .body.2312) ((core#lambda (.variables.2313 .initials.2314) (c",
"t->vector)) (.qq.2299 .depth.2303 (vector->list .expr.2304))) (list (.the.2229 (", "ons (.the.2229 (core#quote let)) (cons .variables.2313 (append .initials.2314 (a",
"core#quote quote)) .expr.2304)))))))) ((core#lambda (.x.2305) (.qq.2299 1 .x.230", "ppend .body.2312 (core#quote ())))))) (map (core#lambda (.v.2315) (cons .v.2315 ",
"5)) (cadr .form.2294)))))))) (core#begin (.define-transformer.2228 (core#quote l", "(cons (core#quote #undefined) (core#quote ())))) (map car .bindings.2311)) (map ",
"et*) (core#lambda (.form.2306 .env.2307) ((core#lambda (.bindings.2308 .body.230", "(core#lambda (.v.2316) (cons (.the.2229 (core#quote set!)) (append .v.2316 (core",
"9) (core#if (null? .bindings.2308) (cons (.the.2229 (core#quote let)) (cons (cor", "#quote ())))) .bindings.2311))) (car (cdr .form.2309)) (cdr (cdr .form.2309)))))",
"e#quote ()) .body.2309)) (cons (.the.2229 (core#quote let)) (cons (cons (cons (c", " (core#begin (.define-transformer.2228 (core#quote let-values) (core#lambda (.fo",
"ar (car .bindings.2308)) (cdr (car .bindings.2308))) (core#quote ())) (cons (con", "rm.2317 .env.2318) (cons (.the.2229 (core#quote let*-values)) (append (cdr .form",
"s (.the.2229 (core#quote let*)) (cons (cdr .bindings.2308) .body.2309)) (core#qu", ".2317) (core#quote ()))))) (core#begin (.define-transformer.2228 (core#quote let",
"ote ())))))) (car (cdr .form.2306)) (cdr (cdr .form.2306))))) (core#begin (.defi", "*-values) (core#lambda (.form.2319 .env.2320) ((core#lambda (.formals.2321 .body",
"ne-transformer.2228 (core#quote letrec) (core#lambda (.form.2310 .env.2311) (con", ".2322) (core#if (null? .formals.2321) (cons (.the.2229 (core#quote let)) (cons (",
"s (.the.2229 (core#quote letrec*)) (cdr .form.2310)))) (core#begin (.define-tran", "core#quote ()) (append .body.2322 (core#quote ())))) ((core#lambda (.formal.2323",
"sformer.2228 (core#quote letrec*) (core#lambda (.form.2312 .env.2313) ((core#lam", ") (cons (.the.2229 (core#quote call-with-values)) (cons (cons .the-lambda.2238 (",
"bda (.bindings.2314 .body.2315) ((core#lambda (.variables.2316 .initials.2317) (", "cons (core#quote ()) (cdr .formal.2323))) (cons (cons (.the.2229 (core#quote lam",
"cons (.the.2229 (core#quote let)) (cons .variables.2316 (append .initials.2317 (", "bda)) (cons (car .formal.2323) (cons (cons (.the.2229 (core#quote let*-values)) ",
"append .body.2315 (core#quote ())))))) (map (core#lambda (.v.2318) (cons .v.2318", "(cons (cdr .formals.2321) .body.2322)) (core#quote ())))) (core#quote ()))))) (c",
" (cons (core#quote #undefined) (core#quote ())))) (map car .bindings.2314)) (map", "ar .formals.2321)))) (cadr .form.2319) (cddr .form.2319)))) (core#begin (.define",
" (core#lambda (.v.2319) (cons (.the.2229 (core#quote set!)) (append .v.2319 (cor", "-transformer.2228 (core#quote define-values) (core#lambda (.form.2324 .env.2325)",
"e#quote ())))) .bindings.2314))) (car (cdr .form.2312)) (cdr (cdr .form.2312))))", " ((core#lambda (.formal.2326 .body.2327) ((core#lambda (.tmps.2328) (cons .the-b",
") (core#begin (.define-transformer.2228 (core#quote let-values) (core#lambda (.f", "egin.2239 (append ((core#lambda () (core#begin (core#define .loop.2329 (core#lam",
"orm.2320 .env.2321) (cons (.the.2229 (core#quote let*-values)) (append (cdr .for", "bda (.formal.2330) (core#if (identifier? .formal.2330) (cons (cons .the-define.2",
"m.2320) (core#quote ()))))) (core#begin (.define-transformer.2228 (core#quote le", "237 (cons .formal.2330 (cons (core#quote #undefined) (core#quote ())))) (core#qu",
"t*-values) (core#lambda (.form.2322 .env.2323) ((core#lambda (.formals.2324 .bod", "ote ())) (core#if (pair? .formal.2330) (cons (cons .the-define.2237 (cons (car .",
"y.2325) (core#if (null? .formals.2324) (cons (.the.2229 (core#quote let)) (cons ", "formal.2330) (cons (core#quote #undefined) (core#quote ())))) (.loop.2329 (cdr .",
"(core#quote ()) (append .body.2325 (core#quote ())))) ((core#lambda (.formal.232", "formal.2330))) (core#quote ()))))) (.loop.2329 .formal.2326)))) (cons (cons (.th",
"6) (cons (.the.2229 (core#quote call-with-values)) (cons (cons .the-lambda.2238 ", "e.2229 (core#quote call-with-values)) (cons (cons .the-lambda.2238 (cons (core#q",
"(cons (core#quote ()) (cdr .formal.2326))) (cons (cons (.the.2229 (core#quote la", "uote ()) .body.2327)) (cons (cons .the-lambda.2238 (cons .tmps.2328 ((core#lambd",
"mbda)) (cons (car .formal.2326) (cons (cons (.the.2229 (core#quote let*-values))", "a () (core#begin (core#define .loop.2331 (core#lambda (.formal.2332 .tmps.2333) ",
" (cons (cdr .formals.2324) .body.2325)) (core#quote ())))) (core#quote ()))))) (", "(core#if (identifier? .formal.2332) (cons (cons .the-set!.2241 (cons .formal.233",
"car .formals.2324)))) (cadr .form.2322) (cddr .form.2322)))) (core#begin (.defin", "2 (cons .tmps.2333 (core#quote ())))) (core#quote ())) (core#if (pair? .formal.2",
"e-transformer.2228 (core#quote define-values) (core#lambda (.form.2327 .env.2328", "332) (cons (cons .the-set!.2241 (cons (car .formal.2332) (cons (car .tmps.2333) ",
") ((core#lambda (.formal.2329 .body.2330) ((core#lambda (.arguments.2331) (cons ", "(core#quote ())))) (.loop.2331 (cdr .formal.2332) (cdr .tmps.2333))) (core#quote",
".the-begin.2239 (append ((core#lambda () (core#begin (core#define .loop.2332 (co", " ()))))) (.loop.2331 .formal.2326 .tmps.2328)))))) (core#quote ())))) (core#quot",
"re#lambda (.formal.2333) (core#if (pair? .formal.2333) (cons (cons .the-define.2", "e ()))))) ((core#lambda () (core#begin (core#define .loop.2334 (core#lambda (.fo",
"237 (cons (car .formal.2333) (cons (core#quote #undefined) (core#quote ())))) (.", "rmal.2335) (core#if (identifier? .formal.2335) (make-identifier .formal.2335 .en",
"loop.2332 (cdr .formal.2333))) (core#if (identifier? .formal.2333) (cons (cons .", "v.2325) (core#if (pair? .formal.2335) (cons (make-identifier (car .formal.2335) ",
"the-define.2237 (cons .formal.2333 (cons (core#quote #undefined) (core#quote ())", ".env.2325) (.loop.2334 (cdr .formal.2335))) (core#quote ()))))) (.loop.2334 .for",
"))) (core#quote ())) (core#quote ()))))) (.loop.2332 .formal.2329)))) (cons (con", "mal.2326)))))) (cadr .form.2324) (cddr .form.2324)))) (core#begin (.define-trans",
"s (.the.2229 (core#quote call-with-values)) (cons (cons .the-lambda.2238 (cons (", "former.2228 (core#quote do) (core#lambda (.form.2336 .env.2337) ((core#lambda (.",
"core#quote ()) (append .body.2330 (core#quote ())))) (cons (cons .the-lambda.223", "bindings.2338 .test.2339 .cleanup.2340 .body.2341) ((core#lambda (.loop.2342) (c",
"8 (cons .arguments.2331 (append ((core#lambda () (core#begin (core#define .loop.", "ons (.the.2229 (core#quote let)) (cons .loop.2342 (cons (map (core#lambda (.x.23",
"2334 (core#lambda (.formal.2335 .args.2336) (core#if (pair? .formal.2335) (cons ", "43) (cons (car .x.2343) (cons (cadr .x.2343) (core#quote ())))) .bindings.2338) ",
"(cons .the-set!.2241 (cons (car .formal.2335) (cons (cons (.the.2229 (core#quote", "(cons (cons .the-if.2242 (cons .test.2339 (cons (cons .the-begin.2239 .cleanup.2",
" car)) (cons .args.2336 (core#quote ()))) (core#quote ())))) (.loop.2334 (cdr .f", "340) (cons (cons .the-begin.2239 (append .body.2341 (cons (cons .loop.2342 (map ",
"ormal.2335) (cons (.the.2229 (core#quote cdr)) (cons .args.2336 (core#quote ()))", "(core#lambda (.x.2344) (core#if (null? (cdr (cdr .x.2344))) (car .x.2344) (car (",
"))) (core#if (identifier? .formal.2335) (cons (cons .the-set!.2241 (cons .formal", "cdr (cdr .x.2344))))) .bindings.2338)) (core#quote ())))) (core#quote ()))))) (c",
".2335 (cons .args.2336 (core#quote ())))) (core#quote ())) (core#quote ()))))) (", "ore#quote ())))))) (make-identifier (core#quote loop) .env.2337))) (car (cdr .fo",
".loop.2334 .formal.2329 .arguments.2331)))) (core#quote ())))) (core#quote ())))", "rm.2336)) (car (car (cdr (cdr .form.2336)))) (cdr (car (cdr (cdr .form.2336)))) ",
") (core#quote ()))))) (make-identifier (core#quote arguments) .env.2328))) (cadr", "(cdr (cdr (cdr .form.2336)))))) (core#begin (.define-transformer.2228 (core#quot",
" .form.2327) (cddr .form.2327)))) (core#begin (.define-transformer.2228 (core#qu", "e when) (core#lambda (.form.2345 .env.2346) ((core#lambda (.test.2347 .body.2348",
"ote do) (core#lambda (.form.2337 .env.2338) ((core#lambda (.bindings.2339 .test.", ") (cons .the-if.2242 (cons .test.2347 (cons (cons .the-begin.2239 (append .body.",
"2340 .cleanup.2341 .body.2342) ((core#lambda (.loop.2343) (cons (.the.2229 (core", "2348 (core#quote ()))) (cons (core#quote #undefined) (core#quote ())))))) (car (",
"#quote let)) (cons .loop.2343 (cons (map (core#lambda (.x.2344) (cons (car .x.23", "cdr .form.2345)) (cdr (cdr .form.2345))))) (core#begin (.define-transformer.2228",
"44) (cons (cadr .x.2344) (core#quote ())))) .bindings.2339) (cons (cons .the-if.", " (core#quote unless) (core#lambda (.form.2349 .env.2350) ((core#lambda (.test.23",
"2242 (cons .test.2340 (cons (cons .the-begin.2239 .cleanup.2341) (cons (cons .th", "51 .body.2352) (cons .the-if.2242 (cons .test.2351 (cons (core#quote #undefined)",
"e-begin.2239 (append .body.2342 (cons (cons .loop.2343 (map (core#lambda (.x.234", " (cons (cons .the-begin.2239 (append .body.2352 (core#quote ()))) (core#quote ()",
"5) (core#if (null? (cdr (cdr .x.2345))) (car .x.2345) (car (cdr (cdr .x.2345))))", ")))))) (car (cdr .form.2349)) (cdr (cdr .form.2349))))) (core#begin (.define-tra",
") .bindings.2339)) (core#quote ())))) (core#quote ()))))) (core#quote ())))))) (", "nsformer.2228 (core#quote case) (core#lambda (.form.2353 .env.2354) ((core#lambd",
"make-identifier (core#quote loop) .env.2338))) (car (cdr .form.2337)) (car (car ", "a (.key.2355 .clauses.2356) ((core#lambda (.the-key.2357) (cons (.the.2229 (core",
"(cdr (cdr .form.2337)))) (cdr (car (cdr (cdr .form.2337)))) (cdr (cdr (cdr .form", "#quote let)) (cons (cons (cons .the-key.2357 (cons .key.2355 (core#quote ()))) (",
".2337)))))) (core#begin (.define-transformer.2228 (core#quote when) (core#lambda", "core#quote ())) (cons ((core#lambda () (core#begin (core#define .loop.2358 (core",
" (.form.2346 .env.2347) ((core#lambda (.test.2348 .body.2349) (cons .the-if.2242", "#lambda (.clauses.2359) (core#if (null? .clauses.2359) #undefined ((core#lambda ",
" (cons .test.2348 (cons (cons .the-begin.2239 (append .body.2349 (core#quote ())", "(.clause.2360) (cons .the-if.2242 (cons (core#if (core#if (identifier? (car .cla",
")) (cons (core#quote #undefined) (core#quote ())))))) (car (cdr .form.2346)) (cd", "use.2360)) (identifier=? (.the.2229 (core#quote else)) (make-identifier (car .cl",
"r (cdr .form.2346))))) (core#begin (.define-transformer.2228 (core#quote unless)", "ause.2360) .env.2354)) #f) #t (cons (.the.2229 (core#quote or)) (append (map (co",
" (core#lambda (.form.2350 .env.2351) ((core#lambda (.test.2352 .body.2353) (cons", "re#lambda (.x.2361) (cons (.the.2229 (core#quote eqv?)) (cons .the-key.2357 (con",
" .the-if.2242 (cons .test.2352 (cons (core#quote #undefined) (cons (cons .the-be", "s (cons .the-quote.2240 (cons .x.2361 (core#quote ()))) (core#quote ()))))) (car",
"gin.2239 (append .body.2353 (core#quote ()))) (core#quote ())))))) (car (cdr .fo", " .clause.2360)) (core#quote ())))) (cons (core#if (core#if (identifier? (cadr .c",
"rm.2350)) (cdr (cdr .form.2350))))) (core#begin (.define-transformer.2228 (core#", "lause.2360)) (identifier=? (.the.2229 (core#quote =>)) (make-identifier (cadr .c",
"quote case) (core#lambda (.form.2354 .env.2355) ((core#lambda (.key.2356 .clause", "lause.2360) .env.2354)) #f) (cons (car (cdr (cdr .clause.2360))) (cons .the-key.",
"s.2357) ((core#lambda (.the-key.2358) (cons (.the.2229 (core#quote let)) (cons (", "2357 (core#quote ()))) (cons .the-begin.2239 (append (cdr .clause.2360) (core#qu",
"cons (cons .the-key.2358 (cons .key.2356 (core#quote ()))) (core#quote ())) (con", "ote ())))) (cons (.loop.2358 (cdr .clauses.2359)) (core#quote ())))))) (car .cla",
"s ((core#lambda () (core#begin (core#define .loop.2359 (core#lambda (.clauses.23", "uses.2359))))) (.loop.2358 .clauses.2356)))) (core#quote ()))))) (make-identifie",
"60) (core#if (null? .clauses.2360) #undefined ((core#lambda (.clause.2361) (cons", "r (core#quote key) .env.2354))) (car (cdr .form.2353)) (cdr (cdr .form.2353)))))",
" .the-if.2242 (cons (core#if (core#if (identifier? (car .clause.2361)) (identifi", " (.define-transformer.2228 (core#quote parameterize) (core#lambda (.form.2362 .e",
"er=? (.the.2229 (core#quote else)) (make-identifier (car .clause.2361) .env.2355", "nv.2363) ((core#lambda (.formal.2364 .body.2365) (cons (.the.2229 (core#quote wi",
")) #f) #t (cons (.the.2229 (core#quote or)) (append (map (core#lambda (.x.2362) ", "th-dynamic-environment)) (cons (cons (.the.2229 (core#quote list)) (append (map ",
"(cons (.the.2229 (core#quote eqv?)) (cons .the-key.2358 (cons (cons .the-quote.2", "(core#lambda (.x.2366) (cons (.the.2229 (core#quote cons)) (cons (car .x.2366) (",
"240 (cons .x.2362 (core#quote ()))) (core#quote ()))))) (car .clause.2361)) (cor", "cons (cadr .x.2366) (core#quote ()))))) .formal.2364) (core#quote ()))) (cons (c",
"e#quote ())))) (cons (core#if (core#if (identifier? (cadr .clause.2361)) (identi", "ons .the-lambda.2238 (cons (core#quote ()) (append .body.2365 (core#quote ()))))",
"fier=? (.the.2229 (core#quote =>)) (make-identifier (cadr .clause.2361) .env.235", " (core#quote ()))))) (car (cdr .form.2362)) (cdr (cdr .form.2362))))))))))))))))",
"5)) #f) (cons (car (cdr (cdr .clause.2361))) (cons .the-key.2358 (core#quote ())", ")))))))))))))))))) (.the.2229 (core#quote core#define)) (.the.2229 (core#quote c",
")) (cons .the-begin.2239 (append (cdr .clause.2361) (core#quote ())))) (cons (.l", "ore#lambda)) (.the.2229 (core#quote core#begin)) (.the.2229 (core#quote core#quo",
"oop.2359 (cdr .clauses.2360)) (core#quote ())))))) (car .clauses.2360))))) (.loo", "te)) (.the.2229 (core#quote core#set!)) (.the.2229 (core#quote core#if)) (.the.2",
"p.2359 .clauses.2357)))) (core#quote ()))))) (make-identifier (core#quote key) .", "229 (core#quote core#define-macro)) (.the.2229 (core#quote define)) (.the.2229 (",
"env.2355))) (car (cdr .form.2354)) (cdr (cdr .form.2354))))) (.define-transforme", "core#quote lambda)) (.the.2229 (core#quote begin)) (.the.2229 (core#quote quote)",
"r.2228 (core#quote parameterize) (core#lambda (.form.2363 .env.2364) ((core#lamb", ") (.the.2229 (core#quote set!)) (.the.2229 (core#quote if)) (.the.2229 (core#quo",
"da (.formal.2365 .body.2366) (cons (.the.2229 (core#quote with-dynamic-environme", "te define-macro)))) (core#lambda (.name.2367 .transformer.2368) (dictionary-set!",
"nt)) (cons (cons (.the.2229 (core#quote list)) (append (map (core#lambda (.x.236", " (macro-objects) .name.2367 .transformer.2368)) (core#lambda (.var.2369) (make-i",
"7) (cons (.the.2229 (core#quote cons)) (cons (car .x.2367) (cons (cadr .x.2367) ", "dentifier .var.2369 default-environment)))",
"(core#quote ()))))) .formal.2365) (core#quote ()))) (cons (cons .the-lambda.2238",
" (cons (core#quote ()) (append .body.2366 (core#quote ())))) (core#quote ())))))",
" (car (cdr .form.2363)) (cdr (cdr .form.2363))))))))))))))))))))))))))))))))))))",
")))))))))))))))",
}; };
#if PIC_USE_LIBRARY #if PIC_USE_LIBRARY
static const char boot_library_rom[][80] = { static const char boot_library_rom[][80] = {
"(core#begin (core#define mangle (core#lambda (.name.2368) (core#begin (core#if (", "(core#begin (core#define current-library #undefined) (core#begin (core#define fi",
"null? .name.2368) (error \"library name should be a list of at least one symbols\"", "nd-library #undefined) (core#begin (core#define make-library #undefined) (core#b",
" .name.2368) #undefined) (core#begin (core#define .->string.2369 (core#lambda (.", "egin (core#define library-environment #undefined) (core#begin (core#define libra",
"n.2371) (core#if (symbol? .n.2371) ((core#lambda (.str.2372) (core#begin (string", "ry-exports #undefined) (core#begin (core#define library-import #undefined) (core",
"-for-each (core#lambda (.c.2373) (core#if ((core#lambda (.it.2374) (core#if .it.", "#begin (core#define library-export #undefined) (call-with-values (core#lambda ()",
"2374 .it.2374 ((core#lambda (.it.2375) (core#if .it.2375 .it.2375 #f)) (char=? .", " ((core#lambda () (core#begin (core#define .mangle.2370 (core#lambda (.name.2379",
"c.2373 #\\:)))) (char=? .c.2373 #\\.)) (error \"elements of library name may not co", ") (core#begin (core#if (null? .name.2379) (error \"library name should be a list ",
"ntain '.' or ':'\" .n.2371) #undefined)) .str.2372) .str.2372)) (symbol->string .", "of at least one symbols\" .name.2379) #undefined) (core#begin (core#define .->str",
"n.2371)) (core#if (core#if (number? .n.2371) (core#if (exact? .n.2371) (<= 0 .n.", "ing.2380 (core#lambda (.n.2382) (core#if (symbol? .n.2382) ((core#lambda (.str.2",
"2371) #f) #f) (number->string .n.2371) (error \"symbol or non-negative integer is", "383) (core#begin (string-for-each (core#lambda (.c.2384) (core#if ((core#lambda ",
" required\" .n.2371))))) (core#begin (core#define .join.2370 (core#lambda (.strs.", "(.it.2385) (core#if .it.2385 .it.2385 ((core#lambda (.it.2386) (core#if .it.2386",
"2376 .delim.2377) ((core#lambda () (core#begin (core#define .loop.2378 (core#lam", " .it.2386 #f)) (char=? .c.2384 #\\:)))) (char=? .c.2384 #\\.)) (error \"elements of",
"bda (.res.2379 .strs.2380) (core#if (null? .strs.2380) .res.2379 (.loop.2378 (st", " library name may not contain '.' or ':'\" .n.2382) #undefined)) .str.2383) .str.",
"ring-append .res.2379 .delim.2377 (car .strs.2380)) (cdr .strs.2380))))) (.loop.", "2383)) (symbol->string .n.2382)) (core#if (core#if (number? .n.2382) (core#if (e",
"2378 (car .strs.2376) (cdr .strs.2376))))))) (core#if (symbol? .name.2368) .name", "xact? .n.2382) (<= 0 .n.2382) #f) #f) (number->string .n.2382) (error \"symbol or",
".2368 (string->symbol (.join.2370 (map .->string.2369 .name.2368) \".\")))))))) (c", " non-negative integer is required\" .n.2382))))) (core#begin (core#define .join.2",
"ore#begin (core#define current-library (make-parameter (core#quote (picrin user)", "381 (core#lambda (.strs.2387 .delim.2388) ((core#lambda () (core#begin (core#def",
") mangle)) (core#begin (core#define *libraries* (make-dictionary)) (core#begin (", "ine .loop.2389 (core#lambda (.res.2390 .strs.2391) (core#if (null? .strs.2391) .",
"core#define find-library (core#lambda (.name.2381) (dictionary-has? *libraries* ", "res.2390 (.loop.2389 (string-append .res.2390 .delim.2388 (car .strs.2391)) (cdr",
"(mangle .name.2381)))) (core#begin (core#define make-library (core#lambda (.name", " .strs.2391))))) (.loop.2389 (car .strs.2387) (cdr .strs.2387))))))) (core#if (s",
".2382) ((core#lambda (.name.2383) ((core#lambda (.env.2384 .exports.2385) (core#", "ymbol? .name.2379) .name.2379 (string->symbol (.join.2381 (map .->string.2380 .n",
"begin (set-identifier! (core#quote define-library) (core#quote define-library) .", "ame.2379) \".\")))))))) (core#begin (core#define .current-library.2371 (make-param",
"env.2384) (core#begin (set-identifier! (core#quote import) (core#quote import) .", "eter (core#quote (picrin user)) .mangle.2370)) (core#begin (core#define .*librar",
"env.2384) (core#begin (set-identifier! (core#quote export) (core#quote export) .", "ies*.2372 (make-dictionary)) (core#begin (core#define .find-library.2373 (core#l",
"env.2384) (core#begin (set-identifier! (core#quote cond-expand) (core#quote cond", "ambda (.name.2392) (dictionary-has? .*libraries*.2372 (.mangle.2370 .name.2392))",
"-expand) .env.2384) (dictionary-set! *libraries* .name.2383 (cons .env.2384 .exp", ")) (core#begin (core#define .make-library.2374 (core#lambda (.name.2393) ((core#",
"orts.2385))))))) (make-environment (string->symbol (string-append (symbol->strin", "lambda (.name.2394) ((core#lambda (.env.2395 .exports.2396) (core#begin (set-ide",
"g .name.2383) \":\"))) (make-dictionary))) (mangle .name.2382)))) (core#begin (cor", "ntifier! (core#quote define-library) (core#quote define-library) .env.2395) (cor",
"e#define library-environment (core#lambda (.name.2386) (car (dictionary-ref *lib", "e#begin (set-identifier! (core#quote import) (core#quote import) .env.2395) (cor",
"raries* (mangle .name.2386))))) (core#begin (core#define library-exports (core#l", "e#begin (set-identifier! (core#quote export) (core#quote export) .env.2395) (cor",
"ambda (.name.2387) (cdr (dictionary-ref *libraries* (mangle .name.2387))))) (cor", "e#begin (set-identifier! (core#quote cond-expand) (core#quote cond-expand) .env.",
"e#begin (core#define library-import (core#lambda (.name.2388 .sym.2389 .alias.23", "2395) (dictionary-set! .*libraries*.2372 .name.2394 (cons .env.2395 .exports.239",
"90) ((core#lambda (.uid.2391) ((core#lambda (.env.2392) (set-identifier! .alias.", "6))))))) (make-environment (string->symbol (string-append (symbol->string .name.",
"2390 .uid.2391 .env.2392)) (library-environment (current-library)))) (dictionary", "2394) \":\"))) (make-dictionary))) (.mangle.2370 .name.2393)))) (core#begin (core#",
"-ref (library-exports .name.2388) .sym.2389)))) (core#begin (core#define library", "define .library-environment.2375 (core#lambda (.name.2397) (car (dictionary-ref ",
"-export (core#lambda (.sym.2393 .alias.2394) ((core#lambda (.env.2395 .exports.2", ".*libraries*.2372 (.mangle.2370 .name.2397))))) (core#begin (core#define .librar",
"396) (dictionary-set! .exports.2396 .alias.2394 (find-identifier .sym.2393 .env.", "y-exports.2376 (core#lambda (.name.2398) (cdr (dictionary-ref .*libraries*.2372 ",
"2395))) (library-environment (current-library)) (library-exports (current-librar", "(.mangle.2370 .name.2398))))) (core#begin (core#define .library-import.2377 (cor",
"y))))) (core#begin ((core#lambda (.define-transformer.2397) (core#begin (.define", "e#lambda (.name.2399 .sym.2400 .alias.2401) ((core#lambda (.uid.2402) ((core#lam",
"-transformer.2397 (core#quote define-library) (core#lambda (.form.2398 ._.2399) ", "bda (.env.2403) (set-identifier! .alias.2401 .uid.2402 .env.2403)) (.library-env",
"((core#lambda (.name.2400 .body.2401) (core#begin ((core#lambda (.it.2402) (core", "ironment.2375 (.current-library.2371)))) (dictionary-ref (.library-exports.2376 ",
"#if .it.2402 .it.2402 ((core#lambda (.it.2403) (core#if .it.2403 .it.2403 #f)) (", ".name.2399) .sym.2400)))) (core#begin (core#define .library-export.2378 (core#la",
"make-library .name.2400)))) (find-library .name.2400)) (with-dynamic-environment", "mbda (.sym.2404 .alias.2405) ((core#lambda (.env.2406 .exports.2407) (dictionary",
" (list (cons current-library .name.2400)) (core#lambda () (for-each (core#lambda", "-set! .exports.2407 .alias.2405 (find-identifier .sym.2404 .env.2406))) (.librar",
" (.expr.2404) (eval .expr.2404 .name.2400)) .body.2401))))) (cadr .form.2398) (c", "y-environment.2375 (.current-library.2371)) (.library-exports.2376 (.current-lib",
"ddr .form.2398)))) (core#begin (.define-transformer.2397 (core#quote cond-expand", "rary.2371))))) (core#begin ((core#lambda (.define-transformer.2408) (core#begin ",
") (core#lambda (.form.2405 ._.2406) ((core#lambda (.test.2407) (core#begin (core", "(.define-transformer.2408 (core#quote define-library) (core#lambda (.form.2409 .",
"#set! .test.2407 (core#lambda (.form.2408) ((core#lambda (.it.2409) (core#if .it", "_.2410) ((core#lambda (.name.2411 .body.2412) (core#begin ((core#lambda (.it.241",
".2409 .it.2409 ((core#lambda (.it.2410) (core#if .it.2410 .it.2410 ((core#lambda", "3) (core#if .it.2413 .it.2413 ((core#lambda (.it.2414) (core#if .it.2414 .it.241",
" (.it.2411) (core#if .it.2411 .it.2411 #f)) (core#if (pair? .form.2408) ((core#l", "4 #f)) (.make-library.2374 .name.2411)))) (.find-library.2373 .name.2411)) (with",
"ambda (.key.2412) (core#if ((core#lambda (.it.2413) (core#if .it.2413 .it.2413 #", "-dynamic-environment (list (cons .current-library.2371 .name.2411)) (core#lambda",
"f)) (eqv? .key.2412 (core#quote library))) (find-library (cadr .form.2408)) (cor", " () (for-each (core#lambda (.expr.2415) (eval .expr.2415 .name.2411)) .body.2412",
"e#if ((core#lambda (.it.2414) (core#if .it.2414 .it.2414 #f)) (eqv? .key.2412 (c", "))))) (cadr .form.2409) (cddr .form.2409)))) (core#begin (.define-transformer.24",
"ore#quote not))) (not (.test.2407 (cadr .form.2408))) (core#if ((core#lambda (.i", "08 (core#quote cond-expand) (core#lambda (.form.2416 ._.2417) ((core#lambda (.te",
"t.2415) (core#if .it.2415 .it.2415 #f)) (eqv? .key.2412 (core#quote and))) ((cor", "st.2418) (core#begin (core#set! .test.2418 (core#lambda (.form.2419) ((core#lamb",
"e#lambda () (core#begin (core#define .loop.2416 (core#lambda (.form.2417) ((core", "da (.it.2420) (core#if .it.2420 .it.2420 ((core#lambda (.it.2421) (core#if .it.2",
"#lambda (.it.2418) (core#if .it.2418 .it.2418 ((core#lambda (.it.2419) (core#if ", "421 .it.2421 ((core#lambda (.it.2422) (core#if .it.2422 .it.2422 #f)) (core#if (",
".it.2419 .it.2419 #f)) (core#if (.test.2407 (car .form.2417)) (.loop.2416 (cdr .", "pair? .form.2419) ((core#lambda (.key.2423) (core#if ((core#lambda (.it.2424) (c",
"form.2417)) #f)))) (null? .form.2417)))) (.loop.2416 (cdr .form.2408))))) (core#", "ore#if .it.2424 .it.2424 #f)) (eqv? .key.2423 (core#quote library))) (.find-libr",
"if ((core#lambda (.it.2420) (core#if .it.2420 .it.2420 #f)) (eqv? .key.2412 (cor", "ary.2373 (cadr .form.2419)) (core#if ((core#lambda (.it.2425) (core#if .it.2425 ",
"e#quote or))) ((core#lambda () (core#begin (core#define .loop.2421 (core#lambda ", ".it.2425 #f)) (eqv? .key.2423 (core#quote not))) (not (.test.2418 (cadr .form.24",
"(.form.2422) (core#if (pair? .form.2422) ((core#lambda (.it.2423) (core#if .it.2", "19))) (core#if ((core#lambda (.it.2426) (core#if .it.2426 .it.2426 #f)) (eqv? .k",
"423 .it.2423 ((core#lambda (.it.2424) (core#if .it.2424 .it.2424 #f)) (.loop.242", "ey.2423 (core#quote and))) ((core#lambda () (core#begin (core#define .loop.2427 ",
"1 (cdr .form.2422))))) (.test.2407 (car .form.2422))) #f))) (.loop.2421 (cdr .fo", "(core#lambda (.form.2428) ((core#lambda (.it.2429) (core#if .it.2429 .it.2429 ((",
"rm.2408))))) (core#if #t #f #undefined)))))) (car .form.2408)) #f)))) (core#if (", "core#lambda (.it.2430) (core#if .it.2430 .it.2430 #f)) (core#if (.test.2418 (car",
"symbol? .form.2408) (memq .form.2408 (features)) #f)))) (eq? .form.2408 (core#qu", " .form.2428)) (.loop.2427 (cdr .form.2428)) #f)))) (null? .form.2428)))) (.loop.",
"ote else))))) ((core#lambda () (core#begin (core#define .loop.2425 (core#lambda ", "2427 (cdr .form.2419))))) (core#if ((core#lambda (.it.2431) (core#if .it.2431 .i",
"(.clauses.2426) (core#if (null? .clauses.2426) #undefined (core#if (.test.2407 (", "t.2431 #f)) (eqv? .key.2423 (core#quote or))) ((core#lambda () (core#begin (core",
"caar .clauses.2426)) (cons (make-identifier (core#quote begin) default-environme", "#define .loop.2432 (core#lambda (.form.2433) (core#if (pair? .form.2433) ((core#",
"nt) (append (cdar .clauses.2426) (core#quote ()))) (.loop.2425 (cdr .clauses.242", "lambda (.it.2434) (core#if .it.2434 .it.2434 ((core#lambda (.it.2435) (core#if .",
"6)))))) (.loop.2425 (cdr .form.2405))))))) #undefined))) (core#begin (.define-tr", "it.2435 .it.2435 #f)) (.loop.2432 (cdr .form.2433))))) (.test.2418 (car .form.24",
"ansformer.2397 (core#quote import) (core#lambda (.form.2427 ._.2428) ((core#lamb", "33))) #f))) (.loop.2432 (cdr .form.2419))))) (core#if #t #f #undefined)))))) (ca",
"da (.caddr.2429 .prefix.2430 .getlib.2431) ((core#lambda (.extract.2432 .collect", "r .form.2419)) #f)))) (core#if (symbol? .form.2419) (memq .form.2419 (features))",
".2433) (core#begin (core#set! .extract.2432 (core#lambda (.spec.2434) ((core#lam", " #f)))) (eq? .form.2419 (core#quote else))))) ((core#lambda () (core#begin (core",
"bda (.key.2435) (core#if ((core#lambda (.it.2436) (core#if .it.2436 .it.2436 ((c", "#define .loop.2436 (core#lambda (.clauses.2437) (core#if (null? .clauses.2437) #",
"ore#lambda (.it.2437) (core#if .it.2437 .it.2437 ((core#lambda (.it.2438) (core#", "undefined (core#if (.test.2418 (caar .clauses.2437)) (cons (make-identifier (cor",
"if .it.2438 .it.2438 ((core#lambda (.it.2439) (core#if .it.2439 .it.2439 #f)) (e", "e#quote begin) default-environment) (append (cdar .clauses.2437) (core#quote ())",
"qv? .key.2435 (core#quote except))))) (eqv? .key.2435 (core#quote prefix))))) (e", ")) (.loop.2436 (cdr .clauses.2437)))))) (.loop.2436 (cdr .form.2416))))))) #unde",
"qv? .key.2435 (core#quote rename))))) (eqv? .key.2435 (core#quote only))) (.extr", "fined))) (core#begin (.define-transformer.2408 (core#quote import) (core#lambda ",
"act.2432 (cadr .spec.2434)) (core#if #t (.getlib.2431 .spec.2434) #undefined))) ", "(.form.2438 ._.2439) ((core#lambda (.caddr.2440 .prefix.2441 .getlib.2442) ((cor",
"(car .spec.2434)))) (core#begin (core#set! .collect.2433 (core#lambda (.spec.244", "e#lambda (.extract.2443 .collect.2444) (core#begin (core#set! .extract.2443 (cor",
"0) ((core#lambda (.key.2441) (core#if ((core#lambda (.it.2442) (core#if .it.2442", "e#lambda (.spec.2445) ((core#lambda (.key.2446) (core#if ((core#lambda (.it.2447",
" .it.2442 #f)) (eqv? .key.2441 (core#quote only))) ((core#lambda (.alist.2443) (", ") (core#if .it.2447 .it.2447 ((core#lambda (.it.2448) (core#if .it.2448 .it.2448",
"map (core#lambda (.var.2444) (assq .var.2444 .alist.2443)) (cddr .spec.2440))) (", " ((core#lambda (.it.2449) (core#if .it.2449 .it.2449 ((core#lambda (.it.2450) (c",
".collect.2433 (cadr .spec.2440))) (core#if ((core#lambda (.it.2445) (core#if .it", "ore#if .it.2450 .it.2450 #f)) (eqv? .key.2446 (core#quote except))))) (eqv? .key",
".2445 .it.2445 #f)) (eqv? .key.2441 (core#quote rename))) ((core#lambda (.alist.", ".2446 (core#quote prefix))))) (eqv? .key.2446 (core#quote rename))))) (eqv? .key",
"2446 .renames.2447) (map (core#lambda (.s.2448) ((core#lambda (.it.2449) (core#i", ".2446 (core#quote only))) (.extract.2443 (cadr .spec.2445)) (core#if #t (.getlib",
"f .it.2449 .it.2449 ((core#lambda (.it.2450) (core#if .it.2450 .it.2450 #f)) .s.", ".2442 .spec.2445) #undefined))) (car .spec.2445)))) (core#begin (core#set! .coll",
"2448))) (assq (car .s.2448) .renames.2447))) .alist.2446)) (.collect.2433 (cadr ", "ect.2444 (core#lambda (.spec.2451) ((core#lambda (.key.2452) (core#if ((core#lam",
".spec.2440)) (map (core#lambda (.x.2451) (cons (car .x.2451) (cadr .x.2451))) (c", "bda (.it.2453) (core#if .it.2453 .it.2453 #f)) (eqv? .key.2452 (core#quote only)",
"ddr .spec.2440))) (core#if ((core#lambda (.it.2452) (core#if .it.2452 .it.2452 #", ")) ((core#lambda (.alist.2454) (map (core#lambda (.var.2455) (assq .var.2455 .al",
"f)) (eqv? .key.2441 (core#quote prefix))) ((core#lambda (.alist.2453) (map (core", "ist.2454)) (cddr .spec.2451))) (.collect.2444 (cadr .spec.2451))) (core#if ((cor",
"#lambda (.s.2454) (cons (.prefix.2430 (.caddr.2429 .spec.2440) (car .s.2454)) (c", "e#lambda (.it.2456) (core#if .it.2456 .it.2456 #f)) (eqv? .key.2452 (core#quote ",
"dr .s.2454))) .alist.2453)) (.collect.2433 (cadr .spec.2440))) (core#if ((core#l", "rename))) ((core#lambda (.alist.2457 .renames.2458) (map (core#lambda (.s.2459) ",
"ambda (.it.2455) (core#if .it.2455 .it.2455 #f)) (eqv? .key.2441 (core#quote exc", "((core#lambda (.it.2460) (core#if .it.2460 .it.2460 ((core#lambda (.it.2461) (co",
"ept))) ((core#lambda (.alist.2456) ((core#lambda () (core#begin (core#define .lo", "re#if .it.2461 .it.2461 #f)) .s.2459))) (assq (car .s.2459) .renames.2458))) .al",
"op.2457 (core#lambda (.alist.2458) (core#if (null? .alist.2458) (core#quote ()) ", "ist.2457)) (.collect.2444 (cadr .spec.2451)) (map (core#lambda (.x.2462) (cons (",
"(core#if (memq (caar .alist.2458) (cddr .spec.2440)) (.loop.2457 (cdr .alist.245", "car .x.2462) (cadr .x.2462))) (cddr .spec.2451))) (core#if ((core#lambda (.it.24",
"8)) (cons (car .alist.2458) (.loop.2457 (cdr .alist.2458))))))) (.loop.2457 .ali", "63) (core#if .it.2463 .it.2463 #f)) (eqv? .key.2452 (core#quote prefix))) ((core",
"st.2456))))) (.collect.2433 (cadr .spec.2440))) (core#if #t (dictionary-map (cor", "#lambda (.alist.2464) (map (core#lambda (.s.2465) (cons (.prefix.2441 (.caddr.24",
"e#lambda (.x.2459) (cons .x.2459 .x.2459)) (library-exports (.getlib.2431 .spec.", "40 .spec.2451) (car .s.2465)) (cdr .s.2465))) .alist.2464)) (.collect.2444 (cadr",
"2440))) #undefined)))))) (car .spec.2440)))) ((core#lambda (.import.2460) (core#", " .spec.2451))) (core#if ((core#lambda (.it.2466) (core#if .it.2466 .it.2466 #f))",
"begin (core#set! .import.2460 (core#lambda (.spec.2461) ((core#lambda (.lib.2462", " (eqv? .key.2452 (core#quote except))) ((core#lambda (.alist.2467) ((core#lambda",
" .alist.2463) (for-each (core#lambda (.slot.2464) (library-import .lib.2462 (cdr", " () (core#begin (core#define .loop.2468 (core#lambda (.alist.2469) (core#if (nul",
" .slot.2464) (car .slot.2464))) .alist.2463)) (.extract.2432 .spec.2461) (.colle", "l? .alist.2469) (core#quote ()) (core#if (memq (caar .alist.2469) (cddr .spec.24",
"ct.2433 .spec.2461)))) (for-each .import.2460 (cdr .form.2427)))) #undefined))))", "51)) (.loop.2468 (cdr .alist.2469)) (cons (car .alist.2469) (.loop.2468 (cdr .al",
" #undefined #undefined)) (core#lambda (.x.2465) (car (cdr (cdr .x.2465)))) (core", "ist.2469))))))) (.loop.2468 .alist.2467))))) (.collect.2444 (cadr .spec.2451))) ",
"#lambda (.prefix.2466 .symbol.2467) (string->symbol (string-append (symbol->stri", "(core#if #t (dictionary-map (core#lambda (.x.2470) (cons .x.2470 .x.2470)) (.lib",
"ng .prefix.2466) (symbol->string .symbol.2467)))) (core#lambda (.name.2468) (cor", "rary-exports.2376 (.getlib.2442 .spec.2451))) #undefined)))))) (car .spec.2451))",
"e#if (find-library .name.2468) .name.2468 (error \"library not found\" .name.2468)", ")) ((core#lambda (.import.2471) (core#begin (core#set! .import.2471 (core#lambda",
"))))) (.define-transformer.2397 (core#quote export) (core#lambda (.form.2469 ._.", " (.spec.2472) ((core#lambda (.lib.2473 .alist.2474) (for-each (core#lambda (.slo",
"2470) ((core#lambda (.collect.2471 .export.2472) (core#begin (core#set! .collect", "t.2475) (.library-import.2377 .lib.2473 (cdr .slot.2475) (car .slot.2475))) .ali",
".2471 (core#lambda (.spec.2473) (core#if (symbol? .spec.2473) (cons .spec.2473 .", "st.2474)) (.extract.2443 .spec.2472) (.collect.2444 .spec.2472)))) (for-each .im",
"spec.2473) (core#if (core#if (list? .spec.2473) (core#if (= (length .spec.2473) ", "port.2471 (cdr .form.2438)))) #undefined)))) #undefined #undefined)) (core#lambd",
"3) (eq? (car .spec.2473) (core#quote rename)) #f) #f) (cons (list-ref .spec.2473", "a (.x.2476) (car (cdr (cdr .x.2476)))) (core#lambda (.prefix.2477 .symbol.2478) ",
" 1) (list-ref .spec.2473 2)) (error \"malformed export\"))))) (core#begin (core#se", "(string->symbol (string-append (symbol->string .prefix.2477) (symbol->string .sy",
"t! .export.2472 (core#lambda (.spec.2474) ((core#lambda (.slot.2475) (library-ex", "mbol.2478)))) (core#lambda (.name.2479) (core#if (.find-library.2373 .name.2479)",
"port (car .slot.2475) (cdr .slot.2475))) (.collect.2471 .spec.2474)))) (for-each", " .name.2479 (error \"library not found\" .name.2479)))))) (.define-transformer.240",
" .export.2472 (cdr .form.2469))))) #undefined #undefined))))))) (core#lambda (.n", "8 (core#quote export) (core#lambda (.form.2480 ._.2481) ((core#lambda (.collect.",
"ame.2476 .macro.2477) (add-macro! .name.2476 .macro.2477))) ((core#lambda () (co", "2482 .export.2483) (core#begin (core#set! .collect.2482 (core#lambda (.spec.2484",
"re#begin (make-library (core#quote (picrin base))) (core#begin (set-car! (dictio", ") (core#if (symbol? .spec.2484) (cons .spec.2484 .spec.2484) (core#if (core#if (",
"nary-ref *libraries* (mangle (core#quote (picrin base)))) default-environment) (", "list? .spec.2484) (core#if (= (length .spec.2484) 3) (eq? (car .spec.2484) (core",
"core#begin ((core#lambda (.export-keywords.2478) (core#begin (.export-keywords.2", "#quote rename)) #f) #f) (cons (list-ref .spec.2484 1) (list-ref .spec.2484 2)) (",
"478 (core#quote (define lambda quote set! if begin define-macro let let* letrec ", "error \"malformed export\"))))) (core#begin (core#set! .export.2483 (core#lambda (",
"letrec* let-values let*-values define-values quasiquote unquote unquote-splicing", ".spec.2485) ((core#lambda (.slot.2486) (.library-export.2378 (car .slot.2486) (c",
" and or cond case else => do when unless parameterize))) (core#begin (.export-ke", "dr .slot.2486))) (.collect.2482 .spec.2485)))) (for-each .export.2483 (cdr .form",
"ywords.2478 (core#quote (features eq? eqv? equal? not boolean? boolean=? pair? c", ".2480))))) #undefined #undefined))))))) (core#lambda (.name.2487 .macro.2488) (d",
"ons car cdr null? set-car! set-cdr! caar cadr cdar cddr list? make-list list len", "ictionary-set! (macro-objects) .name.2487 .macro.2488))) (core#begin ((core#lamb",
"gth append reverse list-tail list-ref list-set! list-copy map for-each memq memv", "da () (core#begin (.make-library.2374 (core#quote (picrin base))) (core#begin (s",
" member assq assv assoc current-input-port current-output-port current-error-por", "et-car! (dictionary-ref .*libraries*.2372 (.mangle.2370 (core#quote (picrin base",
"t port? input-port? output-port? port-open? close-port eof-object? eof-object re", ")))) default-environment) (core#begin ((core#lambda (.exports.2489) ((core#lambd",
"ad-u8 peek-u8 read-bytevector! write-u8 write-bytevector flush-output-port open-", "a (.export-keyword.2490) ((core#lambda () (core#begin (for-each .export-keyword.",
"input-bytevector open-output-bytevector get-output-bytevector number? exact? ine", "2490 (core#quote (define lambda quote set! if begin define-macro let let* letrec",
"xact? inexact exact = < > <= >= + - * / number->string string->number procedure?", " letrec* let-values let*-values define-values quasiquote unquote unquote-splicin",
" apply symbol? symbol=? symbol->string string->symbol make-identifier identifier", "g and or cond case else => do when unless parameterize))) (core#begin (.export-k",
"? identifier=? identifier-base identifier-environment vector? vector make-vector", "eyword.2490 (core#quote boolean?)) (dictionary-for-each .export-keyword.2490 (gl",
" vector-length vector-ref vector-set! vector-copy! vector-copy vector-append vec", "obal-objects))))))) (core#lambda (.keyword.2491) (dictionary-set! .exports.2489 ",
"tor-fill! vector-map vector-for-each list->vector vector->list string->vector ve", ".keyword.2491 .keyword.2491)))) (.library-exports.2376 (core#quote (picrin base)",
"ctor->string bytevector? bytevector make-bytevector bytevector-length bytevector", "))) (core#begin (core#set! eval ((core#lambda (.e.2492) (core#lambda (.expr.2493",
"-u8-ref bytevector-u8-set! bytevector-copy! bytevector-copy bytevector-append by", " . .lib.2494) ((core#lambda (.lib.2495) (.e.2492 .expr.2493 (.library-environmen",
"tevector->list list->bytevector call-with-current-continuation call/cc values ca", "t.2375 .lib.2495))) (core#if (null? .lib.2494) (.current-library.2371) (car .lib",
"ll-with-values char? char->integer integer->char char=? char<? char>? char<=? ch", ".2494))))) eval)) (.make-library.2374 (core#quote (picrin user))))))))) (values ",
"ar>=? current-exception-handlers with-exception-handler raise raise-continuable ", ".current-library.2371 .find-library.2373 .make-library.2374 .library-environment",
"error error-object? error-object-message error-object-irritants error-object-typ", ".2375 .library-exports.2376 .library-import.2377 .library-export.2378)))))))))))",
"e string? string make-string string-length string-ref string-set! string-copy st", ")))) (core#lambda (.current-library.2496 .find-library.2497 .make-library.2498 .",
"ring-copy! string-fill! string-append string-map string-for-each list->string st", "library-environment.2499 .library-exports.2500 .library-import.2501 .library-exp",
"ring->list string=? string<? string>? string<=? string>=? make-parameter with-dy", "ort.2502) (core#begin (core#set! current-library .current-library.2496) (core#be",
"namic-environment read make-dictionary dictionary? dictionary dictionary-has? di", "gin (core#set! find-library .find-library.2497) (core#begin (core#set! make-libr",
"ctionary-ref dictionary-set! dictionary-delete! dictionary-size dictionary-map d", "ary .make-library.2498) (core#begin (core#set! library-environment .library-envi",
"ictionary-for-each dictionary->alist alist->dictionary dictionary->plist plist->", "ronment.2499) (core#begin (core#set! library-exports .library-exports.2500) (cor",
"dictionary make-record record? record-type record-datum default-environment make", "e#begin (core#set! library-import .library-import.2501) (core#set! library-expor",
"-environment find-identifier set-identifier! eval compile add-macro! make-epheme", "t .library-export.2502))))))))))))))))",
"ron-table write write-simple write-shared display))) (.export-keywords.2478 (cor",
"e#quote (find-library make-library current-library)))))) (core#lambda (.keywords",
".2479) ((core#lambda (.env.2480 .exports.2481) (for-each (core#lambda (.keyword.",
"2482) (dictionary-set! .exports.2481 .keyword.2482 .keyword.2482)) .keywords.247",
"9)) (library-environment (core#quote (picrin base))) (library-exports (core#quot",
"e (picrin base)))))) (core#begin (core#set! eval ((core#lambda (.e.2483) (core#l",
"ambda (.expr.2484 . .lib.2485) ((core#lambda (.lib.2486) (.e.2483 .expr.2484 (li",
"brary-environment .lib.2486))) (core#if (null? .lib.2485) (current-library) (car",
" .lib.2485))))) eval)) (core#begin (make-library (core#quote (picrin user))) (cu",
"rrent-library (core#quote (picrin user))))))))))))))))))))",
}; };
#endif #endif

14
lib/ext/compile.c
View File

@ -393,17 +393,11 @@ pic_compile_find_identifier(pic_state *pic)
} }
static pic_value static pic_value
pic_compile_add_macro(pic_state *pic) pic_compile_macro_objects(pic_state *pic)
{ {
pic_value id, mac, uid; pic_get_args(pic, "");
pic_get_args(pic, "ol", &id, &mac); return pic->macros;
TYPE_CHECK(pic, id, id);
uid = pic_find_identifier(pic, id, default_env(pic));
define_macro(pic, uid, mac);
return pic_undef_value(pic);
} }
static pic_value static pic_value
@ -451,7 +445,7 @@ pic_init_compile(pic_state *pic)
pic_defun(pic, "make-environment", pic_compile_make_environment); pic_defun(pic, "make-environment", pic_compile_make_environment);
pic_defun(pic, "find-identifier", pic_compile_find_identifier); pic_defun(pic, "find-identifier", pic_compile_find_identifier);
pic_defun(pic, "set-identifier!", pic_compile_set_identifier); pic_defun(pic, "set-identifier!", pic_compile_set_identifier);
pic_defun(pic, "add-macro!", pic_compile_add_macro); pic_defun(pic, "macro-objects", pic_compile_macro_objects);
pic_defun(pic, "compile", pic_compile_compile); pic_defun(pic, "compile", pic_compile_compile);
pic_defun(pic, "eval", pic_compile_eval); pic_defun(pic, "eval", pic_compile_eval);
} }

10
lib/state.c
View File

@ -81,6 +81,14 @@ pic_add_feature(pic_state *pic, const char *feature)
pic_push(pic, pic_intern_cstr(pic, feature), pic->features); pic_push(pic, pic_intern_cstr(pic, feature), pic->features);
} }
static pic_value
pic_global_objects(pic_state *pic)
{
pic_get_args(pic, "");
return pic->globals;
}
void pic_init_bool(pic_state *); void pic_init_bool(pic_state *);
void pic_init_pair(pic_state *); void pic_init_pair(pic_state *);
void pic_init_port(pic_state *); void pic_init_port(pic_state *);
@ -110,6 +118,8 @@ pic_init_core(pic_state *pic)
{ {
size_t ai = pic_enter(pic); size_t ai = pic_enter(pic);
pic_defun(pic, "global-objects", pic_global_objects);
pic_init_features(pic); DONE; pic_init_features(pic); DONE;
pic_init_bool(pic); DONE; pic_init_bool(pic); DONE;
pic_init_pair(pic); DONE; pic_init_pair(pic); DONE;

599
piclib/boot.scm
View File

@ -1,330 +1,333 @@
(let () (let ((define-transformer
(define (define-transformer name transformer) (lambda (name transformer)
(add-macro! name transformer)) (dictionary-set! (macro-objects) name transformer)))
(the ; synonym for #'var
(lambda (var)
(make-identifier var default-environment))))
;; cache popular identifiers
(let ((the-core-define (the 'core#define))
(the-core-lambda (the 'core#lambda))
(the-core-begin (the 'core#begin))
(the-core-quote (the 'core#quote))
(the-core-set! (the 'core#set!))
(the-core-if (the 'core#if))
(the-core-define-macro (the 'core#define-macro))
(the-define (the 'define))
(the-lambda (the 'lambda))
(the-begin (the 'begin))
(the-quote (the 'quote))
(the-set! (the 'set!))
(the-if (the 'if))
(the-define-macro (the 'define-macro)))
(define (the var) ; synonym for #'var (define-transformer 'quote
(make-identifier var default-environment)) (lambda (form env)
(if (= (length form) 2)
`(,the-core-quote ,(cadr form))
(error "malformed quote" form))))
(define the-core-define (the 'core#define)) (define-transformer 'if
(define the-core-lambda (the 'core#lambda)) (lambda (form env)
(define the-core-begin (the 'core#begin)) (let ((len (length form)))
(define the-core-quote (the 'core#quote)) (cond
(define the-core-set! (the 'core#set!)) ((= len 3) `(,@form #undefined))
(define the-core-if (the 'core#if)) ((= len 4) `(,the-core-if . ,(cdr form)))
(define the-core-define-macro (the 'core#define-macro)) (else (error "malformed if" form))))))
(define the-define (the 'define)) (define-transformer 'begin
(define the-lambda (the 'lambda)) (lambda (form env)
(define the-begin (the 'begin)) (let ((len (length form)))
(define the-quote (the 'quote)) (cond
(define the-set! (the 'set!)) ((= len 1) #undefined)
(define the-if (the 'if)) ((= len 2) (cadr form))
(define the-define-macro (the 'define-macro)) ((= len 3) `(,the-core-begin . ,(cdr form)))
(else `(,the-core-begin ,(cadr form) (,the-begin . ,(cddr form))))))))
(define-transformer 'quote (define-transformer 'set!
(lambda (form env) (lambda (form env)
(if (= (length form) 2) (if (and (= (length form) 3) (identifier? (cadr form)))
`(,the-core-quote ,(cadr form)) `(,the-core-set! . ,(cdr form))
(error "malformed quote" form)))) (error "malformed set!" form))))
(define-transformer 'if (define (check-formal formal)
(lambda (form env) (or (null? formal)
(let ((len (length form))) (identifier? formal)
(cond (and (pair? formal)
((= len 3) `(,@form #undefined)) (identifier? (car formal))
((= len 4) `(,the-core-if . ,(cdr form))) (check-formal (cdr formal)))))
(else (error "malformed if" form))))))
(define-transformer 'begin (define-transformer 'lambda
(lambda (form env) (lambda (form env)
(let ((len (length form))) (if (= (length form) 1)
(cond (error "malformed lambda" form)
((= len 1) #undefined) (if (check-formal (cadr form))
((= len 2) (cadr form)) `(,the-core-lambda ,(cadr form) (,the-begin . ,(cddr form)))
((= len 3) `(,the-core-begin . ,(cdr form))) (error "malformed lambda" form)))))
(else `(,the-core-begin ,(cadr form) (,the-begin . ,(cddr form))))))))
(define-transformer 'set! (define-transformer 'define
(lambda (form env) (lambda (form env)
(if (and (= (length form) 3) (identifier? (cadr form))) (let ((len (length form)))
`(,the-core-set! . ,(cdr form)) (if (= len 1)
(error "malformed set!" form)))) (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 (check-formal formal) (define-transformer 'define-macro
(or (null? formal) (lambda (form env)
(identifier? formal) (if (= (length form) 3)
(and (pair? formal) (if (identifier? (cadr form))
(identifier? (car formal)) `(,the-core-define-macro . ,(cdr form))
(check-formal (cdr formal))))) (error "define-macro: binding to non-variable object" form))
(error "malformed define-macro" form))))
(define-transformer 'lambda
(lambda (form env)
(if (= (length form) 1)
(error "malformed lambda" form)
(if (check-formal (cadr form))
`(,the-core-lambda ,(cadr form) (,the-begin . ,(cddr form)))
(error "malformed lambda" form)))))
(define-transformer 'define
(lambda (form env)
(let ((len (length form)))
(if (= len 1)
(error "malformed define" form)
(let ((formal (cadr form)))
(if (identifier? formal)
(if (= len 3)
`(,the-core-define . ,(cdr form))
(error "malformed define" form))
(if (pair? formal)
`(,the-define ,(car formal) (,the-lambda ,(cdr formal) . ,(cddr form)))
(error "define: binding to non-varaible object" form))))))))
(define-transformer 'define-macro
(lambda (form env)
(if (= (length form) 3)
(if (identifier? (cadr form))
`(,the-core-define-macro . ,(cdr form))
(error "define-macro: binding to non-variable object" form))
(error "malformed define-macro" form))))
(define-macro define-auxiliary-syntax (define-macro define-auxiliary-syntax
(lambda (form _) (lambda (form _)
`(define-transformer ',(cadr form) `(define-transformer ',(cadr form)
(lambda _ (lambda _
(error "invalid use of auxiliary syntax" ',(cadr form)))))) (error "invalid use of auxiliary syntax" ',(cadr form))))))
(define-auxiliary-syntax else) (define-auxiliary-syntax else)
(define-auxiliary-syntax =>) (define-auxiliary-syntax =>)
(define-auxiliary-syntax unquote) (define-auxiliary-syntax unquote)
(define-auxiliary-syntax unquote-splicing) (define-auxiliary-syntax unquote-splicing)
(define-transformer 'let (define-transformer 'let
(lambda (form env) (lambda (form env)
(if (identifier? (cadr form)) (if (identifier? (cadr form))
(let ((name (car (cdr form))) (let ((name (car (cdr form)))
(formal (car (cdr (cdr form)))) (formal (car (cdr (cdr form))))
(body (cdr (cdr (cdr form))))) (body (cdr (cdr (cdr form)))))
`((,the-lambda () `((,the-lambda ()
(,the-define (,name . ,(map car formal)) . ,body) (,the-define (,name . ,(map car formal)) . ,body)
(,name . ,(map cadr formal))))) (,name . ,(map cadr formal)))))
(let ((formal (car (cdr form))) (let ((formal (car (cdr form)))
(body (cdr (cdr form)))) (body (cdr (cdr form))))
`((,the-lambda ,(map car formal) . ,body) . ,(map cadr formal)))))) `((,the-lambda ,(map car formal) . ,body) . ,(map cadr formal))))))
(define-transformer 'and (define-transformer 'and
(lambda (form env) (lambda (form env)
(if (null? (cdr form)) (if (null? (cdr form))
#t #t
(if (null? (cddr form)) (if (null? (cddr form))
(cadr form) (cadr form)
`(,the-if ,(cadr form) (,(the 'and) . ,(cddr form)) #f))))) `(,the-if ,(cadr form) (,(the 'and) . ,(cddr form)) #f)))))
(define-transformer 'or (define-transformer 'or
(lambda (form env) (lambda (form env)
(if (null? (cdr form)) (if (null? (cdr form))
#f #f
(let ((tmp (make-identifier 'it env))) ; should we use #f as the env for tmp? (let ((tmp (make-identifier 'it env))) ; should we use #f as the env for tmp?
`(,(the 'let) ((,tmp ,(cadr form))) `(,(the 'let) ((,tmp ,(cadr form)))
(,the-if ,tmp ,tmp (,(the 'or) . ,(cddr form)))))))) (,the-if ,tmp ,tmp (,(the 'or) . ,(cddr form))))))))
(define-transformer 'cond (define-transformer 'cond
(lambda (form env) (lambda (form env)
(let ((clauses (cdr form))) (let ((clauses (cdr form)))
(if (null? clauses) (if (null? clauses)
#undefined #undefined
(let ((clause (car clauses))) (let ((clause (car clauses)))
(if (and (identifier? (car clause)) (if (and (identifier? (car clause))
(identifier=? (the 'else) (make-identifier (car clause) env))) (identifier=? (the 'else) (make-identifier (car clause) env)))
`(,the-begin . ,(cdr clause)) `(,the-begin . ,(cdr clause))
(if (null? (cdr clause)) (if (null? (cdr clause))
`(,(the 'or) ,(car clause) (,(the 'cond) . ,(cdr clauses))) `(,(the 'or) ,(car clause) (,(the 'cond) . ,(cdr clauses)))
(if (and (identifier? (cadr clause)) (if (and (identifier? (cadr clause))
(identifier=? (the '=>) (make-identifier (cadr clause) env))) (identifier=? (the '=>) (make-identifier (cadr clause) env)))
(let ((tmp (make-identifier 'tmp env))) (let ((tmp (make-identifier 'tmp env)))
`(,(the 'let) ((,tmp ,(car clause))) `(,(the 'let) ((,tmp ,(car clause)))
(,the-if ,tmp (,(cadr (cdr clause)) ,tmp) (,(the 'cond) . ,(cddr form))))) (,the-if ,tmp (,(cadr (cdr clause)) ,tmp) (,(the 'cond) . ,(cddr form)))))
`(,the-if ,(car clause) `(,the-if ,(car clause)
(,the-begin . ,(cdr clause)) (,the-begin . ,(cdr clause))
(,(the 'cond) . ,(cdr clauses))))))))))) (,(the 'cond) . ,(cdr clauses)))))))))))
(define-transformer 'quasiquote (define-transformer 'quasiquote
(lambda (form env) (lambda (form env)
(define (quasiquote? form) (define (quasiquote? form)
(and (pair? form) (and (pair? form)
(identifier? (car form)) (identifier? (car form))
(identifier=? (the 'quasiquote) (make-identifier (car form) env)))) (identifier=? (the 'quasiquote) (make-identifier (car form) env))))
(define (unquote? form) (define (unquote? form)
(and (pair? form) (and (pair? form)
(identifier? (car form)) (identifier? (car form))
(identifier=? (the 'unquote) (make-identifier (car form) env)))) (identifier=? (the 'unquote) (make-identifier (car form) env))))
(define (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 '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
;; unquote ;; unquote
((unquote? expr) ((unquote? expr)
(if (= depth 1) (if (= depth 1)
(cadr expr) (cadr expr)
(list (the 'list) (list (the 'list)
(list (the 'quote) (the 'unquote)) (list (the 'quote) (the 'unquote))
(qq (- depth 1) (car (cdr expr)))))) (qq (- depth 1) (car (cdr expr))))))
;; unquote-splicing ;; unquote-splicing
((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 '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)))))
;; quasiquote ;; quasiquote
((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)))))
;; list ;; list
((pair? expr) ((pair? expr)
(list (the 'cons) (list (the 'cons)
(qq depth (car expr)) (qq depth (car expr))
(qq depth (cdr expr)))) (qq depth (cdr expr))))
;; vector ;; vector
((vector? expr) ((vector? expr)
(list (the 'list->vector) (qq depth (vector->list expr)))) (list (the 'list->vector) (qq depth (vector->list expr))))
;; simple datum ;; simple datum
(else (else
(list (the 'quote) expr)))) (list (the 'quote) expr))))
(let ((x (cadr form))) (let ((x (cadr form)))
(qq 1 x)))) (qq 1 x))))
(define-transformer 'let* (define-transformer 'let*
(lambda (form env) (lambda (form env)
(let ((bindings (car (cdr form))) (let ((bindings (car (cdr form)))
(body (cdr (cdr form)))) (body (cdr (cdr form))))
(if (null? bindings) (if (null? bindings)
`(,(the 'let) () . ,body) `(,(the 'let) () . ,body)
`(,(the 'let) ((,(car (car bindings)) . ,(cdr (car bindings)))) `(,(the 'let) ((,(car (car bindings)) . ,(cdr (car bindings))))
(,(the 'let*) ,(cdr bindings) . ,body)))))) (,(the 'let*) ,(cdr bindings) . ,body))))))
(define-transformer 'letrec (define-transformer 'letrec
(lambda (form env) (lambda (form env)
`(,(the 'letrec*) . ,(cdr form)))) `(,(the 'letrec*) . ,(cdr form))))
(define-transformer 'letrec* (define-transformer 'letrec*
(lambda (form env) (lambda (form env)
(let ((bindings (car (cdr form))) (let ((bindings (car (cdr form)))
(body (cdr (cdr form)))) (body (cdr (cdr form))))
(let ((variables (map (lambda (v) `(,v #undefined)) (map car bindings))) (let ((variables (map (lambda (v) `(,v #undefined)) (map car bindings)))
(initials (map (lambda (v) `(,(the 'set!) ,@v)) bindings))) (initials (map (lambda (v) `(,(the 'set!) ,@v)) bindings)))
`(,(the 'let) ,variables `(,(the 'let) ,variables
,@initials ,@initials
,@body))))) ,@body)))))
(define-transformer 'let-values (define-transformer 'let-values
(lambda (form env) (lambda (form env)
`(,(the 'let*-values) ,@(cdr form)))) `(,(the 'let*-values) ,@(cdr form))))
(define-transformer 'let*-values (define-transformer 'let*-values
(lambda (form env) (lambda (form env)
(let ((formals (cadr form)) (let ((formals (cadr form))
(body (cddr form))) (body (cddr form)))
(if (null? formals) (if (null? formals)
`(,(the 'let) () ,@body) `(,(the 'let) () ,@body)
(let ((formal (car formals))) (let ((formal (car formals)))
`(,(the 'call-with-values) (,the-lambda () . ,(cdr formal)) `(,(the 'call-with-values) (,the-lambda () . ,(cdr formal))
(,(the 'lambda) ,(car formal) (,(the 'lambda) ,(car formal)
(,(the 'let*-values) ,(cdr formals) . ,body)))))))) (,(the 'let*-values) ,(cdr formals) . ,body))))))))
(define-transformer 'define-values (define-transformer 'define-values
(lambda (form env) (lambda (form env)
(let ((formal (cadr form)) (let ((formal (cadr form))
(body (cddr form))) (body (cddr form)))
(let ((arguments (make-identifier 'arguments env))) (let ((tmps (let loop ((formal formal))
`(,the-begin (if (identifier? formal)
,@(let loop ((formal formal)) (make-identifier formal env)
(if (pair? formal) (if (pair? formal)
`((,the-define ,(car formal) #undefined) . ,(loop (cdr formal))) (cons (make-identifier (car formal) env) (loop (cdr formal)))
(if (identifier? formal) '())))))
`((,the-define ,formal #undefined)) `(,the-begin
'()))) ,@(let loop ((formal formal))
(,(the 'call-with-values) (,the-lambda () ,@body) (if (identifier? formal)
(,the-lambda `((,the-define ,formal #undefined))
,arguments (if (pair? formal)
,@(let loop ((formal formal) (args arguments)) (cons `(,the-define ,(car formal) #undefined) (loop (cdr formal)))
(if (pair? formal) '())))
`((,the-set! ,(car formal) (,(the 'car) ,args)) . ,(loop (cdr formal) `(,(the 'cdr) ,args))) (,(the 'call-with-values) (,the-lambda () . ,body)
(if (identifier? formal) (,the-lambda ,tmps . ,(let loop ((formal formal) (tmps tmps))
`((,the-set! ,formal ,args)) (if (identifier? formal)
'())))))))))) `((,the-set! ,formal ,tmps))
(if (pair? formal)
(cons `(,the-set! ,(car formal) ,(car tmps))
(loop (cdr formal) (cdr tmps)))
'()))))))))))
(define-transformer 'do (define-transformer 'do
(lambda (form env) (lambda (form env)
(let ((bindings (car (cdr form))) (let ((bindings (car (cdr form)))
(test (car (car (cdr (cdr form))))) (test (car (car (cdr (cdr form)))))
(cleanup (cdr (car (cdr (cdr form))))) (cleanup (cdr (car (cdr (cdr form)))))
(body (cdr (cdr (cdr form))))) (body (cdr (cdr (cdr form)))))
(let ((loop (make-identifier 'loop env))) (let ((loop (make-identifier 'loop env)))
`(,(the 'let) ,loop ,(map (lambda (x) `(,(car x) ,(cadr x))) bindings) `(,(the 'let) ,loop ,(map (lambda (x) `(,(car x) ,(cadr x))) bindings)
(,the-if ,test (,the-if ,test
(,the-begin . ,cleanup) (,the-begin . ,cleanup)
(,the-begin (,the-begin
,@body ,@body
(,loop . ,(map (lambda (x) (,loop . ,(map (lambda (x)
(if (null? (cdr (cdr x))) (if (null? (cdr (cdr x)))
(car x) (car x)
(car (cdr (cdr x))))) (car (cdr (cdr x)))))
bindings))))))))) bindings)))))))))
(define-transformer 'when (define-transformer 'when
(lambda (form env) (lambda (form env)
(let ((test (car (cdr form))) (let ((test (car (cdr form)))
(body (cdr (cdr form)))) (body (cdr (cdr form))))
`(,the-if ,test `(,the-if ,test
(,the-begin ,@body) (,the-begin ,@body)
#undefined)))) #undefined))))
(define-transformer 'unless (define-transformer 'unless
(lambda (form env) (lambda (form env)
(let ((test (car (cdr form))) (let ((test (car (cdr form)))
(body (cdr (cdr form)))) (body (cdr (cdr form))))
`(,the-if ,test `(,the-if ,test
#undefined #undefined
(,the-begin ,@body))))) (,the-begin ,@body)))))
(define-transformer 'case (define-transformer 'case
(lambda (form env) (lambda (form env)
(let ((key (car (cdr form))) (let ((key (car (cdr form)))
(clauses (cdr (cdr form)))) (clauses (cdr (cdr form))))
(let ((the-key (make-identifier 'key env))) (let ((the-key (make-identifier 'key env)))
`(,(the 'let) ((,the-key ,key)) `(,(the 'let) ((,the-key ,key))
,(let loop ((clauses clauses)) ,(let loop ((clauses clauses))
(if (null? clauses) (if (null? clauses)
#undefined #undefined
(let ((clause (car clauses))) (let ((clause (car clauses)))
`(,the-if ,(if (and (identifier? (car clause)) `(,the-if ,(if (and (identifier? (car clause))
(identifier=? (the 'else) (make-identifier (car clause) env))) (identifier=? (the 'else) (make-identifier (car clause) env)))
#t #t
`(,(the 'or) ,@(map (lambda (x) `(,(the 'eqv?) ,the-key (,the-quote ,x))) (car clause)))) `(,(the 'or) ,@(map (lambda (x) `(,(the 'eqv?) ,the-key (,the-quote ,x))) (car clause))))
,(if (and (identifier? (cadr clause)) ,(if (and (identifier? (cadr clause))
(identifier=? (the '=>) (make-identifier (cadr clause) env))) (identifier=? (the '=>) (make-identifier (cadr clause) env)))
`(,(car (cdr (cdr clause))) ,the-key) `(,(car (cdr (cdr clause))) ,the-key)
`(,the-begin ,@(cdr clause))) `(,the-begin ,@(cdr clause)))
,(loop (cdr clauses))))))))))) ,(loop (cdr clauses)))))))))))
(define-transformer 'parameterize (define-transformer 'parameterize
(lambda (form env) (lambda (form env)
(let ((formal (car (cdr form))) (let ((formal (car (cdr form)))
(body (cdr (cdr form)))) (body (cdr (cdr form))))
`(,(the 'with-dynamic-environment) `(,(the 'with-dynamic-environment)
(,(the 'list) ,@(map (lambda (x) `(,(the 'cons) ,(car x) ,(cadr x))) formal)) (,(the 'list) ,@(map (lambda (x) `(,(the 'cons) ,(car x) ,(cadr x))) formal))
(,the-lambda () ,@body)))))) (,the-lambda () ,@body)))))))

502
piclib/library.scm
View File

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