#!/usr/bin/env mzscheme
#lang scheme/base

;; The 'Staapl Compiler' command line tool.
;;
;; Provides a standard command line interface to all (compilation)
;; functionality.  It is invoked as:
;;
;;   mzscheme -p zwizwa/staapl/staaplc -- <arg> ...

(require scheme/pretty
         scheme/cmdline
         (planet zwizwa/staapl/tools))

(define-syntax-rule (flags: name ...)
  (begin (define name (make-parameter #f)) ...))

(flags: output-hex
        output-dict
        device
        baud
        filename
        print-asm
        )

;; Defaults
(device "/dev/staapl0")
(baud #f)
(print-asm void)


;; Parse argument list
(filename
 (command-line

  #:program "staaplc"
  
  #:once-each
  [("-o" "--output-hex") filename "Output Intel HEX file."
   (output-hex filename)]

  [("--print-code") "Print assembly and binary code output."
   (print-asm (lambda () (eval '(code-print))))]

  [("-d" "--device") filename "Console device. (default: /dev/staapl0)"  (device filename)]
  [("--baud") number   "Console baud rate. (default from source file)" (baud (string->number number))]
  
  [("-d" "--output-dict") filename "Output dictionary file."
   (output-dict filename)]
  
  #:args (filename)
  filename))

 
(define (out param template suffix)
  (let ((p (param)))
    (unless p
      (param
       (let-values (((base name _) (split-path template)))
         (path-replace-suffix name suffix))))))

(out output-hex (filename) ".hex")
(out output-dict (filename) ".dict") ;; (*)

;; (*) The extension .ss is too confusing.  This is a generated file,
;; which should be removable by a simple rm *.<ext> in a Makefile.

(define (absolute param)
  (let ((p (param)))
    (param
     (if (absolute-path? p)
         (string->path p)
         (path->complete-path p)))))

(define orig-filename (filename))

;; Why do these need to be absolute?
(absolute filename)
(absolute output-hex)
(absolute output-dict)

(define (dir-of path)
  (let-values (((base name _) (split-path path)))
    base))

;(printf "in:  ~a\n" (filename))
;(printf "out: ~a ~a\n" (output-hex) (output-dict))

(unless (file-exists? (filename))
  (printf "input file not found: ~a\n" (filename))
  (exit 1))

;; Run + save.
(define (init-code path)
  `(require
    (planet zwizwa/staapl/live)       ;; toplevel interaction
    (planet zwizwa/staapl/code)       ;; code->binary
    (planet zwizwa/staapl/port/ihex)  ;; write-ihex
    (planet zwizwa/staapl/pic18)      ;; base language (FIXME: obtain from module)
    (file ,(path->string path))))     ;; code as module
           

(parameterize
    ((current-namespace
      (make-base-namespace)))

  ;; Load necessary code.
  (eval (init-code (filename)))

  ;; Optionally print assembler code.
  ((print-asm))  
  
  ;; Fetch some defaults from the forth namespace.
  (unless (baud) (baud (eval '(macro-constant 'baud))))

  ;; Save binary output.
  (with-output-to-file/safe
   (output-hex)
   (lambda ()
     (eval '(write-ihex (code->binary)))))

  ;; Save symbolic output.
  (with-output-to-file/safe
   (output-dict)
   (lambda ()
     (pretty-print
      `(begin
         ,(init-code (filename))
         (code-clear!)
         ,(eval '(dict-snapshot))
         (console '(,(device) ,(baud))))))))