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

.

Browse Source 
original commit: 4cb555c73d84cfb4a761ea2180960459ed789691
This commit is contained in:
Matthew Flatt 2001-09-19 22:26:28 +00:00
parent 25333ecf08
commit fbf52dc88d
1 changed files with 33 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
collects/mzlib/etc.ss
View File

@ -2,7 +2,8 @@
(module etc mzscheme (module etc mzscheme
(require "spidey.ss") (require "spidey.ss")
(require-for-syntax (lib "kerncase.ss" "syntax") (require-for-syntax (lib "kerncase.ss" "syntax")
(lib "stx.ss" "syntax")) (lib "stx.ss" "syntax")
"private/stxset.ss")
(provide true false (provide true false
boolean=? symbol=? boolean=? symbol=?
@ -434,41 +435,35 @@
(syntax (or (current-load-relative-directory) (syntax (or (current-load-relative-directory)
(current-directory)))))])) (current-directory)))))]))
;; This is a macro-generating macro that wants to expand
;; expressions used in the generated macro. So it's weird,
;; and we put much of the work in a helper macro,
;; `finish-syntax-set'.
(define-syntax (define-syntax-set stx) (define-syntax (define-syntax-set stx)
(syntax-case stx () (syntax-case stx ()
[(_ (id ...) defn ...) [(_ (id ...) defn ...)
(let ([ids (syntax->list (syntax (id ...)))]) (let ([ids (syntax->list (syntax (id ...)))])
;; Check ids ------------------------------ ;; Check ids ------------------------------
(for-each (lambda (id) (for-each (lambda (id)
(unless (identifier? id) (unless (identifier? id)
(raise-syntax-error (raise-syntax-error
#f #f
"not an identifier or two identifier in parentheses" "not an identifier or two identifier in parentheses"
stx stx
id))) id)))
ids) ids)
(let ([dup (check-duplicate-identifier ids)]) (let ([dup (check-duplicate-identifier ids)])
(when dup (when dup
(raise-syntax-error (raise-syntax-error
#f #f
"duplicate identifier" "duplicate identifier"
stx stx
dup))) dup)))
(let ([internal-ids (map (lambda (id)
(datum->syntax-object
id
(string->symbol (format "~a/proc" (syntax-e id)))
id))
ids)])
;; We'd like to check the `defns', but that requires
;; We'd like to check the `defns', but that requires ;; and expansion in a different phase. So we move
;; and expansion in a different phase. So we punt for now. ;; into that phase using `finish-syntax-set':
(with-syntax ([orig-stx stx])
;; Produce result ------------------------------ (syntax/loc stx
(with-syntax ([(int-id ...) internal-ids]) (define-syntaxes (id ...)
(syntax/loc stx (finish-syntax-set orig-stx)))))])))
(define-syntaxes (id ...)
(let ()
defn ...
(values int-id ...)))))))])))