check the context we are expanding into

svn: r17170
This commit is contained in:
Jon Rafkind 2009-12-03 00:44:11 +00:00
parent 3d10bff57c
commit 81b30db001

View File

@ -2,6 +2,7 @@
(require "honu.ss" (require "honu.ss"
(for-syntax "debug.ss" (for-syntax "debug.ss"
"contexts.ss"
scheme/base scheme/base
syntax/parse syntax/parse
syntax/stx syntax/stx
@ -389,8 +390,23 @@
#:literals (honu-literal ...) #:literals (honu-literal ...)
[(name pattern* ... . rrest) [(name pattern* ... . rrest)
(with-syntax ([(out (... ...)) (unpull #'pulled)]) (with-syntax ([(out (... ...)) (unpull #'pulled)])
;; TODO: use the proper `honu-unparsed' form depending on the context (define (X) (raise-syntax-error (syntax->datum #'name) "implement for this context"))
(values (values
;; this is sort of ugly, is there a better way?
(cond
[(type-context? ctx) (X)]
[(type-or-expression-context? ctx) (X)]
[(expression-context? ctx) #'(honu-unparsed-expr out (... ...))]
[(expression-block-context? ctx)
#'(honu-unparsed-begin out (... ...))]
[(block-context? ctx)
#'(honu-unparsed-begin out (... ...))]
[(variable-definition-context? ctx) (X)]
[(constant-definition-context? ctx) (X)]
[(function-definition-context? ctx) (X)]
[(prototype-context? ctx) (X)]
[else #'(honu-unparsed-expr out (... ...))])
#;
#'(honu-unparsed-begin out (... ...)) #'(honu-unparsed-begin out (... ...))
#'rrest) #'rrest)
#; #;