(module fmt-c mzscheme
(require (only (lib "1.ss" "srfi")
find
fold
length+
remove
filter
every)
(lib "6.ss" "srfi")
(only (lib "13.ss" "srfi")
substring/shared
string-index
string-index-right
string-count
string-concatenate
string-concatenate-reverse
string-tokenize
string-pad
string-prefix?
string-suffix?)
"fmt.ss")
(provide
fmt-in-macro? fmt-expression? fmt-return? fmt-default-type
fmt-newline-before-brace? fmt-braceless-bodies?
fmt-indent-space fmt-switch-indent-space fmt-op fmt-gen
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-attribute
c-expr c-expr/sexp c-apply c-op c-indent c-current-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++/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
)
(define (fmt-in-macro? st) (fmt-ref st 'in-macro?))
(define (fmt-expression? st) (fmt-ref st 'expression?))
(define (fmt-return? st) (fmt-ref st 'return?))
(define (fmt-default-type st) (fmt-ref st 'default-type 'int))
(define (fmt-newline-before-brace? st) (fmt-ref st 'newline-before-brace?))
(define (fmt-braceless-bodies? st) (fmt-ref st 'braceless-bodies?))
(define (fmt-non-spaced-ops? st) (fmt-ref st 'non-spaced-ops?))
(define (fmt-indent-space st) (fmt-ref st 'indent-space))
(define (fmt-switch-indent-space st) (fmt-ref st 'switch-indent-space))
(define (fmt-op st) (fmt-ref st 'op 'stmt))
(define (fmt-gen st) (fmt-ref st 'gen))
(define (c-in-expr proc) (fmt-let 'expression? #t proc))
(define (c-in-stmt proc) (fmt-let 'expression? #f proc))
(define (c-in-test proc) (fmt-let 'in-cond? #t (c-in-expr proc)))
(define (c-with-op op proc) (fmt-let 'op op proc))
(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 95))
(case x
((paren bracket) 5)
((dot arrow post-decrement post-increment) 10)
((**) 15) ((unary+ unary- ! ~ cast unary-* unary-& sizeof) 20) ((=~ !~) 25) ((* / %) 30)
((+ -) 35)
((<< >>) 40)
((< > <= >=) 45)
((lt gt le ge) 45) ((== !=) 50)
((eq ne cmp) 50) ((&) 55)
((^) 60)
((&&) 70)
((?) 80)
((= *= /= %= &= ^= <<= >>=) 85) ((comma) 90)
((=>) 90) ((not) 92) ((and) 93) ((or xor) 94) (else 95))))
(define (c-op< x y) (< (c-op-precedence x) (c-op-precedence y)))
(define (c-paren x) (cat "(" x ")"))
(define (c-maybe-paren op x)
(lambda (st)
((fmt-let 'op op
(if (or (fmt-in-macro? st) (c-op< (fmt-op st) op))
(c-paren x)
x))
st)))
(define (c-type x)
(lambda (st)
((cond
((pair? x)
(case (car x)
((struct union class) (apply c-struct/aux x))
(else (join c-type x ""))))
((not x) (cat (fmt-default-type st)))
(else
(cat
(case x
((%immutable const) "const ")
((%bit %byte) "char") ((%short) "short")
((%word) "int") ((* %pointer) "*")
((%array) "[]")
((signed unsigned long) (cat x " "))
(else x)))))
st)))
(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)
(if (< 32 (char->integer c) 127)
(if (or (eqv? #\' c) (eqv? #\\ c))
(string #\' #\\ c #\')
(string #\' c #\'))
(case (char->integer c)
((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))
(lambda (st)
((case (fmt-radix st)
((16) (cat "0x" (string-upcase (number->string x 16))))
((8) (cat "0" (number->string x 8)))
(else (dsp (number->string x))))
st))
(dsp (number->string x))))
(define (c-simple-literal x)
(c-wrap-stmt
(cond ((char? x) (dsp (char->c-char x)))
((boolean? x) (dsp (if x "1" "0")))
((number? x) (c-format-number x))
((null? x) (dsp "NULL"))
((eof-object? x) (dsp "EOF"))
(else (dsp (write-to-string x))))))
(define (c-literal x)
(lambda (st)
((if (and (fmt-in-macro? st) (c-op< 'paren (fmt-op st))
(not (c-literal? x)))
(c-paren (c-simple-literal x))
(c-simple-literal x))
st)))
(define (c-expr/sexp x)
(if (procedure? x)
x
(lambda (st)
(cond
((pair? x)
(case (car x)
((if) ((apply c-if (cdr x)) st))
((for) ((apply c-for (cdr x)) st))
((while) ((apply c-while (cdr x)) st))
((switch) ((apply c-switch (cdr x)) st))
((case) ((apply c-case (cdr x)) st))
((case/fallthrough) ((apply c-case/fallthrough (cdr x)) st))
((default) ((apply c-default (cdr x)) st))
((break) (c-break st))
((continue) (c-continue st))
((return) ((apply c-return (cdr x)) st))
((goto) ((apply c-goto (cdr x)) st))
((typedef) ((apply c-typedef (cdr x)) st))
((struct union class) ((apply c-struct/aux x) st))
((enum) ((apply c-enum (cdr x)) st))
((inline auto restrict register volatile extern static)
((cat (car x) " " (apply-cat (cdr x))) st))
((extern/C) ((apply c-extern/C (cdr x)) st))
((%apply) ((apply c-apply (cdr x)) st))
((%define) ((apply cpp-define (cdr x)) st))
((%include) ((apply cpp-include (cdr x)) st))
((%fun) ((apply c-fun (cdr x)) st))
((%prototype) ((apply c-prototype (cdr x)) st))
((%var) ((apply c-var (cdr x)) st))
((%begin) ((apply c-begin (cdr x)) st))
((%attribute) ((apply c-attribute (cdr x)) st))
((%line) ((apply cpp-line (cdr x)) st))
((%pragma %error %warning)
((apply cpp-generic (substring/shared (symbol->string (car x)) 1)
(cdr x)) st))
((%if %ifdef %ifndef %elif)
((apply cpp-if/aux (substring/shared (symbol->string (car x)) 1)
(cdr x)) st))
((%endif) ((apply cpp-endif (cdr x)) st))
((%block) ((apply c-braced-block (cdr x)) st))
((%comment) ((apply c-comment (cdr x)) st))
((:) ((apply c-label (cdr x)) st))
((%cast) ((apply c-cast (cdr x)) st))
((+ - & * / % ! ~ ^ && < > <= >= == != << >>
= *= /= %= &= ^= >>= <<=) ((apply c-op x) st))
((bitwise-and bit-and) ((apply c-op '& (cdr x)) st))
((bitwise-ior bit-or) ((apply c-op "|" (cdr x)) st))
((bitwise-xor bit-xor) ((apply c-op '^ (cdr x)) st))
((bitwise-not bit-not) ((apply c-op '~ (cdr x)) st))
((arithmetic-shift) ((apply c-op '<< (cdr x)) st))
((bitwise-ior= bit-or=) ((apply c-op "|=" (cdr x)) st))
((%or) ((apply c-op "||" (cdr x)) st))
((%. %field) ((apply c-op "." (cdr x)) st))
((%->) ((apply c-op "->" (cdr x)) st))
(else
(cond
((eq? (car x) (string->symbol "."))
((apply c-op "." (cdr x)) st))
((eq? (car x) (string->symbol "->"))
((apply c-op "->" (cdr x)) st))
((eq? (car x) (string->symbol "++"))
((apply c-op "++" (cdr x)) st))
((eq? (car x) (string->symbol "--"))
((apply c-op "--" (cdr x)) st))
((eq? (car x) (string->symbol "+="))
((apply c-op "+=" (cdr x)) st))
((eq? (car x) (string->symbol "-="))
((apply c-op "-=" (cdr x)) st))
(else ((c-apply x) st))))))
(else
((c-literal x) st))))))
(define (c-apply ls)
(c-wrap-stmt
(c-with-op
'paren
(cat (c-expr (car ls))
(c-paren
(fmt-try-fit
(join c-expr (cdr ls) ", ")
(lambda (st)
(let* ((col (fmt-col st))
(sep (string-append "," (make-nl-space col))))
((join c-expr (cdr ls) sep) st)))))))))
(define (c-expr x)
(lambda (st) (((or (fmt-gen st) c-expr/sexp) x) st)))
(define (make-comment-writer st)
(define (other-char c) (if (eqv? c #\/) #\* #\/))
(let ((output (fmt-ref st 'writer)))
(lambda (str st)
(let ((lim (- (string-length str) 1)))
(let lp ((i 0) (st st))
(let ((j (string-index str
(lambda (c) (or (eqv? c #\/) (eqv? c #\*))) i)))
(if (and j (< j lim)
(eqv? (string-ref str j)
(other-char (string-ref str (+ j 1)))))
(lp (+ j 1)
(output "\\" (output (substring/shared str i (+ j 1)) st)))
(output (substring/shared str i) st))))))))
(define (c-comment . args)
(lambda (st)
((cat "/*" (fmt-let 'writer (make-comment-writer st) (apply-cat args)) "*/")
st)))
(define (make-block-comment-writer st)
(let ((output (make-comment-writer st))
(indent (string-append (make-nl-space (+ (fmt-col st) 1)) "* ")))
(lambda (str st)
(let ((lim (string-length str)))
(let lp ((i 0) (st st))
(let ((j (string-index str #\newline i)))
(if j
(lp (+ j 1)
(output indent (output (substring/shared str i j) st)))
(output (substring/shared str i) st))))))))
(define (c-block-comment . args)
(lambda (st)
(let ((col (fmt-col st))
(row (fmt-row st))
(indent (c-current-indent-string st)))
((cat "/* "
(fmt-let 'writer (make-block-comment-writer st) (apply-cat args))
(lambda (st)
(cond
((= row (fmt-row st)) ((dsp " */") st))
(else ((cat fl indent " */") st)))))
st))))
(define (make-cpp-writer st)
(let ((output (fmt-ref st 'writer)))
(lambda (str st)
(let lp ((i 0) (st st))
(let ((j (string-index str #\newline i)))
(if j
(lp (+ j 1)
(output
nl-str
(output " \\" (output (substring/shared str i j) st))))
(output (substring/shared str i) st)))))))
(define (cpp-include file)
(if (string? file)
(cat fl "#include " (wrt file) fl)
(cat 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) (if (pair? x) (dsp (cadr x)) (dsp x)))
(lambda (st)
(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)
(cat " "
(fmt-let 'writer (make-cpp-writer st)
(fmt-let 'in-macro? #t
((if (and (null? (cdr body))
(c-literal? (car body)))
(lambda (x) x)
c-paren)
(c-in-expr (apply c-begin body))))))
(lambda (x) x))))
((if (pair? x)
(cat fl "#define " (name-of (car x))
(c-paren
(join/dot name-of
(lambda (dot) (dsp "..."))
(cdr x)
", "))
tail fl)
(cat fl "#define " x tail fl))
st))))
(define (cpp-expr x)
(if (or (symbol? x) (string? x)) (dsp x) (c-expr x)))
(define (cpp-if/aux name check . o)
(let ((pass (and (pair? o) (car o)))
(fail (and (pair? o) (pair? (cdr o)) (cadr o))))
(lambda (st)
(let ((indent (c-current-indent-string st)))
((cat fl "#" name " " (cpp-expr check) fl
(if pass (cat indent pass) "")
(if fail (cat fl "#else" fl indent fail) "")
(if (or pass fail)
(cat fl
"#endif"
(if (member name '("ifdef" "ifndef"))
(cat " "
(c-comment
" " (if (equal? name "ifndef") "! " "")
check " "))
"")
fl)
""))
st)))))
(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-endif . o)
(cat fl "#endif " (if (pair? o) (c-comment (car o)) "") fl))
(define (cpp-wrap-header name . body)
(let ((name name)) (cpp-ifndef name (c-begin (cpp-define name) nl (apply c-begin body) nl))))
(define (cpp-line num . o)
(cat fl "#line " num (if (pair? o) (cat " " (car o)) "") fl))
(define (cpp-generic name . ls)
(cat fl "#" name (apply-cat 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)
(cat "#" x))
(define (cpp-sym-cat . args)
(join dsp args " ## "))
(define (c-current-indent-string st . o)
(make-space (max 0 (+ (fmt-col st) (if (pair? o) (car o) 0)))))
(define (c-indent st . o)
(dsp (make-space (max 0 (+ (fmt-col st) (or (fmt-indent-space st) 4)
(if (pair? o) (car o) 0))))))
(define (c-indent/switch st)
(dsp (make-space (+ (fmt-col st) (or (fmt-switch-indent-space st) 4)))))
(define (c-open-brace st)
(if (fmt-newline-before-brace? st)
(cat nl (c-current-indent-string st) "{" nl)
(cat " {" nl)))
(define (c-close-brace st)
(dsp "}"))
(define (c-wrap-stmt x)
(fmt-if fmt-expression?
(c-expr x)
(cat (fmt-if fmt-return? "return " "")
(c-in-expr (c-expr x)) ";" nl)))
(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)
(lambda (st)
(if (fmt-braceless-bodies? st)
((cat header fl (c-indent st offset) inner fl) st)
((c-braced-block/aux offset header inner) st))))))
(define (c-braced-block . args)
(apply c-braced-block/aux 0 args))
(define (c-braced-block/aux offset header . body)
(lambda (st)
((cat header (c-open-brace st) (c-indent st offset)
(apply c-begin body) fl
(c-current-indent-string st offset) (c-close-brace st))
st)))
(define (c-begin . args)
(apply c-begin/aux #f args))
(define (c-begin/aux ret? body0 . body)
(if (null? body)
(c-expr body0)
(lambda (st)
(if (fmt-expression? st)
((fmt-try-fit
(join c-expr (cons body0 body) ", ")
(lambda (st)
(let ((indent (c-current-indent-string st)))
((join c-expr (cons body0 body) (cat "," nl indent)) st))))
st)
(let ((orig-ret? (fmt-return? st)))
((join/last c-expr
(lambda (x) (fmt-let 'return? orig-ret? (c-expr x)))
(cons body0 body)
(cat fl (c-current-indent-string st)))
(fmt-set! st 'return? (and ret? orig-ret?))))))))
(define (c-typedef what name . o)
(c-wrap-stmt (cat "typedef " (c-type what) name (apply-cat o))))
(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
(cat
(c-braced-block
(cat type (if (and name (not (equal? name ""))) (cat " " name) ""))
(cat
(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) (cat " " (apply c-begin o)) (dsp ""))))))
(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) (cat (car x) " = " (c-expr (cadr x))) (dsp x)))
(let* ((name (if (null? o) (if (or (symbol? x) (string? x)) x #f) x))
(vals (if name (car o) x)))
(c-wrap-stmt
(cat
(c-braced-block
(if name (cat "enum " name) (dsp "enum"))
(c-in-expr (apply c-begin (map c-enum-one vals))))))))
(define (c-attribute . args)
(cat "__attribute__ ((" (join c-expr args ", ") "))"))
(define (c-while check . body)
(cat (c-block (cat "while (" (c-in-test check) ")")
(c-in-stmt (apply c-begin body)))
fl))
(define (c-for init check update . body)
(cat
(c-block
(c-in-expr
(cat "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) (cat (c-type (car x)) " " (cadr x)))
(else (cat (lambda (st) ((c-type (fmt-default-type st)) st)) " " x))))
(define (c-param-list ls)
(c-in-expr (join/dot c-param (dsp "...") ls ", ")))
(define (c-fun type name params . body)
(cat (c-block (c-in-expr (c-prototype type name params))
(fmt-let 'return? (not (eq? 'void type))
(c-in-stmt (apply c-begin body))))
fl))
(define (c-prototype type name params . o)
(c-wrap-stmt
(cat (c-type type) " " name " (" (c-param-list params) ")" (apply-cat o))))
(define (c-static x) (cat "static " (c-expr x)))
(define (c-const x) (cat "const " (c-expr x)))
(define (c-restrict x) (cat "restrict " (c-expr x)))
(define (c-volatile x) (cat "volatile " (c-expr x)))
(define (c-auto x) (cat "auto " (c-expr x)))
(define (c-inline x) (cat "inline " (c-expr x)))
(define (c-extern x) (cat "extern " (c-expr x)))
(define (c-extern/C . body)
(cat "extern \"C\" {" fl (apply c-begin body) fl "}" fl))
(define (c-var type name . init)
(c-wrap-stmt
(if (pair? init)
(cat (c-type type) " " name " = " (c-expr (car init)))
(cat (c-type type) " " name))))
(define (c-cast type expr)
(cat "(" (c-type type) ")" (c-expr expr)))
(define (c-if/stmt c p . rest)
(lambda (st)
(let ((indent (c-current-indent-string st)))
((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)
(cat (c-block/aux -1 " else" p) fl))
(let ((tail (if (pair? ls)
(if (pair? (cdr ls))
(lp (car ls) (cadr ls) (cddr ls))
(lp 'else (car ls) '()))
fl)))
(cat (c-block (cat "if (" (c-in-test (c-expr c)) ")") p)
tail))))
st))))
(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)
(cat (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)
(fmt-if fmt-expression?
(apply c-if/expr args)
(apply c-if/stmt args)))
(define (c-label name)
(lambda (st)
(let ((indent (make-space (max 0 (- (fmt-col st) 2)))))
((cat fl indent name ":" fl) st))))
(define c-break
(c-wrap-stmt (dsp "break")))
(define c-continue
(c-wrap-stmt (dsp "continue")))
(define (c-return . result)
(if (pair? result)
(c-wrap-stmt (cat "return " (c-expr (car result))))
(c-wrap-stmt (dsp "return"))))
(define (c-goto label)
(c-wrap-stmt (cat "goto " (c-expr label))))
(define (c-switch val . clauses)
(lambda (st)
((cat "switch (" (c-in-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)
st)))
(define (c-switch-clause/breaks x)
(lambda (st)
(let* ((break? (car x))
(indent (c-current-indent-string st))
(indent-body (c-indent st))
(sep (string-append ":" nl-str indent)))
((cat (c-in-expr
(join/suffix
dsp
(if (pair? (cadr x))
(map (lambda (y) (cat (dsp "case ") (c-expr y)))
(cadr x))
(list (dsp "default")))
sep))
(make-space (or (fmt-indent-space st) 4))
(join c-expr (cddr x) indent-body)
(if (and break? (not (fmt-return? st)))
(cat fl indent-body c-break)
""))
st))))
(define (c-switch-clause x)
(if (procedure? x) x (c-switch-clause/breaks (cons #t x))))
(define (c-switch-clause/no-break x)
(if (procedure? x) x (c-switch-clause/breaks (cons #f x))))
(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))))
(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 "->"))
(join c-expr ls str)
(fmt-try-fit
(lambda (st)
((join c-expr ls (if (and (fmt-non-spaced-ops? st)
(every lit-op? ls))
str
(string-append " " str " ")))
st))
(lambda (st)
((join c-expr ls (cat nl (make-space (+ 2 (fmt-col st))) str " "))
st))))))))
(define (c-unary-op op x)
(c-wrap-stmt
(cat (display-to-string op) (c-maybe-paren op x))))
(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)
(cat (c-maybe-paren 'post-increment (c-expr x)) "++"))
(define (c--/post x)
(cat (c-maybe-paren 'post-decrement (c-expr x)) "--"))
)