在 48 小時內編寫自己的 Scheme/建立 I/O 原語

在 48 小時內編寫自己的 Scheme
← 定義 Scheme 函式	建立 I/O 原語	走向標準庫 →

我們的 Scheme 現在還不能真正與外部世界通訊，所以如果能給它一些 I/O 函式就好了。此外，每次啟動直譯器時都輸入函式非常乏味，所以能載入程式碼檔案並執行它們會很好。

首先我們需要一個新的 LispVal 建構函式。 PrimitiveFunc 具有特定的型別簽名，不包含 IO 單子，因此它們不能執行任何 IO。我們希望有一個專門的建構函式用於執行 IO 的基本函式。

| IOFunc ([LispVal] -> IOThrowsError LispVal)

趁此機會，讓我們也定義一個用於 Scheme 資料型別（即埠）的建構函式。我們的大多數 IO 函式都會使用其中一個進行讀寫。

| Port Handle

一個 Handle 基本上是 Haskell 的埠概念：它是一個不透明的資料型別，由 openFile 和類似的 IO 操作返回，你可以讀寫它。

為了完整性，我們應該為新的資料型別提供 showVal 方法。

showVal (Port _)   = "<IO port>"
showVal (IOFunc _) = "<IO primitive>"

這將使 REPL 函式正常執行，而不會在你使用返回埠的函式時崩潰。

我們還需要更新 apply，使其能夠處理 IOFuncs。

apply (IOFunc func) args = func args

我們需要對解析器進行一些小的修改，以支援 load。由於 Scheme 檔案通常包含多個定義，因此我們需要新增一個解析器來支援多個表示式，這些表示式用空格隔開。它還需要處理錯誤。我們可以透過將基本 readExpr 提取出來，使其將實際解析器作為引數來重用大部分現有基礎設施。

readOrThrow :: Parser a -> String -> ThrowsError a
readOrThrow parser input = case parse parser "lisp" input of
    Left err  -> throwError $ Parser err
    Right val -> return val

readExpr = readOrThrow parseExpr
readExprList = readOrThrow (endBy parseExpr spaces)

同樣，將 readExpr 和 readExprList 視為新命名的 readOrThrow 的專門化。我們將在 REPL 中使用 readExpr 讀取單個表示式；我們將在 load 內部使用 readExprList 讀取程式。

接下來，我們需要一個新的 I/O 原語列表，其結構與現有的原語列表相同。

ioPrimitives :: [(String, [LispVal] -> IOThrowsError LispVal)]
ioPrimitives = [("apply", applyProc),
                ("open-input-file", makePort ReadMode),
                ("open-output-file", makePort WriteMode),
                ("close-input-port", closePort),
                ("close-output-port", closePort),
                ("read", readProc),
                ("write", writeProc),
                ("read-contents", readContents),
                ("read-all", readAll)]

這裡唯一的區別在於型別簽名。不幸的是，我們不能使用現有的原語列表，因為列表不能包含不同型別的元素。我們還需要更改 primitiveBindings 的定義，以新增新的原語。

primitiveBindings :: IO Env
primitiveBindings = nullEnv >>= (flip bindVars $ map (makeFunc IOFunc) ioPrimitives
                                               ++ map (makeFunc PrimitiveFunc) primitives)
     where makeFunc constructor (var, func) = (var, constructor func)

我們將 makeFunc 泛化為接受一個建構函式引數，現在除了普通的原語之外，還會在 ioPrimitives 列表上呼叫它。

現在我們開始定義實際的函式。 applyProc 是 apply 的一個非常薄的包裝器，負責將引數列表分解為 apply 預期的形式。

applyProc :: [LispVal] -> IOThrowsError LispVal
applyProc [func, List args] = apply func args
applyProc (func : args)     = apply func args

makePort 包裝了 Haskell 函式 openFile，將其轉換為正確的型別並將返回值包裝在 Port 建構函式中。它旨在部分應用於 IOMode，ReadMode 用於 open-input-file，WriteMode 用於 open-output-file。

makePort :: IOMode -> [LispVal] -> IOThrowsError LispVal
makePort mode [String filename] = liftM Port $ liftIO $ openFile filename mode

closePort 也包裝了等效的 Haskell 過程，這次是 hClose。

closePort :: [LispVal] -> IOThrowsError LispVal
closePort [Port port] = liftIO $ hClose port >> (return $ Bool True)
closePort _           = return $ Bool False

