From 4389392123e865aeae6b43493fd44633d18b4cbb Mon Sep 17 00:00:00 2001 From: alex-eg Date: Thu, 5 Jun 2025 07:32:05 +0300 Subject: [PATCH] add cmdline options -h help -o write to file -m expand macros in Sex code and print result --- Readme.org | 4 +-- sexc.scm | 104 ++++++++++++++++++++++++++++++++++++++++++++--------- 2 files changed, 89 insertions(+), 19 deletions(-) diff --git a/Readme.org b/Readme.org index a44096b..7097ebf 100644 --- a/Readme.org +++ b/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~ diff --git a/sexc.scm b/sexc.scm index 6d3a659..5aeeda1 100644 --- a/sexc.scm +++ b/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))) - (when (eof-object? r) - (return '())) - (case (car r) - ((define) - (eval r) - (fmt #t "\n")) - (else - (let ((result (walk-tree r))) - (when result - (fmt #t (c-expr - result)))))) - (loop))))) + (read-forms + (cons + (let ((r (read))) + (when (eof-object? r) + (return (reverse collect))) + (case (car r) + ((define) + (eval r) + '()) + (else + (let ((result (walk-tree r))) + (if result result + '()))))) + 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 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)