#!/run/current-system/profile/bin/guile \
-L ./src -e main -s
!#

(use-modules (ice-9 getopt-long)
             (ice-9 popen)
             (ice-9 pretty-print)
	     (frontend driver)
	     (backend tacky driver)
             (backend generator driver)
             (backend emitter driver))

(define version "v0.1.1")

(define (error-with-message message)
  (display message)
  (exit #f))

(define (error-cli message)
  (error-with-message
   (format #f
	   "~a\nUsage:
        ull [OPTIONS] file
Options:
        --version, -v: print version information
        --debug,   -d: turn on verbose output
        --lex,     -l: run the lexer, but stop before assembly generation
        --parse,   -p: run the lexer and parser, but stop before assembly generation
        --tacky,   -t: run the tacky generation stage, but stop before assembly generation
        --codegen, -c: perform lexing, parsing, tacky, and assembly generation, but stop before code emission\n"
	   message)))

(define (pp-step ast caption)
  (pretty-print ast)
  (display (format #f "^-==~a==-^\n" caption)))

(define (c-extension? file)
  (let ((extension (string-drop file (- (string-length file) 2))))
    (string=? extension ".c")))

(define (cleanup-file file)
  (when (file-exists? file)
    (delete-file file)))

(define (preprocess src dst)
  "Preprocesses SRC with gcc and write it to DST."
  (system (string-concatenate `("gcc -E -P " ,src " -o " ,dst)))
  (display (format #f "Preprocess reported success (wrote ~a).\n" dst)))

(define (frontend file parse?)
  "Wrapper for lexing and parsing. Returns an AST representing FILE."
  (let ((c-ast (file->ast file parse?)))
    (cleanup-file file)
    (or c-ast
	(error-with-message
	 (format #f "~aer reported FAILURE\n" (or (and parse? "Pars") "Lex"))))))

(define (backend ast tack? generate? write?)
  "Driver for tacky and assembly generation, code emission.
Returns an string representing the generated assembly."
  (pp-step ast "file->ast")
  (when tack?
    (let ((ast (ast->tacky ast)))
      (pp-step ast "ast->tacky")
      (when generate?
	(let ((ast (tacky->assembly ast)))
	  (pp-step ast "tacky->assembly")
	  (when write?
	    (assembly->string ast)))))))

(define (write str dst)
  "Writes STR to the file at DST."
  (cleanup-file dst)
  (let ((port (open-output-file dst)))
    (display str port)
    (close-port port))
  (display (format #f "Assembly generation reported success (wrote ~a).\n" dst)))

(define (postprocess src dst)
  "Assembles and links SRC, producing executable DST.
Returns #f on a failure, #t on a success."
  (when (zero? (system (string-concatenate `("gcc " ,src " -o " ,dst))))
    (display (format #f "Postprocess reported success (wrote ~a).\n" dst))))

(define (main args)
  "Entry point for ull. Handles user args and performs initial validity check."
  (let* ((option-spec
          '((version (single-char #\v) (value #f))
            (debug   (single-char #\d) (value #f))
            (lex     (single-char #\l) (value #f))
            (parse   (single-char #\p) (value #f))
            (tacky   (single-char #\t) (value #f))
            (codegen (single-char #\c) (value #f))))
	 (options (getopt-long args option-spec))
	 (rest (option-ref options '() #f))
	 (file-name (if (null? rest) #f (car rest))) )
    (cond
     ;; display version number
     ((option-ref options 'version #f)
      (display (format #f "ull (~a)\n" version)))

     ;; complain about usage
     ((not (equal? 1 (length rest))) (error-cli "Wrong number of arguments."))
     ((or (not file-name)
          (not (access? file-name R_OK))
          (not (equal? 'regular (stat:type (stat file-name))))
          (not (c-extension? file-name))) (error-cli "The file could not be read, or it is not a C source code file."))

     (#t
      (let* ((parse? (not (option-ref options 'lex #f)))
             (tack? (not (option-ref options 'parse #f)))
             (generate? (not (option-ref options 'tacky #f)))
             (write? (and (not (option-ref options 'codegen #f))
			  generate?
			  tack?))
	     (executable-file-name
	      (string-drop-right file-name 2))
	     (preprocessed-file-name
	      (string-concatenate `(,executable-file-name ".i")))
	     (assembly-file-name
	      (string-concatenate `(,executable-file-name ".s"))))

	;; preprocess the file
	(preprocess file-name preprocessed-file-name)
	;; call the frontend
	(let ((c-ast (frontend preprocessed-file-name parse?)))
	  (if (and parse? c-ast)
	      ;; call the backend
	      (begin (display "Parser reported success\n")
		     (let ((program (backend c-ast tack? generate? write?)))
		       (when write?
			 (write program assembly-file-name)
			 ;; call postprocessing
			 (postprocess assembly-file-name executable-file-name))))
	      (display "Tokenizer reported success\n"))))))))