~ chicken-core (chicken-5) e29634594a5fa6164952b1ad5cde0a8df96ebef4
commit e29634594a5fa6164952b1ad5cde0a8df96ebef4 Author: Evan Hanson <evhan@foldling.org> AuthorDate: Sat Jun 9 08:58:20 2018 +1200 Commit: Peter Bex <peter@more-magic.net> CommitDate: Sun Nov 11 20:13:28 2018 +0100 Drop `##sys#canonicalize-extension-path' This procedure is only ever called with extension names, not actual pathnames, so the file path normalisation can be removed and replaced with a simple "foo->string" procedure whereever necessary. Signed-off-by: Peter Bex <peter@more-magic.net> diff --git a/chicken-install.scm b/chicken-install.scm index 8662b692..5774df92 100644 --- a/chicken-install.scm +++ b/chicken-install.scm @@ -696,9 +696,8 @@ (define (ext-version x) (cond ((or (eq? x 'chicken) (equal? x "chicken")) (chicken-version)) - ((let* ((ep (##sys#canonicalize-extension-path x 'ext-version)) - (sf (chicken.load#find-file - (make-pathname #f ep +egg-info-extension+) + ((let* ((sf (chicken.load#find-file + (make-pathname #f (->string x) +egg-info-extension+) (repo-path)))) (and sf (file-exists? sf) diff --git a/eval.scm b/eval.scm index 58d54130..d416c620 100644 --- a/eval.scm +++ b/eval.scm @@ -1173,36 +1173,6 @@ ;;; Extensions: -(define ##sys#canonicalize-extension-path - (let ([string-append string-append]) - (lambda (id loc) - (define (err) (##sys#error loc "invalid extension path" id)) - (define (sep? c) (or (char=? #\\ c) (char=? #\/ c))) - (let ([p (cond [(string? id) id] - [(symbol? id) (##sys#symbol->string id)] - [(list? id) - (let loop ([id id]) - (if (null? id) - "" - (string-append - (let ([id0 (##sys#slot id 0)]) - (cond [(symbol? id0) (##sys#symbol->string id0)] - [(string? id0) id0] - [else (err)] ) ) - (if (null? (##sys#slot id 1)) - "" - "/") - (loop (##sys#slot id 1)) ) ) ) ] ) ] ) - (let check ([p p]) - (let ([n (##sys#size p)]) - (cond [(fx= 0 n) (err)] - [(sep? (string-ref p 0)) - (check (##sys#substring p 1 n)) ] - [(sep? (string-ref p (fx- n 1))) - (check (##sys#substring p 0 (fx- n 1))) ] - [else p] ) ) ) ) ) ) ) - - (define ##sys#setup-mode #f) (define (file-exists? name) ; defined here to avoid file unit dependency @@ -1217,11 +1187,11 @@ (define find-dynamic-extension (let ((string-append string-append)) - (lambda (path inc?) - (let ((p (##sys#canonicalize-extension-path path #f)) - (rp (repository-path))) + (lambda (id inc?) + (let ((rp (repository-path)) + (basename (if (symbol? id) (symbol->string id) id))) (define (check path) - (let ((p0 (string-append path "/" p))) + (let ((p0 (string-append path "/" basename))) (or (and rp (not ##sys#dload-disabled) (feature? #:dload)Trap