Created
February 5, 2010 17:51
-
-
Save anonymous/296028 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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