Name: Anonymous 2011-11-09 9:25
I'm trying to do perl-style string formating:
(let ([a 1] [b 2])
(say "a=$a, b=$b"))
Here is what I wrote so far:
(module snv mzscheme
(require (lib "defmacro.ss"))
(require (lib "list.ss"))
(require (lib "string.ss"))
(require-for-syntax (lib "string.ss"))
(require (only (lib "../srfi/13.ss")
string-null?))
(require snv-hlp)
(require-for-syntax snv-hlp)
(provide (all-from snv-hlp))
(provide (all-from (lib "string.ss")))
(provide-define-macro (fmt xs)
(let ([r '()]
[s 0]
[l (string-length xs)])
(times i l
(let ([x (string-ref xs i)])
(when (char=? x #\$)
(when (> (- i s) 0) (push (substring xs s i) r))
(push #\$ r)
(set! s (+ 1 i)))))
(push (substring xs s l) r)
(set! r (reverse! r))
(letrec
((fold-fmt
(lambda (xs)
(if (null? xs)
null
(let ([x (car xs)])
(set! xs (cdr xs))
(cons
(cond [(eq? x #\$)
(when (null? xs)
(error "missing argument to $"))
(set! x (car xs))
(set! xs (cdr xs))
(cond [(eq? x #\$) "$"]
[else
(let ([l (string-length x)])
(if (or (< l 3) (not (char=? (string-ref x 0) #\{)))
(let* ([s (read-from-string x)]
[sl (string-length (symbol->string s))])
(set! x (substring x sl l))
(if (not (string=? x "")) (push x xs))
`(expr->string ,s))
(read-from-string (substring x 1 (- l 1)))))])]
[else x])
(fold-fmt xs)))))))
`(string-append ,@(fold-fmt r)))
))
(provide-define-macro (say x)
`(printf "~a~n" (fmt ,x)))
) ;; module snv
(let ([a 1] [b 2])
(say "a=$a, b=$b"))
Here is what I wrote so far:
(module snv mzscheme
(require (lib "defmacro.ss"))
(require (lib "list.ss"))
(require (lib "string.ss"))
(require-for-syntax (lib "string.ss"))
(require (only (lib "../srfi/13.ss")
string-null?))
(require snv-hlp)
(require-for-syntax snv-hlp)
(provide (all-from snv-hlp))
(provide (all-from (lib "string.ss")))
(provide-define-macro (fmt xs)
(let ([r '()]
[s 0]
[l (string-length xs)])
(times i l
(let ([x (string-ref xs i)])
(when (char=? x #\$)
(when (> (- i s) 0) (push (substring xs s i) r))
(push #\$ r)
(set! s (+ 1 i)))))
(push (substring xs s l) r)
(set! r (reverse! r))
(letrec
((fold-fmt
(lambda (xs)
(if (null? xs)
null
(let ([x (car xs)])
(set! xs (cdr xs))
(cons
(cond [(eq? x #\$)
(when (null? xs)
(error "missing argument to $"))
(set! x (car xs))
(set! xs (cdr xs))
(cond [(eq? x #\$) "$"]
[else
(let ([l (string-length x)])
(if (or (< l 3) (not (char=? (string-ref x 0) #\{)))
(let* ([s (read-from-string x)]
[sl (string-length (symbol->string s))])
(set! x (substring x sl l))
(if (not (string=? x "")) (push x xs))
`(expr->string ,s))
(read-from-string (substring x 1 (- l 1)))))])]
[else x])
(fold-fmt xs)))))))
`(string-append ,@(fold-fmt r)))
))
(provide-define-macro (say x)
`(printf "~a~n" (fmt ,x)))
) ;; module snv