#!/usr/bin/env mzscheme
#lang scheme/base
(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)
(base-language "pic18")
(device "/dev/staapl0")
(baud #f)
(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))
(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)
(unless (file-exists? (filename))
(printf "input file not found: ~a\n" (filename))
(exit 1))
(eval
`(begin
(require ,(base-language))
(forth-load/compile ,(filename))
(current-console (list
,(device)
,(or (baud) '(prj-macro->data 'baud)))) (save-ihex ,(output-hex))
(save-dict ,(output-dict)))
(make-base-namespace))