source: project/release/3/soundex/trunk/fuzzy-lib.scm @ 11871

Last change on this file since 11871 was 11871, checked in by kburton, 12 years ago

first attempt at egg configuration

File size: 2.1 KB
Line 
1(use regex-literals)
2(use regex)
3(use utils)
4(use extras)
5(use srfi-13) ;; string utils
6
7(define *dupes-regex* #/(.)\1+/)
8
9(define (remove-duplicate-chars str)
10  (string-substitute *dupes-regex* "\\1" str #t))
11
12(define (file.head file #!optional (nlines 5))
13  (read-lines (open-input-file file)
14              nlines))
15
16(define (buff->lines buff)
17  (string-split buff "\n"))
18
19(define (file->lines file)
20  (buff->lines (read-all file)))
21
22(define-macro (incf place #!optional (nn 1))
23  `(set! ,place (+ ,place ,nn)))
24
25;; (macroexpand '(incf x))
26
27(define (expand-tilde-file fname)
28  (cond
29   ((string=? "~" fname)
30    (getenv "HOME"))
31   ((< (string-length fname) 2)
32    fname)
33   ((string=? "~/" (substring fname 0 2))
34    (string-append (getenv "HOME")
35                   (substring fname 1)))
36   (else
37    fname)))
38
39(define (tab-line->fields line)
40  (string-split line "\t"))
41
42(define (lpad str nn #!optional (pfx " "))
43  (cond ((< (string-length str)
44            nn)
45         (lpad (string-append pfx str)
46               nn
47               pfx))
48        (else
49         str)))
50
51(define (for-each-line file unary-proc)
52  (let ((handle (open-input-file file)))
53    (let loop ((line (read-line handle)))
54      (cond ((eof-object? line)
55             #t)
56            (else
57             (unary-proc line)
58             (loop (read-line handle)))))))
59
60
61(define (encode-file file encoder #!optional (outfile "/dev/stdout"))
62  (let ((output-port (open-output-file (expand-tilde-file outfile))))
63    (for-each-line
64     (expand-tilde-file file)
65     (lambda (line)
66       (let ((encoding (encoder line)))
67         (fprintf output-port "~a\t~a\n" encoding line))))
68    ;; ok, how do you close a port?
69    ))
70
71(define (safe-substring string start #!optional end)
72  (if (not end)
73      (set! end (string-length string)))
74  (if (>= end (string-length string))
75      (set! end (string-length string)))
76  (cond
77   ((> start (string-length string))
78    "")
79   ((> (string-length string) 0)
80    (substring string start end))
81   (else
82    string)))
83
84(define-macro (aprog1 thing . body)
85  `(let ((it ,thing))
86     ,@body
87     it))
Note: See TracBrowser for help on using the repository browser.