#lang scheme (require scribble/manual (for-label scheme) (for-syntax planet/util)) (define-for-syntax (build-planet-string suffix) (format "~a/~a:~a:~a~a" (this-package-version-owner) (regexp-replace "\\.plt$" (this-package-version-name) "") (this-package-version-maj) (this-package-version-min) suffix)) (define-for-syntax (build-planet-id stx id) (datum->syntax stx (string->symbol (build-planet-string (if id (format "/~a" (syntax-e id)) ""))))) (define-syntax (this-package-version-id stx) (syntax-case stx () [(tpvi) (build-planet-id stx #f)] [(tpvi name) (identifier? #'name) (build-planet-id stx #'name)])) (define-syntax (scheme/this-package stx) (syntax-case stx () [(sp) (quasisyntax/loc stx (scheme (planet #,(build-planet-id stx #f))))] [(sp name) (identifier? #'name) (quasisyntax/loc stx (scheme (planet #,(build-planet-id stx #'name))))])) (define-syntax (defmodule/this-package stx) (syntax-case stx () [(dmp) (quasisyntax/loc stx (defmodule (planet #,(build-planet-id stx #f))))] [(dmp name) (identifier? #'name) (quasisyntax/loc stx (defmodule (planet #,(build-planet-id stx #'name))))])) (provide this-package-version-id scheme/this-package defmodule/this-package)