(in-package :cl-forth)

(defun drop-file-type (file &key (returns :string))
  (let* ((file-str (namestring file))
         (dropped (subseq file-str 0 (position #\. file-str))))
    (case returns
      (:string dropped)
      (:file (pathname dropped)))))

(defun change-file-type (file new-type &key (returns :string))
  (let* ((pathn (pathname file))
         (new-file (format nil "~a.~a"
                           (drop-file-type pathn)
                           new-type)))
    (case returns
      (:string new-file)
      (:file (pathname new-file)))))

(defun lex-stream (str)
  (iter outer
        (for line = (read-line str nil nil))
        (until (null line))
        (for line-num from 1)
        (appending (lex-line line line-num))))

(defun read-form-comment (str)
  (read-from-string 
   (format nil "~{~a~^~%~}" 
           (iter (for ch = (peek-char t str nil nil))
                 (while ch)
                 (cond ((char= ch #\;)
                        (iter (for ch = (read-char str nil nil))
                              (while (and ch (char= #\; ch))))
                        (collect (read-line str)))
                       (t (finish)))))))

(defun run-test (path &key (target :nasm))
  "File must begin with 2 comments: 
   First must be TEST
   Second must eval to the expected result"
  (let ((abs-path (if (cl-fad:pathname-absolute-p path)
                      path
                      (from-root path)))
        (successful nil))
    (with-open-file (str abs-path)
      (unless (string-equal "test" (second (uiop:split-string
                                            (read-line str)
                                            :separator '(#\Space))))
        (return-from run-test 'not-test))
      (let ((expected-output (eval (read-form-comment str))))
        (generate-program (parse-tokens (lex-stream str))
                          :path (change-file-type abs-path (case target
                                                             (:nasm "asm")
                                                             (:c "c")))
                          :compile t :silence t
                          :target target)
        (let ((output (run (list (drop-file-type abs-path))
                           :output :string :silence t)))
          (format t "testing ~a... " (pathname-name path))
          (if (string= expected-output output)
              (progn (format t "successful~%") (setf successful t))
              (format t "~{~a~%~}"
                      (list "failed"
                            "---expected output---"
                            expected-output
                            "---actual output---"
                            output))))
        ;; delete generated .asm .o and executable file
        (case target
          (:nasm (delete-file (probe-file (change-file-type abs-path "asm")))
           (delete-file (probe-file (change-file-type abs-path "o"))))
          (:c (delete-file (probe-file (change-file-type abs-path "c")))))
        (delete-file (probe-file (drop-file-type abs-path)))))
    successful))

(defun run-tests (&key (ignore-err nil) (target :nasm))
  (loop for success?
          in (mapcar (lambda (file) (if (not ignore-err)
                                   (run-test file :target target)
                                   (ignore-errors
                                    (run-test file :target target))))
                     (remove-if-not (lambda (file)
                                      (string= "lorth" (pathname-type file))) 
                                    (cl-fad:list-directory
                                     (from-root "test"))))
        counting (eq t success?) into succs
        counting (null success?) into fails
        finally (format t "~a success, ~a fail~%" succs fails)))

;; (defun test-from-string (string expected-output &key (silence t))
;;   (generate-program (parse-tokens (lex-string string)) 
;;                     :path "test/test.asm" :compile t :silence silence)
;;   (let ((output (run '("test/test") :output :string :silence silence)))
;;     (if (string= expected-output output)
;;         t
;;         (format t "~{~a~%~}"
;;                 (list "test failed"
;;                       "---expected output---"
;;                       expected-output
;;                       "---actual output---"
;;                       output)))))

;; (defun run-tests ()
;;   (test-from-string "3 6 + dump" (format nil "9~%"))
;;   (test-from-string
;;    "0 döngü eş 4 < iken
;;       eş dump
;;       1 +
;;    yap"
;;    (format nil "~{~a~%~}" '(0 1 2 3)))
;;   (test-from-string
;;    "bel 0 + 97 yaz
;;     bel 1 + 98 yaz
;;     bel 2 + 99 yaz
;;     bel 3 + 10 yaz 
        
;;     1 bel 4 1 syscall-3
    
;;     bel 0 + eş oku 1 + yaz
;;     bel 1 + eş oku 1 + yaz
;;     bel 2 + eş oku 1 + yaz
    
;;     1 bel 4 1 syscall-3
;;     0 60 syscall-1"
;;    (format nil "abc~%bcd~%")))