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

WIP: fix the compiler

This commit is contained in:
Yuichi Nishiwaki 2017-04-09 08:34:03 +09:00
parent 16dafdd032
commit c634948bf1
2 changed files with 55 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

102
lib/ext/boot.c
View File

@ -564,56 +564,58 @@ static const char boot_compile_rom[][80] = {
"#begin ((core#lambda () (core#begin (core#define .loop.2573 (core#lambda (.i.257", "#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", "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", " .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) (core#quote", ".2562)))) (.emit.2539 (cons (core#quote CALL) (cons (- (length .e.2562) 1) (core",
" ()))))) #undefined))))) (car .e.2562)))) (core#begin (core#define .codegen-a.25", "#quote ()))))) #undefined))))) (car .e.2562)))) (core#begin (core#define .codege",
"45 (core#lambda (.e.2576 .i.2577) ((core#lambda (.key.2578) (core#if ((core#lamb", "n-a.2545 (core#lambda (.e.2576 .i.2577) ((core#lambda (.key.2578) (core#if ((cor",
"da (.it.2579) (core#if .it.2579 .it.2579 #f)) (eqv? .key.2578 (core#quote ref)))", "e#lambda (.it.2579) (core#if .it.2579 .it.2579 #f)) (eqv? .key.2578 (core#quote ",
" ((core#lambda (.x.2580) ((core#lambda (.op.2581) ((core#lambda () (.emit.2539 (", "ref))) ((core#lambda (.x.2580) ((core#lambda (.op.2581) ((core#lambda () (.emit.",
"cons .op.2581 (cons .i.2577 (cdr .x.2580))))))) (core#if (eq? (core#quote global", "2539 (cons .op.2581 (cons .i.2577 (cdr .x.2580))))))) (core#if (eq? (core#quote ",
") (car .x.2580)) (core#quote GREF) (core#quote LREF)))) (.lookup.2534 (cadr .e.2", "global) (car .x.2580)) (core#quote GREF) (core#quote LREF)))) (.lookup.2534 (cad",
"576) (.env.2535))) (core#if ((core#lambda (.it.2582) (core#if .it.2582 .it.2582 ", "r .e.2576) (.env.2535))) (core#if ((core#lambda (.it.2582) (core#if .it.2582 .it",
"#f)) (eqv? .key.2578 (core#quote quote))) ((core#lambda (.obj.2583) (core#if (eq", ".2582 #f)) (eqv? .key.2578 (core#quote quote))) ((core#lambda (.obj.2583) (core#",
"? #t .obj.2583) (.emit.2539 (cons (core#quote LOADT) (cons .i.2577 (core#quote (", "if (eq? #t .obj.2583) (.emit.2539 (cons (core#quote LOADT) (cons .i.2577 (core#q",
"))))) (core#if (eq? #f .obj.2583) (.emit.2539 (cons (core#quote LOADF) (cons .i.", "uote ())))) (core#if (eq? #f .obj.2583) (.emit.2539 (cons (core#quote LOADF) (co",
"2577 (core#quote ())))) (core#if (null? .obj.2583) (.emit.2539 (cons (core#quote", "ns .i.2577 (core#quote ())))) (core#if (null? .obj.2583) (.emit.2539 (cons (core",
" LOADN) (cons .i.2577 (core#quote ())))) (core#if (core#if (.integer?.2457 .obj.", "#quote LOADN) (cons .i.2577 (core#quote ())))) (core#if (eq? #undefined .obj.258",
"2583) (<= -128 .obj.2583 127) #f) (.emit.2539 (cons (core#quote LOADI) (cons .i.", "3) (.emit.2539 (cons (core#quote LOADU) (cons .i.2577 (core#quote ())))) (core#i",
"2577 (cons .obj.2583 (core#quote ()))))) ((core#lambda (.n.2584) (.emit.2539 (co", "f (core#if (.integer?.2457 .obj.2583) (<= -128 .obj.2583 127) #f) (.emit.2539 (c",
"ns (core#quote LOAD) (cons .i.2577 (cons .n.2584 (core#quote ())))))) (emit-obj ", "ons (core#quote LOADI) (cons .i.2577 (cons .obj.2583 (core#quote ()))))) ((core#",
".obj.2583))))))) (cadr .e.2576)) (core#if ((core#lambda (.it.2585) (core#if .it.", "lambda (.n.2584) (.emit.2539 (cons (core#quote LOAD) (cons .i.2577 (cons .n.2584",
"2585 .it.2585 #f)) (eqv? .key.2578 (core#quote undefined))) (.emit.2539 (cons (c", " (core#quote ())))))) (emit-obj .obj.2583)))))))) (cadr .e.2576)) (core#if ((cor",
"ore#quote LOADU) (cons .i.2577 (core#quote ())))) (core#if ((core#lambda (.it.25", "e#lambda (.it.2585) (core#if .it.2585 .it.2585 #f)) (eqv? .key.2578 (core#quote ",
"86) (core#if .it.2586 .it.2586 #f)) (eqv? .key.2578 (core#quote lambda))) ((core", "undefined))) (.emit.2539 (cons (core#quote LOADU) (cons .i.2577 (core#quote ()))",
"#lambda (.frame-size.2587 .argc-varg.2588) ((core#lambda (.irep.2589) ((core#lam", ")) (core#if ((core#lambda (.it.2586) (core#if .it.2586 .it.2586 #f)) (eqv? .key.",
"bda (.n.2590) (.emit.2539 (cons (core#quote PROC) (cons .i.2577 (cons .n.2590 (c", "2578 (core#quote lambda))) ((core#lambda (.frame-size.2587 .argc-varg.2588) ((co",
"ore#quote ())))))) (.emit-irep.2540 .irep.2589))) (with-dynamic-environment (lis", "re#lambda (.irep.2589) ((core#lambda (.n.2590) (.emit.2539 (cons (core#quote PRO",
"t (cons .code.2536 (core#quote ())) (cons .env.2535 (cons (cadr .e.2576) (.env.2", "C) (cons .i.2577 (cons .n.2590 (core#quote ())))))) (.emit-irep.2540 .irep.2589)",
"535))) (cons .reps.2537 (core#quote ())) (cons .objs.2538 (core#quote ()))) (cor", ")) (with-dynamic-environment (list (cons .code.2536 (core#quote ())) (cons .env.",
"e#lambda () (core#begin (.codegen-e.2544 (.caddr.2454 .e.2576)) (list (reverse (", "2535 (cons (cadr .e.2576) (.env.2535))) (cons .reps.2537 (core#quote ())) (cons ",
".code.2536)) (reverse (.reps.2537)) (reverse (.objs.2538)) .argc-varg.2588 .fram", ".objs.2538 (core#quote ()))) (core#lambda () (core#begin (.codegen-e.2544 (.cadd",
"e-size.2587)))))) ((core#lambda () (core#begin (core#define .loop.2591 (core#lam", "r.2454 .e.2576)) (list (reverse (.code.2536)) (reverse (.reps.2537)) (reverse (.",
"bda (.e.2592) ((core#lambda (.key.2593) (core#if ((core#lambda (.it.2594) (core#", "objs.2538)) .argc-varg.2588 .frame-size.2587)))))) ((core#lambda () (core#begin ",
"if .it.2594 .it.2594 ((core#lambda (.it.2595) (core#if .it.2595 .it.2595 ((core#", "(core#define .loop.2591 (core#lambda (.e.2592) ((core#lambda (.key.2593) (core#i",
"lambda (.it.2596) (core#if .it.2596 .it.2596 ((core#lambda (.it.2597) (core#if .", "f ((core#lambda (.it.2594) (core#if .it.2594 .it.2594 ((core#lambda (.it.2595) (",
"it.2597 .it.2597 #f)) (eqv? .key.2593 (core#quote undefined))))) (eqv? .key.2593", "core#if .it.2595 .it.2595 ((core#lambda (.it.2596) (core#if .it.2596 .it.2596 ((",
" (core#quote quote))))) (eqv? .key.2593 (core#quote lambda))))) (eqv? .key.2593 ", "core#lambda (.it.2597) (core#if .it.2597 .it.2597 #f)) (eqv? .key.2593 (core#quo",
"(core#quote ref))) 1 (core#if ((core#lambda (.it.2598) (core#if .it.2598 .it.259", "te undefined))))) (eqv? .key.2593 (core#quote quote))))) (eqv? .key.2593 (core#q",
"8 #f)) (eqv? .key.2593 (core#quote if))) (.max.2456 (.loop.2591 (.caddr.2454 .e.", "uote lambda))))) (eqv? .key.2593 (core#quote ref))) 1 (core#if ((core#lambda (.i",
"2592)) (.loop.2591 (.cadddr.2455 .e.2592))) (core#if ((core#lambda (.it.2599) (c", "t.2598) (core#if .it.2598 .it.2598 #f)) (eqv? .key.2593 (core#quote if))) (.max.",
"ore#if .it.2599 .it.2599 #f)) (eqv? .key.2593 (core#quote set!))) (.loop.2591 (.", "2456 (.loop.2591 (.caddr.2454 .e.2592)) (.loop.2591 (.cadddr.2455 .e.2592))) (co",
"cadddr.2455 .e.2592)) (core#if #t (+ 1 (length .e.2592)) #undefined))))) (car .e", "re#if ((core#lambda (.it.2599) (core#if .it.2599 .it.2599 #f)) (eqv? .key.2593 (",
".2592)))) (.loop.2591 (.caddr.2454 .e.2576))))) ((core#lambda () (core#begin (co", "core#quote set!))) (.loop.2591 (.cadddr.2455 .e.2592)) (core#if #t (+ 1 (length ",
"re#define .loop.2600 (core#lambda (.args.2601 .c.2602) (core#if (symbol? .args.2", ".e.2592)) #undefined))))) (car .e.2592)))) (.loop.2591 (.caddr.2454 .e.2576)))))",
"601) (cons (+ 1 .c.2602) #t) (core#if (null? .args.2601) (cons .c.2602 #f) (.loo", " ((core#lambda () (core#begin (core#define .loop.2600 (core#lambda (.args.2601 .",
"p.2600 (cdr .args.2601) (+ 1 .c.2602)))))) (.loop.2600 (cadr .e.2576) 0))))) #un", "c.2602) (core#if (symbol? .args.2601) (cons .c.2602 #t) (core#if (null? .args.26",
"defined))))) (car .e.2576)))) (core#lambda (.e.2603) (with-dynamic-environment (", "01) (cons .c.2602 #f) (.loop.2600 (cdr .args.2601) (+ 1 .c.2602)))))) (.loop.260",
"list (cons .code.2536 (core#quote ())) (cons .env.2535 (core#quote ())) (cons .r", "0 (cadr .e.2576) 0))))) #undefined))))) (car .e.2576)))) (core#lambda (.e.2603) ",
"eps.2537 (core#quote ())) (cons .objs.2538 (core#quote ()))) (core#lambda () (co", "(with-dynamic-environment (list (cons .code.2536 (core#quote ())) (cons .env.253",
"re#begin (.codegen-e.2544 .e.2603) (car (.reps.2537))))))))))))))))))))) (core#l", "5 (core#quote ())) (cons .reps.2537 (core#quote ())) (cons .objs.2538 (core#quot",
"ambda (.e.2604) (.codegen.2460 (.transform.2459 (.normalize.2458 .e.2604))))))))", "e ()))) (core#lambda () (core#begin (.codegen-e.2544 .e.2603) (car (.reps.2537))",
")))))) (core#lambda (.compile.2605) (core#set! compile .compile.2605)))) (core#d", "))))))))))))))))))) (core#lambda (.e.2604) (.codegen.2460 (.transform.2459 (.nor",
"efine eval (core#lambda (.expr.2606 . .env.2607) (load (expand .expr.2606 (core#", "malize.2458 .e.2604)))))))))))))) (core#lambda (.compile.2605) (core#set! compil",
"if (null? .env.2607) default-environment (car .env.2607)))))))))", "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)))))))))",
}; };
#endif #endif

