adding (chibi show c)

lib/chibi/show/base.scm

@@ -84,8 +84,8 @@
 
 (define-syntax with
   (syntax-rules ()
-    ((with params x ... y) (%with params x ... (fn () (displayed y))))
+    ((with params x ... y)
-    ))
+     (%with params (each x ... y)))))
 
 ;;> The noop formatter.  Generates no output and leaves the state
 ;;> unmodified.

lib/chibi/show/c-test.sld

@@ -0,0 +1,508 @@
+
+(define-library (chibi show c-test)
+  (import (scheme base) (chibi show) (chibi show c) (chibi test))
+  (export run-tests)
+  (begin
+    (define (run-tests)
+      (test-begin "(chibi show c)")
+
+      (test "if (1) {
+    2;
+} else {
+    3;
+}
+"
+          (show #f (c-if 1 2 3)))
+
+      (test "if (x ? y : z) {
+    2;
+} else {
+    3;
+}
+"
+          (show #f (c-if (c-if 'x 'y 'z) 2 3)))
+
+      (test "if (x ? y : z) {
+    2;
+} else {
+    3;
+}
+"
+          (show #f (c-expr '(if (if x y z) 2 3))))
+
+      (test "if (x ? y : z) {
+    2;
+} else {
+    3;
+}
+"
+          (show #f (c-expr '(%begin (if (if x y z) 2 3)))))
+
+      (test "if (x ? y : z) {
+    2;
+} else {
+    if (w) {
+        3;
+    } else {
+        4;
+    }
+}
+"
+          (show #f (c-expr '(if (if x y z) 2 (if w 3 4)))))
+
+      (test "if (x ? y : z) {
+    2;
+} else {
+    if (w) {
+        if (u) {
+            3;
+        } else {
+            4;
+        }
+    } else {
+        5;
+    }
+}
+"
+          (show #f (c-expr '(if (if x y z) 2 (if w (if u 3 4) 5)))))
+
+      (test "int square (int x) {
+    return x * x;
+}
+"
+          (show #f (c-fun 'int 'square '((int x)) (c* 'x 'x))))
+
+      (test "int foo (int x, int y, int z) {
+    if (x ? y : z) {
+        return 2;
+    } else {
+        return 3;
+    }
+}
+"
+          (show #f (c-fun 'int 'foo '((int x) (int y) (int z))
+                          (c-if (c-if 'x 'y 'z) 2 3))))
+
+      (test "some_function(shape, x, y + 1, z);\n"
+          (show #f (c-expr '(some_function shape x (+ y 1) z))))
+
+      (test "if (y < 255 && pred(shape, x, y, z) == 0) {
+    2;
+} else {
+    3;
+}
+"
+          (show #f (c-expr '(if (&& (< y 255) (== (pred shape x y z) 0)) 2 3))))
+
+      (test "heightmap[i + k * 16];\n"
+          (show #f (c-expr '(vector-ref heightmap (+ i (* k 16))))))
+
+      (test "void bar (int mode, const char *msg, unsigned int arg) {
+    if (mode == 1) {
+        printf(msg);
+    } else {
+        printf(msg, arg);
+    }
+}
+"
+          (show #f (c-fun 'void 'bar
+                          '((int mode)
+                            ((%pointer (const char)) msg)
+                            ((unsigned int) arg))
+                          (c-if (c== 'mode 1) '(printf msg) '(printf msg arg)))))
+
+      (test "while ((line = readline()) != EOF) {
+    printf(\"%s\", line);
+}
+"
+          (show #f (c-while (c!= (c= 'line '(readline)) 'EOF)
+                            '(printf "%s" line))))
+
+      (test "switch (y) {
+case 1:
+    x = 1;
+    break;
+case 2:
+    x = 4;
+    break;
+default:
+    x = 5;
+    break;
+}
+"
+          (show #f (c-switch 'y
+                             (c-case 1 (c= 'x 1))
+                             (c-case 2 (c= 'x 4))
+                             (c-default (c= 'x 5)))))
+
+      (test "switch (y) {
+case 1:
+    x = 1;
+    break;
+case 2:
+    x = 4;
+default:
+    x = 5;
+    break;
+}
+"
+          (show #f (c-switch 'y
+                             (c-case 1 (c= 'x 1))
+                             (c-case/fallthrough 2 (c= 'x 4))
+                             (c-default (c= 'x 5)))))
+
+      (test "switch (y) {
+case 1:
+    x = 1;
+    break;
+case 2:
+    x = 4;
+    break;
+default:
+    x = 5;
+    break;
+}
+"
+          (show #f (c-switch 'y '((1) (= x 1)) '((2) (= x 4)) '(else (= x 5)))))
+
+      (test "switch (y) {
+case 1:
+    x = 1;
+    break;
+case 2:
+    x = 4;
+    break;
+default:
+    x = 5;
+    break;
+}
+"
+          (show #f (c-expr '(switch y ((1) (= x 1)) ((2) (= x 4)) (else (= x 5))))))
+
+      (test "int q (int x) {
+    switch (x) {
+    case 1:
+        return 1;
+    case 2:
+        return 4;
+    default:
+        return 5;
+    }
+}
+"
+          (show #f (c-fun 'int 'q '(x) (c-switch 'x '((1) 1) '((2) 4) '(else 5)))))
+
+      (test "switch (x) {
+case 1:
+case 2:
+    foo();
+    break;
+default:
+    bar();
+    break;
+}
+"
+          (show #f (c-expr '(switch x ((1 2) (foo)) (else (bar))))))
+
+      (test "switch (x) {
+case 1:
+    foo();
+    break;
+case 2:
+case 3:
+    bar();
+    break;
+default:
+    baz();
+    break;
+}
+"
+          (show #f (c-expr
+                    '(switch x (case 1 (foo)) (case (2 3) (bar)) (else (baz))))))
+
+      (test "switch (x) {
+case 1:
+case 2:
+    foo();
+default:
+    bar();
+    break;
+}
+"
+          (show #f (c-expr '(switch x (case/fallthrough (1 2) (foo)) (else (bar))))))
+
+      (test "switch (x) {
+case 1:
+case 2:
+    foo();
+    break;
+default:
+    bar();
+    break;
+}
+"
+          (show #f (c-expr '(switch x ((1 2) (foo)) (default (bar))))))
+
+      (test "switch (x) {
+default:
+    bar();
+case 1:
+case 2:
+    foo();
+    break;
+}
+"
+          (show #f (c-expr '(switch x (else/fallthrough (bar)) ((1 2) (foo))))))
+
+      (test "for (i = 0; i < n; i++) {
+    printf(\"i: %d\");
+}
+"
+          (show #f (c-for (c= 'i 0) (c< 'i 'n) (c++/post 'i) '(printf "i: %d"))))
+
+      (test "a * x + b * y == c;\n"
+          (show #f (c== (c+ (c* 'a 'x) (c* 'b 'y)) 'c)))
+      (test "a * x + b * y == c;\n"
+          (show #f (c-expr '(== (+ (* a x) (* b y)) c))))
+
+      (test "(a + x) * (b + y) == c;\n"
+          (show #f (c-expr '(== (* (+ a x) (+ b y)) c))))
+
+      (test "1 - (3 + 2);\n"
+          (show #f (c-expr '(- 1 (+ 3 2)))))
+      (test "1 - (3 - 2);\n"
+          (show #f (c-expr '(- 1 (- 3 2)))))
+      (test "1 - 3 - 2;\n"
+          (show #f (c-expr '(- 1 3 2))))
+      (test "1 + (3 + 2);\n"
+          (show #f (c-expr '(+ 1 (+ 3 2)))))
+      (test "1 + 3 + 2;\n"
+          (show #f (c-expr '(+ 1 3 2))))
+
+      (test "x == 0 && (y == 2 || y == 3);\n"
+          (show #f (c-expr '(%and (== x 0) (%or (== y 2) (== y 3))))))
+
+      (test
+          "(abracadabra!!!! + xylophone????)
+  * (bananarama____ + yellowstonepark~~~~)
+  * (cryptoanalysis + zebramania);\n"
+          (show #f (c-expr '(* (+ abracadabra!!!! xylophone????)
+                               (+ bananarama____ yellowstonepark~~~~)
+                               (+ cryptoanalysis zebramania)))))
+
+      (test
+          "abracadabra(xylophone,
+            bananarama,
+            yellowstonepark,
+            cryptoanalysis,
+            zebramania,
+            delightful,
+            wubbleflubbery);\n"
+          (show #f (c-expr '(abracadabra xylophone
+                                         bananarama
+                                         yellowstonepark
+                                         cryptoanalysis
+                                         zebramania
+                                         delightful
+                                         wubbleflubbery))))
+
+      (test "#define foo(x, y) ((x) + (y))\n"
+          (show #f (cpp-define '(foo (int x) (int y)) (c+ 'x 'y))))
+
+      (test "#define foo(x, y) (2 * ((x) + (y) + z))\n"
+          (show #f (cpp-define '(foo (int x) (int y)) '(* 2 (+ x y z)))))
+
+      (test "#define min(x, y) ((x) < (y) ? (x) : (y))\n"
+          (show #f (cpp-define '(min x y) (c-if (c< 'x 'y) 'x 'y))))
+
+      (test
+          "#define foo(x, y) abracadabra((x) + (y),
+                              xylophone,
+                              bananarama,
+                              yellowstonepark,
+                              cryptoanalysis,
+                              zebramania,
+                              delightful,
+                              wubbleflubbery)
+"
+          (show #f (cpp-define '(foo x y)
+                               '(abracadabra (+ x y)
+                                             xylophone
+                                             bananarama
+                                             yellowstonepark
+                                             cryptoanalysis
+                                             zebramania
+                                             delightful
+                                             wubbleflubbery))))
+
+      (test "#ifndef FOO_H
+#define FOO_H
+
+extern int foo ();
+
+#endif  /* ! FOO_H */
+"
+          (show #f (cpp-wrap-header
+                    'FOO_H
+                    (c-extern (c-prototype 'int 'foo '())))))
+
+      (test "#if foo
+1
+#elif bar
+2
+#elif baz
+3
+#else 
+4
+#endif
+"
+          (show #f (cpp-if 'foo 1 'bar 2 'baz 3 4)))
+
+      (test "/* this is a /\\* nested *\\/ comment */"
+          (show #f (c-comment " this is a /* nested */ comment ")))
+
+      (test "/* this is a /\\* nested *\\/ comment */"
+          (show #f (c-comment " this is a " (c-comment " nested ") " comment ")))
+
+      ;; the initial leading space is annoying but hard to remove at the
+      ;; moment - the important thing is we preserve indentation in the body
+      (test "switch (y) {
+case 1:
+    x = 1;
+    break;
+#ifdef H_TWO
+case 2:
+    x = 4;
+    break;
+#endif  /* H_TWO */
+default:
+    x = 5;
+    break;
+}
+"
+          (show #f (c-expr
+                    `(switch y
+                             ((1) (= x 1))
+                             ,(cpp-ifdef 'H_TWO (c-case '(2) '(= x 4)))
+                             (else (= x 5))))))
+
+      (test "#define eprintf(...) fprintf(stderr, __VA_ARGS__)\n"
+          (show #f (c-expr '(%define (eprintf . args) (fprintf stderr args)))))
+
+      (test "struct point {
+    int x;
+    int y;
+};
+"
+          (show #f (c-expr `(struct point (x y)))))
+
+      (test "struct employee {
+    short age;
+    char *name;
+    struct {
+        int year;
+        int month;
+        int day;
+    } dob;
+} __attribute__ ((packed));
+"
+          (show #f (c-expr `(struct employee
+                                    ((short age)
+                                     ((%pointer char) name)
+                                     ((struct (year month day)) dob))
+                                    (%attribute packed)
+                                    ))))
+
+      (test "class employee {
+    short age;
+    char *name;
+    struct {
+        int year;
+        int month;
+        int day;
+    } dob;
+} __attribute__ ((packed));
+"
+          (show #f (c-class 'employee
+                            '((short age)
+                              ((%pointer char) name)
+                              ((struct (year month day)) dob))
+                            (c-attribute 'packed)
+                            )))
+
+      (test "union object {
+    char tag;
+    struct {
+        char tag;
+        char *data;
+    } string;
+    struct {
+        char tag;
+        void *car;
+        void *cdr;
+    } pair;
+    struct {
+        char tag;
+        unsigned int length;
+        void *data;
+    } vector;
+};
+"
+          (show #f (c-expr
+                    '(union object
+                            ((char tag)
+                             ((struct ((char tag) ((* char) data))) string)
+                             ((struct ((char tag)
+                                       ((* void) car)
+                                       ((* void) cdr)))
+                              pair)
+                             ((struct ((char tag)
+                                       ((unsigned int) length)
+                                       ((* void) data)))
+                              vector)
+                             )))))
+
+      (test "enum type_tags {
+    TYPE_CHAR = 1,
+    TYPE_FIXNUM,
+    TYPE_BOOLEAN,
+    TYPE_NULL,
+    TYPE_EOF,
+    TYPE_STRING,
+    TYPE_PAIR,
+    TYPE_VECTOR
+};
+"
+          (show #f (c-expr '(enum type_tags ((TYPE_CHAR 1) TYPE_FIXNUM TYPE_BOOLEAN TYPE_NULL TYPE_EOF TYPE_STRING TYPE_PAIR TYPE_VECTOR)))))
+
+      (test "#define OP_EVAL 0xFE\n" (show #f (with ((radix 16)) (cpp-define 'OP_EVAL 254))))
+
+      (test "unsigned long table[SIZE] = {1, 2, 3, 4};\n"
+          (show #f (c-var '(%array (unsigned long) SIZE) 'table '#(1 2 3 4))))
+
+      (test "int *array_of_ptr[];\n"
+          (show #f (c-var '(%array (* int)) 'array_of_ptr)))
+
+      (test "int (*ptr_to_array)[];\n"
+          (show #f (c-var '(* (%array int)) 'ptr_to_array)))
+
+      (test "foo **table = {{1, \"foo\"}, {2, \"bar\"}, {3, \"baz\"}, {4, \"qux\"}};\n"
+          (show #f (c-var '(* (* foo)) 'table
+                          '#(#(1 "foo") #(2 "bar") #(3 "baz") #(4 "qux")))))
+
+      (test "sexp (*f)(sexp, sexp) = NULL;\n"
+          (show #f (c-var '(%fun sexp (sexp sexp)) 'f 'NULL)))
+
+      (test "sexp (*)(sexp) (*f)(sexp, sexp) = NULL;\n"
+          (show #f (c-var '(%fun (%fun sexp (sexp)) (sexp sexp)) 'f 'NULL)))
+
+      (test "typedef double (*f)(double *, double, int);\n"
+          (show #f (c-typedef '(%fun double ((* double) double int)) 'f)))
+
+      (test "\"foo\\tbar\";\n"
+          (show #f (c-expr "foo\tbar")))
+
+      (test "static int i;\n"
+          (show #f (c-expr '(static (%var int i)))))
+
+      (test-end))))

lib/chibi/show/c.scm

@@ -0,0 +1,869 @@
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; additional state information
+
+(define (c-in-expr proc) (with ((expression? #t)) (c-expr proc)))
+(define (c-in-stmt proc) (with ((expression? #f)) (c-expr proc)))
+(define (c-in-test proc) (with ((in-cond? #t)) (c-in-expr proc)))
+(define (c-with-op op proc) (with ((op op)) proc))
+
+(define nl-str (call-with-output-string newline))
+(define (make-nl-space n) (string-append nl-str (make-string n #\space)))
+(define (make-space n) (make-string n #\space))
+
+(define (call-with-output-string proc)
+  (let ((out (open-output-string)))
+    (proc out)
+    (let ((res (get-output-string out)))
+      (close-output-port out)
+      res)))
+
+(define (display-to-string x)
+  (if (string? x)
+      x
+      (call-with-output-string (lambda (out) (display x out)))))
+
+(define (write-to-string x)
+  (call-with-output-string (lambda (out) (write x out))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; be smart about operator precedence
+
+(define (c-op-precedence x)
+  (if (string? x)
+      (cond
+        ((or (string=? x ".") (string=? x "->")) 10)
+        ((or (string=? x "++") (string=? x "--")) 20)
+        ((string=? x "|") 65)
+        ((string=? x "||") 75)
+        ((string=? x "|=") 85)
+        ((or (string=? x "+=") (string=? x "-=")) 85)
+        (else (c-op-precedence (string->symbol x))))
+      (case x
+        ((zero) 0)
+        ;;((|::|) 5)                    ; C++
+        ((paren bracket) 5)
+        ((dot arrow post-decrement post-increment) 10)
+        ((**) 15)                       ; Perl
+        ((unary+ unary- ! ~ cast unary-* unary-& sizeof) 20) ; ++ --
+        ((=~ !~) 25)                    ; Perl
+        ((* / %) 30)
+        ((+ -) 35)
+        ((<< >>) 40)
+        ((< > <= >=) 45)
+        ((lt gt le ge) 45)              ; Perl
+        ((== !=) 50)
+        ((eq ne cmp) 50)                ; Perl
+        ((&) 55)
+        ((^) 60)
+        ;;((|\||) 65)                   ; SCSH
+        ((&&) 70)
+        ;;((|\|\||) 75)                 ; SCSH
+        ;;((.. ...) 77)                 ; Perl
+        ((? if) 80)
+        ((= *= /= %= &= ^= <<= >>=) 85) ; |\|=| ;  += -=
+        ((comma) 90)
+        ((=>) 90)                       ; Perl
+        ((not) 92)                      ; Perl
+        ((and) 93)                      ; Perl
+        ((or xor) 94)                   ; Perl
+        (else 95))))
+
+(define (c-op< x y) (< (c-op-precedence x) (c-op-precedence y)))
+(define (c-op<= x y) (<= (c-op-precedence x) (c-op-precedence y)))
+
+(define (c-paren x)
+  (each "(" x ")"))
+
+(define (c-maybe-paren x-op x)
+  (fn (op)
+    (let ((x (with ((op x-op)) x)))
+      (if (c-op<= op x-op)
+          (c-paren x)
+          x))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; default literals writer
+
+(define (c-control-operator? x)
+  (memq x '(if while switch repeat do for fun begin)))
+
+(define (c-literal? x)
+  (or (number? x) (string? x) (char? x) (boolean? x)))
+
+(define (char->c-char c)
+  (string-append "'" (c-escape-char c #\') "'"))
+
+(define (c-escape-char c quote-char)
+  (let ((n (char->integer c)))
+    (if (<= 32 n 126)
+        (if (or (eqv? c quote-char) (eqv? c #\\))
+            (string #\\ c)
+            (string c))
+        (case n
+          ((7) "\\a") ((8) "\\b") ((9) "\\t") ((10) "\\n")
+          ((11) "\\v") ((12) "\\f") ((13) "\\r")
+          (else (string-append "\\x" (number->string (char->integer c) 16)))))))
+
+(define (c-format-number x)
+  (if (and (integer? x) (exact? x))
+      (fn (radix)
+        (case radix
+          ((16) (each "0x" (string-upcase-ascii (number->string x 16))))
+          ((8) (each "0" (number->string x 8)))
+          (else (each (number->string x)))))
+      (each (number->string x))))
+
+(define (c-format-string s)
+  (each "\"" (each-in-list (c-string-escaped s)) "\""))
+
+(define (c-string-escaped s)
+  (let ((start (string-cursor-start s)))
+    (let lp ((parts '()) (i (string-cursor-end s)))
+      (let ((j (string-find-right s c-needs-string-escape? start i)))
+        (cond
+         ((string-cursor>? j start)
+          (lp (cons (c-escape-char (string-cursor-ref s (string-cursor-prev s j)) #\")
+                    (cons (substring-cursor s j i) parts))
+              (string-cursor-prev s j)))
+         (else
+          (cons (substring-cursor s start i) parts)))))))
+
+(define (c-needs-string-escape? c)
+  (if (<= 32 (char->integer c) 127) (memv c '(#\" #\\)) #t))
+
+(define (c-simple-literal x)
+  (c-wrap-stmt
+   (cond ((char? x) (each (char->c-char x)))
+         ((boolean? x) (each (if x "1" "0")))
+         ((number? x) (c-format-number x))
+         ((string? x) (c-format-string x))
+         ((null? x) (each "NULL"))
+         ((eof-object? x) (each "EOF"))
+         (else (each (write-to-string x))))))
+
+(define (c-literal x)
+  (fn (op in-macro? macro-vars)
+    (if (and in-macro? (memq x macro-vars))
+        (c-paren (c-simple-literal x))
+        (c-simple-literal x))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; default expression generator
+
+(define (c-expr/sexp x)
+  (cond
+   ((procedure? x)
+    x)
+   ((pair? x)
+    (case (car x)
+      ((if) (apply c-if (cdr x)))
+      ((for) (apply c-for (cdr x)))
+      ((while) (apply c-while (cdr x)))
+      ((switch) (apply c-switch (cdr x)))
+      ((case) (apply c-case (cdr x)))
+      ((case/fallthrough) (apply c-case/fallthrough (cdr x)))
+      ((default) (apply c-default (cdr x)))
+      ((break) c-break)
+      ((continue) c-continue)
+      ((return) (apply c-return (cdr x)))
+      ((goto) (apply c-goto (cdr x)))
+      ((typedef) (apply c-typedef (cdr x)))
+      ((struct union class) (apply c-struct/aux x))
+      ((enum) (apply c-enum (cdr x)))
+      ((inline auto restrict register volatile extern static)
+       (each (car x) " " (apply c-begin (cdr x))))
+      ;; non C-keywords must have some character invalid in a C
+      ;; identifier to avoid conflicts - by default we prefix %
+      ((vector-ref)
+       (c-wrap-stmt
+        (each (c-expr (cadr x)) "[" (c-expr (caddr x)) "]")))
+      ((vector-set!)
+       (c= (c-in-expr
+            (each (c-expr (cadr x)) "[" (c-expr (caddr x)) "]"))
+           (c-expr (cadddr x))))
+      ((extern/C) (apply c-extern/C (cdr x)))
+      ((%apply) (apply c-apply (cdr x)))
+      ((%define) (apply cpp-define (cdr x)))
+      ((%include) (apply cpp-include (cdr x)))
+      ((%fun %lambda) (apply c-fun (cdr x)))
+      ((%cond)
+       (let lp ((ls (cdr x)) (res '()))
+         (if (null? ls)
+             (apply c-if (reverse res))
+             (lp (cdr ls)
+                 (cons (if (pair? (cddar ls))
+                           (apply c-begin (cdar ls))
+                           (cadar ls))
+                       (cons (caar ls) res))))))
+      ((%prototype) (apply c-prototype (cdr x)))
+      ((%var) (apply c-var (cdr x)))
+      ((%begin) (apply c-begin (cdr x)))
+      ((%attribute) (apply c-attribute (cdr x)))
+      ((%line) (apply cpp-line (cdr x)))
+      ((%pragma %error %warning)
+       (apply cpp-generic (substring (symbol->string (car x)) 1) (cdr x)))
+      ((%if %ifdef %ifndef %elif)
+       (apply cpp-if/aux (substring (symbol->string (car x)) 1) (cdr x)))
+      ((%endif) (apply cpp-endif (cdr x)))
+      ((%block) (apply c-braced-block (cdr x)))
+      ((%comment) (apply c-comment (cdr x)))
+      ((:) (apply c-label (cdr x)))
+      ((%cast) (apply c-cast (cdr x)))
+      ((+ - & * / % ! ~ ^ && < > <= >= == != << >>
+          = *= /= %= &= ^= >>= <<=)     ; |\|| |\|\|| |\|=|
+       (apply c-op x))
+      ((bitwise-and bit-and) (apply c-op '& (cdr x)))
+      ((bitwise-ior bit-or) (apply c-op "|" (cdr x)))
+      ((bitwise-xor bit-xor) (apply c-op '^ (cdr x)))
+      ((bitwise-not bit-not) (apply c-op '~ (cdr x)))
+      ((arithmetic-shift) (apply c-op '<< (cdr x)))
+      ((bitwise-ior= bit-or=) (apply c-op "|=" (cdr x)))
+      ((%and) (apply c-op "&&" (cdr x)))
+      ((%or) (apply c-op "||" (cdr x)))
+      ((%. %field) (apply c-op "." (cdr x)))
+      ((%->) (apply c-op "->" (cdr x)))
+      (else
+       (cond
+        ((eq? (car x) (string->symbol "."))
+         (apply c-op "." (cdr x)))
+        ((eq? (car x) (string->symbol "->"))
+         (apply c-op "->" (cdr x)))
+        ((eq? (car x) (string->symbol "++"))
+         (apply c-op "++" (cdr x)))
+        ((eq? (car x) (string->symbol "--"))
+         (apply c-op "--" (cdr x)))
+        ((eq? (car x) (string->symbol "+="))
+         (apply c-op "+=" (cdr x)))
+        ((eq? (car x) (string->symbol "-="))
+         (apply c-op "-=" (cdr x)))
+        (else (c-apply x))))))
+   ((vector? x)
+    (c-wrap-stmt
+     (each "{" (joined c-expr (vector->list x) ", ") "}")))
+   (else
+    (c-literal x))))
+
+(define (c-apply ls)
+  (c-wrap-stmt
+   (with ((op 'comma))
+     (each
+      (c-expr (car ls))
+      (let ((flat (with ((no-wrap? #t)) (joined c-expr (cdr ls) ", "))))
+        (fn (no-wrap?)
+          (if no-wrap?
+              (c-paren flat)
+              (c-paren
+               (try-fitted
+                flat
+                (fn (col)
+                  (let ((sep (string-append "," (make-nl-space col))))
+                    (joined c-expr (cdr ls) sep))))))))))))
+
+(define (c-expr x)
+  (fn (gen) ((or gen c-expr/sexp) x)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; comments, with Emacs-friendly escaping of nested comments
+
+(define (make-comment-writer output)
+  (lambda (str)
+    (let ((start (string-cursor-start str))
+          (end (string-cursor-prev str (string-cursor-end str))))
+      (let lp ((i start))
+        (let ((j (string-find str #\/ i)))
+          (cond
+           ((string-cursor>? j end)
+            (output (substring-cursor str i j)))
+           (else
+            (each
+             (cond
+              ((and (string-cursor>? j start)
+                    (eqv? #\* (string-cursor-ref str (string-cursor-prev str j))))
+               (each (output (substring-cursor str i j))
+                     (output "\\/")))
+              (else
+               (output (substring-cursor str i (string-cursor-next str j)))))
+             (if (and (string-cursor<? j end)
+                      (eqv? #\* (string-cursor-ref str (string-cursor-next str j))))
+                 (output "\\")
+                 nothing)
+             (lp (string-cursor-next str j))))))))))
+
+(define (c-comment . args)
+  (each "/*" (fn (output)
+               (with ((output (make-comment-writer output)))
+                 (each-in-list args)))
+        "*/"))
+
+(define (make-block-comment-writer)
+  (lambda (str)
+    (fn (col output)
+      (with ((output (make-comment-writer output)))
+        (let ((end (string-cursor-end str))
+              (indent (string-append (make-nl-space (+ col 1)) "* ")))
+          (let lp ((i (string-cursor-start str)))
+            (let ((j (string-find str #\newline i)))
+              (output indent)
+              (output (substring-cursor str i j))
+              (if (string-cursor<? j end)
+                  (lp (string-cursor-next str j))))))))))
+
+(define (c-block-comment . args)
+  (fn (col row)
+    (let ((indent (c-indent-string col)))
+      (each "/* "
+            (with ((writer (make-block-comment-writer)))
+              (each-in-list args))
+            (fn ((row2 row))
+              (cond
+               ((= row row2) (displayed " */"))
+               (else (each fl indent " */"))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; preprocessor
+
+(define (make-cpp-writer output)
+  (lambda (str)
+    (let ((lim (string-length str)))
+      (let lp ((i 0))
+        (let ((j (string-find str #\newline i)))
+          (output (substring str i j))
+          (cond
+           ((< j lim)
+            (output "\n")
+            (lp (+ j 1)))))))))
+
+(define (cpp-include file)
+  (if (string? file)
+      (each fl "#include " (written file) fl)
+      (each fl "#include <" file ">" fl)))
+
+(define (list-dot x)
+  (cond ((pair? x) (list-dot (cdr x)))
+        ((null? x) #f)
+        (else x)))
+
+(define (replace-tree from to x)
+  (let replace ((x x))
+    (cond ((eq? x from) to)
+          ((pair? x) (cons (replace (car x)) (replace (cdr x))))
+          (else x))))
+
+(define (cpp-define x . body)
+  (define (name-of x) (c-expr (if (pair? x) (cadr x) x)))
+  (fn ()
+    (let* ((body (cond
+                  ((and (pair? x) (list-dot x))
+                   => (lambda (dot)
+                        (if (eq? dot '...)
+                            body
+                            (replace-tree dot '__VA_ARGS__ body))))
+                  (else body)))
+           (tail
+            (if (pair? body)
+                (each " "
+                      (fn (output)
+                        (with ((writer (make-cpp-writer output))
+                               (in-macro? (pair? x))
+                               (macro-vars
+                                (map (lambda (v) (if (pair? v) (cadr v) v))
+                                     (if (pair? x) x (list x))))
+                               (op 'zero))
+                          (c-in-expr (apply c-begin body)))))
+                "")))
+      (c-in-expr
+       (if (pair? x)
+           (each fl "#define " (name-of (car x))
+                 (c-paren
+                  (joined/dot name-of
+                              (lambda (dot) (displayed "..."))
+                              (cdr x)
+                              ", "))
+                 tail fl)
+           (each fl "#define " (c-expr x) tail fl))))))
+
+(define (cpp-expr x)
+  (if (or (symbol? x) (string? x)) (displayed x) (c-expr x)))
+
+(define (cpp-if/aux name check . o)
+  (let* ((pass (and (pair? o) (car o)))
+         (comment
+          (if (member name '("ifdef" "ifndef"))
+              (each "  "
+                    (c-comment
+                     " " (if (equal? name "ifndef") "! " "")
+                     check " "))
+              ""))
+         (endif (if pass (each fl "#endif" comment) ""))
+         (tail (cond
+                ((and (pair? o) (pair? (cdr o)))
+                 (if (pair? (cddr o))
+                     (apply cpp-elif (cdr o))
+                     (each (cpp-else) (cadr o) endif)))
+                (else endif))))
+    (fn (col)
+      (each fl "#" name " " (cpp-expr check) fl
+            (or pass "")
+            tail fl))))
+
+(define (cpp-if check . o)
+  (apply cpp-if/aux "if" check o))
+(define (cpp-ifdef check . o)
+  (apply cpp-if/aux "ifdef" check o))
+(define (cpp-ifndef check . o)
+  (apply cpp-if/aux "ifndef" check o))
+(define (cpp-elif check . o)
+  (apply cpp-if/aux "elif" check o))
+(define (cpp-else . o)
+  (each fl "#else " (if (pair? o) (c-comment (car o)) "") fl))
+(define (cpp-endif . o)
+  (each fl "#endif " (if (pair? o) (c-comment (car o)) "") fl))
+
+(define (cpp-wrap-header name . body)
+  (let ((name name)) ; consider auto-mangling
+    (cpp-ifndef name (c-begin (cpp-define name) nl (apply c-begin body) nl))))
+
+(define (cpp-line num . o)
+  (each fl "#line " num (if (pair? o) (each " " (car o)) "") fl))
+
+(define (cpp-generic name . ls)
+  (each fl "#" name (each-in-list ls) fl))
+
+(define (cpp-undef . args) (apply cpp-generic "undef" args))
+(define (cpp-pragma . args) (apply cpp-generic "pragma" args))
+(define (cpp-error . args) (apply cpp-generic "error" args))
+(define (cpp-warning . args) (apply cpp-generic "warning" args))
+
+(define (cpp-stringify x)
+  (each "#" x))
+
+(define (cpp-sym-cat . args)
+  (joined displayed args " ## "))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; general indentation and brace rules
+
+(define (c-indent-string col . o)
+  (make-space (max 0 (+ col (if (pair? o) (car o) 0)))))
+
+;; (c-indent [offset])
+(define (c-indent . o)
+  (fn (col indent-space)
+    (displayed
+     (make-space (max 0 (+ (or indent-space 4)
+                           (if (pair? o) (car o) 0)))))))
+
+(define (c-indent/switch)
+  (fn (col switch-indent-space)
+    (displayed (make-space (max 0 (- (or switch-indent-space 0) col))))))
+
+(define (c-open-brace)
+  (fn (col newline-before-brace?)
+    (if newline-before-brace?
+        (each nl (c-indent-string col) "{" nl)
+        (each " {" nl))))
+
+(define (c-close-brace)
+  (displayed "}"))
+
+(define (c-wrap-stmt x)
+  (fn (expression? return?)
+    (if expression?
+        (c-expr x)
+        (each (if return? "return " "")
+              (c-in-expr (c-expr x)) ";" nl))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; code blocks
+
+(define (c-block . args)
+  (apply c-block/aux 0 args))
+
+(define (c-block/aux offset header body0 . body)
+  (let ((inner (apply c-begin body0 body)))
+    (if (or (pair? body)
+            (not (or (c-literal? body0)
+                     (and (pair? body0)
+                          (not (c-control-operator? (car body0)))))))
+        (c-braced-block/aux offset header inner)
+        (fn (braceless-bodies?)
+          (if braceless-bodies?
+              (each header fl (c-indent offset) inner fl)
+              (c-braced-block/aux offset header inner))))))
+
+(define (c-braced-block . args)
+  (fn (col) (apply c-braced-block/aux col args)))
+
+(define (c-braced-block/aux offset header . body)
+  (fn ()
+    (each header (c-open-brace) (c-indent offset)
+          (apply c-begin body) fl
+          (c-indent-string offset)
+          (c-close-brace))))
+
+(define (c-begin . args)
+  (apply c-begin/aux #f args))
+
+(define (c-begin/aux ret? body0 . body)
+  (if (null? body)
+      (c-expr body0)
+      (fn (col expression?)
+        (if expression?
+            (with ((no-wrap? #t))
+               (joined c-expr (cons body0 body) ", "))
+            (let ((sep (each fl (c-indent-string col))))
+              (each
+               (with ((return? #f))
+                 (joined c-expr (cons body0 (drop-right body 1)) sep))
+               sep
+               (with ((return? ret?))
+                 (c-expr (last body)))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; data structures
+
+(define (c-struct/aux type x . o)
+  (let* ((name (if (null? o) (if (or (symbol? x) (string? x)) x #f) x))
+         (body (if name (car o) x))
+         (o (if (null? o) o (cdr o))))
+    (c-wrap-stmt
+     (each
+      (c-braced-block
+       (each type
+             (if (and name (not (equal? name "")))
+                 (each " " name)
+                 nothing))
+       (each
+        (c-in-stmt
+         (if (list? body)
+             (apply c-begin (map c-wrap-stmt (map c-param body)))
+             (c-wrap-stmt (c-expr body))))))
+      (if (pair? o) (each " " (apply c-begin o)) nothing)))))
+
+(define (c-struct . args) (apply c-struct/aux "struct" args))
+(define (c-union . args) (apply c-struct/aux "union" args))
+(define (c-class . args) (apply c-struct/aux "class" args))
+
+(define (c-enum x . o)
+  (define (c-enum-one x)
+    (if (pair? x) (each (car x) " = " (c-expr (cadr x))) (displayed x)))
+  (let* ((name (if (null? o) (if (or (symbol? x) (string? x)) x #f) x))
+         (vals (if name (car o) x)))
+    (fn (col indent-space)
+      (let ((sep (each ",\n" (c-indent-string (+ col (or indent-space 4))))))
+        (c-wrap-stmt
+         (each
+          (c-braced-block
+           (if name (each "enum " name) (displayed "enum"))
+           (joined c-enum-one vals sep))))))))
+
+(define (c-attribute . args)
+  (each "__attribute__ ((" (joined c-expr args ", ") "))"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; basic control structures
+
+(define (c-while check . body)
+  (each (c-block (each "while (" (c-in-test check) ")")
+                 (c-in-stmt (apply c-begin body)))
+        fl))
+
+(define (c-for init check update . body)
+  (each
+   (c-block
+    (c-in-expr
+     (each "for (" (c-expr init) "; " (c-in-test check) "; "
+          (c-expr update ) ")"))
+    (c-in-stmt (apply c-begin body)))
+   fl))
+
+(define (c-param x)
+  (cond
+    ((procedure? x) x)
+    ((pair? x) (c-type (car x) (cadr x)))
+    (else (fn (default-type) (c-type (or default-type 'int) x)))))
+
+(define (c-param-list ls)
+  (c-in-expr (joined/dot c-param (fn (dot) (displayed "...")) ls ", ")))
+
+(define (c-fun type name params . body)
+  (each (c-block (c-in-expr (c-prototype type name params))
+                (with ((return? (not (eq? 'void type))))
+                  (c-in-stmt (apply c-begin body))))
+       fl))
+
+(define (c-prototype type name params . o)
+  (c-wrap-stmt
+   (each (c-type type) " " (c-expr name) " (" (c-param-list params) ")"
+         (joined/prefix c-expr o " "))))
+
+(define (c-static x) (each "static " (c-expr x)))
+(define (c-const x) (each "const " (c-expr x)))
+(define (c-restrict x) (each "restrict " (c-expr x)))
+(define (c-volatile x) (each "volatile " (c-expr x)))
+(define (c-auto x) (each "auto " (c-expr x)))
+(define (c-inline x) (each "inline " (c-expr x)))
+(define (c-extern x) (each "extern " (c-expr x)))
+(define (c-extern/C . body)
+  (each "extern \"C\" {" nl (apply c-begin body) nl "}" nl))
+
+(define (c-type type . o)
+  (let ((name (and (pair? o) (car o))))
+    (cond
+     ((pair? type)
+      (case (car type)
+        ((%fun)
+         (each (c-type (cadr type) #f)
+              " (*" (or name "") ")("
+              (joined (lambda (x) (c-type x #f)) (caddr type) ", ") ")"))
+        ((%array)
+         (let ((name (each name "[" (if (pair? (cddr type))
+                                       (c-expr (caddr type))
+                                       "")
+                          "]")))
+           (c-type (cadr type) name)))
+        ((%pointer *)
+         (let ((name (each "*" (if name (c-expr name) ""))))
+           (c-type (cadr type)
+                   (if (and (pair? (cadr type)) (eq? '%array (caadr type)))
+                       (c-paren name)
+                       name))))
+        ((enum) (apply c-enum name (cdr type)))
+        ((struct union class)
+         (each (apply c-struct/aux (car type) (cdr type)) " " name))
+        (else (joined/last c-expr (lambda (x) (c-type x name)) type " "))))
+     ((not type)
+      (fn (default-type) (c-type (or default-type 'int) name)))
+     (else
+      (each (if (eq? '%pointer type) '* type) (if name (each " " name) ""))))))
+
+(define (c-var type name . init)
+  (c-wrap-stmt
+   (if (pair? init)
+       (each (c-type type name) " = " (c-expr (car init)))
+       (c-type type (if (pair? name)
+                        (joined c-expr name ", ")
+                        (c-expr name))))))
+
+(define (c-cast type expr)
+  (each "(" (c-type type) ")" (c-expr expr)))
+
+(define (c-typedef type alias . o)
+  (c-wrap-stmt
+   (each "typedef " (c-type type alias) (joined/prefix c-expr o " "))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Generalized IF: allows multiple tail forms for if/else if/.../else
+;; blocks.  A final ELSE can be signified with a test of #t or 'else,
+;; or by simply using an odd number of expressions (by which the
+;; normal 2 or 3 clause IF forms are special cases).
+
+(define (c-if/stmt c p . rest)
+  (fn (col)
+    (let lp ((c c) (p p) (ls rest))
+      (if (or (eq? c 'else) (eq? c #t))
+          (if (not (null? ls))
+              (error "forms after else clause in IF" c p ls)
+              (each (c-block/aux col " else" p) fl))
+          (let ((tail (if (pair? ls)
+                          (if (pair? (cdr ls))
+                              (lp (car ls) (cadr ls) (cddr ls))
+                              (lp 'else (car ls) '()))
+                          fl)))
+            (each (c-block/aux
+                   col
+                   (each (if (eq? ls rest) nothing " else ")
+                         "if (" (c-in-test (c-expr c)) ")")
+                   p)
+                  tail))))))
+
+(define (c-if/expr c p . rest)
+  (let lp ((c c) (p p) (ls rest))
+    (cond
+     ((or (eq? c 'else) (eq? c #t))
+      (if (not (null? ls))
+          (error "forms after else clause in IF" c p ls)
+          (c-expr p)))
+     ((pair? ls)
+      (c-maybe-paren
+       '?
+       (with ((op '?))
+         (c-in-test (c-expr c))
+         " ? " (c-expr p) " : "
+         (if (pair? (cdr ls))
+             (lp (car ls) (cadr ls) (cddr ls))
+             (lp 'else (car ls) '())))))
+     (else
+      (c-or (c-in-test (c-expr c)) (c-expr p))))))
+
+(define (c-if . args)
+  (fn (expression?)
+    (if expression?
+        (apply c-if/expr args)
+        (apply c-if/stmt args))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; switch statements, automatic break handling
+
+(define (c-label name)
+  (fn (col)
+    (let ((indent (make-space (max 0 (- col 2)))))
+      (each fl indent name ":" fl))))
+
+(define c-break
+  (c-wrap-stmt (displayed "break")))
+(define c-continue
+  (c-wrap-stmt (displayed "continue")))
+(define (c-return . result)
+  (if (pair? result)
+      (c-wrap-stmt (each "return " (c-expr (car result))))
+      (c-wrap-stmt (displayed "return"))))
+(define (c-goto label)
+  (c-wrap-stmt (each "goto " (c-expr label))))
+
+(define (c-switch val . clauses)
+  (fn (col)
+    (let ((sep (each fl (c-indent-string col))))
+      (each "switch (" (c-in-expr val) ")" (c-open-brace)
+            (c-indent/switch)
+            sep
+            (joined c-in-stmt
+                    (map (lambda (x) (c-switch-clause x col))
+                         clauses)
+                    sep)
+            sep (c-close-brace) fl))))
+
+(define (c-switch-clause/breaks x . o)
+  (fn (col indent indent-space return?)
+    (let* ((col (if (pair? o) (car o) col))
+           (break?
+            (and (car x)
+                 (not (member (cadr x) '(case/fallthrough
+                                         default/fallthrough
+                                         else/fallthrough)))))
+           (explicit-case? (member (cadr x) '(case case/fallthrough)))
+           (indent-body (c-indent-string (+ col (or indent 4))))
+           (indent (c-indent-string col))
+           (sep (string-append ":" nl-str indent)))
+      (each (c-in-expr
+             (joined/suffix
+              displayed
+              (cond
+               ((or explicit-case? (pair? (cadr x)))
+                (map (lambda (y) (each "case " (c-expr y)))
+                     (if explicit-case?
+                         (if (list? (third x))
+                             (third x)
+                             (list (third x)))
+                         (cadr x))))
+               (else
+                (list (each "default"))))
+              sep))
+            (make-space (or indent-space 4))
+            (joined c-expr
+                    (if explicit-case? (cdr (cddr x)) (cddr x))
+                    indent-body)
+            (if (and break? (not return?))
+                (each fl indent-body c-break)
+                "")))))
+
+(define (c-switch-clause x . o)
+  (if (procedure? x) x (apply c-switch-clause/breaks (cons #t x) o)))
+(define (c-switch-clause/no-break x . o)
+  (if (procedure? x) x (apply c-switch-clause/breaks (cons #f x) o)))
+
+(define (c-case x . body)
+  (c-switch-clause (cons (if (pair? x) x (list x)) body)))
+(define (c-case/fallthrough x . body)
+  (c-switch-clause/no-break (cons (if (pair? x) x (list x)) body)))
+(define (c-default . body)
+  (c-switch-clause/breaks (cons #t (cons 'else body))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; operators
+
+(define (c-op op first . rest)
+  (if (null? rest)
+      (c-unary-op op first)
+      (apply c-binary-op op first rest)))
+
+(define (c-binary-op op . ls)
+  (define (lit-op? x) (or (c-literal? x) (symbol? x)))
+  (let ((str (display-to-string op)))
+    (c-wrap-stmt
+     (c-maybe-paren
+      op
+      (if (or (equal? str ".") (equal? str "->"))
+          (joined c-expr ls str)
+          (let ((flat
+                 (with ((no-wrap? #t))
+                   (fn (non-spaced-ops?)
+                     (joined c-expr
+                             ls
+                             (if (and non-spaced-ops?
+                                      (every lit-op? ls))
+                                 str
+                                 (string-append " " str " ")))))))
+            (fn (no-wrap?)
+              (if no-wrap?
+                  flat
+                  (try-fitted
+                   flat
+                   (fn (col)
+                     (joined c-expr
+                             ls
+                             (each nl (make-space (+ 2 col)) str " ")
+                             )))))))))))
+
+(define (c-unary-op op x)
+  (c-wrap-stmt
+   (each (display-to-string op) (c-maybe-paren op (c-expr x)))))
+
+;; some convenience definitions
+
+(define (c++ . args) (apply c-op "++" args))
+(define (c-- . args) (apply c-op "--" args))
+(define (c+ . args) (apply c-op '+ args))
+(define (c- . args) (apply c-op '- args))
+(define (c* . args) (apply c-op '* args))
+(define (c/ . args) (apply c-op '/ args))
+(define (c% . args) (apply c-op '% args))
+(define (c& . args) (apply c-op '& args))
+;; (define (|c\|| . args) (apply c-op '|\|| args))
+(define (c^ . args) (apply c-op '^ args))
+(define (c~ . args) (apply c-op '~ args))
+(define (c! . args) (apply c-op '! args))
+(define (c&& . args) (apply c-op '&& args))
+;; (define (|c\|\|| . args) (apply c-op '|\|\|| args))
+(define (c<< . args) (apply c-op '<< args))
+(define (c>> . args) (apply c-op '>> args))
+(define (c== . args) (apply c-op '== args))
+(define (c!= . args) (apply c-op '!= args))
+(define (c< . args) (apply c-op '< args))
+(define (c> . args) (apply c-op '> args))
+(define (c<= . args) (apply c-op '<= args))
+(define (c>= . args) (apply c-op '>= args))
+(define (c= . args) (apply c-op '= args))
+(define (c+= . args) (apply c-op "+=" args))
+(define (c-= . args) (apply c-op "-=" args))
+(define (c*= . args) (apply c-op '*= args))
+(define (c/= . args) (apply c-op '/= args))
+(define (c%= . args) (apply c-op '%= args))
+(define (c&= . args) (apply c-op '&= args))
+;; (define (|c\|=| . args) (apply c-op '|\|=| args))
+(define (c^= . args) (apply c-op '^= args))
+(define (c<<= . args) (apply c-op '<<= args))
+(define (c>>= . args) (apply c-op '>>= args))
+
+(define (c. . args) (apply c-op "." args))
+(define (c-> . args) (apply c-op "->" args))
+
+(define (c-bit-or . args) (apply c-op "|" args))
+(define (c-or . args) (apply c-op "||" args))
+(define (c-bit-or= . args) (apply c-op "|=" args))
+
+(define (c++/post x)
+  (each (c-maybe-paren 'post-increment (c-expr x)) "++"))
+(define (c--/post x)
+  (each (c-maybe-paren 'post-decrement (c-expr x)) "--"))

lib/chibi/show/c.sld

@@ -0,0 +1,25 @@
+
+(define-library (chibi show c)
+  (export
+   c-in-expr c-in-stmt c-in-test
+   c-paren c-maybe-paren c-type c-literal? c-literal char->c-char
+   c-struct c-union c-class c-enum c-typedef c-cast
+   c-expr c-expr/sexp c-apply c-op c-indent c-indent-string
+   c-wrap-stmt c-open-brace c-close-brace
+   c-block c-braced-block c-begin
+   c-fun c-var c-prototype c-param c-param-list
+   c-while c-for c-if c-switch
+   c-case c-case/fallthrough c-default
+   c-break c-continue c-return c-goto c-label
+   c-static c-const c-extern c-volatile c-auto c-restrict c-inline
+   c++ c-- c+ c- c* c/ c% c& c^ c~ c! c&& c<< c>> c== c!= ;  |c\||  |c\|\||
+   c< c> c<= c>= c= c+= c-= c*= c/= c%= c&= c^= c<<= c>>= ;++c --c ;  |c\|=|
+   c++/post c--/post c. c->
+   c-bit-or c-or c-bit-or=
+   cpp-if cpp-ifdef cpp-ifndef cpp-elif cpp-endif cpp-undef
+   cpp-include cpp-define cpp-wrap-header cpp-pragma cpp-line
+   cpp-error cpp-warning cpp-stringify cpp-sym-cat
+   c-comment c-block-comment c-attribute)
+  (import (chibi) (chibi string) (chibi show) (chibi show pretty)
+          (srfi 1) (scheme cxr))
+  (include "c.scm"))

lib/chibi/show/pretty.sld

@@ -1,7 +1,7 @@
 
 (define-library (chibi show pretty)
   (export pretty pretty-shared pretty-simply
-          joined/shares
+          joined/shares try-fitted
           )
   (import (scheme base) (scheme write) (chibi show) (chibi show base)
           (srfi 1) (srfi 69) (chibi string))