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

support top-level begin in define-library

This commit is contained in:
Yuichi Nishiwaki 2017-04-12 14:17:52 +09:00
parent cf63d541a2
commit 9cc40bd46a
2 changed files with 111 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

207
lib/ext/boot.c
View File

@ -672,108 +672,111 @@ static const char boot_library_rom[][80] = {
"1) (core#if .it.2651 .it.2651 ((core#lambda (.it.2652) (core#if .it.2652 .it.265",
"2 #f)) (.make-library.2612 .name.2649)))) (.find-library.2611 .name.2649)) (with",
"-dynamic-environment (list (cons .current-library.2609 .name.2649)) (core#lambda",
" () (for-each (core#lambda (.expr.2653) (eval .expr.2653 .name.2649)) .body.2650",
"))))) (cadr .form.2647) (cddr .form.2647)))) (core#begin (.define-transformer.26",
"46 (core#quote cond-expand) (core#lambda (.form.2654 ._.2655) ((core#lambda (.te",
"st.2656) (core#begin (core#set! .test.2656 (core#lambda (.form.2657) ((core#lamb",
"da (.it.2658) (core#if .it.2658 .it.2658 ((core#lambda (.it.2659) (core#if .it.2",
"659 .it.2659 ((core#lambda (.it.2660) (core#if .it.2660 .it.2660 #f)) (core#if (",
"pair? .form.2657) ((core#lambda (.key.2661) (core#if ((core#lambda (.it.2662) (c",
"ore#if .it.2662 .it.2662 #f)) (eqv? .key.2661 (core#quote library))) (.find-libr",
"ary.2611 (cadr .form.2657)) (core#if ((core#lambda (.it.2663) (core#if .it.2663 ",
".it.2663 #f)) (eqv? .key.2661 (core#quote not))) (not (.test.2656 (cadr .form.26",
"57))) (core#if ((core#lambda (.it.2664) (core#if .it.2664 .it.2664 #f)) (eqv? .k",
"ey.2661 (core#quote and))) ((core#lambda () (core#begin (core#define .loop.2665 ",
"(core#lambda (.form.2666) ((core#lambda (.it.2667) (core#if .it.2667 .it.2667 ((",
"core#lambda (.it.2668) (core#if .it.2668 .it.2668 #f)) (core#if (.test.2656 (car",
" .form.2666)) (.loop.2665 (cdr .form.2666)) #f)))) (null? .form.2666)))) (.loop.",
"2665 (cdr .form.2657))))) (core#if ((core#lambda (.it.2669) (core#if .it.2669 .i",
"t.2669 #f)) (eqv? .key.2661 (core#quote or))) ((core#lambda () (core#begin (core",
"#define .loop.2670 (core#lambda (.form.2671) (core#if (pair? .form.2671) ((core#",
"lambda (.it.2672) (core#if .it.2672 .it.2672 ((core#lambda (.it.2673) (core#if .",
"it.2673 .it.2673 #f)) (.loop.2670 (cdr .form.2671))))) (.test.2656 (car .form.26",
"71))) #f))) (.loop.2670 (cdr .form.2657))))) (core#if #t #f #undefined)))))) (ca",
"r .form.2657)) #f)))) (core#if (symbol? .form.2657) (memq .form.2657 (features))",
" #f)))) (eq? .form.2657 (core#quote else))))) ((core#lambda () (core#begin (core",
"#define .loop.2674 (core#lambda (.clauses.2675) (core#if (null? .clauses.2675) #",
"undefined (core#if (.test.2656 (caar .clauses.2675)) (cons (make-identifier (cor",
"e#quote begin) default-environment) (append (cdar .clauses.2675) (core#quote ())",
")) (.loop.2674 (cdr .clauses.2675)))))) (.loop.2674 (cdr .form.2654))))))) #unde",
"fined))) (core#begin (.define-transformer.2646 (core#quote import) (core#lambda ",
"(.form.2676 ._.2677) ((core#lambda (.caddr.2678 .prefix.2679 .getlib.2680) ((cor",
"e#lambda (.extract.2681 .collect.2682) (core#begin (core#set! .extract.2681 (cor",
"e#lambda (.spec.2683) ((core#lambda (.key.2684) (core#if ((core#lambda (.it.2685",
") (core#if .it.2685 .it.2685 ((core#lambda (.it.2686) (core#if .it.2686 .it.2686",
" ((core#lambda (.it.2687) (core#if .it.2687 .it.2687 ((core#lambda (.it.2688) (c",
"ore#if .it.2688 .it.2688 #f)) (eqv? .key.2684 (core#quote except))))) (eqv? .key",
".2684 (core#quote prefix))))) (eqv? .key.2684 (core#quote rename))))) (eqv? .key",
".2684 (core#quote only))) (.extract.2681 (cadr .spec.2683)) (core#if #t (.getlib",
".2680 .spec.2683) #undefined))) (car .spec.2683)))) (core#begin (core#set! .coll",
"ect.2682 (core#lambda (.spec.2689) ((core#lambda (.key.2690) (core#if ((core#lam",
"bda (.it.2691) (core#if .it.2691 .it.2691 #f)) (eqv? .key.2690 (core#quote only)",
")) ((core#lambda (.alist.2692) (map (core#lambda (.var.2693) (assq .var.2693 .al",
"ist.2692)) (cddr .spec.2689))) (.collect.2682 (cadr .spec.2689))) (core#if ((cor",
"e#lambda (.it.2694) (core#if .it.2694 .it.2694 #f)) (eqv? .key.2690 (core#quote ",
"rename))) ((core#lambda (.alist.2695 .renames.2696) (map (core#lambda (.s.2697) ",
"((core#lambda (.it.2698) (core#if .it.2698 .it.2698 ((core#lambda (.it.2699) (co",
"re#if .it.2699 .it.2699 #f)) .s.2697))) (assq (car .s.2697) .renames.2696))) .al",
"ist.2695)) (.collect.2682 (cadr .spec.2689)) (map (core#lambda (.x.2700) (cons (",
"car .x.2700) (cadr .x.2700))) (cddr .spec.2689))) (core#if ((core#lambda (.it.27",
"01) (core#if .it.2701 .it.2701 #f)) (eqv? .key.2690 (core#quote prefix))) ((core",
"#lambda (.alist.2702) (map (core#lambda (.s.2703) (cons (.prefix.2679 (.caddr.26",
"78 .spec.2689) (car .s.2703)) (cdr .s.2703))) .alist.2702)) (.collect.2682 (cadr",
" .spec.2689))) (core#if ((core#lambda (.it.2704) (core#if .it.2704 .it.2704 #f))",
" (eqv? .key.2690 (core#quote except))) ((core#lambda (.alist.2705) ((core#lambda",
" () (core#begin (core#define .loop.2706 (core#lambda (.alist.2707) (core#if (nul",
"l? .alist.2707) (core#quote ()) (core#if (memq (caar .alist.2707) (cddr .spec.26",
"89)) (.loop.2706 (cdr .alist.2707)) (cons (car .alist.2707) (.loop.2706 (cdr .al",
"ist.2707))))))) (.loop.2706 .alist.2705))))) (.collect.2682 (cadr .spec.2689))) ",
"(core#if #t (dictionary-map (core#lambda (.x.2708) (cons .x.2708 .x.2708)) (.lib",
"rary-exports.2614 (.getlib.2680 .spec.2689))) #undefined)))))) (car .spec.2689))",
")) ((core#lambda (.import.2709) (core#begin (core#set! .import.2709 (core#lambda",
" (.spec.2710) ((core#lambda (.lib.2711 .alist.2712) (for-each (core#lambda (.slo",
"t.2713) (.library-import.2615 .lib.2711 (cdr .slot.2713) (car .slot.2713))) .ali",
"st.2712)) (.extract.2681 .spec.2710) (.collect.2682 .spec.2710)))) (for-each .im",
"port.2709 (cdr .form.2676)))) #undefined)))) #undefined #undefined)) (core#lambd",
"a (.x.2714) (car (cdr (cdr .x.2714)))) (core#lambda (.prefix.2715 .symbol.2716) ",
"(string->symbol (string-append (symbol->string .prefix.2715) (symbol->string .sy",
"mbol.2716)))) (core#lambda (.name.2717) (core#if (.find-library.2611 .name.2717)",
" .name.2717 (error \"library not found\" .name.2717)))))) (.define-transformer.264",
"6 (core#quote export) (core#lambda (.form.2718 ._.2719) ((core#lambda (.collect.",
"2720 .export.2721) (core#begin (core#set! .collect.2720 (core#lambda (.spec.2722",
") (core#if (symbol? .spec.2722) (cons .spec.2722 .spec.2722) (core#if (core#if (",
"list? .spec.2722) (core#if (= (length .spec.2722) 3) (eq? (car .spec.2722) (core",
"#quote rename)) #f) #f) (cons (list-ref .spec.2722 1) (list-ref .spec.2722 2)) (",
"error \"malformed export\"))))) (core#begin (core#set! .export.2721 (core#lambda (",
".spec.2723) ((core#lambda (.slot.2724) (.library-export.2616 (car .slot.2724) (c",
"dr .slot.2724))) (.collect.2720 .spec.2723)))) (for-each .export.2721 (cdr .form",
".2718))))) #undefined #undefined))))))) (core#lambda (.name.2725 .macro.2726) (d",
"ictionary-set! (macro-objects) .name.2725 .macro.2726))) (core#begin ((core#lamb",
"da () (core#begin (.make-library.2612 (core#quote (picrin base))) (core#begin (s",
"et-car! (dictionary-ref .*libraries*.2610 (.mangle.2608 (core#quote (picrin base",
")))) default-environment) (core#begin ((core#lambda (.exports.2727) ((core#lambd",
"a (.export-keyword.2728) ((core#lambda () (core#begin (for-each .export-keyword.",
"2728 (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 define-record-type))) (co",
"re#begin (.export-keyword.2728 (core#quote boolean?)) (dictionary-for-each .expo",
"rt-keyword.2728 (global-objects))))))) (core#lambda (.keyword.2729) (dictionary-",
"set! .exports.2727 .keyword.2729 .keyword.2729)))) (.library-exports.2614 (core#",
"quote (picrin base)))) (core#begin (core#set! eval ((core#lambda (.e.2730) (core",
"#lambda (.expr.2731 . .lib.2732) ((core#lambda (.lib.2733) (with-dynamic-environ",
"ment (list (cons .current-library.2609 .lib.2733)) (core#lambda () (.e.2730 .exp",
"r.2731 (.library-environment.2613 .lib.2733))))) (core#if (null? .lib.2732) (.cu",
"rrent-library.2609) (car .lib.2732))))) eval)) (.make-library.2612 (core#quote (",
"picrin user))))))))) (values .current-library.2609 .find-library.2611 .make-libr",
"ary.2612 .library-environment.2613 .library-exports.2614 .library-import.2615 .l",
"ibrary-export.2616))))))))))))))) (core#lambda (.current-library.2734 .find-libr",
"ary.2735 .make-library.2736 .library-environment.2737 .library-exports.2738 .lib",
"rary-import.2739 .library-export.2740) (core#begin (core#set! current-library .c",
"urrent-library.2734) (core#begin (core#set! find-library .find-library.2735) (co",
"re#begin (core#set! make-library .make-library.2736) (core#begin (core#set! libr",
"ary-environment .library-environment.2737) (core#begin (core#set! library-export",
"s .library-exports.2738) (core#begin (core#set! library-import .library-import.2",
"739) (core#set! library-export .library-export.2740))))))))))))))))",
" () (for-each (core#lambda (.expr.2653) ((core#lambda (.exprs.2654) (for-each (c",
"ore#lambda (.e.2655) (eval .e.2655 .name.2649)) .exprs.2654)) (core#if (core#if ",
"(pair? .expr.2653) (eq? (car .expr.2653) (core#quote begin)) #f) (cdr .expr.2653",
") (list .expr.2653)))) .body.2650))))) (cadr .form.2647) (cddr .form.2647)))) (c",
"ore#begin (.define-transformer.2646 (core#quote cond-expand) (core#lambda (.form",
".2656 ._.2657) ((core#lambda (.test.2658) (core#begin (core#set! .test.2658 (cor",
"e#lambda (.form.2659) ((core#lambda (.it.2660) (core#if .it.2660 .it.2660 ((core",
"#lambda (.it.2661) (core#if .it.2661 .it.2661 ((core#lambda (.it.2662) (core#if ",
".it.2662 .it.2662 #f)) (core#if (pair? .form.2659) ((core#lambda (.key.2663) (co",
"re#if ((core#lambda (.it.2664) (core#if .it.2664 .it.2664 #f)) (eqv? .key.2663 (",
"core#quote library))) (.find-library.2611 (cadr .form.2659)) (core#if ((core#lam",
"bda (.it.2665) (core#if .it.2665 .it.2665 #f)) (eqv? .key.2663 (core#quote not))",
") (not (.test.2658 (cadr .form.2659))) (core#if ((core#lambda (.it.2666) (core#i",
"f .it.2666 .it.2666 #f)) (eqv? .key.2663 (core#quote and))) ((core#lambda () (co",
"re#begin (core#define .loop.2667 (core#lambda (.form.2668) ((core#lambda (.it.26",
"69) (core#if .it.2669 .it.2669 ((core#lambda (.it.2670) (core#if .it.2670 .it.26",
"70 #f)) (core#if (.test.2658 (car .form.2668)) (.loop.2667 (cdr .form.2668)) #f)",
"))) (null? .form.2668)))) (.loop.2667 (cdr .form.2659))))) (core#if ((core#lambd",
"a (.it.2671) (core#if .it.2671 .it.2671 #f)) (eqv? .key.2663 (core#quote or))) (",
"(core#lambda () (core#begin (core#define .loop.2672 (core#lambda (.form.2673) (c",
"ore#if (pair? .form.2673) ((core#lambda (.it.2674) (core#if .it.2674 .it.2674 ((",
"core#lambda (.it.2675) (core#if .it.2675 .it.2675 #f)) (.loop.2672 (cdr .form.26",
"73))))) (.test.2658 (car .form.2673))) #f))) (.loop.2672 (cdr .form.2659))))) (c",
"ore#if #t #f #undefined)))))) (car .form.2659)) #f)))) (core#if (symbol? .form.2",
"659) (memq .form.2659 (features)) #f)))) (eq? .form.2659 (core#quote else))))) (",
"(core#lambda () (core#begin (core#define .loop.2676 (core#lambda (.clauses.2677)",
" (core#if (null? .clauses.2677) #undefined (core#if (.test.2658 (caar .clauses.2",
"677)) (cons (make-identifier (core#quote begin) default-environment) (append (cd",
"ar .clauses.2677) (core#quote ()))) (.loop.2676 (cdr .clauses.2677)))))) (.loop.",
"2676 (cdr .form.2656))))))) #undefined))) (core#begin (.define-transformer.2646 ",
"(core#quote import) (core#lambda (.form.2678 ._.2679) ((core#lambda (.caddr.2680",
" .prefix.2681 .getlib.2682) ((core#lambda (.extract.2683 .collect.2684) (core#be",
"gin (core#set! .extract.2683 (core#lambda (.spec.2685) ((core#lambda (.key.2686)",
" (core#if ((core#lambda (.it.2687) (core#if .it.2687 .it.2687 ((core#lambda (.it",
".2688) (core#if .it.2688 .it.2688 ((core#lambda (.it.2689) (core#if .it.2689 .it",
".2689 ((core#lambda (.it.2690) (core#if .it.2690 .it.2690 #f)) (eqv? .key.2686 (",
"core#quote except))))) (eqv? .key.2686 (core#quote prefix))))) (eqv? .key.2686 (",
"core#quote rename))))) (eqv? .key.2686 (core#quote only))) (.extract.2683 (cadr ",
".spec.2685)) (core#if #t (.getlib.2682 .spec.2685) #undefined))) (car .spec.2685",
")))) (core#begin (core#set! .collect.2684 (core#lambda (.spec.2691) ((core#lambd",
"a (.key.2692) (core#if ((core#lambda (.it.2693) (core#if .it.2693 .it.2693 #f)) ",
"(eqv? .key.2692 (core#quote only))) ((core#lambda (.alist.2694) (map (core#lambd",
"a (.var.2695) (assq .var.2695 .alist.2694)) (cddr .spec.2691))) (.collect.2684 (",
"cadr .spec.2691))) (core#if ((core#lambda (.it.2696) (core#if .it.2696 .it.2696 ",
"#f)) (eqv? .key.2692 (core#quote rename))) ((core#lambda (.alist.2697 .renames.2",
"698) (map (core#lambda (.s.2699) ((core#lambda (.it.2700) (core#if .it.2700 .it.",
"2700 ((core#lambda (.it.2701) (core#if .it.2701 .it.2701 #f)) .s.2699))) (assq (",
"car .s.2699) .renames.2698))) .alist.2697)) (.collect.2684 (cadr .spec.2691)) (m",
"ap (core#lambda (.x.2702) (cons (car .x.2702) (cadr .x.2702))) (cddr .spec.2691)",
")) (core#if ((core#lambda (.it.2703) (core#if .it.2703 .it.2703 #f)) (eqv? .key.",
"2692 (core#quote prefix))) ((core#lambda (.alist.2704) (map (core#lambda (.s.270",
"5) (cons (.prefix.2681 (.caddr.2680 .spec.2691) (car .s.2705)) (cdr .s.2705))) .",
"alist.2704)) (.collect.2684 (cadr .spec.2691))) (core#if ((core#lambda (.it.2706",
") (core#if .it.2706 .it.2706 #f)) (eqv? .key.2692 (core#quote except))) ((core#l",
"ambda (.alist.2707) ((core#lambda () (core#begin (core#define .loop.2708 (core#l",
"ambda (.alist.2709) (core#if (null? .alist.2709) (core#quote ()) (core#if (memq ",
"(caar .alist.2709) (cddr .spec.2691)) (.loop.2708 (cdr .alist.2709)) (cons (car ",
".alist.2709) (.loop.2708 (cdr .alist.2709))))))) (.loop.2708 .alist.2707))))) (.",
"collect.2684 (cadr .spec.2691))) (core#if #t (dictionary-map (core#lambda (.x.27",
"10) (cons .x.2710 .x.2710)) (.library-exports.2614 (.getlib.2682 .spec.2691))) #",
"undefined)))))) (car .spec.2691)))) ((core#lambda (.import.2711) (core#begin (co",
"re#set! .import.2711 (core#lambda (.spec.2712) ((core#lambda (.lib.2713 .alist.2",
"714) (for-each (core#lambda (.slot.2715) (.library-import.2615 .lib.2713 (cdr .s",
"lot.2715) (car .slot.2715))) .alist.2714)) (.extract.2683 .spec.2712) (.collect.",
"2684 .spec.2712)))) (for-each .import.2711 (cdr .form.2678)))) #undefined)))) #u",
"ndefined #undefined)) (core#lambda (.x.2716) (car (cdr (cdr .x.2716)))) (core#la",
"mbda (.prefix.2717 .symbol.2718) (string->symbol (string-append (symbol->string ",
".prefix.2717) (symbol->string .symbol.2718)))) (core#lambda (.name.2719) (core#i",
"f (.find-library.2611 .name.2719) .name.2719 (error \"library not found\" .name.27",
"19)))))) (.define-transformer.2646 (core#quote export) (core#lambda (.form.2720 ",
"._.2721) ((core#lambda (.collect.2722 .export.2723) (core#begin (core#set! .coll",
"ect.2722 (core#lambda (.spec.2724) (core#if (symbol? .spec.2724) (cons .spec.272",
"4 .spec.2724) (core#if (core#if (list? .spec.2724) (core#if (= (length .spec.272",
"4) 3) (eq? (car .spec.2724) (core#quote rename)) #f) #f) (cons (list-ref .spec.2",
"724 1) (list-ref .spec.2724 2)) (error \"malformed export\"))))) (core#begin (core",
"#set! .export.2723 (core#lambda (.spec.2725) ((core#lambda (.slot.2726) (.librar",
"y-export.2616 (car .slot.2726) (cdr .slot.2726))) (.collect.2722 .spec.2725)))) ",
"(for-each .export.2723 (cdr .form.2720))))) #undefined #undefined))))))) (core#l",
"ambda (.name.2727 .macro.2728) (dictionary-set! (macro-objects) .name.2727 .macr",
"o.2728))) (core#begin ((core#lambda () (core#begin (.make-library.2612 (core#quo",
"te (picrin base))) (core#begin (set-car! (dictionary-ref .*libraries*.2610 (.man",
"gle.2608 (core#quote (picrin base)))) default-environment) (core#begin ((core#la",
"mbda (.exports.2729) ((core#lambda (.export-keyword.2730) ((core#lambda () (core",
"#begin (for-each .export-keyword.2730 (core#quote (define lambda quote set! if b",
"egin define-macro let let* letrec letrec* let-values let*-values define-values q",
"uasiquote unquote unquote-splicing and or cond case else => do when unless param",
"eterize define-record-type))) (core#begin (.export-keyword.2730 (core#quote bool",
"ean?)) (dictionary-for-each .export-keyword.2730 (global-objects))))))) (core#la",
"mbda (.keyword.2731) (dictionary-set! .exports.2729 .keyword.2731 .keyword.2731)",
"))) (.library-exports.2614 (core#quote (picrin base)))) (core#begin (core#set! e",
"val ((core#lambda (.e.2732) (core#lambda (.expr.2733 . .lib.2734) ((core#lambda ",
"(.lib.2735) (with-dynamic-environment (list (cons .current-library.2609 .lib.273",
"5)) (core#lambda () (.e.2732 .expr.2733 (.library-environment.2613 .lib.2735))))",
") (core#if (null? .lib.2734) (.current-library.2609) (car .lib.2734))))) eval)) ",
"(.make-library.2612 (core#quote (picrin user))))))))) (values .current-library.2",
"609 .find-library.2611 .make-library.2612 .library-environment.2613 .library-exp",
"orts.2614 .library-import.2615 .library-export.2616))))))))))))))) (core#lambda ",
"(.current-library.2736 .find-library.2737 .make-library.2738 .library-environmen",
"t.2739 .library-exports.2740 .library-import.2741 .library-export.2742) (core#be",
"gin (core#set! current-library .current-library.2736) (core#begin (core#set! fin",
"d-library .find-library.2737) (core#begin (core#set! make-library .make-library.",
"2738) (core#begin (core#set! library-environment .library-environment.2739) (cor",
"e#begin (core#set! library-exports .library-exports.2740) (core#begin (core#set!",
" library-import .library-import.2741) (core#set! library-export .library-export.",
"2742))))))))))))))))",
};
#endif

7
piclib/library.scm
View File

@ -91,7 +91,12 @@
(parameterize ((current-library name))
(for-each
(lambda (expr)
(eval expr name)) ; TODO parse library declarations
(let ((exprs (if (and (pair? expr) (eq? (car expr) 'begin))
(cdr expr)
(list expr))))
(for-each
(lambda (e) (eval e name))
exprs)))
body)))))
(define-transformer 'cond-expand