Expose the mk-rhs function normalize-definition uses.

I found I wanted this to make a define/stub macro that errors giving the defined identifier:

(define-syntax (define/stub stx)
  (syntax-case stx ()
    [(_ header)
     (let-values ([(id mk-rhs body) (normalize-definition/mk-rhs stx #'lambda #t #t #f)])
       #`(define #,id #,(mk-rhs #`(error '#,id "TODO: stub"))))]))

Closes #508.
This commit is contained in:
J. Ian Johnson 2013-12-04 14:32:50 -05:00 committed by Sam Tobin-Hochstadt
parent 7767ac64fd
commit af12f855ba
4 changed files with 45 additions and 8 deletions

View File

@ -30,3 +30,21 @@ an expression context. The default value of @racket[check-context?] is
If @racket[opt-kws?] is @racket[#t], then arguments of the form
@racket[[id expr]], @racket[keyword id], and @racket[keyword [id
expr]] are allowed, and they are preserved in the expansion.}
@defproc[(normalize-definition/mk-rhs [defn-stx syntax?]
[lambda-id-stx identifier?]
[check-context? boolean?]
[opt+kws? boolean?]
[err-no-body? boolean?])
(values identifier? (-> syntax? syntax?) syntax?)]{
The helper for @racket[normalize-definition] that produces three values:
the defined identifier, a function that takes the syntax of the body
and produces syntax that has the expected binding structure, and
finally the right-hand side expression that @racket[normalize-definition]
gives to the previous function.
If @racket[err-no-body?] is true, then there must be a right-hand side
expression or else it is a syntax error. The @racket[err-no-body?] argument
is true for uses of @racket[normalize-definition].
}

View File

@ -3,11 +3,11 @@
(#%require "small-scheme.rkt" "stxcase-scheme.rkt"
"member.rkt" "stx.rkt" "qqstx.rkt")
(#%provide normalize-definition)
(#%provide normalize-definition normalize-definition/mk-rhs)
(define-values (normalize-definition)
(case-lambda
[(stx lambda-stx check-context? allow-key+opt?)
(define-values (normalize-definition/mk-rhs)
(lambda
(stx lambda-stx check-context? allow-key+opt? err-no-body?)
(when (and check-context?
(memq (syntax-local-context) '(expression)))
(raise-syntax-error
@ -17,7 +17,7 @@
(syntax-case stx ()
[(_ id expr)
(identifier? #'id)
(values #'id #'expr)]
(values #'id values #'expr)]
[(_ id . rest)
(identifier? #'id)
(raise-syntax-error
@ -155,11 +155,18 @@
#f
"bad syntax (illegal use of `.' for procedure body)"
stx))
(when (stx-null? #'body)
(when (and err-no-body? (stx-null? #'body))
(raise-syntax-error
#f
"bad syntax (no expressions for procedure body)"
stx))
(values id (mk-rhs #'body)))])]
(values id mk-rhs #'body))])))
(define-values (normalize-definition)
(case-lambda
[(stx lambda-stx check-context? allow-key+opt?)
(let-values ([(id mk-rhs body)
(normalize-definition/mk-rhs stx lambda-stx check-context? allow-key+opt? #t)])
(values id (mk-rhs body)))]
[(stx lambda-stx check-context?) (normalize-definition stx lambda-stx check-context? #f)]
[(stx lambda-stx) (normalize-definition stx lambda-stx #t #f)])))

View File

@ -1,3 +1,3 @@
(module define racket/base
(require racket/private/norm-define)
(provide normalize-definition))
(provide normalize-definition normalize-definition/mk-rhs))

View File

@ -132,6 +132,18 @@ _define.ss_: handling all the same function forms as `define'
`keyword id', and `keyword [id expr]' are allowed, and they are
preserved in the expansion.
> (normalize-definition/mk-rhs defn-stx lambda-id-stx [check-context? opt+kws? err-no-body?]) -
the helper for `normalize-definition' that produces three values:
the defined identifier, a function that takes the syntax of the body
and produces syntax that has the expected binding structure, and
finally the right-hand side expression that `normalize-definition'
gives to the previous function.
If `err-no-body?' is true, then there must be a right-hand side
expression or else it is a syntax error. This is true for uses of
`normalize-definition'.
======================================================================
_struct.ss_: generating the same names as `define-struct'
======================================================================