suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

show warning text, transform-module reorganization for hacking language

Browse Source 
svn: r10505
This commit is contained in:
Eli Barzilay 2008-06-29 20:09:56 +00:00
parent 443a6fe233
commit c3fae01528
1 changed files with 22 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
collects/drscheme/private/module-language.ss
View File

@ -241,8 +241,7 @@
"\n" "\n"
"and clicking ‘Run’.")) "and clicking ‘Run’."))
error-args)))) error-args))))
;; This would be nice, but it removes the text selection from the error (send rep insert-warning "\n[Interactions disabled]")
;; (fprintf (current-error-port)"\n[Interactions disabled]")
(custodian-shutdown-all (send rep get-user-custodian))) (custodian-shutdown-all (send rep get-user-custodian)))
;; module-language-config-panel : panel -> (case-> (-> settings) (settings -> void)) ;; module-language-config-panel : panel -> (case-> (-> settings) (settings -> void))
@ -405,25 +404,27 @@
;; is the fully path-expanded name with a directory prefix, ;; is the fully path-expanded name with a directory prefix,
;; if the file has been saved ;; if the file has been saved
(define (transform-module filename stx) (define (transform-module filename stx)
(syntax-case* stx (module) (λ (x y) (eq? (syntax-e x) (syntax-e y))) (define-values (mod name lang body)
[(module name lang . rest) (syntax-case stx ()
(eq? 'module (syntax-e #'module)) [(module name lang . body)
(let* ([v-name #'name] (eq? 'module (syntax-e #'module))
[datum (syntax-e v-name)]) (values #'module #'name #'lang #'body)]
(unless (symbol? datum) [_ (raise-hopeless-syntax-error
(raise-hopeless-syntax-error "bad syntax in name position of module" (string-append "only a module expression is allowed, either\n"
stx v-name)) " #lang <language-name>\n or\n"
(when filename (check-filename-matches filename datum stx)) " (module <name> <language> ...)\n")
(values stx)]))
v-name (let* ([datum (syntax-e name)])
;; rewrite the module to use the scheme/base version of `module' (unless (symbol? datum)
(let ([module (datum->syntax #'here 'module #'form)]) (raise-hopeless-syntax-error "bad syntax in name position of module"
(datum->syntax stx `(,module ,#'name ,#'lang . ,#'rest) stx))))] stx name))
[else (raise-hopeless-syntax-error (when filename (check-filename-matches filename datum stx))
(string-append "only a module expression is allowed, either\n" (values
" #lang <language-name>\n or\n" name
" (module <name> <language> ...)\n") ;; rewrite the module to use the scheme/base version of `module'
stx)])) (let* ([mod (datum->syntax #'here 'module mod)]
[expr (datum->syntax stx `(,mod ,name ,lang . ,body) stx)])
expr))))
;; get-filename : port -> (union string #f) ;; get-filename : port -> (union string #f)
;; extracts the file the definitions window is being saved in, if any. ;; extracts the file the definitions window is being saved in, if any.