~ chicken-core (chicken-5) 58158284a7a04c895c7182ac3abe27c2741884ef

commit 58158284a7a04c895c7182ac3abe27c2741884ef
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Mon Jan 24 19:21:26 2011 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Mon Jan 24 19:21:26 2011 +0100

    compile-file returns #f on error

diff --git a/manual/Unit utils b/manual/Unit utils
index 8c174b1d..9d3186ce 100644
--- a/manual/Unit utils	
+++ b/manual/Unit utils	
@@ -62,7 +62,7 @@ as additional command line options to {{csc}}. If {{output-file}} is
 not given, then the compiled file is stored in a temporary location
 and will be deleted when the process exits successfully.
 When compilation and loading succeeds, the name of the compiled file
-is returned.
+is returned, otherwise {{#f}} is returned.
 
 Notes:
 
diff --git a/utils.scm b/utils.scm
index 91e64900..3ca33e23 100644
--- a/utils.scm
+++ b/utils.scm
@@ -68,8 +68,8 @@
 	 (string-concatenate
 	  (map (lambda (c)
 		 (if (or (char-whitespace? c)
-			 (memq c '(#\# #\" #\' #\` #\´ #\~ #\& #\% #\$ #\! #\* #\; #\< #\> #\\
-				   #\( #\) #\[ #\] #\{ #\} #\?)))
+			 (memq c '(#\# #\" #\' #\` #\´ #\~ #\& #\% #\$ #\! #\* #\;
+				   #\< #\> #\\ #\( #\) #\[ #\] #\{ #\} #\?)))
 		     (string #\\ c)
 		     (string c)))
 	       (string->list str)))))))
@@ -83,31 +83,34 @@
   (let ((csc (foreign-value "C_CSC_PROGRAM" c-string))
 	(load-file load)
 	(path (foreign-value "C_INSTALL_BIN_HOME" c-string)) )
-    (lambda (filename #!key (options '()) output-file (load #t))
-      (let ((cscpath (or (file-exists? (make-pathname path csc)) "csc"))
-	    (tmpfile (and (not output-file) (create-temporary-file "so")))
-	    (crapshell (eq? (build-platform) 'mingw32)))
+    (lambda (filename #!key (options '()) output-file (load #t) verbose)
+      (let* ((cscpath (or (file-exists? (make-pathname path csc)) "csc"))
+	     (tmpfile (and (not output-file) (create-temporary-file "so")))
+	     (crapshell (eq? (build-platform) 'mingw32))
+	     (cmd (sprintf "~a~a -s ~a ~a -o ~a~a" 
+		    (if crapshell "\"" "")
+		    (qs cscpath)
+		    (string-intersperse (append (compile-file-options) options) " ")
+		    (qs filename)
+		    (qs (or output-file tmpfile))
+		    (if crapshell "\"" ""))))
 	(print "; compiling " filename " ...")
-	(system* 
-	 "~a~a -s ~a ~a -o ~a~a" 
-	 (if crapshell "\"" "")
-	 (qs cscpath)
-	 (string-intersperse (append (compile-file-options) options) " ")
-	 (qs filename)
-	 (qs (or output-file tmpfile))
-	 (if crapshell "\"" ""))
-	(unless output-file 
-	  (on-exit
-	   (lambda ()
-	     (handle-exceptions ex #f (delete-file* tmpfile)))))
-	(when load
-	  (let ((f (or output-file tmpfile)))
-	    (handle-exceptions ex
-		(begin
-		  (delete-file* f)
-		  (abort ex))
-	      (load-file f)
-	      f)))))))
+	(when verbose (print "  " cmd))
+	(let ((status (system cmd)))
+	  (cond ((zero? status)
+		 (unless output-file 
+		   (on-exit
+		    (lambda ()
+		      (handle-exceptions ex #f (delete-file* tmpfile)))))
+		 (when load
+		   (let ((f (or output-file tmpfile)))
+		     (handle-exceptions ex
+			 (begin
+			   (delete-file* f)
+			   (abort ex))
+		       (load-file f)
+		       f))))
+		(else #f)))))))
 
 
 ;;; Scan lines until regex or predicate matches