reuse sex reader in sextest

This commit is contained in:
2026-07-22 14:12:42 +03:00
parent f6ec07a4b5
commit 9903cae3f7
4 changed files with 36 additions and 64 deletions

View File

@@ -1,5 +1,23 @@
CHICKEN_C = csc
CSC_FLAGS += -K prefix -static
MODULE_FLAGS = -emit-all-import-libraries -module-registration -c
sextest: sextest.scm
$(CHICKEN_C) $(CSC_FLAGS) sextest.scm -o sextest
ROOT = ../..
# sextest reuses sexc's reader (and its utils dependency) instead of
# duplicating the S-expression reader. The module wrappers here include
# the shared sources from the project root.
sextest: sextest.scm reader.o utils.o
$(CHICKEN_C) $(CSC_FLAGS) sextest.scm -o sextest -link reader,utils
utils.o: utils.module.scm $(ROOT)/utils.scm
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) utils.module.scm -o utils.o -unit utils
reader.o: reader.module.scm $(ROOT)/reader.scm utils.o
$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) reader.module.scm -o reader.o -unit reader -link utils
clean:
rm -f *.o *.import.scm *.link sextest
.PHONY: clean

View File

@@ -0,0 +1,3 @@
(module reader (read-from-file
read-raw-forms)
"../../reader.scm")

View File

@@ -7,72 +7,11 @@
(chicken port)
(chicken process)
(chicken process-context)
(chicken read-syntax)
(chicken syntax)
fmt
getopt-long
reader ; read-raw-forms, shared with sexc
srfi-1)
(define-syntax prog1
(syntax-rules ()
((prog1 form . forms)
(let ((res form))
(begin . forms)
res))))
(define-syntax with-directory
(syntax-rules ()
((with-directory path form . forms)
(let ((current-dir (current-directory)))
(set-working-directory path)
(prog1
(begin form . forms)
(change-directory current-dir))))))
(define (set-working-directory file)
(change-directory
(normalize-pathname
(if (absolute-pathname? file)
(pathname-directory file)
(make-absolute-pathname
(current-directory)
(pathname-directory file))))))
;;; TODO: use sexc reader code i.e. link with sex reader
(define open-bracket-counter (make-parameter 0))
(define (read-raw-forms input-source)
(let ((bracket-end (gensym)))
(set-read-syntax!
#\]
(lambda (port)
(when (= 0 (open-bracket-counter))
(error "Unmatched closing bracket"))
(open-bracket-counter (- (open-bracket-counter) 1))
bracket-end))
(set-read-syntax!
#\[
(lambda (port)
(open-bracket-counter (+ (open-bracket-counter) 1))
(let loop ((r (read port))
(acc (list)))
(if (eq? r bracket-end)
(cons '¤ (reverse acc))
(loop (read port)
(cons r acc)))))))
(read-from-file input-source))
(define (read-from-file file)
(with-directory file
(with-input-from-file (pathname-strip-directory file)
(fn (read-forms (list))))))
(define (read-forms acc)
(let ((r (read-with-source-info (current-input-port))))
(if (eof-object? r) (reverse acc)
(read-forms (cons r acc)))))
(define (print-help)
(fmt #t "Usage: sextest [options] filename" nl
"Options:" nl

View File

@@ -0,0 +1,12 @@
(module utils
(get-env-var
set-working-directory
to-absolute-pathname
list-split
list-join
recons
set-form-line!
form-line
with-directory
)
"../../utils.scm")