#!/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/sc -- <arg> ...

(require scheme/pretty
         scheme/cmdline)

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

(flags: base-language
        output-hex
        output-dict
        device
        baud
        filename)

;; Defaults
(base-language "pic18")
(device "/dev/staapl0")
(baud #f)


;; Parse argument list
(filename
 (command-line

  #:program "staaplc"
  
  #:once-each
  [("-b" "--base-language") lang "Base language environment. (default: pic18)"
   (base-language lang)]

  [("-o" "--output-hex") filename "Output Intel HEX file."
   (output-hex filename)]
  
  [("--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))

;; Postprocess configuration
(base-language `(planet ,(string->symbol (format "zwizwa/staapl/prj/~a" (base-language))))) ;; (*)
 
(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) ".ss")

(define (absolute param)
  (let ((p (param)))
    (unless (absolute-path? p)
      (param (path->complete-path p)))))
(absolute filename)
(absolute output-hex)
(absolute output-dict)



;(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.
(eval
 `(begin
    (require ,(base-language)) 
    (forth-load/compile ,(filename))
    (current-console (list
                      ,(device)
                      ,(or (baud)                       ;; specified
                           '(prj-macro->data 'baud))))  ;; from forth code
    (save-ihex ,(output-hex))
    (save-dict ,(output-dict)))
 (make-base-namespace))


;; (*) This is not just the base language, but the module that adds an
;; extra level of indirection to support compiler name space management.