add cmdline options

-h help
-o write to file
-m expand macros in Sex code and print result

Readme.org

@@ -7,14 +7,14 @@ computations are written in Chicken.
 And Chicken is [[https://call-cc.org][R5RS Scheme]].
 
 * Compilation and usage
-First, get yourself a Chicken. Second, one Chicken deps.
+First, get yourself a Chicken. Second, some Chicken deps.
 
 ** Install Chicken Eggs
 By the way, there's a way to make Chicken install eggs non-globally. Refer to
 the documentation for more info:
 https://wiki.call-cc.org/man/5/Extension%20tools#changing-the-repository-location
 
-~chicken-install fmt~
+~chicken-install fmt getopt-long~
 
 ** Compilation
 ~make~

sexc.scm

@@ -1,4 +1,9 @@
-(import fmt fmt-c (chicken string))
+(import (chicken pretty-print)
+        (chicken process-context)
+        (chicken string)
+        fmt
+        fmt-c
+        getopt-long)
 
 (define (unkebabify sym)
   (string->symbol
@@ -17,7 +22,6 @@ If filter-proc returns something other, use it instead of processing the element
   (let ((cont (cut map-filter-tree map-proc filter-proc <>)))
     (if (null? tree) '()
         (let ((filter-res (filter-proc (car tree))))
-          ;(fmt #t "Filter res for " tree " is " filter-res "\n")
           (case filter-res
             ((#t) (cons
                    (if (atom? (car tree))
@@ -52,21 +56,87 @@ If filter-proc returns something other, use it instead of processing the element
          #t))
    tree))
 
-(define (loop)
+(define (read-forms collect)
   (call/cc
    (lambda (return)
-     (let ((r (read)))
+     (read-forms
-       (when (eof-object? r)
+      (cons
-         (return '()))
+       (let ((r (read)))
-       (case (car r)
+         (when (eof-object? r)
-         ((define)
+           (return (reverse collect)))
-          (eval r)
+         (case (car r)
-          (fmt #t "\n"))
+           ((define)
-         (else
+            (eval r)
-          (let ((result (walk-tree r)))
+            '())
-            (when result
+           (else
-              (fmt #t (c-expr
+            (let ((result (walk-tree r)))
-                       result))))))
+              (if result result
-       (loop)))))
+                  '())))))
+       collect)))))
 
-(loop)
+(define (emit-c forms)
+  (map (lambda (form)
+         (if (not (null? form))
+             (fmt #t (c-expr form)))
+         (fmt #t "\n"))
+       forms))
+
+;;; Main function facilities
+
+(define opts-grammar
+  `((output "Write output to file"
+            (required #f)
+            (value #t)
+            (single-char #\o))
+    (help "Show this help"
+          (required #f)
+          (value #f)
+          (single-char #\h))
+    (macro-expand "Emit macro-expanded Sex code instead of C"
+                  (required #f)
+                  (value #f)
+                  (single-char #\m))))
+
+(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"))
+
+(define (help-arg? args)
+  (assoc 'help args))
+
+(define (get-arg args arg-name default)
+  (let ((arg (assoc arg-name args)))
+    (if arg (cdr arg)
+        default)))
+
+(define (get-input-file args)
+  (let ((rest-args (assoc '@ args)))
+    (if (= 1 (length rest-args))
+        'stdin
+        (cadr rest-args))))
+
+(define (main)
+  (let* ((raw-args (command-line-arguments))
+         (args (getopt-long raw-args
+                            opts-grammar))
+         (output (get-arg args 'output 'stdout))
+         (help (help-arg? args))
+         (input (get-input-file args)))
+    (if help (print-help)
+        (let ((sex-forms
+               (if (eq? input 'stdin)
+                   (read-forms (list))
+                   (with-input-from-file input
+                     (lambda () (read-forms (list)))))))
+
+          (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)))))))
+
+(main)