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

*** empty log message ***

Browse Source 
original commit: 307b78c4bc379ed03b93a05558dc77372f626ec0
This commit is contained in:
Scott Owens 2002-07-18 16:32:18 +00:00
parent aafb489b1b
commit 146e7ef350
1 changed files with 39 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
collects/mzlib/cm.ss
View File

@ -57,25 +57,25 @@
(trust-existing-zos))
(touch zo-name)
(begin
(with-handlers ((void void))
(delete-file 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)))
(with-handlers ((not-break-exn?
(lambda (ex)
(close-output-port out)
(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))))))
(write code out)
(close-output-port out))
(write-deps code path))))))
(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))))))
(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))))
(write-deps code path))))))
(indent (substring (indent) 2 (string-length (indent))))
((trace) (format "~aend compile: ~a" (indent) path)))
@ -96,23 +96,26 @@
(stamp stamp)
(else
((trace) (format "~achecking: ~a" (indent) path))
(let ((path-zo-time (get-compiled-time path))
(path-time (file-or-directory-modify-seconds path)))
(cond
((> path-time path-zo-time) (compile-zo path))
(else
(let ((deps (with-handlers ((exn:i/o:filesystem? (lambda (ex) #f)))
(call-with-input-file (string-append (get-compilation-path path) ".dep")
read))))
(cond
((or (not (pair? deps))
(not (equal? (version) (car deps))))
(compile-zo path))
((> (apply my-max (map (lambda (d) (compile-root d up-to-date)) (cdr deps))) path-zo-time)
(compile-zo path)))))))
(let ((stamp (get-compiled-time path)))
(hash-table-put! up-to-date path stamp)
stamp))))))
(with-handlers ((exn:i/o:filesystem? (lambda (ex)
((trace) (format "~a~a does not exist" (indent) path))
+inf.0)))
(let ((path-zo-time (get-compiled-time path))
(path-time (file-or-directory-modify-seconds path)))
(cond
((> path-time path-zo-time) (compile-zo path))
(else
(let ((deps (with-handlers ((exn:i/o:filesystem? (lambda (ex) #f)))
(call-with-input-file (string-append (get-compilation-path path) ".dep")
read))))
(cond
((or (not (pair? deps))
(not (equal? (version) (car deps))))
(compile-zo path))
((> (apply my-max (map (lambda (d) (compile-root d up-to-date)) (cdr deps))) path-zo-time)
(compile-zo path)))))))
(let ((stamp (get-compiled-time path)))
(hash-table-put! up-to-date path stamp)
stamp)))))))
(define (managed-compile-zo zo)
(parameterize ([current-load/use-compiled (make-compilation-manager-load/use-compiled-handler)])