From 945137e6e8acab55e23f2a6f0aa2f41d12c08894 Mon Sep 17 00:00:00 2001
From: Scott Owens <sowens@cs.utah.edu>
Date: Thu, 18 Jul 2002 17:09:41 +0000
Subject: [PATCH] *** empty log message ***

original commit: 064cd1591e3fdb54c368ac34deb5fc7d421488a2
---
 collects/mzlib/cm.ss | 30 ++++++++++++++++--------------
 1 file changed, 16 insertions(+), 14 deletions(-)

diff --git a/collects/mzlib/cm.ss b/collects/mzlib/cm.ss
index 329e9fb..fd51e60 100644
--- a/collects/mzlib/cm.ss
+++ b/collects/mzlib/cm.ss
@@ -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)))