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.
This commit is contained in:
2026-09-21 00:44:22 +03:00
parent ca71ae6e91
commit 08bbe17883
7 changed files with 53 additions and 12 deletions

View File

@@ -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 #\;)))

View File

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

View File

@@ -141,9 +141,6 @@
;;; Fn processing
(define (comment-form? f)
(and (pair? f) (eq? (car f) 'comment)))
(define (strip-fn-header-comments fn-form)
;; Remove comment forms from the function header
;; ([pub|extern] fn name arglist rettype) so the positional accessors

View File

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

View File

@@ -2,6 +2,7 @@
(get-env-var
set-working-directory
to-absolute-pathname
comment-form?
list-split
list-join
recons

View File

@@ -2,6 +2,7 @@
(get-env-var
set-working-directory
to-absolute-pathname
comment-form?
list-split
list-join
recons

View File

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