在 48 小時內編寫自己的 Scheme/錯誤檢查和異常

目前，程式碼中有很多地方我們要麼忽略錯誤，要麼靜默地分配像 #f 或 0 這樣的“預設”值，這些值毫無意義。一些語言——比如 Perl 和 PHP——很好地處理了這種方法。然而，這通常意味著錯誤會靜默地傳遞到整個程式，直到它們變成大問題，這會導致程式設計師很不方便的除錯過程。我們希望在錯誤發生時立即發出訊號，並立即退出執行。

首先，我們需要匯入 Control.Monad.Except 來訪問 Haskell 內建的錯誤函式

import Control.Monad.Except

在基於 Debian 的系統上，這需要安裝 libghc6-mtl-dev。

然後，我們應該定義一個數據型別來表示錯誤

data LispError = NumArgs Integer [LispVal]
               | TypeMismatch String LispVal
               | Parser ParseError
               | BadSpecialForm String LispVal
               | NotFunction String String
               | UnboundVar String String
               | Default String

這比我們目前需要的建構函式多一些，但我們不妨預測一下直譯器中可能出現的其他錯誤。接下來，我們定義如何打印出各種型別的錯誤，並使 LispError 成為 Show 的例項

showError :: LispError -> String
showError (UnboundVar message varname)  = message ++ ": " ++ varname
showError (BadSpecialForm message form) = message ++ ": " ++ show form
showError (NotFunction message func)    = message ++ ": " ++ show func
showError (NumArgs expected found)      = "Expected " ++ show expected 
                                       ++ " args; found values " ++ unwordsList found
showError (TypeMismatch expected found) = "Invalid type: expected " ++ expected
                                       ++ ", found " ++ show found
showError (Parser parseErr)             = "Parse error at " ++ show parseErr

instance Show LispError where show = showError

然後我們定義一個型別來表示可能丟擲 LispError 或返回值的函式。請記住，parse 如何使用 Either 資料型別來表示異常？我們在這裡採用相同的方法

type ThrowsError = Either LispError

型別建構函式就像函式一樣是柯里化的，也可以部分應用。完整的型別將是 Either LispError Integer 或 Either LispError LispVal，但我們想說 ThrowsError LispVal 等等。我們只將 Either 部分應用於 LispError，建立了一個型別建構函式 ThrowsError，我們可以在任何資料型別上使用它。

Either 是單子的另一個例項。在這種情況下，在 Either 操作之間傳遞的“額外資訊”是是否發生了錯誤。Bind 在 Either 操作持有正常值時應用其函式，或者在沒有計算的情況下直接傳遞錯誤。這就是其他語言中異常的工作方式，但由於 Haskell 是惰性求值的，因此不需要單獨的控制流結構。如果 bind 確定一個值已經是錯誤，那麼函式將永遠不會被呼叫。

Control.Monad.Except 庫會自動為 Either 單子提供除標準單子函式之外的另外兩個函式

1. throwError，它接受一個 Error 值並將其提升到 Either 的 Left（錯誤）建構函式中
2. catchError，它接受一個 Either 操作和一個將錯誤轉換為另一個 Either 操作的函式。如果操作表示錯誤，它將應用該函式，您可以使用它來，例如，透過 return 將錯誤值轉換為正常值或將其重新丟擲為不同的錯誤。

在我們的程式中，我們將把所有錯誤轉換為它們的字串表示形式，並將其作為正常值返回。讓我們建立一個輔助函式來為我們做到這一點

trapError action = catchError action (return . show)

呼叫 trapError 的結果是另一個 Either 操作，它將始終具有有效（Right）資料。我們仍然需要從 Either 單子中提取這些資料，以便可以將其傳遞到其他函式

extractValue :: ThrowsError a -> a
extractValue (Right val) = val

我們故意將 extractValue 對於 Left 建構函式保留為未定義，因為這代表程式設計師錯誤。我們打算僅在 catchError 之後使用 extractValue，因此快速失敗比將錯誤值注入程式的其他部分更好。

現在我們擁有了所有基本的基礎設施，是時候開始使用我們的錯誤處理函數了。還記得我們的解析器以前如何在發生錯誤時只返回一個字串“無匹配”嗎？讓我們更改它，使其包裝並丟擲原始的 ParseError

readExpr :: String -> ThrowsError LispVal
readExpr input = case parse parseExpr "lisp" input of
     Left err -> throwError $ Parser err
     Right val -> return val

在這裡，我們首先使用 LispError 建構函式 Parser 包裝原始 ParseError，然後使用內建函式 throwError 在我們的 ThrowsError 單子中返回它。由於 readExpr 現在返回一個單子值，我們還需要在另一個案例中包裝一個 return 函式。

接下來，我們將 eval 的型別簽名更改為返回一個單子值，相應地調整返回值，並新增一個子句，如果我們遇到不識別的模式，則丟擲錯誤

