suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Ignoring submodules in web-server lang

Browse Source
This commit is contained in:
Jay McCarthy 2013-01-25 07:10:22 -07:00
parent 545009a48a
commit 74429db650
2 changed files with 15 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/tests/web-server/pr/lang-submod.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang web-server/base
(define (f a) a)
(module test racket/base
(require rackunit)
(check-equal? 1 1))

20
collects/web-server/lang/util.rkt
View File

@ -48,26 +48,22 @@
(list* #'rv (syntax->list #'(v ...)))])) (list* #'rv (syntax->list #'(v ...)))]))
(define ((make-define-case inner) stx) (define ((make-define-case inner) stx)
(syntax-case stx (define-values define-syntaxes define-values-for-syntax #%require begin-for-syntax) (syntax-case stx (define-values define-syntaxes #%require)
[(define-syntaxes . ds) stx]
[(#%require . r) stx]
[(define-values (v ...) ve) [(define-values (v ...) ve)
(let-values ([(nve) (inner #'ve)]) (let-values ([(nve) (inner #'ve)])
(quasisyntax/loc stx (quasisyntax/loc stx
(define-values (v ...) #,nve)))] (define-values (v ...) #,nve)))]
[(define-syntaxes (v ...) ve)
stx]
[(define-values-for-syntax (v ...) ve)
stx]
[(begin-for-syntax e ...)
stx]
[(#%require spec ...)
stx]
[expr [expr
(inner #'expr)])) (inner #'expr)]))
(define ((make-module-case inner) stx) (define ((make-module-case inner) stx)
(syntax-case* stx (#%provide) free-identifier=? (syntax-case* stx (#%provide begin-for-syntax module module*) free-identifier=?
[(#%provide spec ...) [(#%provide . p) stx]
stx] [(module* . m) stx]
[(module . m) stx]
[(begin-for-syntax . e) stx]
[_ [_
(inner stx)])) (inner stx)]))