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

.

Browse Source 
original commit: bdfee767c2ae8fb7a0b48de7d51be2f0ee1b4a7c
This commit is contained in:
Matthew Flatt 2004-02-19 22:39:34 +00:00
parent d3f952a523
commit 4a7227f22a
2 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/mzlib/cm.ss
View File

@ -66,12 +66,14 @@
(define (touch path)
(close-output-port (open-output-file path 'append)))
(define (compilation-failure path zo-name date-path)
(define (compilation-failure path zo-name date-path reason)
(with-handlers ((not-break-exn? void))
(delete-file zo-name))
(let ([fail-path (bytes->path
(bytes-append (get-compilation-path path) #".fail"))])
(close-output-port (open-output-file fail-path 'truncate/replace)))
(let ([p (open-output-file fail-path 'truncate/replace)])
(display reason p)
(close-output-port p)))
((trace) (format "~afailure" (indent))))
(define (compile-zo path)
@ -86,7 +88,8 @@
(with-handlers ([exn:get-module-code?
(lambda (ex)
(compilation-failure
path zo-name (exn:get-module-code-path ex)))])
path zo-name (exn:get-module-code-path ex)
(exn-message ex)))])
(let* ([param
;; Avoid using cm while loading cm-ctime:
(parameterize ([use-compiled-file-kinds 'none])
@ -103,7 +106,7 @@
(make-directory code-dir))
(let ((out (open-output-file zo-name 'replace)))
(with-handlers ((exn:application:type?
(lambda (ex) (compilation-failure path zo-name #f))))
(lambda (ex) (compilation-failure path zo-name #f (exn-message ex)))))
(dynamic-wind
void
(lambda () (write code out))

1
collects/mzlib/contract.ss
View File

@ -2308,6 +2308,7 @@ add struct contracts for immutable structs?
(let printable? ([x x])
(or (symbol? x)
(string? x)
(bytes? x)
(boolean? x)
(char? x)
(null? x)