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

Binary file not shown.

View File

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

View File

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

View File

@ -393,17 +393,11 @@ pic_compile_find_identifier(pic_state *pic)
}
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);
TYPE_CHECK(pic, id, id);
uid = pic_find_identifier(pic, id, default_env(pic));
define_macro(pic, uid, mac);
return pic_undef_value(pic);
return pic->macros;
}
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, "find-identifier", pic_compile_find_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, "eval", pic_compile_eval);
}

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);
}
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_pair(pic_state *);
void pic_init_port(pic_state *);
@ -110,6 +118,8 @@ pic_init_core(pic_state *pic)
{
size_t ai = pic_enter(pic);
pic_defun(pic, "global-objects", pic_global_objects);
pic_init_features(pic); DONE;
pic_init_bool(pic); DONE;
pic_init_pair(pic); DONE;

View File

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

View File

@ -1,270 +1,234 @@
(begin
;; There are two ways to name a library: (foo bar) or foo.bar
;; The former is normalized to the latter.
(define (mangle name)
(when (null? name)
(error "library name should be a list of at least one symbols" name))
(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...
(define-values (current-library
find-library
make-library
library-environment
library-exports
library-import
library-export)
(let ()
(make-library '(picrin base))
(set-car! (dictionary-ref *libraries* (mangle '(picrin base))) default-environment)
(let ((export-keywords
(lambda (keywords)
(let ((env (library-environment '(picrin base)))
(exports (library-exports '(picrin base))))
(for-each
(lambda (keyword)
(dictionary-set! exports keyword keyword))
keywords)))))
(export-keywords
'(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-keywords
'(features
eq? eqv? equal? not boolean? boolean=?
pair? cons car cdr null? set-car! set-cdr!
caar cadr cdar cddr
list? make-list list length append reverse
list-tail list-ref list-set! list-copy
map for-each memq memv member assq assv assoc
current-input-port current-output-port current-error-port
port? input-port? output-port? port-open? close-port
eof-object? eof-object
read-u8 peek-u8 read-bytevector!
write-u8 write-bytevector flush-output-port
open-input-bytevector open-output-bytevector get-output-bytevector
number? exact? inexact? inexact exact
= < > <= >= + - * /
number->string string->number
procedure? apply
symbol? symbol=? symbol->string string->symbol
make-identifier identifier? identifier=? identifier-base identifier-environment
vector? vector make-vector vector-length vector-ref vector-set!
vector-copy! vector-copy vector-append vector-fill! vector-map vector-for-each
list->vector vector->list string->vector vector->string
bytevector? bytevector make-bytevector
bytevector-length bytevector-u8-ref bytevector-u8-set!
bytevector-copy! bytevector-copy bytevector-append
bytevector->list list->bytevector
call-with-current-continuation call/cc values call-with-values
char? char->integer integer->char char=? char<? char>? char<=? char>=?
current-exception-handlers with-exception-handler
raise raise-continuable error
error-object? error-object-message error-object-irritants
error-object-type
string? string make-string string-length string-ref string-set!
string-copy string-copy! string-fill! string-append
string-map string-for-each list->string string->list
string=? string<? string>? string<=? string>=?
make-parameter with-dynamic-environment
read
make-dictionary dictionary? dictionary dictionary-has?
dictionary-ref dictionary-set! dictionary-delete! dictionary-size
dictionary-map dictionary-for-each
dictionary->alist alist->dictionary dictionary->plist plist->dictionary
make-record record? record-type record-datum
default-environment make-environment find-identifier set-identifier!
eval compile add-macro!
make-ephemeron-table
write write-simple write-shared display))
(export-keywords
'(find-library make-library current-library)))
(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))
(current-library '(picrin user))))
;; There are two ways to name a library: (foo bar) or foo.bar
;; The former is normalized to the latter.
(define (mangle name)
(when (null? name)
(error "library name should be a list of at least one symbols" name))
(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)
(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)))