From fa4ad5acee99a89d15790d4a17aec922bd92f530 Mon Sep 17 00:00:00 2001 From: alex-eg Date: Tue, 15 Sep 2026 12:31:37 +0300 Subject: [PATCH] fix comments inside statements shifting their meaning --- fmt-c-writer.scm | 87 +++++++++++++++++++++++++++++++++++------------ tests/codegen.scm | 29 +++++++++++++++- 2 files changed, 93 insertions(+), 23 deletions(-) diff --git a/fmt-c-writer.scm b/fmt-c-writer.scm index db208aa..8074369 100644 --- a/fmt-c-writer.scm +++ b/fmt-c-writer.scm @@ -61,6 +61,28 @@ surrounding c-block supplies them)." `(%begin ,(line-directive src) ,(walk-expr s)) (walk-expr s)))) +;;; A `;' comment reads as a form, so one written inside a construct +;;; with positional slots lands in a slot and shifts everything after +;;; it. So take the positional slots by skipping comments, and hand +;;; the comments back to be emitted just before the statement +(define (take-slots forms n) + "Three values: the comment forms skipped over, the next N non-comment +forms, and what remains." + (let loop ((fs forms) (n n) (comments (list)) (slots (list))) + (cond ((or (= n 0) (null? fs)) + (values (reverse comments) (reverse slots) fs)) + ((comment-form? (car fs)) + (loop (cdr fs) n (cons (car fs) comments) slots)) + (else + (loop (cdr fs) (- n 1) comments (cons (car fs) slots)))))) + +;;; `%begin' is a statement sequence that emits no braces of its own, so +;;; the comments simply precede the statement. +(define (with-comments comments form) + (if (null? comments) + form + `(%begin ,@(map walk-expr comments) ,form))) + (define (walk-if-clauses clauses) "(test stmt test stmt ... [else-stmt]) -- tests stay expressions." (let loop ((cs clauses) (acc (list))) @@ -128,9 +150,11 @@ surrounding c-block supplies them)." ;; is the fmt-c directive for the `.' operator (see sex-fmt-c). (('dot-access . rest) (cons '%. (map walk-expr rest))) (('var . _) (walk-var form)) - (('cast expr type) (list '%cast - (walk-type type) - (walk-expr expr))) + ;; An expression has no room for a statement, so a comment in a + ;; cast is dropped rather than relocated. + (('cast . rest) + (let-values (((comments slots _) (take-slots rest 2))) + (list '%cast (walk-type (cadr slots)) (walk-expr (car slots))))) (('enum . _) (walk-enum form)) ;; | is problematic... And c-or/bit-or/etc are actually ;; procedures, so we have to call the procedure itself @@ -142,21 +166,38 @@ surrounding c-block supplies them)." ;; and each is spliced or wrapped according to what the ;; corresponding fmt-c procedure accepts. (('do . stmts) (cons '%block-begin (walk-body stmts))) - (('if . clauses) (cons 'if (walk-if-clauses clauses))) - (('while test . body) - (cons* 'while (walk-expr test) (walk-body body))) - (('for init test step . body) - (cons* 'for (walk-expr init) (walk-expr test) (walk-expr step) - (walk-body body))) + (('if . clauses) + (with-comments (filter comment-form? clauses) + (cons 'if (walk-if-clauses (remove comment-form? clauses))))) + (('while . rest) + (let-values (((comments slots body) (take-slots rest 1))) + (with-comments comments + (cons* 'while (walk-expr (car slots)) (walk-body body))))) + (('for . rest) + (let-values (((comments slots body) (take-slots rest 3))) + (with-comments comments + (cons* 'for (walk-expr (car slots)) (walk-expr (cadr slots)) + (walk-expr (caddr slots)) + (walk-body body))))) ;; No anchor *between* switch clauses: c-switch requires every clause ;; to be a case/default form and errors on anything else. The clause ;; bodies are anchored from inside, which is what a debugger steps ;; onto -- a `case' label is not a statement. - (('switch e . clauses) - (cons* 'switch (walk-expr e) (map walk-expr clauses))) - (('case v . body) (cons* 'case (walk-expr v) (walk-body body))) - (('case/fallthrough v . body) - (cons* 'case/fallthrough (walk-expr v) (walk-body body))) + ;; A comment between clauses has to go too: c-switch requires every + ;; clause to be a case/default form and errors on anything else. + (('switch . rest) + (let-values (((comments slots clauses) (take-slots rest 1))) + (with-comments (append comments (filter comment-form? clauses)) + (cons* 'switch (walk-expr (car slots)) + (map walk-expr (remove comment-form? clauses)))))) + (('case . rest) + (let-values (((comments slots body) (take-slots rest 1))) + (with-comments comments + (cons* 'case (walk-expr (car slots)) (walk-body body))))) + (('case/fallthrough . rest) + (let-values (((comments slots body) (take-slots rest 1))) + (with-comments comments + (cons* 'case/fallthrough (walk-expr (car slots)) (walk-body body))))) (('default . body) (cons 'default (walk-body body))) (else (map walk-expr form)))) @@ -167,14 +208,16 @@ surrounding c-block supplies them)." ;; (var b [const char 512]) -> (%var (%array (const char) 512) b) ;; note: [...] is actually (ยค ...) after reading ;; (var c (fn ((int) (float)) void)) -> (%var (%fun void ((int) (float))) c) - `(%var - ,(walk-type (third form)) - ,(atom-to-fmt-c (second form)) - . - ,(if (null? (drop form 3)) - (list) - (walk-expr (drop form 3))) ; optional init expression - )) + ;; Likewise a declaration: drop any comment rather than shift the + ;; name and type apart. + (let ((form (cons (car form) (remove comment-form? (cdr form))))) + `(%var + ,(walk-type (third form)) + ,(atom-to-fmt-c (second form)) + . + ,(if (null? (drop form 3)) + (list) + (walk-expr (drop form 3)))))) ; optional init expression (define (walk-type form) ;; int -> int diff --git a/tests/codegen.scm b/tests/codegen.scm index ad6c05b..5abf204 100644 --- a/tests/codegen.scm +++ b/tests/codegen.scm @@ -72,4 +72,31 @@ "(int *)&a")) (test-assert "sizeof is left bare" (emits? (in-fn "(var n int (cast (sizeof int) int))") - "(int)sizeof(int)")))) + "(int)sizeof(int)"))) + + ;; A `;' comment is a form, so one written inside a construct with + ;; positional slots used to land in a slot and shift everything after + ;; it -- silently. In an `if' the comment became the then-arm and the + ;; then-arm became an `else if' condition, and it still compiled. + ;; Comments are now taken out of the slots and emitted just before the + ;; statement; comments in a body stay where they were written. + (test-group "comments in positional slots" + (test-assert "an if arm is not shifted" + (not (emits? (in-fn "(if 1 ;; c\n (g 1) (g 2))") "else if"))) + (test-assert "and both arms survive" + (emits? (in-fn "(if 1 ;; c\n (g 1) (g 2))") "g(1)")) + (test-assert "the comment survives too" + (emits? (in-fn "(if 1 ;; kept here\n (g 1) (g 2))") "kept here")) + (test-assert "a for header is not shifted" + (emits? (in-fn "(for ;; c\n (var i int 0) (< i 2) (++ i) (g i))") + "for (int i = 0; i < 2; ++i)")) + (test-assert "a while condition is not shifted" + (emits? (in-fn "(while ;; c\n (< a b) (g 1))") "while (a < b)")) + (test-assert "a var is not shifted" + (emits? (in-fn "(var ;; c\n x int 5)") "int x = 5")) + (test-assert "a cast is not shifted" + (emits? (in-fn "(var y int (cast ;; c\n a int))") "(int)a")) + ;; Bodies are a statement sequence, so comments there stay put. + (test-assert "a comment in a body stays in the body" + (emits? (in-fn "(while (< a b) ;; inside\n (g 1))") + "while (a < b) {"))))