; Copyright (c) 2004, 2005 by Juliusz Chroboczek.
; Experimental; do not redistribute.

(in-package cpc)

(defun convert-file (in-filename out-filename
                     &key (pretty t) (convert1 t) (lift convert1)
                     (optimise lift) (linearise lift)
                     (convert2 linearise))
  "Convert preprocessed CPC file IN-FILENAME to the C file OUT-FILENAME.
If PRETTY is true, the output is in C syntax; it's in Lisp syntax otherwise.
CONVERT1 controls whether conversion to CPS-convertible form is done.
LIFT controls whether lambda-lifting is done.
OPTIMISE controls whether an inlining step is done.
CONVERT2 controls whether cps-conversion is done."
  (with-open-file (in in-filename)
    (let* ((*fresh-counter* 0)
           (source (parse-cpc-file in :typedefs '("cpc_condvar")))
           (translatee-1 
            (if convert1
                (convert-translation-unit source '())
                source))
           (liftee
            (if lift
                (lift-translation-unit translatee-1)
                translatee-1))
           (optimisee
            (if optimise
                (optimise-translation-unit liftee)
                liftee))
           (linear
            (if linearise
                (linearise-translation-unit optimisee ())
                optimisee))
           (translatee
            (if convert2
                (convert2-translation-unit linear '() '())
                linear)))
      (declare (special *fresh-counter*))
      (with-open-file (out out-filename
                           :direction :output :if-exists :supersede)
        (progn
          (if pretty
              (progn
                (format out "#include \"cpc_runtime.h\"~%")
                (print-translation-unit translatee out))
              (print translatee out))
          nil)))))

#+CMU
(ext:defswitch "t")

#+(OR CMU CLISP)
(defun cpc-main ()
  #+CMU (setf ext:*gc-verbose* nil)
  (let ((*cpc-tail-recurse* *cpc-tail-recurse*)
        (source nil)
        (target nil)
        (keywords nil)
        (strings
         #+CMU (cdr ext:*command-line-strings*)
         #+CLISP ext:*args*
         #-(or CMU CLISP) (error "Not implemented on this platform")))
    (flet ((syntax ()
             (error "Syntax: cpc [flags] source target~%~S" strings)))
      (loop
       (let ((string (car strings)))
         (cond
           ((null strings)
            (unless (and source target) (syntax))
            (apply #'convert-file source target keywords)
            (ext:quit))
           ((equal string "-core") (setf strings (cddr strings)))
           ((equal string "-t")
            (setf *cpc-tail-recurse* t)
            (setf strings (cdr strings)))
           ((equal (aref string 0) #\-)
            (error "Unknown flag ~A" string))
           (t
            (cond
              ((null source) (setf source string))
              ((null target) (setf target string))
              (t (syntax)))
            (setf strings (cdr strings)))))))))