(cons '(貳 . 輸入/輸出) 《爲本身寫本-Guile-書》)

(car 《爲本身寫本-Guile-書》)

這個世界上，有不少人討厭 Lisp 語言。Guile 是 Sheme 的一種方言，然後者是 Lisp 的一種方言，所以 Guile 天然也會被這些人討厭。在他們給出的本身之因此討厭 Lisp 的衆多理由中，第一個理由是他們所閱讀的一些 Lisp 教材，讀了一半，結果連文件讀寫這麼簡單的程序都寫不出來（見 http://c2.com/cgi/wiki?WhyWeHateLisp）。爲了避免讓他們說『看！又有人寫了本 Lisp 書，即便你讀了一半，依然寫不出能夠讀寫文件的程序』，所以我不顧這本書剛剛進行到第二章這一悲催的現實，毅然的開始講述如何用 Guile 編寫文件讀寫方面一些基本的程序——真的猛士勇於直面文件的讀寫，勇於修改變量的值。希望他們不會抱怨：『有人寫了本 Lisp 書，從第二章就開始講文件讀寫，太變態了！』

端口

Guile 將串行的輸入/輸出抽象爲端口（Port）的讀寫操做。端口能夠關聯到文件、終端以及字符串，也就是說，經過操做端口，可以以統一的形式讀寫文件、終端以及字符串等串行對象。

Guile 交互解釋器之因此可以讀取你的輸入的表達式，並將求值結果在屏幕上顯示出來，全拜 current-input-port 與 current-output-port 端口所賜，這兩個端口分別關聯了系統的標準輸入與標準輸出設備（一般是那個黑乎乎的控制檯或終端界面）。這兩個端口是默認存在的，因此從 current-input-port 中讀取數據，或者向 current-output-port 寫入數據，不須要指定它們。例如：

(define c (read-char))  ;; 變量 c 的值是交互輸入的字符
(write-char c)          ;; 將 c 的值在屏幕上顯示出來

上述代碼等價於：

(define a (read-char (current-input-port)))
(write-char a (current-output-port))

current-input-port 與 current-output-port 本質上分別是能夠返回默認的輸入與輸出端口的函數。

在 C 語言中，stdin 與 stdout 分別與 Guile 的 current-input-port 與 current-output-port 所返回的端口相對應，並且也有相似於 read-char 與 write-char 這樣的函數。例如：

int c = getchar();
putchar(c);

C 語言也容許向指定的 stdin 與 stdout 進行數據的讀寫，只是讀寫數據的函數前面帶有 f 前綴，例如：

int c = fgetc(stdin);
fputc(c, stdout);

getchar，putchar，fgetc，fputc 均爲 C 標準庫提供的函數，顯然它們在命名上缺少一致性，這是先輩的罪。

字符串端口

將端口與一個字符串相關聯，而後用 read-char 與 write-char 的方式來讀寫這個字符串，是否是很方便？我以爲這比其餘語言單獨爲字符串創建一套讀寫機制要簡單幹淨一些。

open-input-string 函數能夠將一個輸入端口與字符串創建關聯。例如，在 Guile 交互解釋環境中，輸入如下『指令』：

> (define in (open-input-string "hello"))

in 即是一個輸入端口，它關聯着一個字符串 "hello world"。因爲這是一個輸入端口，因此能夠用 read-char 從中讀取字符：

> (read-char in)
#\h
> (read-char in)
#\e
> (read-char in)
#\l
> (read-char in)
#\l
> (read-char in)
#\o
> (read-char in)
#<eof>

open-output-string 能夠將輸出端口關聯到字符串：

> (define out (open-output-string))

用 write-char 向 out 寫入幾個字符：

> (write-char #\h out)
> (write-char #\e out)
> (write-char #\l out)
> (write-char #\l out)
> (write-char #\o out)

也能夠用 display 來寫：

> (display "world" out)

要想獲取 out 裏存儲的字符串信息，能夠用 get-output-string 函數：

> (get-output-string out)
"hello world"

若是決定再也不使用這些端口，可以使用 close-port 將它們關閉：

> (close-input-port in)
#t
> (close-output-port out)
#t
> (and (port-closed? in) (port-closed? out))
#t

文件端口

文件端口，就是與文件相關聯的端口。打開文件端口的函數是 open-input-file 與 open-output-file。用於操做字符串端口的那些函數，對於文件端口一樣適用。

下面的 Guile 代碼表示，打開文本文件 foo.txt，而後讀取它的前兩個字符，最後關閉文件：

(define file (open-input-file "foo.txt" #:encoding "utf-8"))
(display (read-char file))
(display (read-char file))file
(close-input-port file)

與之等效的 C 代碼以下：

FILE *file = fopen("foo.txt", "r");
printf("%c", fgetc(file));
printf("%c", fgetc(file));
fclose(file);

值得注意的是，Guile 函數 open-input-file 可以爲其讀取的文件指定編碼，而 C 標準庫函數 fopen 則沒有此功能。

當 read-char 函數讀至文件末尾時，Guile 提供了 eof-object? 函數來判斷它返回的字符是否爲文件結束符，即：

(eof-object? (read-char file))

與該謂詞等效的 C 代碼以下：

feof(fgetc(file));

與文本文件的讀取過程相對應，對於文件的寫入過程，Guile 提供了 open-output-file 以及 write-char 函數，其用法示例以下：

(define file (open-output-file "bar.txt" #:encoding "utf-8"))
(write-char #\測 file)
(write-char #\試 file)
(close-output-port file)

等效的 C 代碼以下：

FILE *file = fopen("bar.txt", "w");
fputc('c', file);
fputc('s', file);
fclose(file);

因爲 C 標準庫函數 fputc 不支持 UTF-8 編碼的字符，因此我只能用 c 與 s 來代替。

guile-wc

Linux 系統中有一個命令行工具 wc，能夠用它統計文本文件的行數、單詞數、字符數等信息。例如，對於下面這份文本文件　foo.txt：

用 C 寫用 C 寫程序，會以爲本身在擺弄一臺小馬達。
用 Guile 寫程序，則以爲本身拿了根小樹枝唆使一隻毛毛蟲。

應用下面這三條命令：

$ wc -l foo.txt
$ wc -w foo.txt
$ wc -m foo.txt

可分別獲得如下輸出結果：

2 foo.txt
8 foo.txt
69 foo.txt

根據 wc 統計的信息，能夠稱 foo.txt 的內容由 2 行文本構成——它包含 8 個單詞，共 69 個字符。我相信 wc，因此我不打算數一遍。

如今，我要作的是，用 Guile 寫一個名爲 guile-wc.scm 腳本，讓它去作上述 wc 所作的事，看看它們的結果是否一致。

;; guile-wc.scm
(define (get-file-name args)
  (cond ((null? (cdr args)) (car args))
        (else (get-file-name (cdr args)))))
(define (arg-parser args opt)
  (cond ((null? args) #f)
        ((string=? (car args) opt) #t)
        (else (arg-parser (cdr args) opt))))
(define (guile-wc args file)
  (define (lwm-count l w m)
    (let ((char (read-char file)))
      (cond ((eof-object? char) `(,l ,w ,m))
            ((char=? char #\newline) (lwm-count (+ l 1) (+ w 1) (+ m 1)))
            ((char=? char #\space) (lwm-count l (+ w 1) (+ m 1)))
            (else (lwm-count l w (+ m 1))))))
  (let ((lwm (lwm-count 0 0 0)))
    (cond ((arg-parser args "-l") (car lwm))
          ((arg-parser args "-w") (cadr lwm))
          ((arg-parser args "-m") (caddr lwm))
          (else lwm))))
(define args (command-line))
(define file (open-input-file (get-file-name args) #:encoding "utf-8"))
(display (guile-wc args file)) (newline)
(close-input-port file)

按如下次序執行 guile-wc.scm 腳本：

$ guile guile-wc.scm -l foo.txt
$ guile guile-wc.scm -w foo.txt
$ guile guile-wc.scm -m foo.txt

可分別獲得如下輸出結果：

2
8
69

這些結果與上述的 wc 的輸出結果相同。

在 guile-wc.scm 腳本中，get-file-name 與 arg-parser 函數的定義均來自上一章，而且對後者進行了大幅刪減——由於 guile-wc.scm 不須要處理帶參數值的選項。

guile-wc 函數可改寫爲如下形式：

(define (lwm-count file l w m)
  (let ((char (read-char file)))
    (cond ((eof-object? char) `(,l ,w ,m))
          ((char=? char #\newline) (lwm-count file (+ l 1) (+ w 1) (+ m 1)))
          ((char=? char #\space) (lwm-count file l (+ w 1) (+ m 1)))
          (else (lwm-count file l w (+ m 1))))))
(define (guile-wc args file)
  (let ((lwm (lwm-count file 0 0 0)))
    (cond ((arg-parser args "-l") (car lwm))
          ((arg-parser args "-w") (cadr lwm))
          ((arg-parser args "-m") (caddr lwm))
          (else lwm))))

原版的 guile-wc 函數的那種寫法只是想代表，Guile 容許函數的嵌套定義，即在一個函數的定義中定義另外一個函數。若是 lwm-count 函數只會應用於 guile-wc 函數的內部，那麼將其定義嵌入 guile-wc 函數，這種方式是合理且值得提倡的，由於它能夠直接訪問外圍環境中的變量，例如 file。

若是使用賦值運算，lwm-count 函數的參數能夠省略：

(define (guile-wc args file)
  (let ((l 0) (w 0) (m 0))
    (define (lwm-count)
      (let ((char (read-char file)))
        (cond ((eof-object? char) `(,l ,w ,m))
              ((char=? char #\newline) (begin (set! l (+ l 1))
                                              (set! w (+ w 1))
                                              (set! m (+ m 1))
                                              (lwm-count)))
              ((char=? char #\space) (begin (set! w (+ w 1))
                                            (set! m (+ m 1))
                                            (lwm-count)))
              (else (begin (set! m (+ m 1)) (lwm-count))))))
    (let ((lwm (lwm-count)))
      (cond ((arg-parser args "-l") (car lwm))
            ((arg-parser args "-w") (cadr lwm))
            ((arg-parser args "-m") (caddr lwm))
            (else lwm)))))

其中，像 (set! w (+ w 1)) 這樣的表達式，相似於 C 語言中的 w = w + 1。

反引號與逗號

須要注意，lwm-count 函數的返回結果是一個列表，即：

((eof-object? char) `(,l ,w ,m))

這個表達式中，引號以及逗號，不用不行。若是不用反引號，Guile 解釋器，會認爲 (,l ,w ,m) 是在應用一個名爲 ,l 的函數，它的參數爲 ,w 與 ,m。

引號是個語法糖，它其實是 quasiquote 函數。例如：

`(,l ,w ,m)

實質上是 (quasiquote (,l ,w ,m))。

若是不用逗號，那麼 Guile 解釋器會認爲 (quasiquote (l w m)) 中的 l，w 以及 m 都是符號。例如：

> (symbol? `(l w m))
#f
> (symbol? (car `(l w m)))
#t

所謂符號，可簡單的將其理解爲 Guile 的變量名與函數名。

Guile 的變量，本質上是將一個符號綁定到一個值：

(define 符號 值)

Guile 的函數，本質上是將一個符號綁定到一個匿名的計算過程：

(define 函數
  (lambda (形參) <計算過程>))

(quasiquote (,l ,w ,m)) 中的逗號，是迫使 Guile 將列表中的符號 l，w 以及 m 做爲表達式進行求值。

逗號也是一個語法糖，它其實是 unquote 函數。,w 其實是 (unquote w)。

Guile 中還有一個引號，一般狀況下能夠用它引用符號或列表，可是當列表中某些元素須要 unquote 時，須要用反引號。換句話說，引號的威力太大，它能夠將列表中的一切東西拍扁爲符號，例如 '(,l ,w ,m)，列表 (,l ,w ,m) 會被它拍的原型畢露：

((unquote l) (unquote w) (unquote m))

而反引號容許列表中的某些符號從引號中逃逸出來。

挑戰

假設有一種被稱爲 zero 文檔的文本格式，其擴展名爲 .zero。例以下面這份 hello-world.zero 文檔：

\starttext
下面咱們用 C 語言寫一個 Hello World 程序：

@ hello.c 文件 #
#include <stdioi.h>

int main(void) {
        # 在屏幕上打印 "Hello world!" 字符串 @;
        return 0;
}
@

可以使用 C 標準庫提供的 \type{printf} 函數在終端屏幕上顯示文本，即：

@ 在屏幕上打印 "Hello world!" 字符串 #
print("Hello World!\n");
@

編譯這個程序的命令爲：

\starttyping
$ gcc hello.c -o hello
\stoptyping
\stoptext

如今，問題來了。我想對這種格式的文檔進行區域劃分，劃分規則是，不管是 @ ... # 格式的文本仍是 @ 符號獨佔一行的文本，劃分位置均在 @ 符號以前。上面的示例文檔，按照這種劃分規則，可將其劃分爲四個區域（間隔線僅做示意用）：

\starttext
下面咱們用 C 語言寫一個 Hello World 程序：

----------------------------------------------------------------
@ hello.c 文件 #
#include <stdioi.h>

int main(void) {
        # 在屏幕上打印 "Hello world!" 字符串 @;
        return 0;
}
----------------------------------------------------------------
@

可以使用 C 標準庫提供的 \type{printf} 函數在終端屏幕上顯示文本，即：

@ 在屏幕上打印 "Hello world!" 字符串 #
print("Hello World!\n");
-----------------------------------------------------------------
@

編譯這個程序的命令爲：

\starttyping
$ gcc hello.c -o hello
\stoptyping
\stoptext

下面的代碼可做爲參考答案，是我做爲 Guile 的初學者，用了一個下午的時間寫出來的。

(define (zero-doc-split file blocks cache)
  (define (error-exit)
    (begin (display "Error: ") (display (get-output-string cache)) (newline) (exit)))
  (define (all-chars-before-@-are-spaces? text)
    (cond ((null? text) #t)
          (else (let ((first (car text)))
                  (cond ((char=? first #\newline) #t)
                        ((char=? first #\space)
                         (all-chars-before-@-are-spaces? (cdr text)))
                        (else #f))))))
  (define (@-alone?)
    (cond ((not (all-chars-before-@-are-spaces?
                 (reverse (string->list (get-output-string (car blocks)))))) #f)
          (else (let ((next-char (read-char file)))
                  (cond ((eof-object? next-char) #f)
                        (else
                         (begin
                           (write-char next-char cache)
                           (cond ((char=? next-char #\newline) #t)
                                 ((char=? next-char #\space) (@-alone?))
                                 (else #f)))))))))
  (define (@-lead-lines?)
    (define (all-chars-after-#-are-spaces?)
      (let ((next-char (read-char file)))
        (begin (write-char next-char cache)
               (cond ((eof-object? next-char) #f)
                     ((char=? next-char #\newline) #t)
                     ((char=? next-char #\space) (all-chars-after-#-are-spaces?))
                     (else #f)))))
    (cond ((not (all-chars-before-@-are-spaces?
                 (reverse (string->list (get-output-string (car blocks)))))) #f)
          (else (let ((next-char (read-char file)))
                  (cond ((eof-object? next-char) #f)
                        (else (begin
                                (write-char next-char cache)
                                (cond ((char=? next-char #\@) (error-exit))
                                      ((char=? next-char #\#)
                                       (cond ((all-chars-after-#-are-spaces?) #t)
                                             (else (error-exit))))
                                      (else (@-lead-lines?))))))))))
  (let ((char (read-char file)))
    (cond ((eof-object? char) blocks)
          ((char=? char #\@)
           (begin (write-char char cache)
                  (cond ((or (@-alone?) (@-lead-lines?))
                         (begin
                           (set! blocks (cons cache blocks))
                           (set! cache (open-output-string))
                           (zero-doc-split file blocks cache)))
                        (else (begin
                                (display (get-output-string cache) (car blocks))
                                (close-output-port cache)
                                (set! cache (open-output-string))
                                (zero-doc-split file blocks cache))))))
          (else (begin
                  (write-char char (car blocks))
                  (zero-doc-split file blocks cache))))))
(define (display-zero-blocks blocks)
  (cond ((null? blocks) #nil)
        (else (begin 
                (display (get-output-string (car blocks)))
                (cond ((null? (cdr blocks)) (newline))
                      (else  (display "----")
                             (newline)))
                (display-zero-blocks (cdr blocks))))))
(setlocale LC_ALL "")
(define (get-file-name args)
  (cond ((null? (cdr args)) (car args))
        (else (get-file-name (cdr args)))))
(define file (open-input-file (get-file-name (command-line)) #:encoding "utf-8"))
(define blocks (cons (open-output-string) #nil))
(define cache (open-output-string))
(display-zero-blocks (reverse (zero-doc-split file blocks cache)))
(close-input-port file)

在 zero-doc-split 函數的實現中，使用了兩個個此前未涉及到的函數，string->list，reverse，這裏給出它們的用法示例：

> (string->list "hello world!")
(#\h #\e #\l #\l #\o #\space #\w #\o #\r #\l #\d #\!)
> (reverse (string->list "hello world!"))
(#\! #\d #\l #\r #\o #\w #\space #\o #\l #\l #\e #\h)

利用這兩章所學的知識，本身動手實現這兩函數也不難，例如：

(define (my-reverse list)
    (define (my-reverse-iter list new-list)
      (cond ((null? list) new-list)
            (else (my-reverse-iter (cdr list) (cons (car list) new-list)))))
    (my-reverse-iter list #nil))
(define (string-to-list s)
  (let ((port (open-input-string s)))
    (define (string-to-list-iter list)
      (let ((char (read-char port)))
        (cond ((eof-object? char) (begin
                                    (close-input-port port)
                                    (my-reverse list)))
              (else (string-to-list-iter (cons char list))))))
    (string-to-list-iter #nil)))

(string-to-list "hello world!")
(my-reverse (string-to-list "hello world!"))

在 zero-doc-split 函數的實現中，還用到了函數 setlocale。對於中文用戶而言，若是想讓 Guile 程序在終端中顯示中文字符，須要：

(setlocale LC_ALL "")

這樣作的用意是，對系統 Locale 不做任何假設，這樣 Guile 程序的 Locale 就會因系統中的 Locale 環境變量的值而異。

(cdr 《爲本身寫本-Guile-書》)