; main driver for frontend and backend

(in-package "VERRAZANO")
  
; a structure representing the configuration of a binding
(defstruct configuration
  binding-name
  binding-nicknames
  included-files
  gccxml-flags
  symbols-hidden
  overrides
  options
  output-filename)

; get the path of the gccxml-executable for a build config
(defun gccxml-path (bconf)
  (car bconf))

; get the working directory from a build config
(defun working-directory (bconf)
  (cadr bconf))

; specify the configuration for the bindings generator
(defun setup-build (gccxml-path working-directory)
  (list gccxml-path working-directory))

; create a binding given an input configuration file
(defun create-binding (bconf filename outname backend &optional dbg?)
  (handler-case (create-binding-internal bconf filename outname backend dbg?)
    (frontend-error (err) (format t "~A~%"
				  (generate-error-message err)))))

; create a binding given an input configuration file
(defun create-binding-internal (bconf filename outname backend &optional dbg?)  
  (let ((cfg (parse-configuration-file filename outname))
        (temp-c (merge-pathnames "vzntemp.cpp" (working-directory bconf)))
        (temp-xml (merge-pathnames "vzntemp.xml" (working-directory bconf)))
	(temp-mac (merge-pathnames "vzntemp.mac" (working-directory bconf))))
    (handler-case (generate-temporary-c-file cfg temp-c)
      (file-error () (error 'tempcpp-error)))
    (run-gccxml cfg (gccxml-path bconf) temp-c temp-xml temp-mac)
    (let ((ir (parse-gccxml-output cfg temp-xml temp-mac)))
      (simplify-ir ir cfg)
      (when dbg? 
	(print-ir ir)
	(print-class-bases ir)
	(print-class-vtables ir))
      (let ((dq (generate-definition-queue ir)))
	(generate-package backend dq cfg))
      (when (not dbg?) (cleanup temp-c temp-xml temp-mac)))))

; a function to parse a configuration file
(defun parse-configuration-file (filename outname)
  (with-open-file (file filename :direction :input)
    (let ((pfile (read file))
	  (cfg (make-configuration)))
      (set-binding-name pfile cfg)
      (set-binding-nicknames pfile cfg)
      (set-binding-includes pfile cfg)
      (set-binding-flags pfile cfg)
      (set-binding-hidden pfile cfg)
      (set-binding-options pfile cfg)
      (setf (configuration-output-filename cfg) outname)
      cfg)))

; get a section in the configuration file
(defun find-section (pfile str)
  (let ((found nil))
    (dolist (fragment pfile found)
      (when (and (listp fragment) (equal (symbol-name (car fragment)) str))
	(setf found fragment)))))

; set the name of a binding
(defun set-binding-name (pfile cfg)
  (setf (configuration-binding-name cfg) 
	(quote-string (string-upcase (second pfile)))))

; set a list of the nicknames of a binding
(defun set-binding-nicknames (pfile cfg)
  (let ((sect (find-section pfile "NICKNAMES")))
    (dolist (element (cdr sect))
      (push (quote-string (string-upcase element))
	    (configuration-binding-nicknames cfg)))))

; set a list of the included files in a binding
(defun set-binding-includes (pfile cfg)
  (let ((sect (find-section pfile "INCLUDE")))
    (setf (configuration-included-files cfg) (cdr sect))))

; set the flags to pass to GCCXML
(defun set-binding-flags (pfile cfg)
  (let ((sect (find-section pfile "FLAGS")))
    (setf (configuration-gccxml-flags cfg) (cadr sect))))

; set the list of symbols to supress in the package
(defun set-binding-hidden (pfile cfg)
  (let ((sect (find-section pfile "HIDE")))
    (dolist (element (cdr sect))
      (push (quote-string (string-upcase element))
	    (configuration-symbols-hidden cfg)))))

; set the list of options in the binding
(defun set-binding-options (pfile cfg)
  (let ((sect (find-section pfile "OPTIONS")))
    (setf (configuration-options cfg) (cdr sect))))

; generate a temporary C file for a binding generation
(defun generate-temporary-c-file (cfg temp-c)
  (with-open-file (out temp-c :direction :output :if-exists :supersede)
    (dolist (inc (configuration-included-files cfg))
      (format out "#include \"~A\"~%" inc))
    (format out "const int __verrazano_binding = 1;")))

; run gccxml on the temporary file
(defun run-gccxml (cfg gccxml temp-c temp-xml temp-mac)
  (let* ((flags (configuration-gccxml-flags cfg))
         (mkxml (format nil "~A ~A -fxml=\"~A\" \"~A\"" gccxml (or flags "")
                  (namestring temp-xml) (namestring temp-c)))
	 (mkmac (format nil "~A ~A --preprocess -dDI \"~A\"" 
			gccxml (or flags "") (namestring temp-c))))
    (asdf:run-shell-command mkxml)
    (run-redirected mkmac (namestring temp-mac))))

; apply given simplifications to ir
(defun simplify-ir (ir cfg)
  (name-anonymous-elements ir)
  (mark-morally-virtual-functions ir)
  (annotate-object-offsets ir)
  (unnest-definitions ir)
  (lower-special-functions ir)
  (categorize-composite-types ir)
  (annotate-class-vtables ir)
  (lift-methods ir)
  (disambiguate-overloading ir)
  (mark-artificial-types ir)
  (mark-node-orders ir)
  (when (not (member :foreign-names (configuration-options cfg)))
    (translate-element-names ir))
  (resolve-casing-conflicts ir)
  (fixup-c-names ir))

; cleanup temporary files
(defun cleanup (&rest files)
  (dolist (one files)
    (delete-file one)))