alex-eg/sex
1
0
Fork 1
Code Issues 3 Pull Requests 1 Actions Packages Projects 1 Releases Wiki Activity

add cmdline options

Browse Source 
-h help
-o write to file
-m expand macros in Sex code and print result
This commit is contained in:
alex-eg
2025-06-05 07:32:05 +03:00
parent 555bd836a9
commit 4389392123
2 changed files with 89 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
Readme.org
View File

@@ -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~

104
sexc.scm
View File

@@ -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 <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)