Added uses of unstable/struct

original commit: 07f57aac9b

collects/compiler/commands/make.rkt

@@ -19,7 +19,7 @@
    #:once-each
    [("--disable-inline") "Disable procedure inlining during compilation"
     (disable-inlining #t)]
-   [("--no-deps") "Compile immediate files without updating depdencies"
+   [("--no-deps") "Compile immediate files without updating dependencies"
     (disable-deps #t)]
    [("-p" "--prefix") file "Add elaboration-time prefix file for --no-deps"
     (prefixes (append (prefixes) (list file)))]

collects/compiler/decompile.rkt

@@ -221,7 +221,7 @@
        (extract-ids! body ids)
        (let ([vars (for/list ([i (in-range count)]
                               [id (in-vector ids)])
-                     (or id (gensym 'localv)))])
+                     (or id (gensym (if boxes? 'localvb 'localv))))])
          `(let ,(map (lambda (i) `[,i ,(if boxes? `(#%box ?) '?)])
                      vars)
             ,(decompile-expr body globs (append vars stack) closed))))]

collects/compiler/sig.rkt

@@ -79,6 +79,7 @@
 
    compile-collection-zos
    compile-directory-zos
+   compile-directory-srcs
 
    current-compiler-dynamic-require-wrapper
    compile-notify-handler))

collects/compiler/zo-marshal.rkt

@@ -1,6 +1,6 @@
 #lang scheme/base
 (require compiler/zo-structs
-         unstable/byte-counting-port
+         scheme/port
          scheme/match
          scheme/contract
          scheme/local
@@ -68,7 +68,7 @@
                (out-data (list* max-let-depth prefix (protect-quote form)) 
                          (make-out outp (lambda (v) (hash-ref shared v #f)) wrapped))
                (values offsets post-shared (file-position outp)))
-             (define counting-p (make-byte-counting-port))
+             (define counting-p (open-output-nowhere))
              (define-values (offsets post-shared all-forms-length)
                (write-all counting-p))
              (define all-short? (post-shared . < . #xFFFF))
@@ -479,7 +479,18 @@
                         [l (cons (lookup-req 1) l)] ; et-requires
                         [l (cons (lookup-req 0) l)] ; requires
                         [l (cons (list->vector body) l)]
-                        [l (cons (list->vector syntax-body) l)]
+                        [l (cons (list->vector
+                                  (for/list ([i (in-list syntax-body)])
+                                    (define (maybe-one l) ;; a single symbol is ok
+                                      (if (and (pair? l) (null? (cdr l)))
+                                          (car l)
+                                          l))
+                                    (match i
+                                      [(struct def-syntaxes (ids rhs prefix max-let-depth))
+                                       (vector (maybe-one ids) rhs max-let-depth prefix #f)]
+                                      [(struct def-for-syntax (ids rhs prefix max-let-depth))
+                                       (vector (maybe-one ids) rhs max-let-depth prefix #t)])))
+                                 l)]
                         [l (append (apply
                                     append
                                     (map (lambda (l)

collects/compiler/zo-parse.rkt

@@ -2,6 +2,7 @@
 (require mzlib/etc 
          scheme/match
          scheme/list
+         unstable/struct
          compiler/zo-structs)
 
 (provide zo-parse)
@@ -529,7 +530,7 @@
                               (apply
                                make-prefab-struct 
                                k
-                               (map loop (cdr (vector->list (struct->vector v)))))))]
+                               (map loop (struct->list v)))))]
                        [else (add-wrap v)]))
                    ;; Decode sub-elements that have their own wraps:
                    (let-values ([(v counter) (if (exact-integer? (car v))
@@ -551,7 +552,7 @@
                      (apply
                       make-prefab-struct 
                       k
-                      (map loop (cdr (vector->list (struct->vector v)))))))]
+                      (map loop (struct->list v)))))]
               [else (add-wrap v)]))))))
 
 (define (decode-wraps cp w)

collects/setup/option-sig.rkt

@@ -21,6 +21,7 @@
      call-install
      call-post-install
      pause-on-errors
+     parallel-workers
      force-unpacks
      doc-pdf-dest
      specific-collections

collects/tests/racket/benchmarks/shootout/nothing.rkt

@@ -0,0 +1,2 @@
+#lang racket/base
+1

collects/tests/racket/embed-planet-1/alt.rkt

@@ -0,0 +1,6 @@
+#lang racket/base
+(require "main.ss")
+
+(with-output-to-file "stdout"
+  #:exists 'append
+  (lambda () (displayln "alt")))

collects/tests/racket/embed-planet-1/main.rkt

@@ -0,0 +1,4 @@
+#lang racket/base
+
+(with-output-to-file "stdout"
+  (lambda () (displayln "one")))

collects/tests/racket/embed-planet-1/other.rkt

@@ -0,0 +1,6 @@
+#lang racket/base
+(require (planet racket-tester/p2))
+
+(with-output-to-file "stdout"
+  #:exists 'append
+  (lambda () (displayln "other")))

collects/tests/racket/embed-planet-2/main.ss

@@ -0,0 +1,5 @@
+#lang racket/base
+
+
+(with-output-to-file "stdout"
+  (lambda () (displayln "two")))

collects/tests/racket/embed-planet-2/private/sub.rkt

@@ -0,0 +1,6 @@
+#lang racket/base
+(require "../main.ss")
+
+(with-output-to-file "stdout"
+  #:exists 'append
+  (lambda () (displayln "sub")))

collects/tests/racket/embed.rktl

@@ -234,18 +234,19 @@
    `(,(flags "ne") "(out \"\u7237...\U1D671\n\")"))
   (try-exe dest "\uA9, \u7238, and \U1D670\n\u7237...\U1D671\n" mred?))
 
-(mz-tests #f)
+(define (try-basic)
-(mz-tests #t)
+  (mz-tests #f)
+  (mz-tests #t)
 
-(begin
+  (begin
-  (prepare mr-dest "embed-me5.rkt")
+    (prepare mr-dest "embed-me5.rkt")
-  (make-embedding-executable 
+    (make-embedding-executable 
-   mr-dest #t #f
+     mr-dest #t #f
-   `((#t (lib "embed-me5.rkt" "tests" "racket")))
+     `((#t (lib "embed-me5.rkt" "tests" "racket")))
-   null
+     null
-   #f
+     #f
-   `("-l" "tests/racket/embed-me5.rkt"))
+     `("-l" "tests/racket/embed-me5.rkt"))
-  (try-exe mr-dest "This is 5: #<class:button%>\n" #t))
+    (try-exe mr-dest "This is 5: #<class:button%>\n" #t)))
 
 ;; Try the mzc interface:
 (require setup/dirs
@@ -306,8 +307,9 @@
 
     (void)))
 
-(mzc-tests #f)
+(define (try-mzc)
-(mzc-tests #t)
+  (mzc-tests #f)
+  (mzc-tests #t))
 
 (require dynext/file)
 (define (extension-test mred?)
@@ -364,32 +366,34 @@
              (path->string (build-path (collection-path "tests" "racket") "embed-me10.rkt")))
     (try-exe (mk-dest mred?) "#t\n" mred?)))
 
-(extension-test #f)
+(define (try-extension)
-(extension-test #t)
+  (extension-test #f)
+  (extension-test #t))
 
-;; A GRacket-specific test with mzc:
+(define (try-gracket)
-(parameterize ([current-directory (find-system-path 'temp-dir)])
+  ;; A GRacket-specific test with mzc:
-  (system* mzc 
+  (parameterize ([current-directory (find-system-path 'temp-dir)])
-	   "--gui-exe"
+    (system* mzc 
-	   (path->string (mk-dest #t))
+             "--gui-exe"
-	   (path->string (build-path (collection-path "tests" "racket") "embed-me5.rkt")))
+             (path->string (mk-dest #t))
-  (try-exe (mk-dest #t) "This is 5: #<class:button%>\n" #t))
+             (path->string (build-path (collection-path "tests" "racket") "embed-me5.rkt")))
+    (try-exe (mk-dest #t) "This is 5: #<class:button%>\n" #t))
 
-;; Another GRacket-specific: try embedding plot, which has extra DLLs and font files:
+  ;; Another GRacket-specific: try embedding plot, which has extra DLLs and font files:
-(parameterize ([current-directory (find-system-path 'temp-dir)])
+  (parameterize ([current-directory (find-system-path 'temp-dir)])
-  (define direct (build-path (find-system-path 'temp-dir) "direct.ps"))
+    (define direct (build-path (find-system-path 'temp-dir) "direct.ps"))
 
-  (test #t
+    (test #t
-        system* (build-path (find-console-bin-dir) "mred")
+          system* (build-path (find-console-bin-dir) "mred")
-        "-qu"
+          "-qu"
-        (path->string (build-path (collection-path "tests" "racket") "embed-me7.rkt"))
+          (path->string (build-path (collection-path "tests" "racket") "embed-me7.rkt"))
-        (path->string direct))
+          (path->string direct))
 
-  (system* mzc 
+    (system* mzc 
-           "--gui-exe"
+             "--gui-exe"
-           (path->string (mk-dest #t))
+             (path->string (mk-dest #t))
-           (path->string (build-path (collection-path "tests" "racket") "embed-me7.rkt")))
+             (path->string (build-path (collection-path "tests" "racket") "embed-me7.rkt")))
-  (try-exe (mk-dest #t) "plotted\n" #t))
+    (try-exe (mk-dest #t) "plotted\n" #t)))
 
 ;; Try including source that needs a reader extension
 
@@ -417,7 +421,60 @@
   (try-exe dest "It goes to eleven!\n" mred?)
   (putenv "ELEVEN" "done"))
 
-(try-reader-test #f)
+(define (try-reader)
-(try-reader-test #t)
+  (try-reader-test #f)
+  (try-reader-test #t))
+
+;; ----------------------------------------
+
+(define planet (build-path (find-console-bin-dir) (if (eq? 'windows (system-type))
+                                                      "planet.exe"
+                                                      "planet")))
+
+(define (try-planet)
+  (system* planet "link" "racket-tester" "p1.plt" "1" "0"
+           (path->string (collection-path "tests" "racket" "embed-planet-1")))
+  (system* planet "link" "racket-tester" "p2.plt" "2" "2"
+           (path->string (collection-path "tests" "racket" "embed-planet-2")))
+
+  (let ([go (lambda (path expected)
+              (printf "Trying planet ~s...\n" path)
+              (let ([tmp (make-temporary-file)]
+                    [dest (mk-dest #f)])
+                (with-output-to-file tmp
+                  #:exists 'truncate
+                  (lambda ()
+                    (printf "#lang racket/base (require ~s)\n" path)))
+                (system* mzc "--exe" (path->string dest) (path->string tmp))
+                (try-exe dest expected #f)
+
+                (delete-directory/files dest)
+
+                (delete-file tmp)))])
+    (go '(planet racket-tester/p1) "one\n")
+    (go '(planet "racket-tester/p1:1") "one\n")
+    (go '(planet "racket-tester/p1:1:0") "one\n")
+    (go '(planet "racket-tester/p1:1:0/main.ss") "one\n")
+    (go '(planet racket-tester/p2) "two\n")
+
+    (go '(planet racket-tester/p1/alt) "one\nalt\n")
+    (go '(planet racket-tester/p1/other) "two\nother\n")
+    (go '(planet "private/sub.rkt" ("racket-tester" "p2.plt" 2 0)) "two\nsub\n")
+
+    (void))
+  
+  (system* planet "unlink" "racket-tester" "p1.plt" "1" "0")
+  (system* planet "unlink" "racket-tester" "p2.plt" "2" "2"))
+
+;; ----------------------------------------
+
+(try-basic)
+(try-mzc)
+(try-extension)
+(try-gracket)
+(try-reader)
+(try-planet)
+
+;; ----------------------------------------
 
 (report-errs)