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

.

Browse Source 
original commit: 615882337b5b8687b03f868246f1c075b12393ae
This commit is contained in:
Matthew Flatt 2004-02-27 19:59:35 +00:00
parent d1e2cf8397
commit 9660f03d97
1 changed files with 0 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/mzlib/include.ss
View File

@ -102,48 +102,21 @@
`(begin ,@lexed-content)
orig-stx))))))]))
(define (check-fn-form fn stx)
;; Check form of fn:
(syntax-case* fn (build-path lib) module-or-top-identifier=?
[fn
(string? (syntax-e (syntax fn)))
'ok]
[(build-path elem1 elem ...)
(andmap
(lambda (e)
(or (path-string? (syntax-e e))
(and (identifier? e)
(or
(module-identifier=? e (quote-syntax up))
(module-identifier=? e (quote-syntax same))))))
(syntax->list (syntax (elem1 elem ...))))
'ok]
[(lib filename ...)
(andmap
(lambda (e)
(path-string? (syntax-e e)))
(syntax->list (syntax (filename ...))))
'ok]
[_else (raise-syntax-error #f "bad syntax" stx fn)]))
(define (include/proc stx)
(syntax-case stx ()
[(_ fn)
(check-fn-form (syntax fn) stx)
(with-syntax ([_stx stx])
(syntax/loc stx (do-include _stx _stx _stx fn #f)))]))
(define (include-at/relative-to/proc stx)
(syntax-case stx ()
[(_ ctx loc fn)
(check-fn-form (syntax fn) stx)
(with-syntax ([_stx stx])
(syntax/loc stx (do-include _stx ctx loc fn #f)))]))
(define (include/reader/proc stx)
(syntax-case stx ()
[(_ fn reader)
(check-fn-form (syntax fn) stx)
;; Expand to do-include:
(with-syntax ([_stx stx])
(syntax/loc stx
@ -157,7 +130,6 @@
(define (include-at/relative-to/reader/proc stx)
(syntax-case stx ()
[(_ ctx loc fn reader)
(check-fn-form (syntax fn) stx)
(with-syntax ([_stx stx])
(syntax/loc stx
(do-include _stx ctx loc fn