Skip to content

Instantly share code, notes, and snippets.

Created February 5, 2010 17:51
Show Gist options
  • Save anonymous/296028 to your computer and use it in GitHub Desktop.
Save anonymous/296028 to your computer and use it in GitHub Desktop.
(define (file-lines file)
(call-with-input-file file
(lambda (port)
(let loop ([line (read-line port)]
[l '()])
(if (eof-object? line) l
(cons line (loop (read-line port) l)))))))
(define (as-string lines)
(apply string-append
(map (lambda (str) (string-append str (string #\newline)))
lines)))
(define (in-comment? char next-char comment)
(cond ((eqv? comment 'simple)
(if (eqv? #\newline char) #f comment))
((eqv? comment 'multiline)
(if (and (eqv? #\* char)
(eqv? #\/ next-char)) #f 'multiline))
((not comment)
(cond ((and (eqv? #\/ char)
(eqv? #\/ next-char)) 'simple)
((and (eqv? #\/ char)
(eqv? #\* next-char)) 'multiline)
(else #f)))))
(define (upcase-comments file)
(let* ([str (as-string (file-lines file))]
[max (string-length str)]
[pick-char (lambda (idx)
(if (< idx max)
(string-ref str idx) #f))])
(let loop ([idx 0]
[comment #f])
(let ([char (pick-char idx)]
[next-char (pick-char (+ idx 1))])
(when char
(if (in-comment? char next-char comment)
(display (string-upcase (string char)))
(display (string char)))
(loop (+ idx 1) (in-comment? char next-char comment)))))))
(define file "/home/daltojr/scheme/compiladores-principios-praticas/test-files/test.c")
(upcase-comments file)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment