diff --git a/collects/unstable/define.rkt b/collects/unstable/define.rkt index a2a73d7ea9..e4d39a47d6 100644 --- a/collects/unstable/define.rkt +++ b/collects/unstable/define.rkt @@ -5,8 +5,12 @@ racket/base racket/list racket/match + racket/block + syntax/parse syntax/kerncase - unstable/syntax)) + unstable/syntax + (for-syntax ;; phase 2! + racket/base))) (provide @@ -32,10 +36,37 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-syntax-rule - (define-syntax-block ([macro-name expander-name] ...) body-def ...) - (define-syntaxes [macro-name ...] - (let () body-def ... (values expander-name ...)))) +(define-syntax define-syntax-block + (block + + (define-syntax-class declaration + #:attributes [internal external] + (pattern external:id + #:attr internal + (format-id #'external #:source #'external + "~a/proc" #'external)) + (pattern [external:id internal:id])) + + (syntax-parser + [(_ (decl:declaration ...) body:expr ...) + #:fail-when (check-duplicate-identifier + (syntax-list decl.external ...)) + "duplicate defined name" + #'(define-syntaxes [decl.external ...] + ;; Easier way to ensure the internal names are bound than + ;; local-expand: bind them to an error macro and force the + ;; user to shadow them. + (let-syntax + ([decl.internal + (make-set!-transformer + (lambda (stx) + (raise-syntax-error #f + "transformer must be defined within define-syntax-block" + stx)))] + ...) + (block + body ... + (values decl.internal ...))))]))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; diff --git a/collects/unstable/scribblings/define.scrbl b/collects/unstable/scribblings/define.scrbl index cbdf029bfa..f4ddd85cda 100644 --- a/collects/unstable/scribblings/define.scrbl +++ b/collects/unstable/scribblings/define.scrbl @@ -1,5 +1,11 @@ #lang scribble/manual -@(require scribble/eval "utils.rkt" (for-label racket unstable/define)) +@(require + scribble/eval + "utils.rkt" + (for-label + racket + unstable/define + (only-in mzlib/etc define-syntax-set))) @title{Definitions} @@ -124,27 +130,34 @@ x @section{Macro Definitions} -@defform[(define-syntax-block ([macro-id expander-id] ...) body ...)]{ +@defform/subs[ +(define-syntax-block (macro-decl ...) body ...) +([macro-decl macro-id [macro-id expander-id]]) +]{ -Define a syntax transformer for each @racket[macro-id] based on the local -definition of each @racket[expander-id] in @racket[body ...]. Especially useful -for mutually recursive expander functions and phase 1 macro definitions. +Defines a syntax transformer for each @racket[macro-id] based on the local +definition of each @racket[expander-id] +(defaulting to @racket[macro-id]@racket[/proc]) in @racket[body ...]. +Especially useful for mutually recursive expander functions and phase 1 macro +definitions. Subsumes the behavior of @racket[define-syntax-set]. @defexamples[ #:eval (eval/require 'unstable/define '(for-syntax racket/base)) (define-syntax-block ([implies expand-implies] - [nand expand-nand]) + nand) (define-syntax-rule (==> pattern template) (syntax-rules () [pattern template])) (define expand-implies (==> (_ a b) (or (not a) b))) - (define expand-nand (==> (_ a ...) (not (and a ...))))) + (define nand/proc (==> (_ a ...) (not (and a ...))))) (implies #t (printf "True!\n")) (implies #f (printf "False!\n")) (nand #t #t (printf "All True!\n")) (nand #t #f (printf "Some False!\n")) +(define-syntax-block (undefined-macro) + (define irrelevant "Whoops!")) ] }