(import (chicken io)
        (chicken pathname)
        (chicken process-context)
        matchable
        srfi-13
        mars parser)

(define (load-progs filenames)
  (map (lambda (filename)
         (string->prog (with-input-from-file filename read-string)))
       filenames))

(define (print-help)
  (print "Commands:\n"
         "q:\tPrint current process queues\n"
         "c:\tClear and reinitialize core\n"
         "d:\tDump list of instructions around each process instruction pointer\n"
         "s, n:\tStep to next iteration\n"
         "x:\tQuit debugger"))

(define (mars-debugger core-size filenames)
  (let* ((core (make-core core-size))
         (progs (load-progs filenames))
         (queues (install-progs core progs)))
    (print "JaRS Redcode Debugger. Enter 'h' for help.")
    (let loop ()
      (print* "> ")
      (if
       (match (string-tokenize (read-line))
         (("h")
          (print-help)
          #t)
         (("q")
          (print queues)
          #t)
         (("c")
          (print "Reinitializing...")
          (set! core (make-core core-size))
          (set! queues (install-progs core progs))
          #t)
         (("d")
          (dump-queues queues core)
          #t)
         ((or ("s") ("n") ())
          (set! queues (run-mars core queues 1 1))
          (dump-queues queues core)
          #t)
         (("x")
          #f)
         (other
          (print "Error: unrecognised command '" other "'")
          #t))
       (loop)
       (print "Bye.")))))

(define (print-usage)
  (print "Usage: run-mars [-h|--help]\n"
         "       run-mars [-c|--core size]\n"
         "                warrior1.red [warrior2.red [...]]"))

(define (main)
  (let loop ((args (cdr (argv)))
             (core-size 8000))
    (match args
      ((or () ((or "-h" "--help")))
       (print-usage))
      (((or "-c" "--core-size") cstr rest ...)
       (loop rest (string->number cstr)))
      ((filenames ...)
       (mars-debugger core-size filenames)))))

(main)