eval :: LispVal -> ThrowsError LispVal
eval val@(String _) = return val
eval val@(Number _) = return val
eval val@(Bool _) = return val
eval (List [Atom "quote", val]) = return val
eval (List (Atom func : args)) = mapM eval args >>= apply func
eval badForm = throwError $ BadSpecialForm "Unrecognized special form" badForm

由於函式應用子句遞迴呼叫 eval（它現在返回一個單子值），我們需要更改該子句。首先，我們必須將 map 更改為 mapM，它將一個單子函式對映到一個值的列表，使用 bind 將生成的動作按順序排列在一起，然後返回一個包含內部結果的列表。在 Error 單子中，這種排序會順序執行所有計算，但如果其中任何一個失敗，則會丟擲一個錯誤值——在成功時提供 Right [results]，在失敗時提供 Left error。然後，我們使用單子“bind”操作將結果傳遞到部分應用的“apply func”，如果任一操作失敗，同樣也會返回一個錯誤。

接下來，我們更改 apply 本身，使其在不識別函式時丟擲錯誤

apply :: String -> [LispVal] -> ThrowsError LispVal
apply func args = maybe (throwError $ NotFunction "Unrecognized primitive function args" func)
                        ($ args)
                        (lookup func primitives)

我們沒有為函式應用 ($ args) 新增 return 語句。我們即將更改原語的型別，以便從查詢中返回的函式返回 ThrowsError 操作

primitives :: [(String, [LispVal] -> ThrowsError LispVal)]

當然，我們需要更改實現這些原語的 numericBinop 函式，使其在只有一個引數時丟擲錯誤

numericBinop :: (Integer -> Integer -> Integer) -> [LispVal] -> ThrowsError LispVal
numericBinop op           []  = throwError $ NumArgs 2 []
numericBinop op singleVal@[_] = throwError $ NumArgs 2 singleVal
numericBinop op params        = mapM unpackNum params >>= return . Number . foldl1 op

我們使用 at-pattern 來捕獲單值情況，因為我們希望將傳遞的實際值包括在內以進行錯誤報告。在這裡，我們正在尋找一個只有一個元素的列表，我們不關心該元素是什麼。我們還需要使用 mapM 對 unpackNum 的結果進行排序，因為對 unpackNum 的每次單獨呼叫都可能因 TypeMismatch 而失敗

unpackNum :: LispVal -> ThrowsError Integer
unpackNum (Number n) = return n
unpackNum (String n) = let parsed = reads n in 
                           if null parsed 
                             then throwError $ TypeMismatch "number" $ String n
                             else return $ fst $ parsed !! 0
unpackNum (List [n]) = unpackNum n
unpackNum notNum     = throwError $ TypeMismatch "number" notNum

最後，我們需要更改我們的主函式以使用整個大型錯誤單子。這可能會變得有點複雜，因為現在我們正在處理兩個單子（Either（用於錯誤）和 IO）。因此，我們回到 do-notation，因為當一個單子的結果巢狀在另一個單子中時，幾乎不可能使用無點風格

main :: IO ()
main = do
     args <- getArgs
     evaled <- return $ liftM show $ readExpr (args !! 0) >>= eval
     putStrLn $ extractValue $ trapError evaled

以下是這個新函式的功能

1. args 是命令列引數的列表。
2. evaled 是以下結果的組合：
   1. 獲取第一個引數（args !! 0）；
   2. 解析它（readExpr）；
   3. 將其傳遞給 eval（>>= eval；bind 操作的優先順序高於 $）；
   4. 在 Error 單子中呼叫 show。（還要注意，整個操作的型別為 IO (Either LispError String)，使 evaled 的型別為 Either LispError String。它必須是，因為我們的 trapError 函式只能將錯誤轉換為 String，並且該型別必須與正常值的型別匹配。）
3. Caught 是以下結果的組合：
   1. 對 evaled 呼叫 trapError，將錯誤轉換為它們的字串表示形式；
   2. 呼叫 extractValue 從此 Either LispError String 操作中獲取 String；
   3. 透過 putStrLn 列印結果。

編譯並執行新的程式碼，並嘗試丟擲一些錯誤

$ ghc -package parsec -o errorcheck [../code/listing5.hs listing5.hs]
$ ./errorcheck "(+ 2 \"two\")"
Invalid type: expected number, found "two"
$ ./errorcheck "(+ 2)"
Expected 2 args; found values 2
$ ./errorcheck "(what? 2)"
Unrecognized primitive function args: "what?"

一些讀者報告說，您需要新增一個 --make 標誌來構建此示例，以及所有後續清單。這會告訴 GHC 構建一個完整的可執行檔案，搜尋匯入語句中列出的所有依賴項。上面的命令在我的系統上有效，但如果它在您的系統上失敗，請嘗試使用 --make。