suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

use some of the original parameter values when compiling planet packages to avoid bad interactions with module language's automatic compilation

Browse Source 
svn: r15785
This commit is contained in:
Robby Findler 2009-08-20 04:43:20 +00:00
parent 8da19de7b2
commit 0645fa16ec
1 changed files with 23 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/planet/resolver.ss
View File

@ -1,3 +1,5 @@
#lang mzscheme
#| resolver.ss -- PLaneT client #| resolver.ss -- PLaneT client
1. Introduction 1. Introduction
@ -160,7 +162,6 @@ subdirectory.
||# ||#
#lang mzscheme
;; This `resolver' no longer fits the normal protocol for a ;; This `resolver' no longer fits the normal protocol for a
;; module name resolver, because it accepts an extra argument in ;; module name resolver, because it accepts an extra argument in
@ -198,7 +199,8 @@ subdirectory.
"private/linkage.ss" "private/linkage.ss"
"parsereq.ss" "parsereq.ss"
"terse-info.ss") "terse-info.ss"
compiler/cm)
(provide (rename resolver planet-module-name-resolver) (provide (rename resolver planet-module-name-resolver)
resolve-planet-path resolve-planet-path
@ -327,10 +329,14 @@ subdirectory.
;; resolves the given request. Returns a name corresponding to the module in ;; resolves the given request. Returns a name corresponding to the module in
;; the correct environment ;; the correct environment
(define (planet-resolve spec rmp stx load? orig-paramz) (define (planet-resolve spec rmp stx load? orig-paramz)
;; Need to send `orig-paramz' on to the right place ;; install various parameters that can affect the compilation of a planet package back to their original state
(let-values ([(path pkg) (get-planet-module-path/pkg spec rmp stx)]) (parameterize ([current-compile (call-with-parameterization orig-paramz current-compile)]
(when load? (add-pkg-to-diamond-registry! pkg stx)) [current-eval (call-with-parameterization orig-paramz current-eval)]
(do-require path (pkg-path pkg) rmp stx load?))) [use-compiled-file-paths (call-with-parameterization orig-paramz use-compiled-file-paths)]
[current-library-collection-paths (call-with-parameterization orig-paramz current-library-collection-paths)])
(let-values ([(path pkg) (get-planet-module-path/pkg spec rmp stx)])
(when load? (add-pkg-to-diamond-registry! pkg stx))
(do-require path (pkg-path pkg) rmp stx load?))))
;; resolve-planet-path : planet-require-spec -> path ;; resolve-planet-path : planet-require-spec -> path
;; retrieves the path to the given file in the planet package. downloads and ;; retrieves the path to the given file in the planet package. downloads and
@ -560,15 +566,20 @@ subdirectory.
(current-time)) (current-time))
;; oh man is this a bad hack! ;; oh man is this a bad hack!
(parameterize ([current-namespace (make-namespace)]) (parameterize ([current-namespace (make-namespace)])
(printf "new namespace\n")
(let ([ipp (dynamic-require 'setup/plt-single-installer (let ([ipp (dynamic-require 'setup/plt-single-installer
'install-planet-package)] 'install-planet-package)]
[rud (dynamic-require 'setup/plt-single-installer [rud (dynamic-require 'setup/plt-single-installer
'reindex-user-documentation)]) 'reindex-user-documentation)]
(ipp path the-dir (list owner (pkg-spec-name pkg) [msfh (dynamic-require 'compiler/cm 'manager-skip-file-handler)])
extra-path maj min)) (printf "starting setup-plt ~s ~s\n" (manager-skip-file-handler) (msfh))
(unless was-nested? (parameterize ([msfh (manager-skip-file-handler)])
(printf "------------- Rebuilding documentation index -------------\n") (printf "starting setup-plt.2 ~s ~s\n" (manager-skip-file-handler) (msfh))
(rud)))))) (ipp path the-dir (list owner (pkg-spec-name pkg)
extra-path maj min))
(unless was-nested?
(printf "------------- Rebuilding documentation index -------------\n")
(rud)))))))
(planet-terse-log 'finish (pkg-spec->string pkg)) (planet-terse-log 'finish (pkg-spec->string pkg))
(make-pkg (pkg-spec-name pkg) (pkg-spec-path pkg) (make-pkg (pkg-spec-name pkg) (pkg-spec-path pkg)
maj min the-dir 'normal))))) maj min the-dir 'normal)))))