fix stray commas and add comment packing

Shorter and doesn't imply existence of `end'

Readme.org

@@ -49,6 +49,12 @@ directory. Sex uses C under the hood, the default C compiler is ~cc~,
 but you can pass any using ~--c-compiler~ option, or by setting
 ~SEX_CC~ environment variable.
 
+Everything after ~--~ is handed to the C compiler exactly as written:
+
+#+begin_src shell
+sexc example/sdl3-triangle.sex -o triangle -- `pkg-config --cflags --libs sdl3` -framework OpenGL
+#+end_src
+
 ** Example
 An example of Sex source:
 #+begin_src scheme
@@ -122,7 +128,7 @@ return Sex code.
 #+begin_src scheme
 (pub defmacro (check-sdl-return call message ret-code)
   `(if (< 0 ,call)
-       (begin
+       (do
          (puts ,message)
          (return ,ret-code))))
 
@@ -135,7 +141,7 @@ return Sex code.
 #+begin_src scheme
 (pub fn init () int
   (if (< 0 (SDL_Init SDL_INIT_VIDEO))
-    (begin (puts "Failed to initialize SDL") (return 1)))
+    (do (puts "Failed to initialize SDL") (return 1)))
   ...)
 #+end_src
 

example/list.sex

@@ -39,7 +39,7 @@
 
 (pub defmacro (list-for-each list-type list-var elt-type elt-var what-do)
   (let ((list-var-2 (cat list-var '-2)))
-    `(begin
+    `(do
       (var ,list-var-2 (* ,list-type) ,list-var)
       (var ,elt-var ,elt-type (-> ,list-var-2 value))
       (while (!= (-> ,list-var-2 next) NULL)

fmt-c-writer.scm

@@ -47,8 +47,8 @@ source location. Only statement positions may be walked this way: a
                       (if src
                           (list (line-directive src) (walk-expr s))
                           (list (walk-expr s)))))
-                  stmts)
-      (map walk-expr stmts)))
+                  (pack-comments stmts))
+      (map walk-expr (pack-comments stmts))))
 
 (define (walk-stmt s)
   "A statement in a slot that holds exactly one form -- an `if' arm.
@@ -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)))
@@ -85,7 +107,7 @@ surrounding c-block supplies them)."
   (case atom
     ((fn) '%fun)
     ((prototype) '%prototype)
-    ((begin) '%block-begin)
+    ((do) '%block-begin)
     ((define) '%define)
     ((pointer) '%pointer)
     ((array) '%array)
@@ -110,6 +132,40 @@ surrounding c-block supplies them)."
 (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 #\;)))
+
+(define (walk-comment texts)
+  (list '%comment
+        (string-append " "
+                       (string-intersperse (map strip-comment-marker texts)
+                                           "\n ")
+                       " ")))
+
+;;; Merge multiple lines of /* */ into single block
+(define (pack-comments forms)
+  (let loop ((fs forms) (acc (list)))
+    (cond
+     ((null? fs) (reverse acc))
+     ((comment-form? (car fs))
+      (let ((first (car fs)))
+        (let gather ((rest (cdr fs)) (texts (cdr first)) (line (form-line first)))
+          (if (and (pair? rest)
+                   (comment-form? (car rest))
+                   line
+                   (equal? (form-file first) (form-file (car rest)))
+                   (eqv? (form-line (car rest)) (+ line 1)))
+              (gather (cdr rest)
+                      (append texts (cdr (car rest)))
+                      (form-line (car rest)))
+              (loop rest
+                    (cons (if (eq? texts (cdr first))
+                              first          ; a run of one, left alone
+                              (copy-form-source! first (cons 'comment texts)))
+                          acc))))))
+     (else (loop (cdr fs) (cons (car fs) acc))))))
+
 (define (walk-generic-toplevel form)
   (cond ((atom? form) (atom-to-fmt-c form))
         ((list? form) (map walk-generic-toplevel form))
@@ -123,14 +179,16 @@ surrounding c-block supplies them)."
     ((? atom?)
      (atom-to-fmt-c form))
     ;; (comment "text") -> /* text */. `%comment' is the fmt-c directive.
-    (('comment . text) (cons '%comment text))
+    (('comment . text) (walk-comment text))
     ;; (dot-access obj field ...) -> obj.field... member access. `%.'
     ;; 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
@@ -141,25 +199,43 @@ surrounding c-block supplies them)."
     ;; Statement positions. These are the only places a #line may go,
     ;; and each is spliced or wrapped according to what the
     ;; corresponding fmt-c procedure accepts.
-    (('begin . 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)))
+    (('do . stmts) (cons '%block-begin (walk-body stmts)))
+    (('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))))
+    ;; Drop comments so they will not generate additional comma
+    (else (map walk-expr (remove comment-form? form)))))
 
 (define (walk-var form)
   ;; (var a int) -> (%var int a)
@@ -167,14 +243,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)
+  ;; 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
-    ))
+           (walk-expr (drop form 3)))))) ; optional init expression
 
 (define (walk-type form)
   ;; int -> int
@@ -322,7 +400,7 @@ surrounding c-block supplies them)."
 
 (define (process-toplevel-form form)
   (match form
-    (('comment . text) (cons '%comment text))
+    (('comment . text) (walk-comment text))
     (('fn . _) (list 'static (walk-function form)))
     (('var . _) (list 'static (walk-var form)))
     (('extern . rest) (walk-extern rest))
@@ -343,4 +421,4 @@ surrounding c-block supplies them)."
                 (when src
                   (fmt #t (c-expr (line-directive src)))))
               (fmt #t (c-expr (process-toplevel-form form)) nl))
-            sex-forms))
+            (pack-comments sex-forms)))

sex-fmt-c.scm

@@ -787,8 +787,32 @@
                           (fmt-join c-expr name ", ")
                           (c-expr name))))))
 
+  ;; MODIFIED FROM UPSTREAM fmt-c: parenthesise a binary operand.
+  ;;
+  ;; A cast binds tighter than every binary operator, so upstream's
+  ;; unparenthesised (cat "(" type ")" expr) silently casts only the
+  ;; first operand: (cast (* 2 (sizeof GLfloat)) (* void)) came out as
+  ;; `(void *)2 * sizeof(GLfloat)'. Unary operands -- &x, *p, -n,
+  ;; sizeof, calls, identifiers, literals -- are already
+  ;; unary-expressions and are left alone, so this changes nothing that
+  ;; was previously correct.
+  (define c-binary-operators
+    '(+ - * / % << >> < > <= >= == != & ^ && %and %or
+        = *= /= %= &= ^= <<= >>=))
+
+  (define (c-binary-expression? expr)
+    (and (pair? expr)
+         (memq (car expr) c-binary-operators)
+         (pair? (cdr expr))
+         (pair? (cddr expr))))         ; two or more operands
+
   (define (c-cast type expr)
-    (cat "(" (c-type type) ")" (c-expr expr)))
+    (cat "(" (c-type type) ")"
+         (if (c-binary-expression? expr)
+             ;; c-with-op stops the operand from parenthesising itself
+             ;; a second time inside the parens we just added.
+             (cat "(" (c-with-op 'paren (c-expr expr)) ")")
+             (c-expr expr))))
 
   (define (c-typedef type alias . o)
     (c-wrap-stmt
@@ -861,7 +885,12 @@
   (define (c-switch val . clauses)
     (c-reset-newline
      (lambda (st)
-       ((cat "switch (" (c-in-expr val) ")" (c-open-brace st)
+       ;; MODIFIED FROM UPSTREAM fmt-c: c-expr on the scrutinee.
+       ;; Upstream passes `val' straight to cat, which only works when
+       ;; it is an atom -- anything else (a member access, a call) is
+       ;; displayed as a raw s-expression instead of being rendered.
+       ;; c-while and c-for already do (c-in-test (c-expr check)).
+       ((cat "switch (" (c-in-expr (c-expr val)) ")" (c-open-brace st)
              (c-indent/switch st)
              (c-in-stmt (apply c-begin/aux #t (map c-switch-clause clauses))) fl
              (c-current-indent-string st) (c-close-brace st) fl)

sex-mode.el

@@ -51,7 +51,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
      ;; Keywords
      (list (concat "("
                    (regexp-opt '(
-                                 "begin"
+                                 "do"
                                  "case"
                                  "default"
                                  "do"

sexc.scm

@@ -16,7 +16,6 @@
         reader
         semen
         srfi-1                          ; list routines
-        srfi-13
         utils)
 
 ;;; Main function facilities
@@ -73,12 +72,24 @@
     (if arg (cdr arg)
         default)))
 
+;;; Everything before the first `--' is ours to parse, everything after
+;;; is handed to the C compiler verbatim
+
+(define (separator? a)
+  (string=? a "--"))
+
+(define (args-before-separator argv)
+  (take-while (complement separator?) argv))
+
+(define (args-after-separator argv)
+  (let ((tail (drop-while (complement separator?) argv)))
+    (if (null? tail)
+        (list)
+        (cdr tail))))
+
 (define (get-rest-args args)
   (cdr (assoc '@ args)))
 
-(define (get-c-compiler-args args)
-  (filter (fn (string-prefix? "-" x)) (get-rest-args args)))
-
 (define (line-directives-arg args)
   (let ((v (get-arg args 'line-directives "statement")))
     (cond ((equal? v "statement") 'statement)
@@ -105,7 +116,7 @@
                                  (map pp sex-forms)
                                  (emit-c sex-forms)))))
 
-(define (compile-to-file sex-forms output args)
+(define (compile-to-file sex-forms output args cc-args)
   (let ((compiler (or (get-arg args 'c-compiler #f)
                       (get-env-var "SEX_CC")
                       "cc"))
@@ -120,7 +131,7 @@
                                                (list "-c")
                                                (list))
                                            (list "-")  ; read stdin
-                                           (get-c-compiler-args args))))
+                                           cc-args)))
            (cc-stdin (process-input-port proc)))
       (with-output-to-port cc-stdin
         (lambda () (emit-c sex-forms)))
@@ -146,7 +157,9 @@
     (typedef i64 int64-t)))
 
 (define (main)
-  (let* ((raw-args (command-line-arguments))
+  (let* ((argv (command-line-arguments))
+         (raw-args (args-before-separator argv))
+         (cc-args (args-after-separator argv))
          (args (getopt-long raw-args
                             opts-grammar))
          (output (get-arg args 'output 'default))
@@ -185,4 +198,4 @@
              ;; Emit processed and macro-expanded sex code, or emit C code
              (emit-c-or-sex sex-forms output args)
              ;; Compile file!
-             (compile-to-file sex-forms output args)))))))
+             (compile-to-file sex-forms output args cc-args)))))))

tests/Makefile

@@ -6,7 +6,7 @@ MODULE_FLAGS = -emit-all-import-libraries -module-registration -c
 MODULES = utils sex-macros reader sex-modules semen sex-fmt-c fmt-c-writer sexc
 SEX_OBJ = $(MODULES:%=%.o)
 
-TESTS = basic semen reader fmt-c-writer utils line-directives
+TESTS = basic semen reader fmt-c-writer utils line-directives codegen args
 TEST_SRCS = $(TESTS:%=%.scm)
 
 sex-tests: run.scm $(TEST_SRCS) $(SEX_OBJ)

tests/args.scm

@@ -0,0 +1,55 @@
+;;; Splitting the command line at `--'.
+;;;
+;;; getopt-long cannot do this: it consumes the separator and merges
+;;; everything after it into `@' alongside the input file. So sexc
+;;; splits the raw argv first, and only the head is parsed as options.
+;;; Everything else reaches the C compiler exactly as written --
+;;; including the words that do not start with a dash, which a previous
+;;; leading-dash heuristic used to drop.
+
+(import sexc)
+
+(define full '("foo.sex" "-o" "bar" "--" "-framework" "OpenGL" "-Wall"))
+
+(test-group "argument separator"
+
+  (test "options and input file stay with sexc"
+        '("foo.sex" "-o" "bar")
+        (args-before-separator full))
+
+  (test "the tail reaches the compiler verbatim"
+        '("-framework" "OpenGL" "-Wall")
+        (args-after-separator full))
+
+  ;; The case that motivated this: `OpenGL' has no leading dash and was
+  ;; silently dropped, leaving `-framework' to swallow whatever flag
+  ;; came next.
+  (test "a word without a dash survives"
+        '("-framework" "OpenGL")
+        (args-after-separator '("x.sex" "--" "-framework" "OpenGL")))
+
+  (test "no separator means nothing for the compiler"
+        '()
+        (args-after-separator '("foo.sex" "-o" "bar")))
+
+  (test "no separator leaves every argument with sexc"
+        '("foo.sex" "-o" "bar")
+        (args-before-separator '("foo.sex" "-o" "bar")))
+
+  (test "a trailing separator is allowed"
+        '()
+        (args-after-separator '("foo.sex" "--")))
+
+  (test "a leading separator leaves no input file"
+        '()
+        (args-before-separator '("--" "-lm")))
+
+  ;; Only the first `--' separates; a later one is an ordinary compiler
+  ;; argument (ld takes several).
+  (test "only the first separator counts"
+        '("-Wl,--as-needed" "--" "-lm")
+        (args-after-separator '("x.sex" "--" "-Wl,--as-needed" "--" "-lm")))
+
+  (test "an empty command line is handled"
+        '()
+        (args-before-separator '())))

tests/basic.scm

@@ -24,7 +24,7 @@
   ;; atom-to-fmt-c
   (test '%fun (atom-to-fmt-c 'fn))
   (test '%prototype (atom-to-fmt-c 'prototype))
-  (test '%block-begin (atom-to-fmt-c 'begin))
+  (test '%block-begin (atom-to-fmt-c 'do))
   (test '%define (atom-to-fmt-c 'define))
   (test '%pointer (atom-to-fmt-c 'pointer))
   (test '%array (atom-to-fmt-c 'array))
@@ -42,5 +42,10 @@
   (test '(%. a_b c) (walk-expr '(dot-access a-b c)))
 
   ;; comment -> %comment directive (rendered as /* ... */)
+  ;; The reader eats only the `;' that introduced the line, so ";;; Foo"
+  ;; arrives as ";; Foo"; and c-comment puts nothing between /* */ and
+  ;; the text. Both are handled on the way out.
   (test '(%comment " hi ") (walk-expr '(comment " hi")))
-  (test '(%comment " hi") (process-toplevel-form '(comment " hi"))))
+  (test '(%comment " hi ") (process-toplevel-form '(comment " hi")))
+  (test '(%comment " Foo ") (walk-expr '(comment ";; Foo")))
+  (test '(%comment " Foo ") (walk-expr '(comment ";;;   Foo   "))))

tests/codegen.scm

@@ -0,0 +1,126 @@
+;;; Codegen details that are easy to get subtly wrong, and that the
+;;; walk-* unit tests cannot see: they check the intermediate form we
+;;; hand to fmt-c, not the C that fmt-c renders from it.
+;;;
+;;; Both cases below were found by writing an OpenGL example, not by
+;;; the existing suite, because both need an operand shape that no
+;;; earlier test program happened to use.
+
+(import (chicken port)
+        (chicken string)
+        srfi-13
+        fmt-c-writer
+        reader
+        semen
+        utils)
+
+(define (sex->c source)
+  "Compile SOURCE, a string of Sex, and return the generated C."
+  (let ((forms (with-input-from-string source
+                 (lambda ()
+                   (parameterize ((current-source-file "codegen.sex"))
+                     (parse-all (current-input-port)))))))
+    (with-output-to-string
+      (lambda ()
+        (parameterize ((sex-line-directives 'none))
+          (emit-c (semen-process forms)))))))
+
+(define (emits? source fragment)
+  (and (string-contains (sex->c source) fragment) #t))
+
+(define (in-fn body)
+  (string-append "(fn f ((a int) (b int)) void " body ")"))
+
+(test-group "codegen"
+
+  ;; c-switch handed its scrutinee straight to `cat', which only works
+  ;; when it is an atom. Anything else was displayed as a raw
+  ;; s-expression: `switch ((%. e type))'.
+  (test-group "switch scrutinee"
+    (test-assert "member access"
+      (emits? "(struct s ((type int))) (fn f ((e (struct s))) void (switch (. e type) (case 1 (g))))"
+              "switch (e.type)"))
+    (test-assert "call"
+      (emits? (in-fn "(switch (g a) (case 1 (h)))")
+              "switch (g(a))"))
+    (test-assert "arithmetic"
+      (emits? (in-fn "(switch (+ a b) (case 1 (h)))")
+              "switch (a + b)")))
+
+  ;; A cast binds tighter than every binary operator, so an operand
+  ;; that is itself a binary expression has to be parenthesised --
+  ;; otherwise the cast silently applies to the first operand only.
+  (test-group "cast precedence"
+    (test-assert "binary operand is parenthesised"
+      (emits? (in-fn "(var p (* void) (cast (* 2 (sizeof int)) (* void)))")
+              "(void *)(2 * sizeof(int))"))
+    (test-assert "subtraction operand is parenthesised"
+      (emits? (in-fn "(var f float (cast (- a b) float))")
+              "(float)(a - b)"))
+    ;; ...but exactly once. The operand used to parenthesise itself
+    ;; again inside the parens the cast had just added.
+    (test-assert "and not parenthesised twice"
+      (not (emits? (in-fn "(var f float (cast (- a b) float))")
+                   "(float)((a - b))")))
+    ;; Unary operands are already unary-expressions and must be left
+    ;; alone, or every existing cast in the tree gains noise.
+    (test-assert "identifier is left bare"
+      (emits? (in-fn "(var f float (cast a float))")
+              "(float)a"))
+    (test-assert "address-of is left bare"
+      (emits? (in-fn "(var p (* int) (cast (& a) (* int)))")
+              "(int *)&a"))
+    (test-assert "sizeof is left bare"
+      (emits? (in-fn "(var n int (cast (sizeof int) int))")
+              "(int)sizeof(int)")))
+
+  ;; A comment among a call's arguments used to become an argument,
+  ;; and c-apply put a comma on each side of it -- which does not
+  ;; compile. It is dropped, as in any other expression context.
+  (test-group "comments among arguments"
+    (test-assert "no stray comma"
+      (not (emits? (in-fn "(g 1 ;; c\n 2)") "*/,")))
+    (test-assert "the arguments survive"
+      (emits? (in-fn "(g 1 ;; c\n 2)") "g(1, 2)")))
+
+  ;; The reader leaves the `;'s that introduced each line, and a run of
+  ;; comment lines arrives as one form per line.
+  (test-group "comment rendering"
+    (test-assert "the markers are stripped"
+      (emits? "(fn f () void ;;; Foo\n (g))" "/* Foo */"))
+    (test-assert "so none survive into the C"
+      (not (emits? "(fn f () void ;;; Foo\n (g))" ";;")))
+    (test-assert "consecutive lines are packed into one comment"
+      (emits? "(fn f () void\n ;; first\n ;; second\n (g))"
+              "/* first\n second */"))
+    ;; Packing compares locations rather than just looking for adjacent
+    ;; comment forms, so a blank line still separates them.
+    (test-assert "a blank line keeps them apart"
+      (emits? "(fn f () void\n ;; first\n\n ;; second\n (g))" "/* first */")))
+
+  ;; 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) {"))))

tests/line-directives.scm

@@ -79,7 +79,7 @@
     "      (break))"                      ; 45
     "    (default"                        ; 46
     "      (putchar 120)))"               ; 47
-    "  (begin"                            ; 48
+    "  (do"                            ; 48
     "    (var bvar int 121)"              ; 49
     "    (putchar bvar))"                 ; 50
     "  (goto done)"                       ; 51

tests/run.scm

@@ -7,6 +7,8 @@
 (include "fmt-c-writer.scm")
 (include "utils.scm")
 (include "line-directives.scm")
+(include "codegen.scm")
+(include "args.scm")
 
 ;;; Should be the last in the test suite
 (test-exit)

tests/sex-programs/comments.sex

@@ -0,0 +1,13 @@
+(input)
+(output "start" "end")
+(return 0)
+
+;;; A top-level comment, preserved into the generated C.
+(include stdio.h)
+
+;; Another top-level comment, right before the function.
+(pub fn main () int
+  ;; a comment in statement position
+  (puts "start")
+  (puts "end") ; a trailing comment after a statement
+  (return 0))

tests/sex-programs/list-macros.sex

@@ -39,7 +39,7 @@
 
 (pub defmacro (list-for-each list-type list-var elt-type elt-var what-do)
   (let ((list-var-2 (cat list-var '-2)))
-    `(begin
+    `(do
       (var ,list-var-2 (* ,list-type) ,list-var)
       (var ,elt-var ,elt-type (-> ,list-var-2 value))
       (while (!= (-> ,list-var-2 next) NULL)

tests/sexc.module.scm

@@ -1 +1,3 @@
-(module sexc (main) "../sexc.scm")
+(module sexc
+    *
+  "../sexc.scm")