~ chicken-core (chicken-5) e51635e25fa50e0f28e206506ab1beb135c3952f
commit e51635e25fa50e0f28e206506ab1beb135c3952f Author: felix <felix@call-with-current-continuation.org> AuthorDate: Wed Feb 17 07:55:51 2010 +0100 Commit: felix <felix@call-with-current-continuation.org> CommitDate: Wed Feb 17 07:55:51 2010 +0100 fixed egg mapping diff --git a/chicken-install.scm b/chicken-install.scm index ac83f403..0ce7f68c 100644 --- a/chicken-install.scm +++ b/chicken-install.scm @@ -110,11 +110,11 @@ (let ((p (list-index (cut eq? '-> <>) m))) (unless p (broken x)) (let-values (((from to) (split-at m p))) - (cons from to)))) + (cons from (cdr to))))) (cdr x))))) (else (broken x)))) (read-file deff))) - (pair? *default-sources*) ] ) ) ) + (pair? *default-sources*) ) ) ) (define (known-default-sources) (if (and *default-location* *default-transport*) @@ -417,13 +417,20 @@ (remove-directory tmpdir)))) (define (apply-mappings eggs) - (delete-duplicates - (append-map - (lambda (egg) - (cond ((find (lambda (m) (member egg (car m))) *mappings*) => cdr) - (else '())) ) - eggs) - string=?)) + (define (same? e1 e2) + (string=? (->string e1) (->string e2))) + (let ((eggs2 + (delete-duplicates + (append-map + (lambda (egg) + (cond ((find (lambda (m) (find (cut same? egg <>) (car m))) + *mappings*) => + (lambda (m) (map ->string (cdr m)))) + (else (list egg)))) + eggs) + string=?))) + (print "mapped " eggs " to " eggs2) + eggs2)) (define ($system str) (let ((r (system diff --git a/setup.defaults b/setup.defaults index 3aff8131..313c15fc 100644 --- a/setup.defaults +++ b/setup.defaults @@ -7,7 +7,3 @@ (server (location "http://galinha.ucpel.tche.br/cgi-bin/henrietta") (transport http)) - -(map - (regex-case defstruct -> test) - (trace -> tabexpand))Trap