call C compiler from Sex directly
Also rework options printing, add some cmdline options, rework others, all in all, the logic is now looking like this: * -E to emit C code * -m to emit macro-expanded Sex code * -c to emit object file instead of executable * --c-compiler to set C compiler. If not provided, check SEX_CC enviroment variable, if it's empty, default to `cc' * options after -- are passed to C compiler * default mode is to compile Sex module to executable
This commit is contained in:
98
sexc.scm
98
sexc.scm
@@ -2,9 +2,11 @@
|
||||
(uses templates))
|
||||
|
||||
(import brev-separate
|
||||
(chicken file)
|
||||
(chicken pathname)
|
||||
(chicken plist)
|
||||
(chicken pretty-print)
|
||||
(chicken process)
|
||||
(chicken process-context)
|
||||
(chicken string)
|
||||
fmt
|
||||
@@ -195,24 +197,35 @@
|
||||
;;; Main function facilities
|
||||
|
||||
(define opts-grammar
|
||||
`((output "Write output to file"
|
||||
(required #f)
|
||||
(value #t)
|
||||
(single-char #\o))
|
||||
`((c-compiler "Select C compiler. Defaults to value of SEX_CC environment variable, or if it is empty, to cc"
|
||||
(required #f)
|
||||
(value #t))
|
||||
(compile-object "Compile object file instead of executable program"
|
||||
(required #f)
|
||||
(value #f)
|
||||
(single-char #\c))
|
||||
(preprocess "Emit C code"
|
||||
(required #f)
|
||||
(value #f)
|
||||
(single-char #\E))
|
||||
(help "Show this help"
|
||||
(required #f)
|
||||
(value #f)
|
||||
(single-char #\h))
|
||||
(macro-expand "Emit macro-expanded Sex code instead of C"
|
||||
(macro-expand "Emit macro-expanded Sex code"
|
||||
(required #f)
|
||||
(value #f)
|
||||
(single-char #\m))))
|
||||
(single-char #\m))
|
||||
(output "Write output to file. Default file name is a.out. If -E or -m options are provided, defaults to stdout"
|
||||
(required #f)
|
||||
(value #t)
|
||||
(single-char #\o))))
|
||||
|
||||
(define (print-help)
|
||||
(fmt #t "Usage: sexc [OPTIONS] [FILE]\n")
|
||||
(fmt #t "Options: -o, --output <file> Write output to file. If omitted, write to stdout\n")
|
||||
(fmt #t " -h, --help Show this help\n")
|
||||
(fmt #t " -m, --macro-expand Emit macro-expanded Sex code instead of C\n"))
|
||||
(fmt #t "Usage: sexc [options] filename [-- options-for-c-compiler]\n")
|
||||
(fmt #t "Options:\n")
|
||||
(fmt #t (usage opts-grammar))
|
||||
(fmt #t ""))
|
||||
|
||||
(define (help-arg? args)
|
||||
(assoc 'help args))
|
||||
@@ -222,11 +235,20 @@
|
||||
(if arg (cdr arg)
|
||||
default)))
|
||||
|
||||
(define (get-rest-args args)
|
||||
(cdr (assoc '@ args)))
|
||||
|
||||
(define (get-c-compiler-args args)
|
||||
(do ((c-args (get-rest-args args) (cdr c-args)))
|
||||
((or (null? c-args)
|
||||
(char=? #\- (string-ref (car c-args) 0)))
|
||||
c-args)))
|
||||
|
||||
(define (get-input-file args)
|
||||
(let ((rest-args (assoc '@ args)))
|
||||
(if (= 1 (length rest-args))
|
||||
(let ((rest-args (get-rest-args args)))
|
||||
(if (null? rest-args)
|
||||
'stdin
|
||||
(cadr rest-args))))
|
||||
(car rest-args))))
|
||||
|
||||
(define (read-from-file file)
|
||||
(with-input-from-file (pathname-strip-directory file)
|
||||
@@ -239,13 +261,48 @@
|
||||
(current-directory)
|
||||
(pathname-directory file)))))
|
||||
|
||||
(define (preprocess-or-macroexpand sex-forms output args)
|
||||
(if (not (eq? output 'default))
|
||||
(with-output-to-file output
|
||||
(lambda ()
|
||||
(if (get-arg args 'macro-expand #f)
|
||||
(map pp sex-forms)
|
||||
(emit-c sex-forms))))
|
||||
(if (get-arg args 'macro-expand #f)
|
||||
(map pp sex-forms)
|
||||
(emit-c sex-forms))))
|
||||
|
||||
(define (get-env-var name)
|
||||
(get-environment-variable name))
|
||||
|
||||
(define (compile-to-file sex-forms output args)
|
||||
(let ((compiler (or (get-arg args 'c-compiler #f)
|
||||
(get-env-var "SEX_CC")
|
||||
"cc"))
|
||||
(out-file (if (eq? output 'default)
|
||||
"a.out"
|
||||
output))
|
||||
(temp-c-out (create-temporary-file ".sex.c")))
|
||||
(with-output-to-file temp-c-out
|
||||
(lambda ()
|
||||
(emit-c sex-forms)))
|
||||
(call-with-values
|
||||
(lambda () (process compiler (append (list temp-c-out "-o" out-file)
|
||||
(if (get-arg args 'compile-object #f)
|
||||
(list "-c")
|
||||
(list))
|
||||
(get-c-compiler-args args))))
|
||||
(lambda (out-port in-port pid)
|
||||
(process-wait pid)))))
|
||||
|
||||
(define (main)
|
||||
(let* ((raw-args (command-line-arguments))
|
||||
(current-dir (current-directory))
|
||||
(args (getopt-long raw-args
|
||||
opts-grammar))
|
||||
(output (get-arg args 'output 'stdout))
|
||||
(output (get-arg args 'output 'default))
|
||||
(help (help-arg? args))
|
||||
|
||||
(input (get-input-file args)))
|
||||
(if help (print-help)
|
||||
(let* ((raw-forms
|
||||
@@ -256,10 +313,9 @@
|
||||
(read-from-file input))))
|
||||
(sex-forms (process-raw-forms raw-forms (list))))
|
||||
(change-directory current-dir)
|
||||
(if (get-arg args 'macro-expand #f)
|
||||
(map pp sex-forms)
|
||||
(if (not (eq? output 'stdout))
|
||||
(with-output-to-file output
|
||||
(lambda ()
|
||||
(emit-c sex-forms)))
|
||||
(emit-c sex-forms)))))))
|
||||
(if (or (get-arg args 'macro-expand #f)
|
||||
(get-arg args 'preprocess #f))
|
||||
;; Preprocess or macroexpand
|
||||
(preprocess-or-macroexpand sex-forms output args)
|
||||
;; Compile file!
|
||||
(compile-to-file sex-forms output args))))))
|
||||
|
||||
Reference in New Issue
Block a user