From e0a228c66eb64c8e62e497c65636c9aae2816c3a Mon Sep 17 00:00:00 2001 From: alex-eg Date: Mon, 21 Sep 2026 00:44:22 +0300 Subject: [PATCH] make feature guard produce nothing on eof/closing bracket/paren A dropped datum is replaced by whatever follows it, but what follows may be the end of the file or the paren closing the list we are in. Hand the token back to the caller instead: read-list closes its list with it and the toplevel loop stops. A `;' comment between a guard and the form it guards was also taken for the guarded datum, so the form stayed unconditional and the guard did nothing. Skip comments when reading the guard. comment-form? was defined three times over; it moves to utils. --- fmt-c-writer.scm | 3 --- reader.scm | 38 ++++++++++++++++++++++++++++------ semen.scm | 3 --- tests/reader.scm | 16 ++++++++++++++ tools/sextest/utils.module.scm | 1 + utils.module.scm | 1 + utils.scm | 3 +++ 7 files changed, 53 insertions(+), 12 deletions(-) diff --git a/fmt-c-writer.scm b/fmt-c-writer.scm index e5d6731..50daaac 100644 --- a/fmt-c-writer.scm +++ b/fmt-c-writer.scm @@ -135,9 +135,6 @@ forms, and what remains." (car type) type)) -(define (comment-form? f) - (and (pair? f) (eq? (car f) 'comment))) - ;;; Strip ;s so ;;; Foo becomes /* Foo */ and not /* ;; Foo */ (define (strip-comment-marker text) (string-trim-both (string-trim text #\;))) diff --git a/reader.scm b/reader.scm index 45b8fd5..dcc8e94 100644 --- a/reader.scm +++ b/reader.scm @@ -115,6 +115,21 @@ ((eq? tok dot-token) (error "Unexpected .")) (else tok)))) +;;; A token that stands for a datum +(define (datum-token? tok) + (not (or (eof-object? tok) + (eq? tok close-paren) + (eq? tok close-bracket) + (eq? tok dot-token)))) + +;;; next-token, sans the comments +(define (next-code-token port) + (let loop () + (let ((tok (next-token port))) + (if (comment-form? tok) + (loop) + tok)))) + ;;; Read list elements up to close-paren or close-bracket, ;;; honoring dotted-pair notation (a b . c) (define (read-list port closer) @@ -208,13 +223,24 @@ (else (error "Malformed feature expression" test)))) ;;; The #-/#+ preceded datum is always read -- there is no other way -;;; to know where it ends -- and then either returned or dropped +;;; to know where it ends -- and then either returned or dropped. What +;;; follows a dropped datum is read in its place: `#+x #+y (a) (b)' +;;; with only x is (b). +;;; +;;; That next thing may be nothing: the end of the file, or the +;;; paren closing the list we are in (define (read-conditional port keep-when) - (let ((keep (eq? keep-when (feature-true? (read-datum port))))) - (if keep - (read-datum port) - (begin (read-datum port) - (next-token port))))) + (let* ((test (next-code-token port)) + (keep (begin + (unless (datum-token? test) + (error "Unexpected end of input in feature expression")) + (eq? keep-when (feature-true? test)))) + (guarded (next-code-token port))) + (cond + (keep guarded) + ;; A datum was dropped, so the next one stands in for it + ((datum-token? guarded) (next-token port)) + (else guarded)))) ;;; #t / #true / #f / #false. `val' is the boolean; consume any ;;; trailing name characters and validate diff --git a/semen.scm b/semen.scm index 4b0800e..f18113e 100644 --- a/semen.scm +++ b/semen.scm @@ -145,9 +145,6 @@ ;;; C code it will be placed as a C commentary just before the function ;;; definition (actually that works for all blocky things: enum, struct, union as well). -(define (comment-form? f) - (and (pair? f) (eq? (car f) 'comment))) - (define (fn-header-length fn-form) (if (memq (first fn-form) '(pub extern)) 5 4)) diff --git a/tests/reader.scm b/tests/reader.scm index b525b05..7367b48 100644 --- a/tests/reader.scm +++ b/tests/reader.scm @@ -80,6 +80,22 @@ ;; guards nest (feature-test '((a)) (x y) "#+x #+y (a)") (feature-test '((b)) (x) "#+x #+y (a) (b)") + ;; ...and the inner one may leave nothing behind: the end of the + ;; file, or the paren closing the list, is what the outer one then + ;; produces, and neither is an error + (feature-test '() (x) "#+x #+y (a)") + (feature-test '((f)) (x) "(f #+x #+y 1)") + (feature-test '((f 2)) (x) "(f #+x #+y 1 2)") + (feature-test '((a)) (x) "(a) #+x #+y (b)") + + ;; a comment between a guard and the form it guards describes the + ;; guard. Taking it for the guarded datum would leave the form itself + ;; unconditional + (feature-test '((a)) (x) "#+x ;; why\n (a)") + (feature-test '() (y) "#+x ;; why\n (a)") + (feature-test '((b)) (y) "#+x ;; why\n (a) (b)") + ;; a comment after the guarded form is an ordinary form, and stays + (feature-test '((comment "; tail")) (y) "#+x (a) ;; tail") ;; a feature the program was not given is simply absent (feature-test '() () "#+anything (a)") diff --git a/tools/sextest/utils.module.scm b/tools/sextest/utils.module.scm index 13c0bed..51c6c26 100644 --- a/tools/sextest/utils.module.scm +++ b/tools/sextest/utils.module.scm @@ -2,6 +2,7 @@ (get-env-var set-working-directory to-absolute-pathname + comment-form? list-split list-join recons diff --git a/utils.module.scm b/utils.module.scm index 7e1e3f1..e4a91aa 100644 --- a/utils.module.scm +++ b/utils.module.scm @@ -2,6 +2,7 @@ (get-env-var set-working-directory to-absolute-pathname + comment-form? list-split list-join recons diff --git a/utils.scm b/utils.scm index 7a99fb1..d97c043 100644 --- a/utils.scm +++ b/utils.scm @@ -42,6 +42,9 @@ (current-directory) pathname))) +(define (comment-form? form) + (and (pair? form) (eq? (car form) 'comment))) + (define (list-split src-list split-elt) ;; split '(1 2 / 3 4 / 5 6) by '/ -> '((1 2) (3 4) (5 6)) (fold (lambda (elt acc)