HaskellでLispを書く日記を読んでいたのですけれども、私の能力では Cons のネストを追うのが大変なので、以前に写経した「『Write Yourself a Scheme in 48 Hours』を写経してみる」の続きをやってみます(こっちは出来ない英語なので大変なのですが)。
まず、入力した文字列のパースです。
パースとは何か、ここでは"( 123 'a')" のようなリストを示す文字列を本物のリストにすることです。
module Main where import Monad import System.Environment import Text.ParserCombinators.Parsec hiding (spaces) symbol :: Parser Char symbol = oneOf "!$%&|*+-/:<=>?@^_~#" readExpr input = case parse parseExpr "lisp" input of Left err -> putStrLn $ "No match: " ++ show err Right val -> putStrLn $ "showVal:"++showVal val ++"\nshow :"++ show val retExpr input = case parse parseExpr "lisp" input of Right val -> val spaces :: Parser () spaces = skipMany1 space data LispVal = Atom String | List [LispVal] -- List は LispVal のリスト。ネストしていても良い。 | DottedList [LispVal] LispVal -- (a b c . d) のようなリスト | Number Integer | String String | Bool Bool deriving Show -- show と showVal を両方表示してみるので。 -- instance Show LispVal where show = showVal 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 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 {- > parseTest parseList "(a b c . d)" --> List [DottedList [Atom "a",Atom "b",Atom "c"] (Atom "d")] -} 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
パースした結果の内部データを表示してみます。
> retExpr "a" -- > Atom "a" > retExpr "\"Hello\"" -- > String "Hello" > retExpr "123" -- > Number 123 > retExpr "(abc def)" -- > List [Atom "abc",Atom "def"] > retExpr "(abc def . ghi)" -- > DottedList [Atom "abc",Atom "def"] (Atom "ghi") > retExpr "'(1 '(a b))" -- > List [Atom "quote",List [Number 1,List [Atom "quote",List [Atom "a",Atom "b"]]]]
内部データを showVal を適用させて表示。実際はコメントにした instance Show LispVal where show = showVal によりS式が表示されます。
> let (List xs) = retExpr "'(1 2 abc)" > map showVal xs -- > ["quote","(1 2 abc)"] > unwords $ map showVal xs -- > "quote (1 2 abc)"
パースした結果の内部データを表示するための sohwVal が追加されているので両方表示してみます。
> readExpr "\"Hello,world\"" showVal:"Hello,world" -- 上段:S式表示 show :String "Hello,world" -- 下段:内部のLispVal型 > readExpr "atom" showVal:atom show :Atom "atom" > readExpr "123" showVal:123 show :Number 123 > readExpr "(123 #t #f (nest abc))" showVal:(123 #t #f (nest abc)) show :List [Number 123,Bool True,Bool False,List [Atom "nest",Atom "abc"]] > readExpr "(dotted list . 123)" showVal:(dotted list . 123) show :DottedList [Atom "dotted",Atom "list"] (Number 123)