git @ Cat's Eye Technologies The-Dipple / 65015d9
Much sketching must occur, apparently. Chris Pressey 10 years ago
1 changed file(s) with 41 addition(s) and 2 deletion(s). Raw diff Collapse all Expand all
+41
-2
scheme/read-file.scm less more
0 ; Much sketching must occur.
1
02 (define read-chars
13 (lambda (port acc)
24 (let* ((c (read-char port)))
1416 (or (equal? char #\space)
1517 (equal? char #\newline)
1618 (equal? char #\tab))))
19
20 (define newline?
21 (lambda (char)
22 (equal? char #\newline)))
23
24 (define consume-one
25 (lambda (pred chars)
26 (if (null? chars) chars)
27 (if (pred (car chars) (cdr chars))
28 chars)))
1729
1830 (define extract-whitespace
1931 (lambda (chars acc)
3345 (list (reverse acc) chars)
3446 (extract-word rest (cons char acc)))))))
3547
48 ; ----- untagged lists -----
49
50 ; (#\a #\b ...) -- a list of chars representing a text (or portion thereof)
51
52 ; ----- tagged-list style ----- ;
53
54 ; (lines ...) -- a list of strings, where each string is a line
55 ; (words ...) -- a list of strings, where each string is a word
56
3657 (define extract-words
3758 (lambda (chars acc)
38 (if (null? chars) (reverse acc)
59 (if (null? chars) (cons 'words (reverse acc))
3960 (let* ((result (extract-word chars '()))
4061 (word (list->string (car result)))
4162 (rest (cadr result))
4263 (result2 (extract-whitespace rest '()))
4364 (word2 (list->string (car result2)))
4465 (rest2 (cadr result2)))
45 (extract-words rest2 (cons word acc))))))
66 (extract-words rest2 (cons word2 (cons word acc)))))))
67
68 (define extract-line
69 (lambda (chars acc)
70 (if (null? chars) (list (reverse acc) chars)
71 (let* ((char (car chars))
72 (rest (cdr chars)))
73 (if (newline? char)
74 (list (reverse acc) rest)
75 (extract-line rest (cons char acc)))))))
76
77 (define extract-lines
78 (lambda (chars acc)
79 (if (null? chars) (cons 'lines (reverse acc))
80 (let* ((result (extract-line chars '()))
81 (line (list->string (car result)))
82 (rest (cadr result)))
83 (extract-lines rest (cons line acc))))))
84