# 开始求值

``````showVal :: LispVal -> String
showVal (String contents) = "\"" ++ contents ++ "\""
showVal (Atom name) = name
showVal (Number contents) = show contents
showVal (Bool True) = "#t"
showVal (Bool False) = "#f"
``````

List和DottedList类似，但是我们需要定义一个辅助函数unwordsList来将列表转换成一个字符串：

``````showVal (List contents) = "(" ++ unwordsList contents ++ ")"
showVal (DottedList head tail) = "(" ++ unwordsList head ++ " . " ++ showVal tail ++ ")"
``````

unwordsList函数与Prelude库中的unwords函数类似，它把列表中的的单词用空格粘在一起。因为我们要处理的是LispVal而不是单词组成的列表，我们需要定义一个函数将LispVal转换成为对应的字符串形式然后再对它们使用unwords函数：

``````unwordsList :: [LispVal] -> String
unwordsList = unwords . map showVal
``````

``````instance Show LispVal where show = showVal
``````

``````readExpr input = case parse parseExpr "lisp" input of
Left err -> "No match: " ++ show err
Right val -> "Found " ++ show val
``````

``````\$ ghc -package parsec -o parser listing4.1.hs
\$ ./parser "(1 2 2)"
Found (1 2 2)
\$ ./parser "'(1 3 (\"this\" \"one\"))"
Found (quote (1 3 ("this" "one")))
``````

# 开始求值：初版

``````eval :: LispVal -> LispVal
eval val@(String _) = val
eval val@(Number _) = val
eval val@(Bool _) = val
eval (List [Atom "quote", val]) = val
``````

``````readExpr :: String -> LispVal
readExpr input = case parse parseExpr "lisp" input of
Left err -> String \$ "No match: " ++ show err
Right val -> val
``````

``````main :: IO ()
main = getArgs >>= print . eval . readExpr . head
``````

1. 取出第一个元素（head）
2. 进行解析（readExpr）
3. 求值（eval）
4. 转换结果成字符串并打印出来。

``````\$ ghc -package parsec -o eval listing4.2.hs
\$ ./eval "'atom"
atom
\$ ./eval 2
2
\$ ./eval "\"a string\""
"a string"
\$ ./eval "(+ 2 2)"
Fail: listing6.hs:83: Non-exhaustive patterns in function eval
``````

# 添加基本操作

``````eval (List (Atom func : args)) = apply func \$ map eval args
``````

``````apply :: String -> [LispVal] -> LispVal
apply func args = maybe (Bool False) (\$ args) \$ lookup func primitives
``````

``````primitives :: [(String, [LispVal] -> LispVal)]
primitives = [("+", numericBinop (+)),
("-", numericBinop (-)),
("*", numericBinop (*)),
("/", numericBinop div),
("mod", numericBinop mod),
("quotient", numericBinop quot),
("remainder", numericBinop rem)]
``````

``````numericBinop :: (Integer -> Integer -> Integer) -> [LispVal] -> LispVal
numericBinop op params = Number \$ foldl1 op \$ map unpackNum params

unpackNum :: LispVal -> Integer
unpackNum (Number n) = n
unpackNum (String n) = let parsed = reads n :: [(Integer, String)] in
if null parsed
then 0
else fst \$ parsed !! 0
unpackNum (List [n]) = unpackNum n
unpackNum _ = 0
``````

``````\$ ghc -package parsec -o eval listing7.hs
\$ ./eval "(+ 2 2)"
4
\$ ./eval "(+ 2 (-4 1))"
2
\$ ./eval "(+ 2 (- 4 1))"
5
\$ ./eval "(- (+ 4 6 3) 3 5 2)"
3
``````

# 习题

1. 添加对R5RS中的类型测试数的原生支持 :symbol?，string?和number?等。
2. 修改unpackNum函数让它当输入值不是一个数字的时候总是返回0，即使它是一个可以被解析成数字的字符串或者列表。
3. 添加对R5RS中的symbol-handling functions的支持。symbol是指我们在之前的LispVal类型中被称作Atom的东西。