Moved most of the planet-related bindings from unstable/scribble and

unstable/planet to planet/scribble and planet/util.  Did not move
define-planet-package; it is not as crucial as the "this-package" macros.

collects/planet/scribble.rkt

@@ -0,0 +1,192 @@
+#lang racket/base
+
+(provide
+  this-package-in
+  racketmod/this-package
+  racketmodname/this-package
+  racketmodlink/this-package
+  defmodule/this-package
+  defmodulelang/this-package
+  defmodulereader/this-package
+  defmodule*/this-package
+  defmodulelang*/this-package
+  defmodulereader*/this-package
+  defmodule*/no-declare/this-package
+  defmodulelang*/no-declare/this-package
+  defmodulereader*/no-declare/this-package
+  declare-exporting/this-package)
+
+(require
+  scribble/manual
+  planet/util
+  planet/version
+  (for-label
+    racket/base)
+  (for-syntax
+    racket/base
+    racket/block
+    syntax/parse
+    planet/syntax))
+
+(define-syntax-rule (define-syntaxes-with [name ...] body ...)
+  (define-syntaxes [name ...] (block body ... (values name ...))))
+
+(define-syntaxes-with
+  [ racketmod/this-package
+    racketmodname/this-package
+    racketmodlink/this-package
+    defmodule/this-package
+    defmodulelang/this-package
+    defmodulereader/this-package
+    defmodule*/this-package
+    defmodulelang*/this-package
+    defmodulereader*/this-package
+    defmodule*/no-declare/this-package
+    defmodulelang*/no-declare/this-package
+    defmodulereader*/no-declare/this-package
+    declare-exporting/this-package ]
+
+  (define-syntax-class id/this-package
+    #:attributes [planet-id]
+    (pattern (~and src (~datum main))
+      #:attr planet-id
+      (datum->syntax
+        #'src
+        (syntax-source-planet-package-symbol #'src #f)
+        #'src))
+    (pattern suffix:id
+      #:attr planet-id
+      (datum->syntax
+        #'suffix
+        (syntax-source-planet-package-symbol #'suffix #'suffix)
+        #'suffix)))
+
+  (define-splicing-syntax-class (maybe-option kw)
+    #:attributes [(option 1)]
+    (pattern (~seq
+               (~and key:keyword
+                 (~fail #:unless (eq? (syntax-e #'key) kw)))
+               arg:expr)
+      #:attr (option 1) (list #'key #'arg))
+    (pattern (~seq) #:attr (option 1) (list)))
+
+  (define-splicing-syntax-class maybe-sources
+    #:attributes [(option 1)]
+    (pattern (~seq #:use-sources [src:id/this-package ...])
+      #:attr (option 1) (list #'#:use-sources #'[(planet src.planet-id) ...]))
+    (pattern (~seq) #:attr (option 1) (list)))
+
+  (define racketmod/this-package
+    (syntax-parser
+      [(_ filename lang:id/this-package . body)
+       #:declare filename (maybe-option '#:file)
+       (with-syntax ([spec (syntax/loc #'lang
+                             (code:line planet lang.planet-id))])
+         #'(racketmod filename.option ... spec . body))]))
+
+  (define racketmodname/this-package
+    (syntax-parser #:literals [unsyntax]
+      [(~and orig (_ (unsyntax e:expr)))
+       #'(racketmodname
+           (unsyntax `(planet ,(make-planet-symbol (syntax-quote orig) e))))]
+      [(_ suffix:id/this-package)
+       #'(racketmodname (planet suffix.planet-id))]))
+
+  (define racketmodlink/this-package
+    (syntax-parser
+      [(_ suffix:id/this-package . body)
+       #'(racketmodlink (planet suffix.planet-id) . body)]))
+
+  (define defmodule/this-package
+    (syntax-parser
+      [(_ req-form suffix:id/this-package src:maybe-sources . body)
+       #:declare req-form (maybe-option '#:require-form)
+       #'(defmodule
+           req-form.option ...
+           (planet suffix.planet-id)
+           src.option ...
+           . body)]))
+
+  (define defmodule*/this-package
+    (syntax-parser
+      [(_ req-form [suffix:id/this-package ...] src:maybe-sources . body)
+       #:declare req-form (maybe-option '#:require-form)
+       #'(defmodule*
+           req-form.option ...
+           [(planet suffix.planet-id) ...]
+           src.option ...
+           . body)]))
+
+  (define defmodule*/no-declare/this-package
+    (syntax-parser
+      [(_ req-form [suffix:id/this-package ...] . body)
+       #:declare req-form (maybe-option '#:require-form)
+       #'(defmodule*/no-declare
+           req-form.option ...
+           [(planet suffix.planet-id) ...]
+           . body)]))
+
+  (define defmodulelang/this-package
+    (syntax-parser
+      [(_ suffix:id/this-package #:module-paths [path:id/this-package ...]
+         src:maybe-sources
+         . body)
+       #'(defmodulelang (racket (code:line planet suffix.planet-id))
+           #:module-paths [(planet path.planet-id) ...]
+           src.option ...
+           . body)]
+      [(_ suffix:id/this-package src:maybe-sources . body)
+       #'(defmodulelang (racket (code:line planet suffix.planet-id))
+           #:module-paths [(planet suffix.planet-id)]
+           src.option ...
+           . body)]))
+
+  (define defmodulelang*/this-package
+    (syntax-parser
+      [(_ [suffix:id/this-package ...] #:module-paths [path:id/this-package ...]
+         src:maybe-sources
+         . body)
+       #'(defmodulelang* [(racket (code:line planet suffix.planet-id)) ...]
+           #:module-paths [(planet path.planet-id) ...]
+           src.option ...
+           . body)]
+      [(_ [suffix:id/this-package ...] src:maybe-sources . body)
+       #'(defmodulelang* [(racket (code:line planet suffix.planet-id)) ...]
+           #:module-paths [(planet suffix.planet-id) ...]
+           src.option ...
+           . body)]))
+
+  (define defmodulelang*/no-declare/this-package
+    (syntax-parser
+      [(_ [suffix:id/this-package ...] #:module-paths [path:id/this-package ...]
+         . body)
+       #'(defmodulelang*/no-declare
+           [(racket (code:line planet suffix.planet-id)) ...]
+           #:module-paths [(planet path.planet-id) ...]
+           . body)]
+      [(_ [suffix:id/this-package ...] . body)
+       #'(defmodulelang*/no-declare
+           [(racket (code:line planet suffix.planet-id)) ...]
+           #:module-paths [(planet suffix.planet-id) ...]
+           . body)]))
+
+  (define defmodulereader/this-package
+    (syntax-parser
+      [(_ suffix:id/this-package src:maybe-sources . body)
+       #'(defmodulereader (planet suffix.planet-id) src.option ... . body)]))
+
+  (define defmodulereader*/this-package
+    (syntax-parser
+      [(_ [suffix:id/this-package ...] src:maybe-sources . body)
+       #'(defmodulereader* [(planet suffix.planet-id) ...] src.option ...
+           . body)]))
+
+  (define defmodulereader*/no-declare/this-package
+    (syntax-parser
+      [(_ [suffix:id/this-package ...] . body)
+       #'(defmodulereader*/no-declare [(planet suffix.planet-id) ...] . body)]))
+
+  (define declare-exporting/this-package
+    (syntax-parser
+      [(_ suffix:id/this-package ... src:maybe-sources)
+       #'(declare-exporting (planet suffix.planet-id) ... src.option ...)])))

collects/planet/syntax.rkt

@@ -8,7 +8,12 @@
          syntax-source-planet-package-minor
          syntax-source-planet-package-symbol)
 
-(require racket/match planet/util unstable/syntax)
+(require racket/match
+         planet/util
+         syntax/parse
+         unstable/syntax
+         (for-template racket/base)
+         (for-label racket/base))
 
 (define (syntax-source-planet-package stx)
   (let* ([dir (syntax-source-directory stx)])
@@ -46,7 +51,7 @@
               (if suffix (format-symbol "/~a" suffix) "")))]
     [#f #f]))
 
-(define (make-planet-require-spec stx id/f)
+(define (make-planet-require-spec stx [id/f #f])
   (datum->syntax
    stx
    (list #'planet (syntax-source-planet-package-symbol stx id/f))

collects/planet/util.rkt

@@ -25,7 +25,8 @@
          setup/getinfo
          setup/unpack
 
-         (for-syntax racket/base)
+         unstable/syntax
+         (for-syntax racket/base syntax/parse)
          (prefix-in srfi1: srfi/1)
          )
 
@@ -784,13 +785,16 @@
          this-package-version-owner
          this-package-version-maj
          this-package-version-min
+         this-package-version-symbol
+         package-version->symbol
+         make-planet-symbol
          (rename-out [this-package-version/proc path->package-version]))
 
 (define-syntax (this-package-version stx)
   (syntax-case stx ()
     [(_)
      #`(this-package-version/proc
-        #,(datum->syntax stx `(,#'this-expression-source-directory)))]))
+         (this-expression-source-directory #,stx))]))
 
 (define-syntax define-getters
   (syntax-rules ()
@@ -809,8 +813,35 @@
   (this-package-version-maj pd->maj)
   (this-package-version-min pd->min))
 
+(define-syntax (this-package-version-symbol stx)
+  (syntax-parse stx
+    [(_ (~optional suffix:id))
+     #`(package-version->symbol
+         (this-package-version/proc
+           (this-expression-source-directory #,stx))
+         #,@(if (attribute suffix) #'['suffix] #'[]))]))
+
 ;; ----------------------------------------
 
+(define (make-planet-symbol stx [suffix #f])
+  (match (syntax-source-directory stx)
+    [#f #f]
+    [dir (match (this-package-version/proc dir)
+           [#f #f]
+           [ver (package-version->symbol ver suffix)])]))
+
+(define (package-version->symbol ver [suffix #f])
+  (match ver
+    [(list owner name major minor)
+     (string->symbol
+       (format "~a/~a:~a:~a~a"
+         owner
+         (regexp-replace #rx"\\.plt$" name "")
+         major
+         minor
+         (if suffix (format-symbol "/~a" suffix) "")))]
+    [#f #f]))
+
 (define (this-package-version/proc srcdir)
   (let* ([package-roots (get-all-planet-packages)]
          [thepkg (ormap (predicate->projection (contains-dir? srcdir))

collects/unstable/planet-syntax.rkt

@@ -1,6 +1,6 @@
 #lang racket/base
 
-(provide make-planet-path
+(provide (rename-out [make-planet-require-spec make-planet-path])
          syntax-source-planet-package
          syntax-source-planet-package-owner
          syntax-source-planet-package-name
@@ -8,46 +8,4 @@
          syntax-source-planet-package-minor
          syntax-source-planet-package-symbol)
 
-(require racket/match planet/util unstable/syntax)
+(require planet/util planet/syntax)
-
-(define (syntax-source-planet-package stx)
-  (let* ([dir (syntax-source-directory stx)])
-    (and dir (path->package-version dir))))
-
-(define (syntax-source-planet-package-owner stx)
-  (match (syntax-source-planet-package stx)
-    [(list owner name major minor) owner]
-    [_ #f]))
-
-(define (syntax-source-planet-package-name stx)
-  (match (syntax-source-planet-package stx)
-    [(list owner name major minor) name]
-    [_ #f]))
-
-(define (syntax-source-planet-package-major stx)
-  (match (syntax-source-planet-package stx)
-    [(list owner name major minor) major]
-    [_ #f]))
-
-(define (syntax-source-planet-package-minor stx)
-  (match (syntax-source-planet-package stx)
-    [(list owner name major minor) minor]
-    [_ #f]))
-
-(define (syntax-source-planet-package-symbol stx [suffix #f])
-  (match (syntax-source-planet-package stx)
-    [(list owner name major minor)
-     (string->symbol
-      (format "~a/~a:~a:~a~a"
-              owner
-              (regexp-replace "\\.plt$" name "")
-              major
-              minor
-              (if suffix (format-symbol "/~a" suffix) "")))]
-    [#f #f]))
-
-(define (make-planet-path stx id/f)
-  (datum->syntax
-   stx
-   (list #'planet (syntax-source-planet-package-symbol stx id/f))
-   (or id/f stx)))

collects/unstable/planet.rkt

@@ -1,19 +1,10 @@
 #lang racket/base
 
 (require (for-syntax racket/base unstable/planet-syntax)
+         planet/version
          unstable/planet-syntax
          unstable/require)
 
-(define-syntax (this-package-version-symbol stx)
-  (syntax-case stx ()
-    [(tpvi)
-     (quasisyntax/loc stx
-       '#,(syntax-source-planet-package-symbol stx #f))]
-    [(tpvi name)
-     (identifier? #'name)
-     (quasisyntax/loc stx
-       '#,(syntax-source-planet-package-symbol stx #'name))]))
-
 (provide this-package-version-symbol
          this-package-in
          define-planet-package

collects/unstable/require.rkt

@@ -6,6 +6,7 @@
                      racket/provide-transform
                      syntax/parse
                      unstable/planet-syntax)
+         planet/version
          unstable/define)
 
 (define-syntax (define-planet-package stx)
@@ -39,13 +40,6 @@
                       [spec (datum->syntax stx* sym)])
                  (expand-import spec))]))))]))
 
-(define-syntax this-package-in
-  (make-require-transformer
-   (lambda (stx)
-     (syntax-parse stx
-       [(_ file:id)
-        (expand-import (make-planet-path stx #'file))]))))
-
 (define-syntax this-package-out
   (make-provide-transformer
    (lambda (stx modes)

collects/unstable/scribblings/planet.scrbl

@@ -2,7 +2,11 @@
 @(require scribble/eval
           scribble/bnf
           "utils.rkt"
-          (for-label racket/base scribble/manual unstable/planet planet/util))
+          (for-label racket/base
+                     scribble/manual
+                     unstable/planet
+                     (except-in planet/util
+                       this-package-version-symbol)))
 
 @title[#:style 'quiet #:tag "cce-planet"]{@|PLaneT| Packages}