www

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

equations-lang.rkt (1840B)


      1 #lang racket/base
      2 
      3 (require racket/require
      4          (for-syntax (rename-in racket/base [compose ∘])
      5                      syntax/stx
      6                      syntax/parse)
      7          (subtract-in scribble/manual "../scribblings/util.rkt")
      8          "../scribblings/util.rkt"
      9          "../scribblings/abbreviations.rkt"
     10          "../scribblings/adt-utils.rkt"
     11          (for-label (only-meta-in 0 typed/racket)
     12                     typed/racket/class)
     13          (only-in scribble/base emph)
     14          scribble/example
     15          racket/string)
     16 
     17 (define tr-eval (make-eval-factory '(typed/racket)))
     18 
     19 (provide (rename-out [-#%module-begin #%module-begin])
     20          tr-eval
     21          (except-out (all-from-out racket/base) #%module-begin)
     22          (all-from-out scribble/manual
     23                        "../scribblings/util.rkt"
     24                        "../scribblings/abbreviations.rkt"
     25                        "../scribblings/adt-utils.rkt"
     26                        scribble/base
     27                        scribble/example
     28                        racket/string)
     29          (for-label (all-from-out typed/racket)
     30                     (all-from-out typed/racket/class)))
     31 
     32 (define-syntax -#%module-begin
     33   (syntax-parser
     34     [(_ {~optional {~seq {~and def {~not :keyword}} ... #:}}
     35         {~and body {~not :keyword}} ...
     36         {~seq namekw:keyword {~and nbody {~not :keyword}} ...}
     37         ...)
     38      #:with (name ...) (stx-map (∘ string->symbol keyword->string syntax-e)
     39                                 #'(namekw ...))
     40      #:with (ntmp ...) (generate-temporaries #'(name ...))
     41      #`(#%module-begin
     42         (provide (rename-out [ntmp name] ...))
     43         #,@(if (attribute def) #'{def ...} #'{})
     44         (define tmp (list body ...))
     45         (define ntmp (list nbody ...))
     46         ...
     47         (module+ equations
     48           (provide (rename-out [tmp equations]))))]))