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

scheme/signature: fixed to recognize scheme require forms

Browse Source 
svn: r14396
This commit is contained in:
Ryan Culpepper 2009-04-01 03:14:34 +00:00
parent a2ebc93bd8
commit eb349682c3
2 changed files with 18 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/mzlib/private/unit-compiletime.ss
View File

@ -21,15 +21,16 @@
set!-trans-extract
process-tagged-import process-tagged-export
lookup-signature lookup-def-unit make-id-mapper make-id-mappers sig-names sig-int-names sig-ext-names
map-sig split-requires apply-mac complete-exports complete-imports check-duplicate-subs
map-sig split-requires split-requires* apply-mac complete-exports complete-imports check-duplicate-subs
process-spec)
(define-syntax (apply-mac stx)
(syntax-case stx ()
((_ f x) ((syntax-e #'f) #'x))))
;; split-requires : (listof syntax-object) -> (values (listof syntax-object) (listof syntax-object))
(define (split-requires l)
;; split-requires* : (listof identifier) -> (listof syntax) -> (values (listof syntax) (listof syntax))
;; Parameterized over identifiers for require forms.
(define ((split-requires* req-forms) l)
(let loop ((l l)
(requires null))
(cond
@ -37,14 +38,18 @@
(else
(syntax-case (car l) ()
((r . x)
(or (module-identifier=? #'r #'require)
(module-identifier=? #'r #'require-for-syntax)
(module-identifier=? #'r #'require-for-template))
(ormap (lambda (req) (module-identifier=? #'r req))
req-forms)
(loop (cdr l) (cons (car l) requires)))
(_
(cons (reverse requires) l)))))))
;; split-requires : (listof syntax) -> (values (listof syntax) (listof syntax))
;; Recognizes mzscheme require forms.
(define split-requires
(split-requires*
(list #'require #'require-for-syntax #'require-for-template)))
;; (make-var-info bool bool identifier (U #f syntax-object))
(define-struct var-info (syntax? [exported? #:mutable] id [ctc #:mutable]))

6
collects/scheme/signature/lang.ss
View File

@ -15,13 +15,17 @@
(string-append (regexp-replace "-sig$" (symbol->string s) "")
"^")))
;; Recognizes scheme require forms.
(define-for-syntax split-scheme-requires
(split-requires* (list #'require #'#%require)))
(define-syntax (module-begin stx)
(parameterize ((error-syntax stx))
(with-syntax ((name (make-name (syntax-property stx 'enclosing-module-name))))
(syntax-case stx ()
((_ . x)
(with-syntax ((((reqs ...) . (body ...))
(split-requires (checked-syntax->list #'x))))
(split-scheme-requires (checked-syntax->list #'x))))
(datum->syntax
stx
(syntax-e #'(#%module-begin