今回は基本的なS式の評価です。
- 評価する様子が見えるようにtraceを入れてみました。
- 内部データが見えるように Show インスタンスをコメントで無効にし、deriving Show を追加しました。
module Main where import Monad import System.Environment import Text.ParserCombinators.Parsec hiding (spaces) import Debug.Trace main :: IO () main = getArgs >>= putStrLn . show . eval . readExpr . (!! 0) symbol :: Parser Char symbol = oneOf "!$%&|*+-/:<=>?@^_~" readExpr :: String -> LispVal readExpr input = case parse parseExpr "lisp" input of Left err -> String $ "No match: " ++ show err Right val -> val spaces :: Parser () spaces = skipMany1 space data LispVal = Atom String | List [LispVal] | DottedList [LispVal] LispVal | Number Integer | String String | Bool Bool deriving Show -- deriving Show を追加しました。 parseString :: Parser LispVal parseString = do char '"' x <- many (noneOf "\"") char '"' return $ String x parseAtom :: Parser LispVal parseAtom = do first <- letter <|> symbol rest <- many (letter <|> digit <|> symbol) let atom = [first] ++ rest return $ case atom of "#t" -> Bool True "#f" -> Bool False otherwise -> Atom atom parseNumber :: Parser LispVal parseNumber = liftM (Number . read) $ many1 digit parseList :: Parser LispVal parseList = liftM List $ sepBy parseExpr spaces parseDottedList :: Parser LispVal parseDottedList = do head <- endBy parseExpr spaces tail <- char '.' >> spaces >> parseExpr return $ DottedList head tail parseQuoted :: Parser LispVal parseQuoted = do char '\'' x <- parseExpr return $ List [Atom "quote", x] parseExpr :: Parser LispVal parseExpr = parseAtom <|> parseString <|> parseNumber <|> parseQuoted <|> do char '(' x <- (try parseList) <|> parseDottedList char ')' return x showVal :: LispVal -> String showVal (String contents) = "\"" ++ contents ++ "\"" showVal (Atom name) = name showVal (Number contents) = show contents showVal (Bool True) = "#t" showVal (Bool False) = "#f" showVal (List contents) = "(" ++ unwordsList contents ++ ")" showVal (DottedList head tail) = "(" ++ unwordsList head ++ " . " ++ showVal tail ++ ")" unwordsList :: [LispVal] -> String unwordsList = unwords . map showVal -- instance Show LispVal where show = showVal eval :: LispVal -> LispVal eval val@(String _) = val -- eval (String val) = (String val) と同等 eval val@(Number _) = val eval val@(Bool _) = val eval (List [Atom "quote", val]) = val -- リストの先頭を funcとする。 -- リストの先頭以外の args の各要素に eval 適用して評価する。 -- 評価した args に対し func を適用させる。 eval (List (Atom func : args)) = trace("apply{func:"++show func++" args:"++show args++"}") (apply func $ map eval args) -- primitives から func を検索してその結果にargsを適用する。 -- lookup の結果が Nothing の場合は (Bool False)::LispValを返す。 apply :: String -> [LispVal] -> LispVal apply func args = maybe (Bool False) ($ args) $ lookup func primitives -- funcとしてパースされた文字列と意味値に変換する関数のテーブル primitives :: [(String, [LispVal] -> LispVal)] primitives = [("+", numericBinop (+)), ("-", numericBinop (-)), ("*", numericBinop (*)), ("/", numericBinop div), ("mod", numericBinop mod), ("quotient", numericBinop quot), ("remainder", numericBinop rem)] -- op は (+),(-),(*),div,mod,quot,rem の演算子 -- foldl1 により演算子が数値化されたリストに適用されます。 numericBinop :: (Integer -> Integer -> Integer) -> [LispVal] -> LispVal numericBinop op params = trace("numericBinop >" ++ " op:<#> params:"++ show params) (Number $ foldl1 op $ map unpackNum params) unpackNum :: LispVal -> Integer unpackNum (Number n) = n -- (+ 123 "456") のように文字列の場合は数値に変換する。 unpackNum (String n) = let parsed = reads n in if null parsed then 0 else fst $ parsed !! 0 unpackNum (List [n]) = unpackNum n unpackNum _ = 0
評価させてみます。
> eval $ readExpr "(+ 2 2)" apply{func:"+" args:[Number 2,Number 2]} numericBinop > op:<#> params:[Number 2,Number 2] Number 4 -- "-4" と入力したので(wikibooksがそうなっている) lookup の結果が -- Nothing になり (Bool False)の値になった。 > eval $ readExpr "(+ 2 (-4 1))" apply{func:"+" args:[Number 2,List [Atom "-4",Number 1]]} apply{func:"-4" args:[Number 1]} numericBinop > op:<#> params:[Number 2,Bool False] Number 2 > eval $ readExpr "(+ 2 (- 4 1))" apply{func:"+" args:[Number 2,List [Atom "-",Number 4,Number 1]]} apply{func:"-" args:[Number 4,Number 1]} numericBinop > op:<#> params:[Number 4,Number 1] numericBinop > op:<#> params:[Number 2,Number 3] Number 5 > eval $ readExpr "(mod 100 23)" apply{func:"mod" args:[Number 100,Number 23]} numericBinop > op:<#> params:[Number 100,Number 23] Number 8 -- 文字列は数値に変換して計算される。 > eval $ readExpr "(+ \"234\" \"1000\")" apply{func:"+" args:[String "234",String "1000"]} numericBinop > op:<#> params:[String "234",String "1000"] Number 1234
エクササイズ
symbol?, string?, number? のようなタイプをテストする関数を追加しなさいってことですが、symbolが分かっていないので string? と number? を。
-- funcとしてパースされた文字列と意味値に変換する関数のテーブル primitives :: [(String, [LispVal] -> LispVal)] primitives = [("+", numericBinop (+)), ("-", numericBinop (-)), ("*", numericBinop (*)), ("/", numericBinop div), ("mod", numericBinop mod), ("quotient", numericBinop quot), ("remainder", numericBinop rem), ("string?", (\s->case head s of {(String _)->(Bool True);_->(Bool False)})), ("number?", (\s->case head s of {(Number _)->(Bool True);_->(Bool False)}))]
> eval $ readExpr "(string? \"1000\")" apply{func:"string?" args:[String "1000"]} Bool True > eval $ readExpr "(string? 1000)" apply{func:"string?" args:[Number 1000]} Bool False > eval $ readExpr "(number? 1000)" apply{func:"number?" args:[Number 1000]} Bool True > eval $ readExpr "(number? \"1000\")" apply{func:"number?" args:[String "1000"]} Bool False > eval $ readExpr "(number? '())" apply{func:"number?" args:[List [Atom "quote",List []]]} Bool False
