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

*** empty log message ***

Browse Source 
original commit: 064cd1591e3fdb54c368ac34deb5fc7d421488a2
This commit is contained in:
Scott Owens 2002-07-18 17:09:41 +00:00
parent 146e7ef350
commit 945137e6e8
1 changed files with 16 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/mzlib/cm.ss
View File

@ -49,6 +49,14 @@
(define (touch path)
(close-output-port (open-output-file path 'append)))
(define (compilation-failure path zo-name)
(with-handlers ((not-break-exn? void))
(delete-file zo-name))
(let ((out (open-output-file (string-append (get-compilation-path path) ".fail")
'replace)))
(close-output-port out))
((trace) (format "~afailure" (indent))))
(define (compile-zo path)
((trace) (format "~acompiling: ~a" (indent) path))
(indent (format " ~a" (indent)))
@ -59,22 +67,16 @@
(begin
(with-handlers ((not-break-exn? void))
(delete-file zo-name))
(with-handlers ((not-break-exn?
(lambda (ex)
(delete-file zo-name)
(let ((out (open-output-file (string-append (get-compilation-path path)
".fail")
'replace)))
(close-output-port out))
((trace) (format "~afailure" (indent))))))
(with-handlers ((exn:user? (lambda (ex) (compilation-failure path zo-name))))
(let ((code (get-module-code path))
(code-dir (get-code-dir path)))
(if (not (directory-exists? code-dir))
(make-directory code-dir))
(let ((out (open-output-file zo-name 'replace)))
(dynamic-wind void
(lambda () (write code out))
(lambda () (close-output-port out))))
(with-handlers ((not-break-exn? (lambda (ex) (compilation-failure path zo-name))))
(if (not (directory-exists? code-dir))
(make-directory code-dir))
(let ((out (open-output-file zo-name 'replace)))
(dynamic-wind void
(lambda () (write code out))
(lambda () (close-output-port out)))))
(write-deps code path))))))
(indent (substring (indent) 2 (string-length (indent))))
((trace) (format "~aend compile: ~a" (indent) path)))