fix problems with get-info use by setup-plt

svn: r15242

collects/compiler/compiler-unit.ss

@@ -51,6 +51,9 @@
   (define (c-get-info cp)
     ((current-compiler-dynamic-require-wrapper)
      (lambda () (get-info cp))))
+  (define (c-get-info/full cp)
+    ((current-compiler-dynamic-require-wrapper)
+     (lambda () (get-info/full cp))))
 
   (define (make-extension-compiler mode prefix)
     (let ([u (c-dynamic-require 'compiler/private/base 'base@)]
@@ -143,7 +146,7 @@
 
   (define (compile-directory dir info #:verbose [verbose? #t])
     (define info* (or info (lambda (key mk-default) (mk-default))))
-    (define omit-paths (omitted-paths dir))
+    (define omit-paths (omitted-paths dir c-get-info/full))
     (unless (eq? 'all omit-paths)
       (parameterize ([current-directory dir]
                      [current-load-relative-directory dir]
@@ -168,7 +171,7 @@
         (for ([p (directory-list dir)])
           (let ([p* (build-path dir p)])
             (when (and (directory-exists? p*) (not (member p omit-paths)))
-              (compile-directory p* (get-info/full p*))))))))
+              (compile-directory p* (c-get-info/full p*))))))))
 
   (define (compile-collection-zos collection . cp)
     (compile-directory (apply collection-path collection cp)

collects/setup/infotab.ss

@@ -1,7 +1,8 @@
 
 ;; Defines a language to be used by info.ss files
 
-#lang mzscheme
+#lang scheme/base
+(require (for-syntax scheme/base))
 
 (define-syntax info-module-begin
   (lambda (stx)
@@ -49,14 +50,14 @@
 
 (define-syntax (limited-require stx)
   (syntax-case stx ()
-    [(_ lib) (member (syntax-object->datum #'lib)
+    [(_ lib) (member (syntax->datum #'lib)
                      '((lib "string-constant.ss" "string-constants")
                        (lib "string-constants/string-constant.ss")
                        string-constants/string-constant
                        string-constants))
      (syntax/loc stx (require lib))]))
 
-(provide (rename info-module-begin #%module-begin)
+(provide (rename-out [info-module-begin #%module-begin])
          #%app #%datum #%top
          define quote
          list cons car cdr quasiquote unquote unquote-splicing
@@ -64,4 +65,4 @@
          string-append
          path->string build-path collection-path
          system-library-subpath
-         (rename limited-require require))
+         (rename-out [limited-require require]))

collects/setup/private/omitted-paths.ss

@@ -9,7 +9,7 @@
 
 (provide omitted-paths)
 
-(require scheme/path scheme/list "../dirs.ss" "../getinfo.ss" "lib-roots.ss")
+(require scheme/path scheme/list "../dirs.ss" "lib-roots.ss")
 
 ;; An entry for each collections root that holds a hash table.  The hash table
 ;; maps a reversed list of subpath elements to the exploded omitted-paths
@@ -42,7 +42,7 @@
         (and omit-doc? (equal? "doc" str))
         (regexp-match? #rx"^[.]" str))))
 
-(define (compute-omitted dir accumulated implicit-omit?)
+(define (compute-omitted dir accumulated implicit-omit? get-info/full)
   (define info (or (get-info/full dir) (lambda _ '())))
   (define explicit
     (let ([omit (info 'compile-omit-paths (lambda () '()))])
@@ -63,12 +63,12 @@
                   (map list (filter implicit-omit? (directory-list dir)))
                   accumulated)]))
 
-(define (accumulate-omitted rsubs root t omit-doc?)
+(define (accumulate-omitted get-info/full rsubs root t omit-doc?)
   (define dir (apply build-path root))
   (define implicit? (implicit-omit? omit-doc?))
   (let loop ([rsubs rsubs])
     (if (null? rsubs)
-      (compute-omitted dir '() implicit?)
+      (compute-omitted dir '() implicit? get-info/full)
       (with-memo t rsubs
         (let ([acc (loop (cdr rsubs))])
           (if (or (eq? 'all acc) (member (list (car rsubs)) acc))
@@ -78,9 +78,10 @@
                                         #:when (equal? (car up) (car rsubs)))
                                ;; must have non-null cdr: see `member' check
                                (cdr up))
-                             implicit?)))))))
+                             implicit?
+                             get-info/full)))))))
 
-(define (omitted-paths* dir)
+(define (omitted-paths* dir get-info/full)
   (unless (and (path-string? dir) (complete-path? dir) (directory-exists? dir))
     (raise-type-error 'omitted-paths
                       "complete path to an existing directory" dir))
@@ -89,7 +90,7 @@
                      (let ([r (relative-from dir* (car root+table))])
                        (and r (cons (reverse r) root+table))))
                    roots)]
-         [r (and r (apply accumulate-omitted r))])
+         [r (and r (apply accumulate-omitted get-info/full r))])
     (unless r
       (error 'omitted-paths
              "given directory path is not in any collection root: ~e" dir))
@@ -99,5 +100,5 @@
 
 (define omitted-paths-memo (make-hash))
 
-(define (omitted-paths dir)
-  (with-memo omitted-paths-memo dir (omitted-paths* dir)))
+(define (omitted-paths dir get-info/full)
+  (with-memo omitted-paths-memo dir (omitted-paths* dir get-info/full)))

collects/setup/setup-unit.ss

@@ -186,7 +186,7 @@
                     "ignoring `compile-subcollections' entry in info ~a"
                     path-name))
     ;; this check is also done in compiler/compiler-unit, in compile-directory
-    (and (not (eq? 'all (omitted-paths path)))
+    (and (not (eq? 'all (omitted-paths path getinfo)))
          (make-cc collection path
                   (if name (string-append path-name " (" name ")") path-name)
                   info root-dir info-path shadowing-policy)))
@@ -282,7 +282,7 @@
              ;; collection should not have been included, but we might
              ;; jump in if a command-line argument specified a
              ;; coll/subcoll
-             [omit (omitted-paths ccp)]
+             [omit (omitted-paths ccp getinfo)]
              [subs (if (eq? 'all omit)
                      '()
                      (filter (lambda (p)