Scheme: Save preprocessor output for all compiled files

This is a wrapper for the MSVC compiler (cl.exe) to generate a .i file as well as a .obj. Compiled with Bigloo.

(module cl-wrap
  (main main))
 
(define (quote-args args)
  (let loop ((args args)
	     (result ""))
    (if (null? args)
      result
      (loop (cdr args) (string-append result " \"" (car args) "\"")))))
 
(define (main args)
  ; Run cl.exe to compile
  (let ((exit-code (system (string-append "cl" (quote-args (cdr args))))))
    (if (not (= 0 exit-code))
      (exit exit-code)))
 
  ; Run cl.exe to produce preprocessed .i
  (let ((exit-code (system (string-append "cl /P" (quote-args (cdr args))))))
    (if (not (= 0 exit-code))
      (exit exit-code)))
 
  ; /P puts the file in the current directory, so we need to move it to the
  ; same directory the object would have been in.  Get the target directory from
  ; the /Fo option and the source name from the .(c|cpp).
  (let ((cpp-filename #f)
	(obj-filename #f))
    (let loop ((args (cdr args)))
      (cond
	((null? args)
	 #f)
 
	((and (>= (string-length (car args)) 3)
	      (string=? (substring (car args) 0 3) "/Fo"))
	 (set! obj-filename (substring (car args) 3 (string-length (car args))))
	 (loop (cdr args)))
 
	((or (string=? (suffix (car args)) "cpp")
	     (string=? (suffix (car args)) "c")
	     (string=? (suffix (car args)) "cxx"))
	 (set! cpp-filename (car args))
	 (loop (cdr args)))
 
	(else
	  (loop (cdr args)))))
 
    (let ((i-file (string-append (prefix (basename cpp-filename)) ".i")))
      (copy-file i-file (string-append (prefix obj-filename) ".i"))
      (delete-file i-file))))
Posted by: Jason Felice on June 7, 2009 • Tags: , , , , • Posted in: Jigs

Comments are closed for this entry.