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

56
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,34 +978,35 @@ 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",
"ap (lambda (s) (cons (prefix (caddr spec) (car s)) (cdr s))) alist)))\n ",
" ((except)\n (let ((alist (collect (cadr spec))))\n ", " ((except)\n (let ((alist (collect (cadr spec))))\n ",
" (let loop ((alist alist))\n (if (null? alist)\n ", " (let loop ((alist alist))\n (if (null? alist)\n ",
" '()\n (if (memq (caar alist) (cddr spec)", " '()\n (if (memq (caar alist) (cddr spe",
")\n (loop (cdr alist))\n (", "c))\n (loop (cdr alist))\n ",
"cons (car alist) (loop (cdr alist))))))))\n (else\n ", " (cons (car alist) (loop (cdr alist))))))))\n (else\n ",
" (let ((lib (or (find-library spec) (error \"library not found\" spec))))\n ", " (let ((lib (or (find-library spec) (error \"library not found\" spec))))\n ",
" (map (lambda (x) (cons x x)) (library-exports lib))))))))\n (le", " (map (lambda (x) (cons x x)) (library-exports lib))))))))\n (",
"trec\n ((import\n (lambda (spec)\n (let ((", "letrec\n ((import\n (lambda (spec)\n (let ",
"lib (extract spec))\n (alist (collect spec)))\n ", "((lib (extract spec))\n (alist (collect spec)))\n ",
" (for-each\n (lambda (slot)\n (librar", " (for-each\n (lambda (slot)\n (libr",
"y-import lib (cdr slot) (car slot)))\n alist)))))\n (f", "ary-import lib (cdr slot) (car slot)))\n alist)))))\n ",
"or-each import (cdr form)))))))\n\n(define-macro export\n (lambda (form _)\n (le", "(for-each import (cdr form)))))))\n\n(define-macro export\n (lambda (form _)\n (",
"trec\n ((collect\n (lambda (spec)\n (cond\n (", "letrec\n ((collect\n (lambda (spec)\n (cond\n ",
"(symbol? spec)\n `(,spec . ,spec))\n ((and (list? spec) (", " ((symbol? spec)\n `(,spec . ,spec))\n ((and (list? spec)",
"= (length spec) 3) (eq? (car spec) 'rename))\n `(,(list-ref spec 1) ", " (= (length spec) 3) (eq? (car spec) 'rename))\n `(,(list-ref spec 1",
". ,(list-ref spec 2)))\n (else\n (error \"malformed export", ") . ,(list-ref spec 2)))\n (else\n (error \"malformed expo",
"\")))))\n (export\n (lambda (spec)\n (let ((slot (coll", "rt\")))))\n (export\n (lambda (spec)\n (let ((slot (co",
"ect spec)))\n (library-export (car slot) (cdr slot))))))\n (for", "llect spec)))\n (library-export (car slot) (cdr slot))))))\n (f",
"-each export (cdr form)))))\n\n(export define-library\n cond-expand\n ", "or-each export (cdr form)))))\n\n(export define-library\n cond-expand\n ",
"import\n export)\n\n(export define lambda quote set! if begin define-macro\n ", " import\n export)\n\n(export define lambda quote set! if begin define-macro",
" let let* letrec letrec*\n let-values let*-values define-values\n ", "\n let let* letrec letrec*\n let-values let*-values define-values\n ",
" quasiquote unquote unquote-splicing\n and or\n cond case else =>", " quasiquote unquote unquote-splicing\n and or\n cond case else ",
"\n do when unless\n parameterize\n define-syntax\n synta", "=>\n do when unless\n parameterize\n define-syntax\n syn",
"x-quote syntax-unquote\n syntax-quasiquote syntax-unquote-splicing\n ", "tax-quote syntax-unquote\n syntax-quasiquote syntax-unquote-splicing\n ",
" let-syntax letrec-syntax\n syntax-error)\n\n\n", " let-syntax letrec-syntax\n syntax-error)\n\n\n",
"", "",
"" ""