5
piclib/compile.scm
View File

@ -835,7 +835,7 @@
(unless (null? e) (unless (null? e)
(codegen-a (car e) i) (codegen-a (car e) i)
(loop (+ i 1) (cdr e)))) (loop (+ i 1) (cdr e))))
(emit `(CALL ,(length e))))))) (emit `(CALL ,(- (length e) 1)))))))
(define (codegen-a e i) (define (codegen-a e i)
(case (car e) (case (car e)
@ -846,6 +846,7 @@
(cond ((eq? #t obj) (emit `(LOADT ,i))) (cond ((eq? #t obj) (emit `(LOADT ,i)))
((eq? #f obj) (emit `(LOADF ,i))) ((eq? #f obj) (emit `(LOADF ,i)))
((null? obj) (emit `(LOADN ,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) (<= -128 obj 127)) (emit `(LOADI ,i ,obj)))
(else (let ((n (emit-obj obj))) (else (let ((n (emit-obj obj)))
(emit `(LOAD ,i ,n))))))) (emit `(LOAD ,i ,n)))))))
@ -860,7 +861,7 @@
(argc-varg (argc-varg
(let loop ((args (cadr e)) (c 0)) (let loop ((args (cadr e)) (c 0))
(if (symbol? args) (if (symbol? args)
(cons (+ 1 c) #t) (cons c #t)
(if (null? args) (if (null? args)
(cons c #f) (cons c #f)
(loop (cdr args) (+ 1 c))))))) (loop (cdr args) (+ 1 c)))))))