www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README

make-lang.rkt (1637B)


      1 #lang at-exp racket/base
      2 
      3 (module reader syntax/module-reader
      4   phc-graph/make-lang)
      5 
      6 (provide (rename-out [-#%module-begin #%module-begin]))
      7 
      8 (require (for-syntax racket/base
      9                      setup/collects)
     10          scribble/manual)
     11 
     12 (define-syntax (-#%module-begin stx)
     13   (syntax-case stx ()
     14     [(self #:require req)
     15      ;; TODO: isn't there a more reliable way to get the "require path"
     16      ;;       for the source module of #'self ?
     17      (let* ([src (syntax-source #'self)]
     18             [modpath (path->module-path src)]
     19             [md (if (and (pair? modpath)
     20                          (eq? (car modpath) 'lib)
     21                          (string? (cadr modpath))
     22                          (null? (cddr modpath))
     23                          (regexp-match ".rkt$" (cadr modpath)))
     24                     (string->symbol
     25                      (substring (cadr modpath)
     26                                 0
     27                                 (- (string-length (cadr modpath)) 4)))
     28                     modpath)])
     29        #`(-#%module-begin #:module #,md #:require req))]
     30     [(_ #:module md ;; TODO: detect this automatically
     31         #:require (req ...))
     32      #`(#%module-begin
     33         (module reader syntax/module-reader
     34           md)
     35         @module[scrbl racket/base (require scribble/manual)]{
     36       @defmodule[md]{
     37        This module language re-provides the following modules:
     38        @itemlist[(item (racketmodname req)) ...]
     39       }
     40      }
     41         (module doc racket/base
     42           (require (submod ".." scrbl))
     43           (provide (all-from-out (submod ".." scrbl))))
     44         (require req ...)
     45         (provide (all-from-out req ...)))]))
     46