more specific error message for misuse of a pattern variable

svn: r3978
This commit is contained in:
Matthew Flatt 2006-08-07 12:56:13 +00:00
parent 720969a8b6
commit d2f73275c4
3 changed files with 2563 additions and 2502 deletions

File diff suppressed because it is too large Load Diff

View File

@ -867,6 +867,7 @@
EVAL_ONE_STR( EVAL_ONE_STR(
"(module #%sc #%kernel" "(module #%sc #%kernel"
"(require #%stx #%small-scheme)" "(require #%stx #%small-scheme)"
"(require-for-template(only #%kernel set!))"
"(-define(...? s)" "(-define(...? s)"
"(if(symbol?(syntax-e s))" "(if(symbol?(syntax-e s))"
"(module-identifier=? s(quote-syntax ...))" "(module-identifier=? s(quote-syntax ...))"
@ -1534,7 +1535,32 @@
"((identifier? stx)" "((identifier? stx)"
"(not(...? stx)))" "(not(...? stx)))"
"(else #t)))" "(else #t)))"
"(define-struct syntax-mapping(depth valvar))" "(define-values(struct:syntax-mapping -make-syntax-mapping -syntax-mapping? syntax-mapping-ref syntax-mapping-set!)"
"(make-struct-type 'syntax-mapping #f 2 0 #f null(current-inspector)"
"(lambda(self stx)"
"(if(identifier? stx)"
"(raise-syntax-error"
" #f"
" \"pattern variable cannot be used outside of a template\""
" stx)"
"(raise-syntax-error"
" #f"
" \"pattern variable cannot be used outside of a template\""
" stx"
"(if(module-template-identifier=?(quote-syntax set!)(stx-car stx))"
"(stx-car(stx-cdr stx))"
"(stx-car stx)))))))"
"(-define -syntax-mapping-depth(make-struct-field-accessor syntax-mapping-ref 0))"
"(-define -syntax-mapping-valvar(make-struct-field-accessor syntax-mapping-ref 1))"
"(-define(make-syntax-mapping depth valvar)"
"(make-set!-transformer(-make-syntax-mapping depth valvar)))"
"(-define(syntax-mapping? v)"
"(and(set!-transformer? v)"
"(-syntax-mapping?(set!-transformer-procedure v))))"
"(-define(syntax-mapping-depth v)"
"(-syntax-mapping-depth(set!-transformer-procedure v)))"
"(-define(syntax-mapping-valvar v)"
"(-syntax-mapping-valvar(set!-transformer-procedure v)))"
"(provide(protect make-match&env get-match-vars make-pexpand" "(provide(protect make-match&env get-match-vars make-pexpand"
" make-syntax-mapping syntax-mapping?" " make-syntax-mapping syntax-mapping?"
" syntax-mapping-depth syntax-mapping-valvar" " syntax-mapping-depth syntax-mapping-valvar"

View File

@ -995,6 +995,7 @@
(module #%sc #%kernel (module #%sc #%kernel
(require #%stx #%small-scheme) (require #%stx #%small-scheme)
(require-for-template (only #%kernel set!))
;; Checks whether s is "..." ;; Checks whether s is "..."
(-define (...? s) (-define (...? s)
@ -1808,7 +1809,32 @@
[else #t])) [else #t]))
;; Structure for communicating first-order pattern variable information: ;; Structure for communicating first-order pattern variable information:
(define-struct syntax-mapping (depth valvar)) (define-values (struct:syntax-mapping -make-syntax-mapping -syntax-mapping? syntax-mapping-ref syntax-mapping-set!)
(make-struct-type 'syntax-mapping #f 2 0 #f null (current-inspector)
(lambda (self stx)
(if (identifier? stx)
(raise-syntax-error
#f
"pattern variable cannot be used outside of a template"
stx)
(raise-syntax-error
#f
"pattern variable cannot be used outside of a template"
stx
(if (module-template-identifier=? (quote-syntax set!) (stx-car stx))
(stx-car (stx-cdr stx))
(stx-car stx)))))))
(-define -syntax-mapping-depth (make-struct-field-accessor syntax-mapping-ref 0))
(-define -syntax-mapping-valvar (make-struct-field-accessor syntax-mapping-ref 1))
(-define (make-syntax-mapping depth valvar)
(make-set!-transformer (-make-syntax-mapping depth valvar)))
(-define (syntax-mapping? v)
(and (set!-transformer? v)
(-syntax-mapping? (set!-transformer-procedure v))))
(-define (syntax-mapping-depth v)
(-syntax-mapping-depth (set!-transformer-procedure v)))
(-define (syntax-mapping-valvar v)
(-syntax-mapping-valvar (set!-transformer-procedure v)))
(provide (protect make-match&env get-match-vars make-pexpand (provide (protect make-match&env get-match-vars make-pexpand
make-syntax-mapping syntax-mapping? make-syntax-mapping syntax-mapping?