readProc（命名是為了避免與內建的 read 衝突）包裝了 Haskell hGetLine，然後將結果傳送到 parseExpr，將其轉換為適合 Scheme 的 LispVal。

readProc :: [LispVal] -> IOThrowsError LispVal
readProc []          = readProc [Port stdin]
readProc [Port port] = (liftIO $ hGetLine port) >>= liftThrows . readExpr

請注意 hGetLine port 的型別為 IO String，而 readExpr 的型別為 String -> ThrowsError LispVal，因此它們都需要轉換為 IOThrowsError 單子（分別使用 liftIO 和 liftThrows）。只有這樣，它們才能與單子繫結運算子一起使用。

writeProc 將 LispVal 轉換為字串，然後將其寫入指定的埠。

writeProc :: [LispVal] -> IOThrowsError LispVal
writeProc [obj]            = writeProc [obj, Port stdout]
writeProc [obj, Port port] = liftIO $ hPrint port obj >> (return $ Bool True)

我們不必顯式呼叫要列印的物件的 show，因為 hPrint 接受 Show a 型別的 value。它正在自動呼叫 show。這就是我們費心將 LispVal 設定為 Show 的例項的原因；否則，我們將無法使用此自動轉換，並且必須自己呼叫 showVal。許多其他 Haskell 函式也接受 Show 的例項，因此如果我們用其他 IO 原語擴充套件它，它可以為我們節省大量工作。

readContents 將整個檔案讀入記憶體中的字串。它只是 Haskell 的 readFile 的一個薄包裝器，同樣只是將 IO 操作提升為 IOThrowsError 操作並將其包裝在 String 建構函式中。

readContents :: [LispVal] -> IOThrowsError LispVal
readContents [String filename] = liftM String $ liftIO $ readFile filename

輔助函式 load 不執行 Scheme 的 load 所做的事情（我們將在後面處理它）。相反，它只負責讀取和解析一個充滿語句的檔案。它在兩個地方使用：readAll（它返回一個值列表）和 load（它將這些值作為 Scheme 表示式進行評估）。

load :: String -> IOThrowsError [LispVal]
load filename = (liftIO $ readFile filename) >>= liftThrows . readExprList

readAll 然後只是用 List 建構函式包裝返回值。

readAll :: [LispVal] -> IOThrowsError LispVal
readAll [String filename] = liftM List $ load filename

實現實際的 Scheme load 函式有點棘手，因為 load 可以將繫結引入本地環境。但是，apply 不接受環境引數，因此基本函式（或任何函式）都沒有辦法做到這一點。我們透過將 load 實現為特殊形式來解決這個問題。

eval env (List [Atom "load", String filename]) = 
     load filename >>= liftM last . mapM (eval env)

最後，我們不妨更改 runOne 函式，使其不再評估來自命令列的單個表示式，而是接受要執行的檔案的名稱並將其作為程式執行。附加的命令列引數將繫結到 Scheme 程式中的 args 列表中。

runOne :: [String] -> IO ()
runOne args = do
    env <- primitiveBindings >>= flip bindVars [("args", List $ map String $ drop 1 args)] 
    (runIOThrows $ liftM show $ eval env (List [Atom "load", String (args !! 0)])) 
        >>= hPutStrLn stderr

這有點複雜，讓我們一步一步地進行。第一行接受原始基本繫結，將其傳遞到 bindVars，然後新增一個名為 args 的變數，該變數繫結到一個包含所有引數（第一個引數除外）的 String 版本的 List。（第一個引數是要執行的檔名。）然後，它建立一個 Scheme 形式 load "arg1"，就像使用者在裡面鍵入的一樣，並對其進行評估。結果被轉換為字串（請記住，我們必須在捕獲錯誤之前這樣做，因為錯誤處理程式將它們轉換為字串，並且型別必須匹配），然後我們執行整個 IOThrowsError 操作。然後我們在 stderr 上列印結果。（傳統的 UNIX 約定認為 stdout 應該只用於程式輸出，任何錯誤訊息都應該傳送到 stderr。在這種情況下，我們還將列印程式中最後一個語句的返回值，該語句通常對任何事物都沒有意義。）

然後我們更改 main，使其使用新的 runOne 函式。由於我們不再需要第三個子句來處理錯誤數量的命令列引數，因此我們可以將其簡化為一個 if 語句。

main :: IO ()
main = do args <- getArgs
          if null args then runRepl else runOne $ args

在 48 小時內編寫自己的 Scheme
← 定義 Scheme 函式	建立 I/O 原語	走向標準庫 →