#!/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 message)
  (display (string-concatenate `(,message "
Usage:
        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")))
  (exit #f))

(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 (string-concatenate `("Preprocess reported success (wrote " ,dst ").\n"))))

(define (frontend file parse?)
  "Wrapper for lexing and parsing. Returns an AST representing FILE."
  (let ((c-ast (file->ast file parse?)))
    (or c-ast
	(begin
	  (display (format #f "~a reported failure!\n" (or (and parse? "Parser") "Lexer")))
	  (cleanup-file file)
	  (exit #f)))))

(define (backend c-ast tack? generate? write?)
  "Driver for tacky and assembly generation, code emission. Returns an assembly program representing C-AST."
  (pretty-print c-ast)
  (display "===^file->ast^===\n")
  (when tack?
    (let ((tacky-ast (ast->tacky c-ast)))
      (pretty-print tacky-ast)
      (display "===^ast->tacky^===\n")
      (when generate?
	(let ((assembly-ast (tacky->assembly tacky-ast)))
	  (pretty-print assembly-ast)
	  (display "===^tacky->assembly^===\n")
	  (when write?
	    (assembly->string assembly-ast)))))))

(define (postprocess src dest)
  "Assembles and links SRC, producing executable DEST.
Returns #f on a failure, #t on a success."
  (zero? (system (string-concatenate `("gcc " ,src " -o " ,dest)))))

(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 (string-concatenate `("Assembly generation reported success (wrote " ,dst ").\n"))))

(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 (string-concatenate `("ull (" ,version ")\n"))))

     ;; complain about usage
     ((not (equal? 1 (length rest))) (error "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 "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? (not (option-ref options 'codegen #f)))
	    (preprocessed-file-name
	     (string-concatenate `(,(string-drop-right file-name 1) "i")))
	    (assembly-file-name
	     (string-concatenate `(,(string-drop-right file-name 1) "s")))
	    (executable-file-name
	     (string-drop-right file-name 2)))

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