Daemmerung

  ; @echo off && REM -*- scheme -*-
  ; if not "%MZSCHEME%" == "" goto :run
  ; set MZSCHEME=mzscheme.exe
  ; :run
  ; "%MZSCHEME%" "%~f0" %*
  ; exit /b
  
  #lang scheme
  (require xml)
  
  (permissive-xexprs #t)
  ;(read-comments #t)
  
  
  ;;; Filter to scrub whitespace
  ;;;
  (define f 
    (eliminate-whitespace 
     '(project path target property fileset condition copy exec cvs commandline tar classpath 
  	     tarfileset manifest section junit jar java and or not uptodate javac javadoc delete move) 
     (lambda (x) x)))
  
  
  ;;; Move "name" attribute to the beginning of any attribute list in an xexpr
  ;;;
  (define (name-first-attrib l)
    (letrec
        ;; take attribute list, move any "name" element to its car
        ((reorder-attrs (lambda (alist)
  			(cond
  			 ((null? alist) alist)
  			 ((assq 'name alist) => (lambda (el) (cons el (remove 'name alist (lambda (x y) (eq? x (car y)))))))
  			 (else alist))))
         ;; process any element (tag attrs el*)
         (process-element (lambda (el)
  			  (cons (car l) (cons (reorder-attrs (cadr l)) (map name-first-attrib (cddr l)))))) )
      (if (pair? l)
  	(process-element l)
  	l)))
  
  
  (define (process in out)
    (pretty-print (name-first-attrib (xml->xexpr (f (document-element (read-xml in))))) out))
  
  
  ;;; Open input file before output file, so that an error upon opening input doesn't create a zero-length output file
  ;;; If either parameter is #f, default to stdin/stdout
  ;;;
  (define (call-filter-with-files in-file out-file proc)
    (let ((output-processing-thunk (lambda (from)
  				   (if out-file
  				       (call-with-output-file out-file (lambda (to) (proc from to)))
  				       (proc from (current-output-port))))))
      (if in-file
  	(call-with-input-file in-file output-processing-thunk)
  	(output-processing-thunk (current-input-port)))))
  
  (define input-file (make-parameter #f))
  (define output-file (make-parameter #f))
  
  (command-line
   #:program "ant-make-scm"
   #:once-each
   (("--output" "-o") filename "Create S-expression format Ant buildfile" (output-file filename))
   #:args (build.xml) (unless (string=? "-" build.xml) (input-file build.xml)))
  
  (call-filter-with-files (input-file) (output-file) process)

  ;; The purpose of this compiler is to demonstrate
  ;; the most direct possible mapping of Scheme into C.
  ;; Toward that end, the compiler uses only two
  ;; intermediate transformations: mutable-variable
  ;; elimination and closure-conversion.