lassik
/
lisp-mangler
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Refactor

This commit is contained in:
Lassi Kortela 2022-09-25 17:16:22 +03:00
parent 2e98664072
commit e531778723
1 changed files with 42 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
translate.scm
View File

@ -5,11 +5,9 @@
(define rest cdr) (define rest cdr)
(define (string-join list delimiter) (define (string-join list delimiter)
(if (null? list) (fold (lambda (item result) (string-append result delimiter item))
"" (first list)
(fold (lambda (item result) (string-append result delimiter item)) (rest list)))
(first list)
(rest list))))
(define (capitalize str) (define (capitalize str)
(string-append (string (ascii-upcase (string-ref str 0))) (string-append (string (ascii-upcase (string-ref str 0)))
@ -44,31 +42,30 @@
(cons (string-copy str a b) words) (cons (string-copy str a b) words)
words)) words))
(let loop ((a 0) (b 0) (words '())) (let loop ((a 0) (b 0) (words '()))
(cond ((= b (string-length str)) (if (= b (string-length str))
(reverse (eject a b words))) (reverse (eject a b words))
(else (let* ((char (string-ref str b))
(let* ((char (string-ref str b)) (name* (assoc char names))
(name* (assoc char names)) (name (and name* (second name*))))
(name (and name* (second name*)))) (cond ((and (char=? #\- char)
(cond ((and (char=? #\- char) (< b (- (string-length str) 1)))
(< b (- (string-length str) 1))) (loop (+ b 1)
(loop (+ b 1) (+ b 1)
(+ b 1) (eject a b words)))
(eject a b words))) ((and (char=? #\> char)
((and (char=? #\> char) (not (null? words))
(not (null? words)) (= a b))
(= a b)) (loop (+ b 1)
(loop (+ b 1) (+ b 1)
(+ b 1) (cons "to" words)))
(cons "to" words))) (name
(name (loop (+ b 1)
(loop (+ b 1) (+ b 1)
(+ b 1) (cons name (eject a b words))))
(cons name (eject a b words)))) ((ascii-alphanumeric? char)
((ascii-alphanumeric? char) (loop a (+ b 1) words))
(loop a (+ b 1) words)) (else
(else (error "What?" char)))))))
(error "What?" char))))))))
(define (translate-camel str) (define (translate-camel str)
(string-join (map capitalize (translate-words str)) (string-join (map capitalize (translate-words str))
@ -89,19 +86,25 @@
(write-string file) (write-string file)
(newline)) (newline))
(define (write-two-column-list list1 list2)
(let ((width (fold max 0 (map string-length list1))))
(for-each (lambda (item1 item2)
(let ((pad (max 0 (- width (string-length item1)))))
(write-string item1)
(write-string (make-string (+ pad 2) #\space))
(write-string item2)
(newline)))
list1
list2)))
(define (process translate from-file to-file) (define (process translate from-file to-file)
(let* ((lines (with-input-from-file from-file read-all-lines)) (let* ((source-lines (with-input-from-file from-file read-all-lines))
(width (fold max 0 (map string-length lines)))) (target-lines (map translate source-lines)))
(writing to-file) (writing to-file)
(with-output-to-file to-file (with-output-to-file to-file
(lambda () (lambda ()
(for-each (lambda (line) (write-two-column-list source-lines
(let ((pad (max 0 (- width (string-length line))))) target-lines)))))
(write-string line)
(write-string (make-string (+ pad 2) #\space))
(write-string (translate line))
(newline)))
lines)))))
(define (main) (define (main)
(define sa string-append) (define sa string-append)