From 6968a9d9ef2c90c76d61c05c3bbfccbe22e65379 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Thu, 13 Apr 2017 00:02:25 +0900 Subject: [PATCH] fix compiler --- lib/ext/boot.c | 359 +++++++++++++++++++------------------ lib/include/picrin/setup.h | 2 +- piclib/compile.scm | 38 ++-- 3 files changed, 203 insertions(+), 196 deletions(-) diff --git a/lib/ext/boot.c b/lib/ext/boot.c index c48ba059..e577b059 100644 --- a/lib/ext/boot.c +++ b/lib/ext/boot.c @@ -438,184 +438,187 @@ static const char boot_compile_rom[][80] = { "bda (.body.2477) (core#if (null? (.defs.2466)) (cons (core#quote lambda) (cons .", "args.2475 (cons .body.2477 (core#quote ())))) (cons (core#quote lambda) (cons .a", "rgs.2475 (cons (cons (cons (core#quote lambda) (cons (.defs.2466) (cons .body.24", -"77 (core#quote ())))) (append (map (core#lambda (._.2478) #f) (.defs.2466)) (cor", -"e#quote ()))) (core#quote ())))))) (.normalize.2467 .body.2476))))) (cadr .e.246", -"8) (.caddr.2454 .e.2468)) (core#if ((core#lambda (.it.2479) (core#if .it.2479 .i", -"t.2479 #f)) (eqv? .key.2469 (core#quote core#set!))) (cons (core#quote set!) (ma", -"p .normalize.2467 (cdr .e.2468))) (core#if ((core#lambda (.it.2480) (core#if .it", -".2480 .it.2480 #f)) (eqv? .key.2469 (core#quote core#if))) (cons (core#quote if)", -" (map .normalize.2467 (cdr .e.2468))) (core#if ((core#lambda (.it.2481) (core#if", -" .it.2481 .it.2481 #f)) (eqv? .key.2469 (core#quote core#begin))) (cons (core#qu", -"ote begin) (map .normalize.2467 (cdr .e.2468))) (core#if #t (map .normalize.2467", -" .e.2468) #undefined)))))))) (car .e.2468)))))) .normalize.2467)) (make-paramete", -"r (core#quote ())))) (core#begin (core#define .transform.2459 ((core#lambda () (", -"core#begin (core#define .uniq.2482 ((core#lambda (.n.2487) (core#lambda () (core", -"#begin (core#set! .n.2487 (+ .n.2487 1)) (string->symbol (string-append \"$\" (num", -"ber->string .n.2487)))))) 0)) (core#begin (core#define .transform-k.2483 (core#l", -"ambda (.e.2488 .k.2489) ((core#lambda (.key.2490) (core#if ((core#lambda (.it.24", -"91) (core#if .it.2491 .it.2491 ((core#lambda (.it.2492) (core#if .it.2492 .it.24", -"92 ((core#lambda (.it.2493) (core#if .it.2493 .it.2493 #f)) (eqv? .key.2490 (cor", -"e#quote quote))))) (eqv? .key.2490 (core#quote lambda))))) (eqv? .key.2490 (core", -"#quote ref))) (.k.2489 (.transform-v.2486 .e.2488)) (core#if ((core#lambda (.it.", -"2494) (core#if .it.2494 .it.2494 #f)) (eqv? .key.2490 (core#quote begin))) (.tra", -"nsform-k.2483 (cadr .e.2488) (core#lambda (._.2495) (.transform-k.2483 (.caddr.2", -"454 .e.2488) .k.2489))) (core#if ((core#lambda (.it.2496) (core#if .it.2496 .it.", -"2496 #f)) (eqv? .key.2490 (core#quote set!))) (.transform-k.2483 (.caddr.2454 .e", -".2488) (core#lambda (.v.2497) (cons (core#quote set!) (cons (cadr .e.2488) (cons", -" .v.2497 (cons (.k.2489 (core#quote (undefined))) (core#quote ()))))))) (core#if", -" ((core#lambda (.it.2498) (core#if .it.2498 .it.2498 #f)) (eqv? .key.2490 (core#", -"quote if))) ((core#lambda (.v.2499 .c.2500) (cons (cons (core#quote lambda) (con", -"s (cons .c.2500 (core#quote ())) (cons (.transform-k.2483 (cadr .e.2488) (core#l", -"ambda (.x.2501) (cons (core#quote if) (cons .x.2501 (cons (.transform-c.2485 (.c", -"addr.2454 .e.2488) .c.2500) (cons (.transform-c.2485 (.cadddr.2455 .e.2488) .c.2", -"500) (core#quote ()))))))) (core#quote ())))) (cons (cons (core#quote lambda) (c", -"ons (cons .v.2499 (core#quote ())) (cons (.k.2489 (cons (core#quote ref) (cons .", -"v.2499 (core#quote ())))) (core#quote ())))) (core#quote ())))) (.uniq.2482) (co", -"ns (core#quote ref) (cons (.uniq.2482) (core#quote ())))) (core#if #t ((core#lam", -"bda (.v.2502) ((core#lambda (.c.2503) ((core#lambda () (.transform-k.2483 (car .", -"e.2488) (core#lambda (.f.2504) (.transform*-k.2484 (cdr .e.2488) (core#lambda (.", -"args.2505) (cons .f.2504 (cons .c.2503 (append .args.2505 (core#quote ()))))))))", -"))) (cons (core#quote lambda) (cons (cons .v.2502 (core#quote ())) (cons (.k.248", -"9 (cons (core#quote ref) (cons .v.2502 (core#quote ())))) (core#quote ())))))) (", -".uniq.2482)) #undefined)))))) (car .e.2488)))) (core#begin (core#define .transfo", -"rm*-k.2484 (core#lambda (.es.2506 .k.2507) (core#if (null? .es.2506) (.k.2507 (c", -"ore#quote ())) (.transform-k.2483 (car .es.2506) (core#lambda (.x.2508) (.transf", -"orm*-k.2484 (cdr .es.2506) (core#lambda (.xs.2509) (.k.2507 (cons .x.2508 .xs.25", -"09))))))))) (core#begin (core#define .transform-c.2485 (core#lambda (.e.2510 .c.", -"2511) ((core#lambda (.key.2512) (core#if ((core#lambda (.it.2513) (core#if .it.2", -"513 .it.2513 ((core#lambda (.it.2514) (core#if .it.2514 .it.2514 ((core#lambda (", -".it.2515) (core#if .it.2515 .it.2515 #f)) (eqv? .key.2512 (core#quote quote)))))", -" (eqv? .key.2512 (core#quote lambda))))) (eqv? .key.2512 (core#quote ref))) (con", -"s .c.2511 (cons (.transform-v.2486 .e.2510) (core#quote ()))) (core#if ((core#la", -"mbda (.it.2516) (core#if .it.2516 .it.2516 #f)) (eqv? .key.2512 (core#quote begi", -"n))) (.transform-k.2483 (cadr .e.2510) (core#lambda (._.2517) (.transform-c.2485", -" (.caddr.2454 .e.2510) .c.2511))) (core#if ((core#lambda (.it.2518) (core#if .it", -".2518 .it.2518 #f)) (eqv? .key.2512 (core#quote set!))) (.transform-k.2483 (.cad", -"dr.2454 .e.2510) (core#lambda (.v.2519) (cons (core#quote set!) (cons (cadr .e.2", -"510) (cons .v.2519 (cons (cons .c.2511 (cons (cons (core#quote undefined) (core#", -"quote ())) (core#quote ()))) (core#quote ()))))))) (core#if ((core#lambda (.it.2", -"520) (core#if .it.2520 .it.2520 #f)) (eqv? .key.2512 (core#quote if))) (core#if ", -"(core#if (pair? .c.2511) (eq? (core#quote lambda) (car .c.2511)) #f) ((core#lamb", -"da (.k.2521) (cons (cons (core#quote lambda) (cons (cons .k.2521 (core#quote ())", -") (cons (.transform-k.2483 (cadr .e.2510) (core#lambda (.x.2522) (cons (core#quo", -"te if) (cons .x.2522 (cons (.transform-c.2485 (.caddr.2454 .e.2510) .k.2521) (co", -"ns (.transform-c.2485 (.cadddr.2455 .e.2510) .k.2521) (core#quote ()))))))) (cor", -"e#quote ())))) (cons .c.2511 (core#quote ())))) (cons (core#quote ref) (cons (.u", -"niq.2482) (core#quote ())))) (.transform-k.2483 (cadr .e.2510) (core#lambda (.x.", -"2523) (cons (core#quote if) (cons .x.2523 (cons (.transform-c.2485 (.caddr.2454 ", -".e.2510) .c.2511) (cons (.transform-c.2485 (.cadddr.2455 .e.2510) .c.2511) (core", -"#quote ())))))))) (core#if #t (.transform-k.2483 (car .e.2510) (core#lambda (.f.", -"2524) (.transform*-k.2484 (cdr .e.2510) (core#lambda (.args.2525) (cons .f.2524 ", -"(cons .c.2511 (append .args.2525 (core#quote ())))))))) #undefined)))))) (car .e", -".2510)))) (core#begin (core#define .transform-v.2486 (core#lambda (.e.2526) ((co", -"re#lambda (.key.2527) (core#if ((core#lambda (.it.2528) (core#if .it.2528 .it.25", -"28 ((core#lambda (.it.2529) (core#if .it.2529 .it.2529 #f)) (eqv? .key.2527 (cor", -"e#quote quote))))) (eqv? .key.2527 (core#quote ref))) .e.2526 (core#if ((core#la", -"mbda (.it.2530) (core#if .it.2530 .it.2530 #f)) (eqv? .key.2527 (core#quote lamb", -"da))) ((core#lambda (.k.2531) (cons (core#quote lambda) (cons (cons .k.2531 (app", -"end (cadr .e.2526) (core#quote ()))) (cons (.transform-c.2485 (.caddr.2454 .e.25", -"26) (cons (core#quote ref) (cons .k.2531 (core#quote ())))) (core#quote ()))))) ", -"(.uniq.2482)) #undefined))) (car .e.2526)))) (core#lambda (.e.2532) ((core#lambd", -"a (.k.2533) (cons (core#quote lambda) (cons (cons .k.2533 (core#quote ())) (cons", -" (.transform-c.2485 .e.2532 (cons (core#quote ref) (cons .k.2533 (core#quote ())", -"))) (core#quote ()))))) (.uniq.2482))))))))))) (core#begin (core#define .codegen", -".2460 ((core#lambda () (core#begin (core#define .lookup.2534 (core#lambda (.var.", -"2546 .env.2547) ((core#lambda () (core#begin (core#define .up.2548 (core#lambda ", -"(.depth.2549 .env.2550) (core#if (null? .env.2550) (cons (core#quote global) (co", -"ns .var.2546 (core#quote ()))) ((core#lambda () (core#begin (core#define .loop.2", -"551 (core#lambda (.index.2552 .binding.2553) (core#if (symbol? .binding.2553) (c", -"ore#if (eq? .var.2546 .binding.2553) (cons (core#quote local) (cons .depth.2549 ", -"(cons .index.2552 (core#quote ())))) (.up.2548 (+ .depth.2549 1) (cdr .env.2550)", -")) (core#if (null? .binding.2553) (.up.2548 (+ .depth.2549 1) (cdr .env.2550)) (", -"core#if (eq? .var.2546 (car .binding.2553)) (cons (core#quote local) (cons .dept", -"h.2549 (cons .index.2552 (core#quote ())))) (.loop.2551 (+ .index.2552 1) (cdr .", -"binding.2553))))))) (.loop.2551 1 (car .env.2550)))))))) (.up.2548 0 .env.2547))", -")))) (core#begin (core#define .env.2535 (make-parameter (core#quote ()))) (core#", -"begin (core#define .code.2536 (make-parameter (core#quote ()))) (core#begin (cor", -"e#define .reps.2537 (make-parameter (core#quote ()))) (core#begin (core#define .", -"objs.2538 (make-parameter (core#quote ()))) (core#begin (core#define .emit.2539 ", -"(core#lambda (.inst.2554) (.code.2536 (cons .inst.2554 (.code.2536))))) (core#be", -"gin (core#define .emit-irep.2540 (core#lambda (.irep.2555) ((core#lambda (.n.255", -"6) (core#begin (.reps.2537 (cons .irep.2555 (.reps.2537))) .n.2556)) (length (.r", -"eps.2537))))) (core#begin (core#define .emit-objs.2541 (core#lambda (.obj.2557) ", -"((core#lambda (.n.2558) (core#begin (.objs.2538 (cons .obj.2557 (.objs.2538))) .", -"n.2558)) (length (.objs.2538))))) (core#begin (core#define .make-label.2542 ((co", -"re#lambda (.n.2559) (core#lambda () ((core#lambda (.m.2560) (core#begin (core#se", -"t! .n.2559 (+ .n.2559 1)) .m.2560)) .n.2559))) 0)) (core#begin (core#define .emi", -"t-label.2543 (core#lambda (.label.2561) (.code.2536 (cons .label.2561 (.code.253", -"6))))) (core#begin (core#define .codegen-e.2544 (core#lambda (.e.2562) ((core#la", -"mbda (.key.2563) (core#if ((core#lambda (.it.2564) (core#if .it.2564 .it.2564 ((", -"core#lambda (.it.2565) (core#if .it.2565 .it.2565 ((core#lambda (.it.2566) (core", -"#if .it.2566 .it.2566 ((core#lambda (.it.2567) (core#if .it.2567 .it.2567 #f)) (", -"eqv? .key.2563 (core#quote undefined))))) (eqv? .key.2563 (core#quote quote)))))", -" (eqv? .key.2563 (core#quote lambda))))) (eqv? .key.2563 (core#quote ref))) (.co", -"degen-a.2545 .e.2562 0) (core#if ((core#lambda (.it.2568) (core#if .it.2568 .it.", -"2568 #f)) (eqv? .key.2563 (core#quote set!))) (core#begin (.codegen-a.2545 (.cad", -"dr.2454 .e.2562) 0) (core#begin ((core#lambda (.x.2569) ((core#lambda (.op.2570)", -" ((core#lambda () (.emit.2539 (cons .op.2570 (cons (core#quote 0) (cdr .x.2569))", -"))))) (core#if (eq? (core#quote global) (car .x.2569)) (core#quote GSET) (core#q", -"uote LSET)))) (.lookup.2534 (cadr .e.2562) (.env.2535))) (.codegen-e.2544 (.cadd", -"dr.2455 .e.2562)))) (core#if ((core#lambda (.it.2571) (core#if .it.2571 .it.2571", -" #f)) (eqv? .key.2563 (core#quote if))) (core#begin (.codegen-a.2545 (cadr .e.25", -"62) 0) ((core#lambda (.label.2572) (core#begin (.emit.2539 (cons (core#quote CON", -"D) (cons (core#quote 0) (cons .label.2572 (core#quote ()))))) (core#begin (.code", -"gen-e.2544 (.caddr.2454 .e.2562)) (core#begin (.emit-label.2543 .label.2572) (.c", -"odegen-e.2544 (.cadddr.2455 .e.2562)))))) (.make-label.2542))) (core#if #t (core", -"#begin ((core#lambda () (core#begin (core#define .loop.2573 (core#lambda (.i.257", -"4 .e.2575) (core#if (null? .e.2575) #undefined (core#begin (.codegen-a.2545 (car", -" .e.2575) .i.2574) (.loop.2573 (+ .i.2574 1) (cdr .e.2575)))))) (.loop.2573 0 .e", -".2562)))) (.emit.2539 (cons (core#quote CALL) (cons (- (length .e.2562) 1) (core", -"#quote ()))))) #undefined))))) (car .e.2562)))) (core#begin (core#define .codege", -"n-a.2545 (core#lambda (.e.2576 .i.2577) ((core#lambda (.key.2578) (core#if ((cor", -"e#lambda (.it.2579) (core#if .it.2579 .it.2579 #f)) (eqv? .key.2578 (core#quote ", -"ref))) ((core#lambda (.x.2580) ((core#lambda (.op.2581) ((core#lambda () (.emit.", -"2539 (cons .op.2581 (cons .i.2577 (cdr .x.2580))))))) (core#if (eq? (core#quote ", -"global) (car .x.2580)) (core#quote GREF) (core#quote LREF)))) (.lookup.2534 (cad", -"r .e.2576) (.env.2535))) (core#if ((core#lambda (.it.2582) (core#if .it.2582 .it", -".2582 #f)) (eqv? .key.2578 (core#quote quote))) ((core#lambda (.obj.2583) (core#", -"if (eq? #t .obj.2583) (.emit.2539 (cons (core#quote LOADT) (cons .i.2577 (core#q", -"uote ())))) (core#if (eq? #f .obj.2583) (.emit.2539 (cons (core#quote LOADF) (co", -"ns .i.2577 (core#quote ())))) (core#if (null? .obj.2583) (.emit.2539 (cons (core", -"#quote LOADN) (cons .i.2577 (core#quote ())))) (core#if (eq? #undefined .obj.258", -"3) (.emit.2539 (cons (core#quote LOADU) (cons .i.2577 (core#quote ())))) (core#i", -"f (core#if (.integer?.2457 .obj.2583) (<= -128 .obj.2583 127) #f) (.emit.2539 (c", -"ons (core#quote LOADI) (cons .i.2577 (cons .obj.2583 (core#quote ()))))) ((core#", -"lambda (.n.2584) (.emit.2539 (cons (core#quote LOAD) (cons .i.2577 (cons .n.2584", -" (core#quote ())))))) (emit-obj .obj.2583)))))))) (cadr .e.2576)) (core#if ((cor", -"e#lambda (.it.2585) (core#if .it.2585 .it.2585 #f)) (eqv? .key.2578 (core#quote ", -"undefined))) (.emit.2539 (cons (core#quote LOADU) (cons .i.2577 (core#quote ()))", -")) (core#if ((core#lambda (.it.2586) (core#if .it.2586 .it.2586 #f)) (eqv? .key.", -"2578 (core#quote lambda))) ((core#lambda (.frame-size.2587 .argc-varg.2588) ((co", -"re#lambda (.irep.2589) ((core#lambda (.n.2590) (.emit.2539 (cons (core#quote PRO", -"C) (cons .i.2577 (cons .n.2590 (core#quote ())))))) (.emit-irep.2540 .irep.2589)", -")) (with-dynamic-environment (list (cons .code.2536 (core#quote ())) (cons .env.", -"2535 (cons (cadr .e.2576) (.env.2535))) (cons .reps.2537 (core#quote ())) (cons ", -".objs.2538 (core#quote ()))) (core#lambda () (core#begin (.codegen-e.2544 (.cadd", -"r.2454 .e.2576)) (list (reverse (.code.2536)) (reverse (.reps.2537)) (reverse (.", -"objs.2538)) .argc-varg.2588 .frame-size.2587)))))) ((core#lambda () (core#begin ", -"(core#define .loop.2591 (core#lambda (.e.2592) ((core#lambda (.key.2593) (core#i", -"f ((core#lambda (.it.2594) (core#if .it.2594 .it.2594 ((core#lambda (.it.2595) (", -"core#if .it.2595 .it.2595 ((core#lambda (.it.2596) (core#if .it.2596 .it.2596 ((", -"core#lambda (.it.2597) (core#if .it.2597 .it.2597 #f)) (eqv? .key.2593 (core#quo", -"te undefined))))) (eqv? .key.2593 (core#quote quote))))) (eqv? .key.2593 (core#q", -"uote lambda))))) (eqv? .key.2593 (core#quote ref))) 1 (core#if ((core#lambda (.i", -"t.2598) (core#if .it.2598 .it.2598 #f)) (eqv? .key.2593 (core#quote if))) (.max.", -"2456 (.loop.2591 (.caddr.2454 .e.2592)) (.loop.2591 (.cadddr.2455 .e.2592))) (co", -"re#if ((core#lambda (.it.2599) (core#if .it.2599 .it.2599 #f)) (eqv? .key.2593 (", -"core#quote set!))) (.loop.2591 (.cadddr.2455 .e.2592)) (core#if #t (+ 1 (length ", -".e.2592)) #undefined))))) (car .e.2592)))) (.loop.2591 (.caddr.2454 .e.2576)))))", -" ((core#lambda () (core#begin (core#define .loop.2600 (core#lambda (.args.2601 .", -"c.2602) (core#if (symbol? .args.2601) (cons .c.2602 #t) (core#if (null? .args.26", -"01) (cons .c.2602 #f) (.loop.2600 (cdr .args.2601) (+ 1 .c.2602)))))) (.loop.260", -"0 (cadr .e.2576) 0))))) #undefined))))) (car .e.2576)))) (core#lambda (.e.2603) ", -"(with-dynamic-environment (list (cons .code.2536 (core#quote ())) (cons .env.253", -"5 (core#quote ())) (cons .reps.2537 (core#quote ())) (cons .objs.2538 (core#quot", -"e ()))) (core#lambda () (core#begin (.codegen-e.2544 .e.2603) (car (.reps.2537))", -"))))))))))))))))))) (core#lambda (.e.2604) (.codegen.2460 (.transform.2459 (.nor", -"malize.2458 .e.2604)))))))))))))) (core#lambda (.compile.2605) (core#set! compil", -"e .compile.2605)))) (core#define eval (core#lambda (.expr.2606 . .env.2607) (loa", -"d (expand .expr.2606 (core#if (null? .env.2607) default-environment (car .env.26", -"07)))))))))", +"77 (core#quote ())))) (append (map (core#lambda (._.2478) (core#quote '#f)) (.de", +"fs.2466)) (core#quote ()))) (core#quote ())))))) (.normalize.2467 .body.2476))))", +") (cadr .e.2468) (.caddr.2454 .e.2468)) (core#if ((core#lambda (.it.2479) (core#", +"if .it.2479 .it.2479 #f)) (eqv? .key.2469 (core#quote core#set!))) (cons (core#q", +"uote set!) (cons (cadr .e.2468) (cons (.normalize.2467 (.caddr.2454 .e.2468)) (c", +"ore#quote ())))) (core#if ((core#lambda (.it.2480) (core#if .it.2480 .it.2480 #f", +")) (eqv? .key.2469 (core#quote core#if))) (cons (core#quote if) (map .normalize.", +"2467 (cdr .e.2468))) (core#if ((core#lambda (.it.2481) (core#if .it.2481 .it.248", +"1 #f)) (eqv? .key.2469 (core#quote core#begin))) (cons (core#quote begin) (map .", +"normalize.2467 (cdr .e.2468))) (core#if #t (map .normalize.2467 .e.2468) #undefi", +"ned)))))))) (car .e.2468)))))) .normalize.2467)) (make-parameter (core#quote ())", +"))) (core#begin (core#define .transform.2459 ((core#lambda () (core#begin (core#", +"define .uniq.2482 ((core#lambda (.n.2487) (core#lambda () (core#begin (core#set!", +" .n.2487 (+ .n.2487 1)) (string->symbol (string-append \"$\" (number->string .n.24", +"87)))))) 0)) (core#begin (core#define .transform-k.2483 (core#lambda (.e.2488 .k", +".2489) ((core#lambda (.key.2490) (core#if ((core#lambda (.it.2491) (core#if .it.", +"2491 .it.2491 ((core#lambda (.it.2492) (core#if .it.2492 .it.2492 ((core#lambda ", +"(.it.2493) (core#if .it.2493 .it.2493 #f)) (eqv? .key.2490 (core#quote quote))))", +") (eqv? .key.2490 (core#quote lambda))))) (eqv? .key.2490 (core#quote ref))) (.k", +".2489 (.transform-v.2486 .e.2488)) (core#if ((core#lambda (.it.2494) (core#if .i", +"t.2494 .it.2494 #f)) (eqv? .key.2490 (core#quote begin))) (.transform-k.2483 (ca", +"dr .e.2488) (core#lambda (._.2495) (.transform-k.2483 (.caddr.2454 .e.2488) .k.2", +"489))) (core#if ((core#lambda (.it.2496) (core#if .it.2496 .it.2496 #f)) (eqv? .", +"key.2490 (core#quote set!))) (.transform-k.2483 (.caddr.2454 .e.2488) (core#lamb", +"da (.v.2497) (cons (core#quote set!) (cons (cadr .e.2488) (cons .v.2497 (cons (.", +"k.2489 (core#quote (undefined))) (core#quote ()))))))) (core#if ((core#lambda (.", +"it.2498) (core#if .it.2498 .it.2498 #f)) (eqv? .key.2490 (core#quote if))) ((cor", +"e#lambda (.v.2499 .c.2500) (cons (cons (core#quote lambda) (cons (cons .c.2500 (", +"core#quote ())) (cons (.transform-k.2483 (cadr .e.2488) (core#lambda (.x.2501) (", +"cons (core#quote if) (cons .x.2501 (cons (.transform-c.2485 (.caddr.2454 .e.2488", +") (cons (core#quote ref) (cons .c.2500 (core#quote ())))) (cons (.transform-c.24", +"85 (.cadddr.2455 .e.2488) (cons (core#quote ref) (cons .c.2500 (core#quote ())))", +") (core#quote ()))))))) (core#quote ())))) (cons (cons (core#quote lambda) (cons", +" (cons .v.2499 (core#quote ())) (cons (.k.2489 (cons (core#quote ref) (cons .v.2", +"499 (core#quote ())))) (core#quote ())))) (core#quote ())))) (.uniq.2482) (.uniq", +".2482)) (core#if #t ((core#lambda (.v.2502) ((core#lambda (.c.2503) ((core#lambd", +"a () (.transform-k.2483 (car .e.2488) (core#lambda (.f.2504) (.transform*-k.2484", +" (cdr .e.2488) (core#lambda (.args.2505) (cons .f.2504 (cons .c.2503 (append .ar", +"gs.2505 (core#quote ()))))))))))) (cons (core#quote lambda) (cons (cons .v.2502 ", +"(core#quote ())) (cons (.k.2489 (cons (core#quote ref) (cons .v.2502 (core#quote", +" ())))) (core#quote ())))))) (.uniq.2482)) #undefined)))))) (car .e.2488)))) (co", +"re#begin (core#define .transform*-k.2484 (core#lambda (.es.2506 .k.2507) (core#i", +"f (null? .es.2506) (.k.2507 (core#quote ())) (.transform-k.2483 (car .es.2506) (", +"core#lambda (.x.2508) (.transform*-k.2484 (cdr .es.2506) (core#lambda (.xs.2509)", +" (.k.2507 (cons .x.2508 .xs.2509))))))))) (core#begin (core#define .transform-c.", +"2485 (core#lambda (.e.2510 .c.2511) ((core#lambda (.key.2512) (core#if ((core#la", +"mbda (.it.2513) (core#if .it.2513 .it.2513 ((core#lambda (.it.2514) (core#if .it", +".2514 .it.2514 ((core#lambda (.it.2515) (core#if .it.2515 .it.2515 #f)) (eqv? .k", +"ey.2512 (core#quote quote))))) (eqv? .key.2512 (core#quote lambda))))) (eqv? .ke", +"y.2512 (core#quote ref))) (cons .c.2511 (cons (.transform-v.2486 .e.2510) (core#", +"quote ()))) (core#if ((core#lambda (.it.2516) (core#if .it.2516 .it.2516 #f)) (e", +"qv? .key.2512 (core#quote begin))) (.transform-k.2483 (cadr .e.2510) (core#lambd", +"a (._.2517) (.transform-c.2485 (.caddr.2454 .e.2510) .c.2511))) (core#if ((core#", +"lambda (.it.2518) (core#if .it.2518 .it.2518 #f)) (eqv? .key.2512 (core#quote se", +"t!))) (.transform-k.2483 (.caddr.2454 .e.2510) (core#lambda (.v.2519) (cons (cor", +"e#quote set!) (cons (cadr .e.2510) (cons .v.2519 (cons (cons .c.2511 (cons (cons", +" (core#quote undefined) (core#quote ())) (core#quote ()))) (core#quote ())))))))", +" (core#if ((core#lambda (.it.2520) (core#if .it.2520 .it.2520 #f)) (eqv? .key.25", +"12 (core#quote if))) (core#if (core#if (pair? .c.2511) (eq? (core#quote lambda) ", +"(car .c.2511)) #f) ((core#lambda (.k.2521) (cons (cons (core#quote lambda) (cons", +" (cons .k.2521 (core#quote ())) (cons (.transform-k.2483 (cadr .e.2510) (core#la", +"mbda (.x.2522) (cons (core#quote if) (cons .x.2522 (cons (.transform-c.2485 (.ca", +"ddr.2454 .e.2510) (cons (core#quote ref) (cons .k.2521 (core#quote ())))) (cons ", +"(.transform-c.2485 (.cadddr.2455 .e.2510) (cons (core#quote ref) (cons .k.2521 (", +"core#quote ())))) (core#quote ()))))))) (core#quote ())))) (cons .c.2511 (core#q", +"uote ())))) (.uniq.2482)) (.transform-k.2483 (cadr .e.2510) (core#lambda (.x.252", +"3) (cons (core#quote if) (cons .x.2523 (cons (.transform-c.2485 (.caddr.2454 .e.", +"2510) .c.2511) (cons (.transform-c.2485 (.cadddr.2455 .e.2510) .c.2511) (core#qu", +"ote ())))))))) (core#if #t (.transform-k.2483 (car .e.2510) (core#lambda (.f.252", +"4) (.transform*-k.2484 (cdr .e.2510) (core#lambda (.args.2525) (cons .f.2524 (co", +"ns .c.2511 (append .args.2525 (core#quote ())))))))) #undefined)))))) (car .e.25", +"10)))) (core#begin (core#define .transform-v.2486 (core#lambda (.e.2526) ((core#", +"lambda (.key.2527) (core#if ((core#lambda (.it.2528) (core#if .it.2528 .it.2528 ", +"((core#lambda (.it.2529) (core#if .it.2529 .it.2529 #f)) (eqv? .key.2527 (core#q", +"uote quote))))) (eqv? .key.2527 (core#quote ref))) .e.2526 (core#if ((core#lambd", +"a (.it.2530) (core#if .it.2530 .it.2530 #f)) (eqv? .key.2527 (core#quote lambda)", +")) ((core#lambda (.k.2531) (cons (core#quote lambda) (cons (cons .k.2531 (cadr .", +"e.2526)) (cons (.transform-c.2485 (.caddr.2454 .e.2526) (cons (core#quote ref) (", +"cons .k.2531 (core#quote ())))) (core#quote ()))))) (.uniq.2482)) #undefined))) ", +"(car .e.2526)))) (core#lambda (.e.2532) ((core#lambda (.k.2533) (cons (core#quot", +"e lambda) (cons (cons .k.2533 (core#quote ())) (cons (.transform-c.2485 .e.2532 ", +"(cons (core#quote ref) (cons .k.2533 (core#quote ())))) (core#quote ()))))) (.un", +"iq.2482))))))))))) (core#begin (core#define .codegen.2460 ((core#lambda () (core", +"#begin (core#define .lookup.2534 (core#lambda (.var.2546 .env.2547) ((core#lambd", +"a () (core#begin (core#define .up.2548 (core#lambda (.depth.2549 .env.2550) (cor", +"e#if (null? .env.2550) (cons (core#quote global) (cons .var.2546 (core#quote ())", +")) ((core#lambda () (core#begin (core#define .loop.2551 (core#lambda (.index.255", +"2 .binding.2553) (core#if (symbol? .binding.2553) (core#if (eq? .var.2546 .bindi", +"ng.2553) (cons (core#quote local) (cons .depth.2549 (cons .index.2552 (core#quot", +"e ())))) (.up.2548 (+ .depth.2549 1) (cdr .env.2550))) (core#if (null? .binding.", +"2553) (.up.2548 (+ .depth.2549 1) (cdr .env.2550)) (core#if (eq? .var.2546 (car ", +".binding.2553)) (cons (core#quote local) (cons .depth.2549 (cons .index.2552 (co", +"re#quote ())))) (.loop.2551 (+ .index.2552 1) (cdr .binding.2553))))))) (.loop.2", +"551 1 (car .env.2550)))))))) (.up.2548 0 .env.2547)))))) (core#begin (core#defin", +"e .env.2535 (make-parameter (core#quote ()))) (core#begin (core#define .code.253", +"6 (make-parameter (core#quote ()))) (core#begin (core#define .reps.2537 (make-pa", +"rameter (core#quote ()))) (core#begin (core#define .objs.2538 (make-parameter (c", +"ore#quote ()))) (core#begin (core#define .emit.2539 (core#lambda (.inst.2554) (.", +"code.2536 (cons .inst.2554 (.code.2536))))) (core#begin (core#define .emit-irep.", +"2540 (core#lambda (.irep.2555) ((core#lambda (.n.2556) (core#begin (.reps.2537 (", +"cons .irep.2555 (.reps.2537))) .n.2556)) (length (.reps.2537))))) (core#begin (c", +"ore#define .emit-obj.2541 (core#lambda (.obj.2557) ((core#lambda (.n.2558) (core", +"#begin (.objs.2538 (cons .obj.2557 (.objs.2538))) .n.2558)) (length (.objs.2538)", +")))) (core#begin (core#define .make-label.2542 ((core#lambda (.n.2559) (core#lam", +"bda () ((core#lambda (.m.2560) (core#begin (core#set! .n.2559 (+ .n.2559 1)) .m.", +"2560)) .n.2559))) 0)) (core#begin (core#define .emit-label.2543 (core#lambda (.l", +"abel.2561) (.code.2536 (cons .label.2561 (.code.2536))))) (core#begin (core#defi", +"ne .codegen-e.2544 (core#lambda (.e.2562) ((core#lambda (.key.2563) (core#if ((c", +"ore#lambda (.it.2564) (core#if .it.2564 .it.2564 ((core#lambda (.it.2565) (core#", +"if .it.2565 .it.2565 ((core#lambda (.it.2566) (core#if .it.2566 .it.2566 ((core#", +"lambda (.it.2567) (core#if .it.2567 .it.2567 #f)) (eqv? .key.2563 (core#quote un", +"defined))))) (eqv? .key.2563 (core#quote quote))))) (eqv? .key.2563 (core#quote ", +"lambda))))) (eqv? .key.2563 (core#quote ref))) (.codegen-a.2545 .e.2562 0) (core", +"#if ((core#lambda (.it.2568) (core#if .it.2568 .it.2568 #f)) (eqv? .key.2563 (co", +"re#quote set!))) (core#begin (.codegen-a.2545 (.caddr.2454 .e.2562) 0) (core#beg", +"in ((core#lambda (.x.2569) (core#if (eq? (core#quote global) (car .x.2569)) ((co", +"re#lambda (.i.2570) (.emit.2539 (cons (core#quote GSET) (cons (core#quote 0) (co", +"ns .i.2570 (core#quote ())))))) (.emit-obj.2541 (cadr .x.2569))) (.emit.2539 (co", +"ns (core#quote LSET) (cons (core#quote 0) (cdr .x.2569)))))) (.lookup.2534 (cadr", +" .e.2562) (.env.2535))) (.codegen-e.2544 (.cadddr.2455 .e.2562)))) (core#if ((co", +"re#lambda (.it.2571) (core#if .it.2571 .it.2571 #f)) (eqv? .key.2563 (core#quote", +" if))) (core#begin (.codegen-a.2545 (cadr .e.2562) 0) ((core#lambda (.label.2572", +") (core#begin (.emit.2539 (cons (core#quote COND) (cons (core#quote 0) (cons .la", +"bel.2572 (core#quote ()))))) (core#begin (.codegen-e.2544 (.caddr.2454 .e.2562))", +" (core#begin (.emit-label.2543 .label.2572) (.codegen-e.2544 (.cadddr.2455 .e.25", +"62)))))) (.make-label.2542))) (core#if #t (core#begin ((core#lambda () (core#beg", +"in (core#define .loop.2573 (core#lambda (.i.2574 .e.2575) (core#if (null? .e.257", +"5) #undefined (core#begin (.codegen-a.2545 (car .e.2575) .i.2574) (.loop.2573 (+", +" .i.2574 1) (cdr .e.2575)))))) (.loop.2573 0 .e.2562)))) (.emit.2539 (cons (core", +"#quote CALL) (cons (- (length .e.2562) 1) (core#quote ()))))) #undefined))))) (c", +"ar .e.2562)))) (core#begin (core#define .codegen-a.2545 (core#lambda (.e.2576 .i", +".2577) ((core#lambda (.key.2578) (core#if ((core#lambda (.it.2579) (core#if .it.", +"2579 .it.2579 #f)) (eqv? .key.2578 (core#quote ref))) ((core#lambda (.x.2580) (c", +"ore#if (eq? (core#quote global) (car .x.2580)) ((core#lambda (.n.2581) (.emit.25", +"39 (cons (core#quote GREF) (cons .i.2577 (cons .n.2581 (core#quote ())))))) (.em", +"it-obj.2541 (cadr .x.2580))) (.emit.2539 (cons (core#quote LREF) (cons .i.2577 (", +"cdr .x.2580)))))) (.lookup.2534 (cadr .e.2576) (.env.2535))) (core#if ((core#lam", +"bda (.it.2582) (core#if .it.2582 .it.2582 #f)) (eqv? .key.2578 (core#quote quote", +"))) ((core#lambda (.obj.2583) (core#if (eq? #t .obj.2583) (.emit.2539 (cons (cor", +"e#quote LOADT) (cons .i.2577 (core#quote ())))) (core#if (eq? #f .obj.2583) (.em", +"it.2539 (cons (core#quote LOADF) (cons .i.2577 (core#quote ())))) (core#if (null", +"? .obj.2583) (.emit.2539 (cons (core#quote LOADN) (cons .i.2577 (core#quote ()))", +")) (core#if (eq? #undefined .obj.2583) (.emit.2539 (cons (core#quote LOADU) (con", +"s .i.2577 (core#quote ())))) (core#if (core#if (.integer?.2457 .obj.2583) (<= -1", +"27 .obj.2583 127) #f) (.emit.2539 (cons (core#quote LOADI) (cons .i.2577 (cons .", +"obj.2583 (core#quote ()))))) ((core#lambda (.n.2584) (.emit.2539 (cons (core#quo", +"te LOAD) (cons .i.2577 (cons .n.2584 (core#quote ())))))) (.emit-obj.2541 .obj.2", +"583)))))))) (cadr .e.2576)) (core#if ((core#lambda (.it.2585) (core#if .it.2585 ", +".it.2585 #f)) (eqv? .key.2578 (core#quote undefined))) (.emit.2539 (cons (core#q", +"uote LOADU) (cons .i.2577 (core#quote ())))) (core#if ((core#lambda (.it.2586) (", +"core#if .it.2586 .it.2586 #f)) (eqv? .key.2578 (core#quote lambda))) ((core#lamb", +"da (.frame-size.2587 .argc-varg.2588) ((core#lambda (.irep.2589) ((core#lambda (", +".n.2590) (.emit.2539 (cons (core#quote PROC) (cons .i.2577 (cons .n.2590 (core#q", +"uote ())))))) (.emit-irep.2540 .irep.2589))) (with-dynamic-environment (list (co", +"ns .code.2536 (core#quote ())) (cons .env.2535 (cons (cadr .e.2576) (.env.2535))", +") (cons .reps.2537 (core#quote ())) (cons .objs.2538 (core#quote ()))) (core#lam", +"bda () (core#begin (.codegen-e.2544 (.caddr.2454 .e.2576)) (list (reverse (.code", +".2536)) (reverse (.reps.2537)) (reverse (.objs.2538)) .argc-varg.2588 .frame-siz", +"e.2587)))))) ((core#lambda () (core#begin (core#define .loop.2591 (core#lambda (", +".e.2592) ((core#lambda (.key.2593) (core#if ((core#lambda (.it.2594) (core#if .i", +"t.2594 .it.2594 ((core#lambda (.it.2595) (core#if .it.2595 .it.2595 ((core#lambd", +"a (.it.2596) (core#if .it.2596 .it.2596 ((core#lambda (.it.2597) (core#if .it.25", +"97 .it.2597 #f)) (eqv? .key.2593 (core#quote undefined))))) (eqv? .key.2593 (cor", +"e#quote quote))))) (eqv? .key.2593 (core#quote lambda))))) (eqv? .key.2593 (core", +"#quote ref))) 1 (core#if ((core#lambda (.it.2598) (core#if .it.2598 .it.2598 #f)", +") (eqv? .key.2593 (core#quote if))) (.max.2456 (.loop.2591 (.caddr.2454 .e.2592)", +") (.loop.2591 (.cadddr.2455 .e.2592))) (core#if ((core#lambda (.it.2599) (core#i", +"f .it.2599 .it.2599 #f)) (eqv? .key.2593 (core#quote set!))) (.loop.2591 (.caddd", +"r.2455 .e.2592)) (core#if #t (+ 1 (length .e.2592)) #undefined))))) (car .e.2592", +")))) (.loop.2591 (.caddr.2454 .e.2576))))) ((core#lambda () (core#begin (core#de", +"fine .loop.2600 (core#lambda (.args.2601 .c.2602) (core#if (symbol? .args.2601) ", +"(cons .c.2602 #t) (core#if (null? .args.2601) (cons .c.2602 #f) (.loop.2600 (cdr", +" .args.2601) (+ 1 .c.2602)))))) (.loop.2600 (cadr .e.2576) 0))))) #undefined))))", +") (car .e.2576)))) (core#lambda (.e.2603) (with-dynamic-environment (list (cons ", +".code.2536 (core#quote ())) (cons .env.2535 (core#quote ())) (cons .reps.2537 (c", +"ore#quote ())) (cons .objs.2538 (core#quote ()))) (core#lambda () (core#begin (.", +"codegen-e.2544 .e.2603) (car (.reps.2537))))))))))))))))))))) (core#lambda (.e.2", +"604) (.codegen.2460 (.transform.2459 (.normalize.2458 .e.2604)))))))))))))) (cor", +"e#lambda (.compile.2605) (core#set! compile .compile.2605)))) (core#define eval ", +"(core#lambda (.expr.2606 . .env.2607) (load (expand .expr.2606 (core#if (null? .", +"env.2607) default-environment (car .env.2607)))))))))", }; #endif diff --git a/lib/include/picrin/setup.h b/lib/include/picrin/setup.h index f0f0cd6d..2f9d9998 100644 --- a/lib/include/picrin/setup.h +++ b/lib/include/picrin/setup.h @@ -61,7 +61,7 @@ void abort(void); #endif #ifndef PIC_STACK_SIZE -# define PIC_STACK_SIZE 2048 +# define PIC_STACK_SIZE 8192 #endif #ifndef PIC_RESCUE_SIZE diff --git a/piclib/compile.scm b/piclib/compile.scm index 04b2e75a..04001e2b 100644 --- a/piclib/compile.scm +++ b/piclib/compile.scm @@ -656,8 +656,8 @@ (if (null? (defs)) `(lambda ,args ,body) `(lambda ,args - ((lambda ,(defs) ,body) ,@(map (lambda (_) #f) (defs))))))))) - ((core#set!) `(set! . ,(map normalize (cdr e)))) + ((lambda ,(defs) ,body) ,@(map (lambda (_) ''#f) (defs))))))))) + ((core#set!) `(set! ,(cadr e) ,(normalize (caddr e)))) ((core#if) `(if . ,(map normalize (cdr e)))) ((core#begin) `(begin . ,(map normalize (cdr e)))) (else @@ -698,13 +698,13 @@ (lambda (v) `(set! ,(cadr e) ,v ,(k '(undefined)))))) ((if) (let ((v (uniq)) - (c `(ref ,(uniq)))) + (c (uniq))) `((lambda (,c) ,(transform-k (cadr e) (lambda (x) `(if ,x - ,(transform-c (caddr e) c) - ,(transform-c (cadddr e) c))))) + ,(transform-c (caddr e) `(ref ,c)) + ,(transform-c (cadddr e) `(ref ,c)))))) (lambda (,v) ,(k `(ref ,v)))))) (else (let* ((v (uniq)) @@ -734,13 +734,13 @@ (lambda (v) `(set! ,(cadr e) ,v (,c (undefined)))))) ((if) (if (and (pair? c) (eq? 'lambda (car c))) - (let ((k `(ref ,(uniq)))) + (let ((k (uniq))) `((lambda (,k) ,(transform-k (cadr e) (lambda (x) `(if ,x - ,(transform-c (caddr e) k) - ,(transform-c (cadddr e) k))))) + ,(transform-c (caddr e) `(ref ,k)) + ,(transform-c (cadddr e) `(ref ,k)))))) ,c)) (transform-k (cadr e) (lambda (x) @@ -759,7 +759,7 @@ ((ref quote) e) ((lambda) (let ((k (uniq))) - `(lambda (,k ,@(cadr e)) ,(transform-c (caddr e) `(ref ,k))))))) + `(lambda (,k . ,(cadr e)) ,(transform-c (caddr e) `(ref ,k))))))) (lambda (e) (let ((k (uniq))) @@ -799,7 +799,7 @@ (reps (cons irep (reps))) n)) - (define (emit-objs obj) ; TODO remove duplicates + (define (emit-obj obj) ; TODO remove duplicates (let ((n (length (objs)))) (objs (cons obj (objs))) n)) @@ -819,9 +819,11 @@ ((ref lambda quote undefined) (codegen-a e 0)) ((set!) (begin (codegen-a (caddr e) 0) - (let* ((x (lookup (cadr e) (env))) - (op (if (eq? 'global (car x)) 'GSET 'LSET))) - (emit `(,op 0 . ,(cdr x)))) + (let ((x (lookup (cadr e) (env)))) + (if (eq? 'global (car x)) + (let ((i (emit-obj (cadr x)))) + (emit `(GSET 0 ,i))) + (emit `(LSET 0 . ,(cdr x))))) (codegen-e (cadddr e)))) ((if) (begin (codegen-a (cadr e) 0) @@ -839,15 +841,17 @@ (define (codegen-a e i) (case (car e) - ((ref) (let* ((x (lookup (cadr e) (env))) - (op (if (eq? 'global (car x)) 'GREF 'LREF))) - (emit `(,op ,i . ,(cdr x))))) + ((ref) (let ((x (lookup (cadr e) (env)))) + (if (eq? 'global (car x)) + (let ((n (emit-obj (cadr x)))) + (emit `(GREF ,i ,n))) + (emit `(LREF ,i . ,(cdr x)))))) ((quote) (let ((obj (cadr e))) (cond ((eq? #t obj) (emit `(LOADT ,i))) ((eq? #f obj) (emit `(LOADF ,i))) ((null? obj) (emit `(LOADN ,i))) ((eq? #undefined obj) (emit `(LOADU ,i))) - ((and (integer? obj) (<= -128 obj 127)) (emit `(LOADI ,i ,obj))) + ((and (integer? obj) (<= -127 obj 127)) (emit `(LOADI ,i ,obj))) (else (let ((n (emit-obj obj))) (emit `(LOAD ,i ,n))))))) ((undefined) (emit `(LOADU ,i)))