diff --git a/pkgs/racket-doc/syntax/scribblings/define.scrbl b/pkgs/racket-doc/syntax/scribblings/define.scrbl index b513b31cde..71dffdc6fe 100644 --- a/pkgs/racket-doc/syntax/scribblings/define.scrbl +++ b/pkgs/racket-doc/syntax/scribblings/define.scrbl @@ -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]. +} \ No newline at end of file diff --git a/racket/collects/racket/private/norm-define.rkt b/racket/collects/racket/private/norm-define.rkt index aff277383f..4e07ab98f5 100644 --- a/racket/collects/racket/private/norm-define.rkt +++ b/racket/collects/racket/private/norm-define.rkt @@ -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)]))) diff --git a/racket/collects/syntax/define.rkt b/racket/collects/syntax/define.rkt index 04c3066a69..5e49f06688 100644 --- a/racket/collects/syntax/define.rkt +++ b/racket/collects/syntax/define.rkt @@ -1,3 +1,3 @@ (module define racket/base (require racket/private/norm-define) - (provide normalize-definition)) + (provide normalize-definition normalize-definition/mk-rhs)) diff --git a/racket/collects/syntax/doc.txt b/racket/collects/syntax/doc.txt index db2405d6c2..3b746ee619 100644 --- a/racket/collects/syntax/doc.txt +++ b/racket/collects/syntax/doc.txt @@ -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' ======================================================================