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

working on error messages

Browse Source
This commit is contained in:
Danny Yoo 2011-10-03 13:05:19 -04:00
parent 1447b39167
commit f0d231bd81
5 changed files with 120 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
js-assembler/check-valid-module-source.rkt Normal file
View File

@ -0,0 +1,90 @@
#lang racket/base
(provide check-valid-module-source)
(require syntax/kerncase
syntax/modresolve
racket/path
"../parameters.rkt"
"../parser/path-rewriter.rkt")
(define (abort-abort)
(printf "Aborting compilation.\n")
(exit))
(define (check-valid-module-source module-source-path)
;; Check that the file exists.
(unless (file-exists? module-source-path)
(printf "ERROR: Can't read a Racket module from ~e. The file does not appear to exist.\n"
module-source-path)
(abort-abort))
;; Is the file one that we know how to symbolically resolve?
(cond [(rewrite-path module-source-path)
(void)]
[else
(printf "ERROR: The file ~e appears to be outside the root package directory ~e. You may need to use --root-dir.\n"
module-source-path
(current-root-path))
(abort-abort)])
;; Check that it looks like a module.
(define stx
(with-handlers ([exn:fail?
(lambda (exn)
;; We can't even get the bytecode for the file.
;; Fail immediately.
(printf "ERROR: Can't read a Racket module from ~e. The file may be ill-formed.\n"
module-source-path)
(printf "\nFor reference, the error message produced when trying to read ~e is:\n\n" module-source-path)
(printf "~a\n" (exn-message exn))
(abort-abort))])
(parameterize ([read-accept-reader #t])
(call-with-input-file* module-source-path
(lambda (ip)
(read-syntax #f ip))))))
(define relative-language-stx
(kernel-syntax-case stx #t
[(module name language body ...)
#'language]
[else
(printf "ERROR: Can't read a Racket module from ~e. The file exists, but does not appear to be a Racket module.\n"
module-source-path)
(abort-abort)]))
;; Finally, check that the module is written in a language that we allow.
(define resolved-language-path
(resolve-module-path (syntax->datum relative-language-stx)
module-source-path))
(cond
[(eq? resolved-language-path '#%kernel)
(void)]
[(path? resolved-language-path)
(define normalized-resolved-language-path
(normalize-path resolved-language-path))
(cond
[(within-root-path? normalized-resolved-language-path)
(void)]
[(within-whalesong-path? normalized-resolved-language-path)
(void)]
[else
;; Something bad is about to happen, as the module is written
;; in a language that we, most likely, can't compile.
;;
;; Let's see if we can provide a good error message here
(printf "ERROR: The file ~e is a Racket module, but is written in the language ~a [~e], which Whalesong does not know how to compile.\n"
module-source-path
(syntax->datum relative-language-stx)
normalized-resolved-language-path)
(abort-abort)])]))

40
js-assembler/package.rkt
View File

@ -12,6 +12,7 @@
"../resource/structs.rkt"
"../promise.rkt"
"../get-module-bytecode.rkt"
"check-valid-module-source.rkt"
(prefix-in hash-cache: "hash-cache.rkt")
racket/match
racket/list
@ -22,6 +23,7 @@
racket/port
syntax/modread
syntax/kerncase
syntax/modresolve
(prefix-in query: "../lang/js/query.rkt")
(prefix-in resource-query: "../resource/query.rkt")
(prefix-in runtime: "get-runtime.rkt")
@ -110,44 +112,6 @@
[(UninterpretedSource? src)
(void)]))
(define (check-valid-module-source module-source-path)
;; Check that the file exists.
(unless (file-exists? module-source-path)
(printf "Can't read a Racket module from ~e. The file does not appear to exist.\n"
module-source-path)
(error 'check-valid-module-source))
;; Check that it looks like a module.
(define stx
(with-handlers ([exn:fail?
(lambda (exn)
;; We can't even get the bytecode for the file.
;; Fail immediately.
(printf "Can't read a Racket module from ~e. The file may be ill-formed.\n"
module-source-path)
(printf "\nFor reference, the error message produced when trying to read ~e is:\n\n" module-source-path)
(printf "~a\n" (exn-message exn))
(error 'check-valid-module-source))])
(parameterize ([read-accept-reader #t])
(call-with-input-file* module-source-path
(lambda (ip)
(read-syntax #f ip))))))
(define language-stx
(kernel-syntax-case stx #t
[(module name language body ...)
#'language]
[else
(printf "Can't read a Racket module from ~e.\nThe file exists, but does not appear to be a Racket module.\n"
module-source-path)
(error 'check-valid-module-source)]))
;; Check that the module is written in a language that we allow.
(displayln language-stx)
(void))
;; source-is-javascript-module?: Source -> boolean

5
parser/path-rewriter.rkt
View File

@ -10,6 +10,7 @@
(provide/contract [rewrite-path (complete-path? . -> . (or/c symbol? false/c))]
[within-root-path? (complete-path? . -> . boolean?)]
[within-whalesong-path? (complete-path? . -> . boolean?)])
@ -42,7 +43,7 @@
(string-append "collects/"
(path->string
(find-relative-path collects-path a-path))))]
[(within-root? a-path)
[(within-root-path? a-path)
(string->symbol
(string-append "root/"
(path->string
@ -53,7 +54,7 @@
(define (within-root? a-path)
(define (within-root-path? a-path)
(within? (current-root-path) a-path))

4
whalesong-helpers.rkt
View File

@ -87,7 +87,7 @@
(resource-path r))
(void)]
[else
(error 'whalesong "Unable to write resource ~s; this will overwrite a file"
(error 'whalesong "Unable to write resource ~s; this will overwrite a file that already exists."
(build-path (current-output-dir)
(resource-key r)))])]
[else
@ -141,7 +141,7 @@
(resource-key r))))
(void)]
[else
(error 'whalesong "Unable to write resource ~s; this will overwrite a file"
(error 'whalesong "Unable to write resource ~s; this will overwrite a file that already exists."
(build-path (current-output-dir)
(resource-key r)))])]
[else

23
whalesong.rkt
View File

@ -5,6 +5,7 @@
"parameters.rkt"
"whalesong-helpers.rkt"
profile profile/render-text
racket/path
(for-syntax racket/base))
;; Command line for running Whalesong.
@ -49,6 +50,15 @@
expr))]))
(define (set-root-path! root-path)
(unless (directory-exists? root-path)
(printf "ERROR: root path ~a does not appear to exist.\n" root-path)
(printf "Aborting compilation.\n")
(exit))
(current-root-path (normalize-path root-path)))
(define (at-toplevel)
(svn-style-command-line
#:program "whalesong"
@ -78,6 +88,10 @@
[("--split-modules")
("Write one file per module")
(current-one-module-per-file? #t)]
[("--root-dir")
root-path
("Set the root package path (default: current-directory)")
(set-root-path! root-path)]
[("--dest-dir")
dest-dir
("Set destination directory (default: current-directory)")
@ -110,6 +124,10 @@
[("--without-cache")
("Turn off the internal compilation cache")
(current-with-cache? #f)]
[("--root-dir")
root-path
("Set the root package path (default: current-directory)")
(set-root-path! root-path)]
[("--compress-javascript")
("Compress JavaScript with Google Closure (requires Java)")
(current-compress-javascript? #t)]
@ -135,6 +153,11 @@
[("--without-cache")
("Turn off the internal compilation cache")
(current-with-cache? #f)]
[("--root-dir")
root-path
("Set the root package path (default: current-directory)")
(set-root-path! root-path)]
[("--compress-javascript")
("Compress JavaScript with Google Closure (requires Java)")
(current-compress-javascript? #t)]