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

[bugfix] renaming import broken

This commit is contained in:
Yuichi Nishiwaki 2015-07-04 18:17:01 +09:00
parent 7e970258f4
commit e6719a43bb
1 changed files with 33 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
extlib/benz/boot.c
View File

@ -600,8 +600,9 @@ my $src = <<'EOL';
(let ((alist (collect (cadr spec)))) (let ((alist (collect (cadr spec))))
(map (lambda (var) (assq var alist)) (cddr spec)))) (map (lambda (var) (assq var alist)) (cddr spec))))
((rename) ((rename)
(let ((alist (collect (cadr spec)))) (let ((alist (collect (cadr spec)))
(map (lambda (s) (or (assq (car s) (cddr spec)) s)) alist))) (renames (map (lambda (x) `((car x) . (cadr x))) (cddr spec))))
(map (lambda (s) (or (assq (car s) renames) s)) alist)))
((prefix) ((prefix)
(let ((alist (collect (cadr spec)))) (let ((alist (collect (cadr spec))))
(map (lambda (s) (cons (prefix (caddr spec) (car s)) (cdr s))) alist))) (map (lambda (s) (cons (prefix (caddr spec) (car s)) (cdr s))) alist)))
@ -977,35 +978,36 @@ const char pic_boot[][80] = {
" (collect\n (lambda (spec)\n (case (car spec)\n ", " (collect\n (lambda (spec)\n (case (car spec)\n ",
" ((only)\n (let ((alist (collect (cadr spec))))\n ", " ((only)\n (let ((alist (collect (cadr spec))))\n ",
" (map (lambda (var) (assq var alist)) (cddr spec))))\n ((renam", " (map (lambda (var) (assq var alist)) (cddr spec))))\n ((renam",
"e)\n (let ((alist (collect (cadr spec))))\n (map", "e)\n (let ((alist (collect (cadr spec)))\n (",
" (lambda (s) (or (assq (car s) (cddr spec)) s)) alist)))\n ((prefi", "renames (map (lambda (x) `((car x) . (cadr x))) (cddr spec))))\n ",
"x)\n (let ((alist (collect (cadr spec))))\n (map", " (map (lambda (s) (or (assq (car s) renames) s)) alist)))\n ((pre",
" (lambda (s) (cons (prefix (caddr spec) (car s)) (cdr s))) alist)))\n ", "fix)\n (let ((alist (collect (cadr spec))))\n (m",
" ((except)\n (let ((alist (collect (cadr spec))))\n ", "ap (lambda (s) (cons (prefix (caddr spec) (car s)) (cdr s))) alist)))\n ",
" (let loop ((alist alist))\n (if (null? alist)\n ", " ((except)\n (let ((alist (collect (cadr spec))))\n ",
" '()\n (if (memq (caar alist) (cddr spec)", " (let loop ((alist alist))\n (if (null? alist)\n ",
")\n (loop (cdr alist))\n (", " '()\n (if (memq (caar alist) (cddr spe",
"cons (car alist) (loop (cdr alist))))))))\n (else\n ", "c))\n (loop (cdr alist))\n ",
" (let ((lib (or (find-library spec) (error \"library not found\" spec))))\n ", " (cons (car alist) (loop (cdr alist))))))))\n (else\n ",
" (map (lambda (x) (cons x x)) (library-exports lib))))))))\n (le", " (let ((lib (or (find-library spec) (error \"library not found\" spec))))\n ",
"trec\n ((import\n (lambda (spec)\n (let ((", " (map (lambda (x) (cons x x)) (library-exports lib))))))))\n (",
"lib (extract spec))\n (alist (collect spec)))\n ", "letrec\n ((import\n (lambda (spec)\n (let ",
" (for-each\n (lambda (slot)\n (librar", "((lib (extract spec))\n (alist (collect spec)))\n ",
"y-import lib (cdr slot) (car slot)))\n alist)))))\n (f", " (for-each\n (lambda (slot)\n (libr",
"or-each import (cdr form)))))))\n\n(define-macro export\n (lambda (form _)\n (le", "ary-import lib (cdr slot) (car slot)))\n alist)))))\n ",
"trec\n ((collect\n (lambda (spec)\n (cond\n (", "(for-each import (cdr form)))))))\n\n(define-macro export\n (lambda (form _)\n (",
"(symbol? spec)\n `(,spec . ,spec))\n ((and (list? spec) (", "letrec\n ((collect\n (lambda (spec)\n (cond\n ",
"= (length spec) 3) (eq? (car spec) 'rename))\n `(,(list-ref spec 1) ", " ((symbol? spec)\n `(,spec . ,spec))\n ((and (list? spec)",
". ,(list-ref spec 2)))\n (else\n (error \"malformed export", " (= (length spec) 3) (eq? (car spec) 'rename))\n `(,(list-ref spec 1",
"\")))))\n (export\n (lambda (spec)\n (let ((slot (coll", ") . ,(list-ref spec 2)))\n (else\n (error \"malformed expo",
"ect spec)))\n (library-export (car slot) (cdr slot))))))\n (for", "rt\")))))\n (export\n (lambda (spec)\n (let ((slot (co",
"-each export (cdr form)))))\n\n(export define-library\n cond-expand\n ", "llect spec)))\n (library-export (car slot) (cdr slot))))))\n (f",
"import\n export)\n\n(export define lambda quote set! if begin define-macro\n ", "or-each export (cdr form)))))\n\n(export define-library\n cond-expand\n ",
" let let* letrec letrec*\n let-values let*-values define-values\n ", " import\n export)\n\n(export define lambda quote set! if begin define-macro",
" quasiquote unquote unquote-splicing\n and or\n cond case else =>", "\n let let* letrec letrec*\n let-values let*-values define-values\n ",
"\n do when unless\n parameterize\n define-syntax\n synta", " quasiquote unquote unquote-splicing\n and or\n cond case else ",
"x-quote syntax-unquote\n syntax-quasiquote syntax-unquote-splicing\n ", "=>\n do when unless\n parameterize\n define-syntax\n syn",
" let-syntax letrec-syntax\n syntax-error)\n\n\n", "tax-quote syntax-unquote\n syntax-quasiquote syntax-unquote-splicing\n ",
" let-syntax letrec-syntax\n syntax-error)\n\n\n",
"", "",
"" ""
}; };