rendered paste bodydiff --git a/fmt/private/fmt-c.scm b/fmt/private/fmt-c.scmindex f686406..8c1d51f 100644--- a/fmt/private/fmt-c.scm+++ b/fmt/private/fmt-c.scm@@ -88,15 +88,20 @@ (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) "'")))))+ (string-append "'" (c-escape-char c #\') "'"))++(define (c-escape-char c quote-char)+ (let ((n (char->integer c)))+ (if (<= 32 n 127)+ (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))@@ -108,6 +113,27 @@ st)) (dsp (number->string x)))) +(define (c-format-string x)+ (lambda (st)+ ((cat #\" (apply-cat (c-string-escaped x)) #\") st)))++(define (c-string-escaped x)+ (let loop ((parts '()) (idx (string-length x)))+ (cond ((string-index-right x c-needs-string-escape? 0 idx)+ => (lambda (special-idx)+ (loop (cons (c-escape-char (string-ref x special-idx) #\")+ (cons (substring/shared x (+ special-idx 1) idx)+ parts))+ special-idx)))+ (else+ (cons (substring/shared x 0 idx) parts)))))++(define (c-needs-string-escape? c)+ (let ((n (char->integer c)))+ (if (<= 32 n 127)+ (memv c '(#\" #\\))+ #t)))+ (define (c-simple-literal x) (c-wrap-stmt (cond ((char? x) (dsp (char->c-char x)))@@ -115,6 +141,7 @@ ((number? x) (c-format-number x)) ((null? x) (dsp "NULL")) ((eof-object? x) (dsp "EOF"))+ ((string? x) (c-format-string x)) (else (dsp (write-to-string x)))))) (define (c-literal x)diff --git a/fmt/private/test-fmt-c.scm b/fmt/private/test-fmt-c.scmindex 88247f4..de67eee 100644--- a/fmt/private/test-fmt-c.scm+++ b/fmt/private/test-fmt-c.scm@@ -363,5 +363,8 @@ extern int foo (); (test "typedef double (*f)(double *, double, int);\n" (fmt #f (c-typedef '(%fun double ((* double) double int)) 'f))) +(test "\"foo\\tbar\";\n"+ (fmt #f (c-expr "foo\tbar")))+ (test-end)