- 916 名前：デフォルトの名無しさん mailto:sage [2009/07/22(水) 19:29:01 ]
- ;remove comment
(define (remcom l)
(define (test str lst)
(if (< (length lst) (string-length str)) #f
(let* ((a (string->list str))
(l (take lst (length a))))
(every eq? a l))))
(define (outcomment l res)
(cond ((null? l) res)
((test "/*" l) (incomment (cddr l) res))
((test "//" l) (inlinecomment (cddr l) res))
((eq? #\' (car l)) (inquote #\' (cdr l) (cons #\' res)))
((eq? #\" (car l)) (inquote #\" (cdr l) (cons #\" res)))
(else (outcomment (cdr l) (cons (car l) res)))))
(define (incomment l res)
(cond ((null? l) res)
((test "*/" l) (outcomment (cddr l) res))
(else (incomment (cdr l) res))))
(define (inquote sep l res)
(cond ((null? l) res)
((eq? sep (car l)) (outcomment (cdr l) (cons sep res)))
(else (inquote sep (cdr l) (cons (car l) res)))))
(define (inlinecomment l res)
(cond ((null? l) res)
((eq? #\newline (car l)) (outcomment (cdr l) res))
(else (inlinecomment (cdr l) res))))
(list->string (reverse (outcomment (string->list l) '()))))
|
 |
