diff options
Diffstat (limited to 'nixpkgs/pkgs/development/compilers/chicken/4/0001-Introduce-CHICKEN_REPOSITORY_EXTRA.patch')
| -rw-r--r-- | nixpkgs/pkgs/development/compilers/chicken/4/0001-Introduce-CHICKEN_REPOSITORY_EXTRA.patch | 157 |
1 files changed, 157 insertions, 0 deletions
diff --git a/nixpkgs/pkgs/development/compilers/chicken/4/0001-Introduce-CHICKEN_REPOSITORY_EXTRA.patch b/nixpkgs/pkgs/development/compilers/chicken/4/0001-Introduce-CHICKEN_REPOSITORY_EXTRA.patch new file mode 100644 index 000000000000..ca72ba0119f0 --- /dev/null +++ b/nixpkgs/pkgs/development/compilers/chicken/4/0001-Introduce-CHICKEN_REPOSITORY_EXTRA.patch @@ -0,0 +1,157 @@ +From 2877f33747e3871c3a682b3a0c812b8ba2e4da5a Mon Sep 17 00:00:00 2001 +From: Caolan McMahon <caolan@caolanmcmahon.com> +Date: Sat, 25 Jun 2016 11:52:28 +0100 +Subject: [PATCH] Introduce CHICKEN_REPOSITORY_EXTRA + +This environment variable works like CHICKEN_REPOSITORY but supports +multiple paths separated by `:'. Those paths are searched after +CHICKEN_REPOSITORY when loading extensions via `require-library' and +friends. It can be accessed and changed at runtime via the new procedure +`repository-extra-paths' which is analog to `repository-path'. + +Original patch by Moritz Heidkamp. +Updated by Caolan McMahon for CHICKEN 4.11.0 +--- + chicken-install.scm | 29 ++++++++++++++++++++++++----- + chicken.import.scm | 1 + + eval.scm | 37 +++++++++++++++++++++++++++++++------ + 3 files changed, 56 insertions(+), 11 deletions(-) + +diff --git a/chicken-install.scm b/chicken-install.scm +index 7bc6041..f557793 100644 +--- a/chicken-install.scm ++++ b/chicken-install.scm +@@ -120,6 +120,19 @@ + (sprintf "lib/chicken/~a" (##sys#fudge 42))) + (repository-path))))) + ++ (define (repo-paths) ++ (if *deploy* ++ *prefix* ++ (if (and *cross-chicken* (not *host-extension*)) ++ (list (make-pathname C_TARGET_LIB_HOME (sprintf "chicken/~a" C_BINARY_VERSION))) ++ (cons ++ (if *prefix* ++ (make-pathname ++ *prefix* ++ (sprintf "lib/chicken/~a" (##sys#fudge 42))) ++ (repository-path)) ++ (repository-extra-paths))))) ++ + (define (get-prefix #!optional runtime) + (cond ((and *cross-chicken* + (not *host-extension*)) +@@ -226,10 +239,13 @@ + (chicken-version) ) + ;; Duplication of (extension-information) to get custom + ;; prefix. This should be fixed. +- ((let* ((ep (##sys#canonicalize-extension-path x 'ext-version)) +- (sf (make-pathname (repo-path) ep "setup-info"))) +- (and (file-exists? sf) +- (with-input-from-file sf read))) => ++ ((let ((ep (##sys#canonicalize-extension-path x 'ext-version))) ++ (let loop ((paths (repo-paths))) ++ (cond ((null? paths) #f) ++ ((let ((sf (make-pathname (car paths) ep "setup-info"))) ++ (and (file-exists? sf) ++ (with-input-from-file sf read)))) ++ (else (loop (cdr paths)))))) => + (lambda (info) + (let ((a (assq 'version info))) + (if a +@@ -776,7 +792,10 @@ + "installed extension has no information about which egg it belongs to" + (pathname-file sf)) + #f)))) +- (glob (make-pathname (repo-path) "*" "setup-info"))) ++ (append-map ++ (lambda (path) ++ (glob (make-pathname path "*" "setup-info"))) ++ (repo-paths))) + equal?)) + + (define (list-available-extensions trans locn) +diff --git a/chicken.import.scm b/chicken.import.scm +index f6e3a19..be1637c 100644 +--- a/chicken.import.scm ++++ b/chicken.import.scm +@@ -200,6 +200,7 @@ + repl + repl-prompt + repository-path ++ repository-extra-paths + require + reset + reset-handler +diff --git a/eval.scm b/eval.scm +index 6242f62..f7d76d4 100644 +--- a/eval.scm ++++ b/eval.scm +@@ -81,6 +81,7 @@ + (define-constant source-file-extension ".scm") + (define-constant setup-file-extension "setup-info") + (define-constant repository-environment-variable "CHICKEN_REPOSITORY") ++(define-constant repository-extra-environment-variable "CHICKEN_REPOSITORY_EXTRA") + (define-constant prefix-environment-variable "CHICKEN_PREFIX") + + ; these are actually in unit extras, but that is used by default +@@ -1176,6 +1177,25 @@ + + (define ##sys#repository-path repository-path) + ++(define ##sys#repository-extra-paths ++ (let* ((repaths (get-environment-variable repository-extra-environment-variable)) ++ (repaths (if repaths ++ (let ((len (string-length repaths))) ++ (let loop ((i 0) (offset 0) (res '())) ++ (cond ((> i len) ++ (reverse res)) ++ ((or (= i len) (eq? #\: (string-ref repaths i))) ++ (loop (+ i 1) (+ i 1) (cons (substring repaths offset i) res))) ++ (else ++ (loop (+ i 1) offset res))))) ++ '()))) ++ (lambda (#!optional val) ++ (if val ++ (set! repaths val) ++ repaths)))) ++ ++(define repository-extra-paths ##sys#repository-extra-paths) ++ + (define ##sys#setup-mode #f) + + (define ##sys#find-extension +@@ -1193,6 +1213,7 @@ + (let loop ((paths (##sys#append + (if ##sys#setup-mode '(".") '()) + (if rp (list rp) '()) ++ (##sys#repository-extra-paths) + (if inc? ##sys#include-pathnames '()) + (if ##sys#setup-mode '() '("."))) )) + (and (pair? paths) +@@ -1252,12 +1273,16 @@ + [string-append string-append] + [read read] ) + (lambda (id loc) +- (and-let* ((rp (##sys#repository-path))) +- (let* ((p (##sys#canonicalize-extension-path id loc)) +- (rpath (string-append rp "/" p ".")) ) +- (cond ((file-exists? (string-append rpath setup-file-extension)) +- => (cut with-input-from-file <> read) ) +- (else #f) ) ) ) ) )) ++ (let loop ((rpaths (cons (##sys#repository-path) (##sys#repository-extra-paths)))) ++ (and (pair? rpaths) ++ (let ((rp (car rpaths))) ++ (if (not rp) ++ (loop (cdr rpaths)) ++ (let* ((p (##sys#canonicalize-extension-path id loc)) ++ (rpath (string-append rp "/" p ".")) ) ++ (cond ((file-exists? (string-append rpath setup-file-extension)) ++ => (cut with-input-from-file <> read) ) ++ (else (loop (cdr rpaths))) ) )) ))) ) )) + + (define (extension-information ext) + (##sys#extension-information ext 'extension-information) ) +-- +2.1.4 + |